aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_ch12.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/sem_ch12.adb')
-rw-r--r--gcc/ada/sem_ch12.adb68
1 files changed, 36 insertions, 32 deletions
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 697c3133334..b84cf1ea8d1 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -634,8 +634,8 @@ package body Sem_Ch12 is
-- loaded. In that case a missing body is acceptable.
procedure Inherit_Context (Gen_Decl : Node_Id; Inst : Node_Id);
- -- Add the context clause of the unit containing a generic unit to an
- -- instantiation that is a compilation unit.
+ -- Add the context clause of the unit containing a generic unit to a
+ -- compilation unit that is, or contains, an instantiation.
function Get_Associated_Node (N : Node_Id) return Node_Id;
-- In order to propagate semantic information back from the analyzed copy
@@ -4360,7 +4360,7 @@ package body Sem_Ch12 is
Old_Main : constant Entity_Id := Cunit_Entity (Main_Unit);
begin
- -- A new compilation unit node is built for the instance declaration
+ -- A new compilation unit node is built for the instance declaration.
Decl_Cunit :=
Make_Compilation_Unit (Sloc (N),
@@ -5740,9 +5740,9 @@ package body Sem_Ch12 is
then
if not Instantiating then
- -- Link both nodes in order to assign subsequently the
- -- entity of the copy to the original node, in case this
- -- is a global reference.
+ -- Link both nodes in order to assign subsequently the entity of
+ -- the copy to the original node, in case this is a global
+ -- reference.
Set_Associated_Node (N, New_N);
@@ -6935,9 +6935,19 @@ package body Sem_Ch12 is
Item := First (Context_Items (Parent (Gen_Decl)));
while Present (Item) loop
if Nkind (Item) = N_With_Clause then
- New_I := New_Copy (Item);
- Set_Implicit_With (New_I, True);
- Append (New_I, Current_Context);
+
+ -- Take care to prevent direct cyclic with's, which can happen
+ -- if the generic body with's the current unit. Such a case
+ -- would result in binder errors (or run-time errors if the
+ -- -gnatE switch is in effect), but we want to prevent it here,
+ -- because Sem.Walk_Library_Items doesn't like cycles. Note
+ -- that we don't bother to detect indirect cycles.
+
+ if Library_Unit (Item) /= Current_Unit then
+ New_I := New_Copy (Item);
+ Set_Implicit_With (New_I, True);
+ Append (New_I, Current_Context);
+ end if;
end if;
Next (Item);
@@ -8777,12 +8787,12 @@ package body Sem_Ch12 is
Act_Decl : constant Node_Id := Body_Info.Act_Decl;
Inst_Node : constant Node_Id := Body_Info.Inst_Node;
Loc : constant Source_Ptr := Sloc (Inst_Node);
- Gen_Id : constant Node_Id := Name (Inst_Node);
- Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node);
- Gen_Decl : constant Node_Id := Unit_Declaration_Node (Gen_Unit);
- Anon_Id : constant Entity_Id :=
+ Gen_Id : constant Node_Id := Name (Inst_Node);
+ Gen_Unit : constant Entity_Id := Get_Generic_Entity (Inst_Node);
+ Gen_Decl : constant Node_Id := Unit_Declaration_Node (Gen_Unit);
+ Anon_Id : constant Entity_Id :=
Defining_Unit_Name (Specification (Act_Decl));
- Pack_Id : constant Entity_Id :=
+ Pack_Id : constant Entity_Id :=
Defining_Unit_Name (Parent (Act_Decl));
Decls : List_Id;
Gen_Body : Node_Id;
@@ -11867,6 +11877,8 @@ package body Sem_Ch12 is
-- transformation is propagated to the generic unit.
procedure Save_References (N : Node_Id) is
+ Loc : constant Source_Ptr := Sloc (N);
+
begin
if N = Empty then
null;
@@ -12008,10 +12020,8 @@ package body Sem_Ch12 is
elsif Nkind (N2) = N_Explicit_Dereference then
- -- An identifier is rewritten as a dereference if it is
- -- the prefix in a selected component, and it denotes an
- -- access to a composite type, or a parameterless function
- -- call that returns an access type.
+ -- An identifier is rewritten as a dereference if it is the
+ -- prefix in an implicit dereference.
-- Check whether corresponding entity in prefix is global
@@ -12020,23 +12030,18 @@ package body Sem_Ch12 is
and then Is_Global (Entity (Prefix (N2)))
then
Rewrite (N,
- Make_Explicit_Dereference (Sloc (N),
- Prefix => Make_Identifier (Sloc (N),
- Chars => Chars (N))));
- Set_Associated_Node (Prefix (N), Prefix (N2));
-
+ Make_Explicit_Dereference (Loc,
+ Prefix =>
+ New_Occurrence_Of (Entity (Prefix (N2)), Loc)));
elsif Nkind (Prefix (N2)) = N_Function_Call
and then Is_Global (Entity (Name (Prefix (N2))))
then
Rewrite (N,
- Make_Explicit_Dereference (Sloc (N),
- Prefix => Make_Function_Call (Sloc (N),
- Name =>
- Make_Identifier (Sloc (N),
- Chars => Chars (N)))));
-
- Set_Associated_Node
- (Name (Prefix (N)), Name (Prefix (N2)));
+ Make_Explicit_Dereference (Loc,
+ Prefix => Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (Entity (Name (Prefix (N2))),
+ Loc))));
else
Set_Associated_Node (N, Empty);
@@ -12063,7 +12068,6 @@ package body Sem_Ch12 is
else
declare
- Loc : constant Source_Ptr := Sloc (N);
Qual : Node_Id := Empty;
Typ : Entity_Id := Empty;
Nam : Node_Id;