This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] ada: Enclosing record type name can appear anywhere in an access to subprogram


RM 8.6(17/2) states that the enclosing record type name denotes the
type itself when used anywhere in a subtype appearing in an access to
subprogram declaration. GNAT only honored this rule for an access type
parameter.  This patch adds handling of non-access parameters as well
as access or non-access result.

Also, the ekind of anonymous access types created for those record components
was set to E_Anonymous_Access_Type while Covers expects them to be of kind
E_Anonymous_Access_Subprogram_Type.

Regtested on i686-pc-linux-gnu.

    gcc/ada/
	PR ada/34366
	* sem_ch3.adb (Designates_T): New function.
	(Mentions_T): Factor reusable part of the logic into Designates_T.
	Consider non-access parameters and access and non-access result.
	(Check_Anonymous_Access_Components): Set ekind of anonymous access to
	E_Subprogram_Type to E_Anonymous_Access_Subprogram_Type.

	* einfo.ads: Update comment for E_Anonymous_Access_Subprogram_Type.

    gcc/testsuite/
	PR ada/34366
	* enclosing_record_reference.ads, enclosing_record_reference.adb: New
	test.
---
 gcc/ada/einfo.ads   |    3 +-
 gcc/ada/sem_ch3.adb |  138 ++++++++++++++++++++++++++++++---------------------
 2 files changed, 84 insertions(+), 57 deletions(-)

diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 8e659f1..08c4815 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3786,7 +3786,8 @@ package Einfo is
 
       E_Anonymous_Access_Subprogram_Type,
       --  An anonymous access to subprogram type, created by an access to
-      --  subprogram declaration.
+      --  subprogram declaration or access record component referencing
+      --  the enclosing record type.
 
       E_Access_Protected_Subprogram_Type,
       --  An access to a protected subprogram, created by the corresponding
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 84e64a5..97b436b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16045,6 +16045,9 @@ package body Sem_Ch3 is
       --  This is done only once, and only if there is no previous partial
       --  view of the type.
 
+      function Designates_T (Subt : Node_Id) return Boolean;
+      --  Check whether a node designates the enclosing record type
+
       function Mentions_T (Acc_Def : Node_Id) return Boolean;
       --  Check whether an access definition includes a reference to
       --  the enclosing record type. The reference can be a subtype
@@ -16133,12 +16136,12 @@ package body Sem_Ch3 is
          end if;
       end Build_Incomplete_Type_Declaration;
 
-      ----------------
-      -- Mentions_T --
-      ----------------
+      ------------------
+      -- Designates_T --
+      ------------------
+
+      function Designates_T (Subt : Node_Id) return Boolean is
 
-      function Mentions_T (Acc_Def : Node_Id) return Boolean is
-         Subt : Node_Id;
          Type_Id : constant Name_Id := Chars (Typ);
 
          function Names_T (Nam : Node_Id) return Boolean;
@@ -16175,75 +16178,94 @@ package body Sem_Ch3 is
             end if;
          end Names_T;
 
-      --  Start of processing for Mentions_T
+      --  Start of processing for Designates_T
 
       begin
-         if No (Access_To_Subprogram_Definition (Acc_Def)) then
-            Subt := Subtype_Mark (Acc_Def);
-
-            if Nkind (Subt) = N_Identifier then
-               return Chars (Subt) = Type_Id;
+         if Nkind (Subt) = N_Identifier then
+            return Chars (Subt) = Type_Id;
 
             --  Reference can be through an expanded name which has not been
             --  analyzed yet, and which designates enclosing scopes.
 
-            elsif Nkind (Subt) = N_Selected_Component then
-               if Names_T (Subt) then
-                  return True;
+         elsif Nkind (Subt) = N_Selected_Component then
+            if Names_T (Subt) then
+               return True;
 
                --  Otherwise it must denote an entity that is already visible.
                --  The access definition may name a subtype of the enclosing
                --  type, if there is a previous incomplete declaration for it.
 
-               else
-                  Find_Selected_Component (Subt);
-                  return
-                    Is_Entity_Name (Subt)
-                      and then Scope (Entity (Subt)) = Current_Scope
-                      and then (Chars (Base_Type (Entity (Subt))) = Type_Id
-                        or else
-                          (Is_Class_Wide_Type (Entity (Subt))
-                            and then
-                              Chars (Etype (Base_Type (Entity (Subt))))
-                                = Type_Id));
-               end if;
-
-            --  A reference to the current type may appear as the prefix of
-            --  a 'Class attribute.
-
-            elsif Nkind (Subt) = N_Attribute_Reference
-              and then Attribute_Name (Subt) = Name_Class
-            then
-               return Names_T (Prefix (Subt));
             else
-               return False;
+               Find_Selected_Component (Subt);
+               return
+                 Is_Entity_Name (Subt)
+                   and then
+                 Scope (Entity (Subt)) = Current_Scope
+                   and then
+                 (Chars (Base_Type (Entity (Subt))) = Type_Id
+                    or else
+                  (Is_Class_Wide_Type (Entity (Subt))
+                     and then
+                   Chars (Etype (Base_Type (Entity (Subt)))) = Type_Id));
             end if;
 
-         else
-            --  Component is an access_to_subprogram: examine its formals
+         --  A reference to the current type may appear as the prefix of
+         --  a 'Class attribute.
 
-            declare
-               Param_Spec : Node_Id;
+         elsif Nkind (Subt) = N_Attribute_Reference
+           and then Attribute_Name (Subt) = Name_Class
+         then
+            return Names_T (Prefix (Subt));
+         end if;
 
-            begin
-               Param_Spec :=
-                 First
-                   (Parameter_Specifications
-                     (Access_To_Subprogram_Definition (Acc_Def)));
-               while Present (Param_Spec) loop
-                  if Nkind (Parameter_Type (Param_Spec))
-                       = N_Access_Definition
-                    and then Mentions_T (Parameter_Type (Param_Spec))
-                  then
-                     return True;
-                  end if;
+         return False;
 
-                  Next (Param_Spec);
-               end loop;
+      end Designates_T;
 
-               return False;
-            end;
+      ----------------
+      -- Mentions_T --
+      ----------------
+
+      function Mentions_T (Acc_Def : Node_Id) return Boolean is
+
+         Param_Spec : Node_Id;
+
+         Acc_Subprg : constant Node_Id :=
+           Access_To_Subprogram_Definition (Acc_Def);
+
+      begin
+         if No (Acc_Subprg) then
+            return Designates_T (Subtype_Mark (Acc_Def));
          end if;
+
+         --  Component is an access_to_subprogram: examine its formals,
+         --  and return type in the case of an access_to_function.
+
+         Param_Spec := First (Parameter_Specifications (Acc_Subprg));
+         while Present (Param_Spec) loop
+            if Nkind (Parameter_Type (Param_Spec)) = N_Access_Definition
+              and then Mentions_T (Parameter_Type (Param_Spec))
+            then
+               return True;
+            elsif Designates_T (Parameter_Type (Param_Spec)) then
+               return True;
+            end if;
+
+            Next (Param_Spec);
+         end loop;
+
+         if Nkind (Acc_Subprg) = N_Access_Function_Definition then
+            if Nkind (Result_Definition (Acc_Subprg)) =
+                 N_Access_Definition
+            then
+               return Mentions_T (Result_Definition (Acc_Subprg));
+            else
+               return Designates_T (Result_Definition (Acc_Subprg));
+            end if;
+         end if;
+
+         return False;
+
       end Mentions_T;
 
    --  Start of processing for Check_Anonymous_Access_Components
@@ -16341,7 +16363,11 @@ package body Sem_Ch3 is
               Make_Component_Definition (Loc,
                 Subtype_Indication =>
                New_Occurrence_Of (Anon_Access, Loc)));
-            Set_Ekind (Anon_Access, E_Anonymous_Access_Type);
+            if Ekind (Designated_Type (Anon_Access)) = E_Subprogram_Type then
+               Set_Ekind (Anon_Access, E_Anonymous_Access_Subprogram_Type);
+            else
+               Set_Ekind (Anon_Access, E_Anonymous_Access_Type);
+            end if;
             Set_Is_Local_Anonymous_Access (Anon_Access);
          end if;
 
-- 
1.5.3.7


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]