This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] ada: Enclosing record type name can appear anywhere in an access to subprogram
- From: Samuel Tardieu <sam at rfc1149 dot net>
- To: gcc-patches at gcc dot gnu dot org
- Date: Fri, 7 Dec 2007 03:47:21 +0100
- Subject: [PATCH] ada: Enclosing record type name can appear anywhere in an access to subprogram
- Organisation: RFC1149 (see http://www.rfc1149.net/)
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