@@ -2942,24 +2942,22 @@ package body ALI is
Checkc (' ');
Skip_Space;
Withs.Increment_Last;
- Withs.Table (Withs.Last).Uname := Get_Unit_Name;
- Withs.Table (Withs.Last).Elaborate := False;
- Withs.Table (Withs.Last).Elaborate_All := False;
- Withs.Table (Withs.Last).Elab_Desirable := False;
- Withs.Table (Withs.Last).Elab_All_Desirable := False;
- Withs.Table (Withs.Last).SAL_Interface := False;
- Withs.Table (Withs.Last).Limited_With := (C = 'Y');
- Withs.Table (Withs.Last).Implicit_With := (C = 'Z');
+ Withs.Table (Withs.Last) :=
+ (Uname => Get_Unit_Name,
+ Sfile => No_File,
+ Afile => No_File,
+ Elaborate => False,
+ Elaborate_All => False,
+ Elab_Desirable => False,
+ Elab_All_Desirable => False,
+ SAL_Interface => False,
+ Limited_With => (C = 'Y'),
+ Implicit_With => (C = 'Z'));
+
+ -- If At_Eol, then no object file is available; leave Sfile and
+ -- Afile as above (No_File).
- -- Generic case with no object file available
-
- if At_Eol then
- Withs.Table (Withs.Last).Sfile := No_File;
- Withs.Table (Withs.Last).Afile := No_File;
-
- -- Normal case
-
- else
+ if not At_Eol then
Withs.Table (Withs.Last).Sfile := Get_File_Name
(Lower => True);
Withs.Table (Withs.Last).Afile := Get_File_Name
@@ -26,6 +26,7 @@
with Aspects; use Aspects;
with Atree; use Atree;
with Csets; use Csets;
+with Debug; use Debug;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
with Einfo.Utils; use Einfo.Utils;
@@ -37,6 +38,7 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
+with Output; use Output;
with Rtsfind; use Rtsfind;
with Sem_Aux; use Sem_Aux;
with Sem_Util; use Sem_Util;
@@ -1375,8 +1377,19 @@ package body Exp_Put_Image is
-- Preload_Root_Buffer_Type --
------------------------------
+ Preload_Root_Buffer_Type_Done : Boolean := False;
+ -- True if Preload_Root_Buffer_Type has already done its work;
+ -- no need to do it again in that case.
+
+ Debug_Unit_Walk : Boolean renames Debug_Flag_Dot_WW;
+
procedure Preload_Root_Buffer_Type (Compilation_Unit : Node_Id) is
+ Ignore : Entity_Id;
begin
+ if Preload_Root_Buffer_Type_Done then
+ return;
+ end if;
+
-- We can't call RTE (RE_Root_Buffer_Type) for at least some
-- predefined units, because it would introduce cyclic dependences.
-- The package where Root_Buffer_Type is declared, for example, and
@@ -1393,19 +1406,26 @@ package body Exp_Put_Image is
-- RTE (RE_Root_Buffer_Type) when compiling the compiler itself.
-- Packages Ada.Strings.Buffer_Types and friends are not included
-- in the compiler.
- --
- -- Don't do it if type Root_Buffer_Type is unavailable in the runtime.
if not In_Predefined_Unit (Compilation_Unit)
and then Tagged_Seen
and then not No_Run_Time_Mode
- and then RTE_Available (RE_Root_Buffer_Type)
then
- declare
- Ignore : constant Entity_Id := RTE (RE_Root_Buffer_Type);
- begin
- null;
- end;
+ Preload_Root_Buffer_Type_Done := True;
+
+ -- Don't do it if type Root_Buffer_Type is unavailable in the
+ -- runtime.
+
+ if RTE_Available (RE_Root_Buffer_Type) then
+ if Debug_Unit_Walk then
+ Write_Line ("Preload_Root_Buffer_Type: ");
+ Write_Unit_Info
+ (Get_Cunit_Unit_Number (Compilation_Unit),
+ Unit (Compilation_Unit));
+ end if;
+
+ Ignore := RTE (RE_Root_Buffer_Type);
+ end if;
end if;
end Preload_Root_Buffer_Type;
@@ -8204,7 +8204,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_With_Clause:
if (gnat_encodings == DWARF_GNAT_ENCODINGS_ALL
- || Implicit_With (gnat_node)
+ || Is_Implicit_With (gnat_node)
|| Limited_Present (gnat_node))
gnu_result = alloc_stmt_list ();
else
@@ -9541,7 +9541,7 @@ elaborate_all_entities (Node_Id gnat_node)
if (!present_gnu_tree (gnat_node))
save_gnu_tree (gnat_node, integer_zero_node, true);
- /* Save entities in all context units. A body may have an implicit_with
+ /* Save entities in all context units. A body may have an implicit with
on its own spec, if the context includes a child unit, so don't save
the spec twice. */
for (gnat_with_clause = First (Context_Items (gnat_node));
@@ -225,7 +225,6 @@ package Gen_IL.Fields is
Identifier,
Interface_List,
Interface_Present,
- Implicit_With,
Import_Interface_Present,
In_Present,
Includes_Infinities,
@@ -262,6 +261,7 @@ package Gen_IL.Fields is
Is_Parenthesis_Aggregate,
Is_Ignored,
Is_Ignored_Ghost_Pragma,
+ Is_Implicit_With,
Is_In_Discriminant_Check,
Is_Inherited_Pragma,
Is_Initialization_Block,
@@ -1678,7 +1678,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sm (Elaborate_All_Present, Flag),
Sm (Elaborate_Desirable, Flag),
Sm (Elaborate_Present, Flag),
- Sm (Implicit_With, Flag),
+ Sm (Is_Implicit_With, Flag),
Sm (Library_Unit, Node_Id),
Sm (Limited_View_Installed, Flag),
Sm (Next_Implicit_With, Node_Id),
@@ -692,7 +692,7 @@ package body Lib.Load is
-- of being loaded. We do *not* care about a circular chain that
-- leads back to a body, because this kind of circular dependence
-- legitimately occurs (e.g. two package bodies that contain
- -- inlined subprogram referenced by the other).
+ -- inlined subprograms referenced by each other).
-- Ada 2005 (AI-50217): We also ignore limited_with clauses, because
-- their purpose is precisely to create legal circular structures.
@@ -316,7 +316,7 @@ package body Lib.Writ is
return False;
else
- return Implicit_With (Clause);
+ return Is_Implicit_With (Clause);
end if;
end Is_Implicit_With_Clause;
@@ -1335,7 +1335,7 @@ package body Lib is
(Unit_Name
(Get_Cunit_Unit_Number (Library_Unit (Context_Item))));
- if Implicit_With (Context_Item) then
+ if Is_Implicit_With (Context_Item) then
Write_Str (" -- implicit");
end if;
@@ -1310,11 +1310,11 @@ package body Rtsfind is
(U, Defining_Unit_Name (Specification (LibUnit))));
Ghost_Mode := Saved_GM;
- Set_Corresponding_Spec (Withn, U.Entity);
- Set_First_Name (Withn);
- Set_Implicit_With (Withn);
- Set_Library_Unit (Withn, Cunit (U.Unum));
- Set_Next_Implicit_With (Withn, U.First_Implicit_With);
+ Set_Corresponding_Spec (Withn, U.Entity);
+ Set_First_Name (Withn);
+ Set_Is_Implicit_With (Withn);
+ Set_Library_Unit (Withn, Cunit (U.Unum));
+ Set_Next_Implicit_With (Withn, U.First_Implicit_With);
U.First_Implicit_With := Withn;
@@ -1031,7 +1031,7 @@ package body Sem_Cat is
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then
- not (Implicit_With (Item)
+ not (Is_Implicit_With (Item)
or else Limited_Present (Item)
-- Skip if error already posted on the WITH clause (in
@@ -329,7 +329,7 @@ package body Sem_Ch10 is
Clause : Node_Id;
Used : out Boolean;
Withed : out Boolean;
- Exit_On_Self : Boolean := False);
+ Exit_On_Self : Boolean);
-- Examine the context clauses of a package spec, trying to match
-- the name entity of Clause with any list element. If the match
-- occurs on a use package clause, set Used to True, for a with
@@ -472,7 +472,7 @@ package body Sem_Ch10 is
Clause : Node_Id;
Used : out Boolean;
Withed : out Boolean;
- Exit_On_Self : Boolean := False)
+ Exit_On_Self : Boolean)
is
Nam_Ent : constant Entity_Id := Entity (Name (Clause));
Cont_Item : Node_Id;
@@ -488,11 +488,7 @@ package body Sem_Ch10 is
-- already been examined in a previous iteration of the reverse
-- loop in Check_Redundant_Withs.
- if Exit_On_Self
- and Cont_Item = Clause
- then
- exit;
- end if;
+ exit when Exit_On_Self and Cont_Item = Clause;
-- Package use clause
@@ -523,7 +519,7 @@ package body Sem_Ch10 is
elsif Nkind (Cont_Item) = N_With_Clause
and then Comes_From_Source (Cont_Item)
- and then not Implicit_With (Cont_Item)
+ and then not Is_Implicit_With (Cont_Item)
and then not Limited_Present (Cont_Item)
and then Cont_Item /= Clause
and then Entity (Name (Cont_Item)) = Nam_Ent
@@ -545,7 +541,7 @@ package body Sem_Ch10 is
-- clauses or withs that have pragma Elaborate or Elaborate_All.
if Nkind (Clause) = N_With_Clause
- and then not Implicit_With (Clause)
+ and then not Is_Implicit_With (Clause)
and then not Limited_Present (Clause)
and then not Elaborate_Present (Clause)
@@ -570,7 +566,8 @@ package body Sem_Ch10 is
(Context_List => Spec_Context_Items,
Clause => Clause,
Used => Used_In_Spec,
- Withed => Withed_In_Spec);
+ Withed => Withed_In_Spec,
+ Exit_On_Self => False);
Process_Body_Clauses
(Context_List => Context_Items,
@@ -1332,7 +1329,7 @@ package body Sem_Ch10 is
-- Check for explicit with clause
if Nkind (Item) = N_With_Clause
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
-- Ada 2005 (AI-50217): Ignore limited-withed units
@@ -1685,28 +1682,16 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause
and then not Limited_Present (Item)
then
- -- Skip analyzing with clause if no unit, nothing to do (this
- -- happens for a with that references a non-existent unit).
+ -- Skip analyzing with clause if no unit; this happens for a with
+ -- that references a non-existent unit.
if Present (Library_Unit (Item)) then
-
- -- Skip analyzing with clause if this is a with_clause for
- -- the main unit, which happens if a subunit has a useless
- -- with_clause on its parent.
-
- if Library_Unit (Item) /= Cunit (Current_Sem_Unit) then
- Analyze (Item);
-
- -- Here for the case of a useless with for the main unit
-
- else
- Set_Entity (Name (Item), Cunit_Entity (Current_Sem_Unit));
- end if;
+ Analyze (Item);
end if;
-- Do version update (skipped for implicit with)
- if not Implicit_With (Item) then
+ if not Is_Implicit_With (Item) then
Version_Update (N, Library_Unit (Item));
end if;
@@ -1739,7 +1724,7 @@ package body Sem_Ch10 is
-- No need to check errors on implicitly generated limited-with
-- clauses.
- if not Implicit_With (Item) then
+ if not Is_Implicit_With (Item) then
-- Verify that the illegal contexts given in 10.1.2 (18/2) are
-- properly rejected, including renaming declarations.
@@ -1858,7 +1843,7 @@ package body Sem_Ch10 is
-- A limited_with does not impose an elaboration order, but there
-- is a semantic dependency for recompilation purposes.
- if not Implicit_With (Item) then
+ if not Is_Implicit_With (Item) then
Version_Update (N, Library_Unit (Item));
end if;
@@ -2162,8 +2147,7 @@ package body Sem_Ch10 is
if Unum /= No_Unit then
if Debug_Flag_L then
- Write_Str ("*** Loaded subunit from stub. Analyze");
- Write_Eol;
+ Write_Line ("*** Loaded subunit from stub. Analyze");
end if;
Comp_Unit := Cunit (Unum);
@@ -2290,7 +2274,7 @@ package body Sem_Ch10 is
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
then
return True;
end if;
@@ -2396,7 +2380,7 @@ package body Sem_Ch10 is
while Present (Item) loop
if Nkind (Item) = N_With_Clause
and then Limited_Present (Item)
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
then
Semantics (Library_Unit (Item));
end if;
@@ -2957,7 +2941,7 @@ package body Sem_Ch10 is
E_Name : Entity_Id;
Par_Name : Entity_Id;
Pref : Node_Id;
- U : Node_Id;
+ U : constant Node_Id := Unit (Library_Unit (N));
Intunit : Boolean;
-- Set True if the unit currently being compiled is an internal unit
@@ -2969,8 +2953,6 @@ package body Sem_Ch10 is
Save_Style_Check : constant Boolean := Opt.Style_Check;
begin
- U := Unit (Library_Unit (N));
-
-- If this is an internal unit which is a renaming, then this is a
-- violation of No_Obsolescent_Features.
@@ -3034,16 +3016,38 @@ package body Sem_Ch10 is
-- If we are compiling under "don't quit" mode (-gnatq) and we have
-- already detected serious errors then we mark the with-clause nodes as
-- analyzed before the corresponding compilation unit is analyzed. This
- -- is done here to protect the frontend against never ending recursion
+ -- is done here to protect the frontend against infinite recursion
-- caused by circularities in the sources (because the previous errors
- -- may break the regular machine of the compiler implemented in
- -- Load_Unit to detect circularities).
+ -- might break the circularity detection in Load_Unit).
if Serious_Errors_Detected > 0 and then Try_Semantics then
Set_Analyzed (N);
end if;
- Semantics (Library_Unit (N));
+ -- Skip Semantics if this is a with clause for the main unit (e.g.
+ -- "with X;" on the body of X or its subunits), because calling
+ -- Semantics on the spec of X at this point would cause trouble,
+ -- such as duplicate instantiations of generics. Instead, mark the
+ -- self-referential "with" as Is_Implicit_With, to avoid later
+ -- processing done for non-self-referential with clauses. Note that
+ -- we can't simply remove the with clause from the tree, because the
+ -- legality of subsequent (also useless) use clauses depend on the
+ -- presence of the with clause.
+
+ if Library_Unit (N) = Library_Unit (Cunit (Current_Sem_Unit)) then
+ Set_Is_Implicit_With (N);
+
+ -- Self-referential withs are always useless, so warn
+
+ if Warn_On_Redundant_Constructs then
+ Error_Msg_N ("unnecessary with of self?r?", N);
+ end if;
+
+ -- Normal (non-self-referential) case
+
+ else
+ Semantics (Library_Unit (N));
+ end if;
Intunit := Is_Internal_Unit (Current_Sem_Unit);
@@ -3079,7 +3083,7 @@ package body Sem_Ch10 is
if Implementation_Unit_Warnings
and then not Intunit
- and then not Implicit_With (N)
+ and then not Is_Implicit_With (N)
and then not Restriction_Violation
then
case Get_Kind_Of_Unit (Get_Source_Unit (U)) is
@@ -3125,7 +3129,7 @@ package body Sem_Ch10 is
end if;
-- Semantic analysis of a generic unit is performed on a copy of
- -- the original tree. Retrieve the entity on which semantic info
+ -- the original tree. Retrieve the entity on which semantic info
-- actually appears.
if Unit_Kind in N_Generic_Declaration then
@@ -3400,10 +3404,10 @@ package body Sem_Ch10 is
while Present (Item) loop
-- Ada 2005 (AI-262): Allow private_with of a private child package
- -- in public siblings
+ -- in public siblings.
if Nkind (Item) = N_With_Clause
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
and then not Limited_Present (Item)
and then Is_Private_Descendant (Entity (Name (Item)))
then
@@ -3648,7 +3652,7 @@ package body Sem_Ch10 is
begin
Set_Corresponding_Spec (Withn, Ent);
- Set_Implicit_With (Withn);
+ Set_Is_Implicit_With (Withn);
Set_Library_Unit (Withn, Parent (Unit_Declaration_Node (Ent)));
Set_Parent_With (Withn);
@@ -3873,7 +3877,7 @@ package body Sem_Ch10 is
First_Name => True, Last_Name => True);
begin
Set_Corresponding_Spec (Withn, P_Name);
- Set_Implicit_With (Withn);
+ Set_Is_Implicit_With (Withn);
Set_Library_Unit (Withn, P);
Set_Parent_With (Withn);
@@ -3965,7 +3969,7 @@ package body Sem_Ch10 is
-- Case of explicit WITH clause
if Nkind (Item) = N_With_Clause
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
then
if Limited_Present (Item) then
@@ -4443,8 +4447,8 @@ package body Sem_Ch10 is
Set_Parent (Withn, Parent (N));
end if;
- Set_First_Name (Withn);
- Set_Implicit_With (Withn);
+ Set_First_Name (Withn);
+ Set_Is_Implicit_With (Withn);
Set_Limited_Present (Withn);
Unum :=
@@ -4501,7 +4505,8 @@ package body Sem_Ch10 is
Check_Private_Limited_Withed_Unit (Item);
- if not Implicit_With (Item) and then Is_Child_Spec (Unit (N)) then
+ if not Is_Implicit_With (Item) and then Is_Child_Spec (Unit (N))
+ then
Check_Renamings (Parent_Spec (Unit (N)), Item);
end if;
@@ -4748,7 +4753,7 @@ package body Sem_Ch10 is
if Nkind (Item) = N_With_Clause
and then Private_Present (Item)
- and then (not Implicit_With (Item) or else Parent_With (Item))
+ and then (not Is_Implicit_With (Item) or else Parent_With (Item))
then
-- If the unit is an ancestor of the current one, it is the
-- case of a private limited with clause on a child unit, and
@@ -4796,7 +4801,7 @@ package body Sem_Ch10 is
-- until after the specification.
if Nkind (Item) /= N_With_Clause
- or else Implicit_With (Item)
+ or else Is_Implicit_With (Item)
or else Limited_Present (Item)
or else Error_Posted (Item)
@@ -5712,7 +5717,7 @@ package body Sem_Ch10 is
Write_Str ("install private withed unit ");
elsif Parent_With (With_Clause) then
Write_Str ("install parent withed unit ");
- elsif Implicit_With (With_Clause) then
+ elsif Is_Implicit_With (With_Clause) then
Write_Str ("install implicit withed unit ");
else
Write_Str ("install withed unit ");
@@ -6140,8 +6145,7 @@ package body Sem_Ch10 is
if Fatal_Error (Unum) /= Error_Detected or else Try_Semantics then
if Debug_Flag_L then
- Write_Str ("*** Loaded generic body");
- Write_Eol;
+ Write_Line ("*** Loaded generic body");
end if;
-- We always perform analyses
@@ -6748,7 +6752,7 @@ package body Sem_Ch10 is
-- for this special analysis mode.
and then not
- (GNATprove_Mode and then Implicit_With (CI))
+ (GNATprove_Mode and then Is_Implicit_With (CI))
then
Error_Msg_Sloc := Sloc (No_Elab_Code_All_Pragma);
Error_Msg_N
@@ -6918,7 +6922,7 @@ package body Sem_Ch10 is
elsif Current_Sem_Unit = Main_Unit
and then Serious_Errors_Detected = 0
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
then
Set_Is_Immediately_Visible
(Defining_Entity (Unit (Library_Unit (Item))), False);
@@ -7227,8 +7231,7 @@ package body Sem_Ch10 is
if Debug_Flag_I then
Write_Str ("remove limited view of ");
Write_Name (Chars (Pack_Id));
- Write_Str (" from visibility");
- Write_Eol;
+ Write_Line (" from visibility");
end if;
-- The package already appears in the compilation closure. As a result,
@@ -7393,8 +7396,7 @@ package body Sem_Ch10 is
if Debug_Flag_I then
Write_Str ("remove unit ");
Write_Name (Chars (Unit_Name));
- Write_Str (" from visibility");
- Write_Eol;
+ Write_Line (" from visibility");
end if;
Set_Is_Visible_Lib_Unit (Unit_Name, False);
@@ -10671,7 +10671,7 @@ package body Sem_Ch12 is
if OK then
New_I := New_Copy (Item);
- Set_Implicit_With (New_I);
+ Set_Is_Implicit_With (New_I);
Append (New_I, Current_Context);
end if;
@@ -10054,7 +10054,7 @@ package body Sem_Ch8 is
Set_Corresponding_Spec (Withn, System_Aux_Id);
Set_First_Name (Withn);
- Set_Implicit_With (Withn);
+ Set_Is_Implicit_With (Withn);
Set_Library_Unit (Withn, Cunit (Unum));
Insert_After (With_Sys, Withn);
@@ -8482,8 +8482,8 @@ package body Sem_Elab is
Make_With_Clause (Loc,
Name => New_Occurrence_Of (Unit_Id, Loc));
- Set_Implicit_With (Clause);
- Set_Library_Unit (Clause, Unit_Cunit);
+ Set_Is_Implicit_With (Clause);
+ Set_Library_Unit (Clause, Unit_Cunit);
Append_To (Items, Clause);
end if;
@@ -16393,8 +16393,8 @@ package body Sem_Elab is
Name => Name (Itm));
begin
- Set_Library_Unit (CW, Library_Unit (Itm));
- Set_Implicit_With (CW);
+ Set_Is_Implicit_With (CW);
+ Set_Library_Unit (CW, Library_Unit (Itm));
-- Set elaborate all desirable on copy and then append the copy to
-- the list of body with's and we are done.
@@ -16549,15 +16549,15 @@ package body Sem_Prag is
-- In Ada 83 mode, there can be no items following it in the
-- context list except other pragmas and implicit with clauses
- -- (e.g. those added by use of Rtsfind). In Ada 95 mode, this
- -- placement rule does not apply.
+ -- (e.g. those added by Rtsfind). In Ada 95 mode, this placement
+ -- rule does not apply.
if Ada_Version = Ada_83 and then Comes_From_Source (N) then
Citem := Next (N);
while Present (Citem) loop
if Nkind (Citem) = N_Pragma
or else (Nkind (Citem) = N_With_Clause
- and then Implicit_With (Citem))
+ and then Is_Implicit_With (Citem))
then
null;
else
@@ -15254,10 +15254,8 @@ package body Sem_Util is
(E1 : Entity_Id;
E2 : Entity_Id) return Boolean
is
- Par : Entity_Id;
-
+ Par : Entity_Id := E2;
begin
- Par := E2;
while Present (Par) and then Par /= Standard_Standard loop
if Par = E1 then
return True;
@@ -1780,7 +1780,7 @@ package Sem_Util is
function Is_Ancestor_Package
(E1 : Entity_Id;
E2 : Entity_Id) return Boolean;
- -- Determine whether package E1 is an ancestor of E2
+ -- True if package E1 is an ancestor of E2 other than E2 itself
function Is_Atomic_Object (N : Node_Id) return Boolean;
-- Determine whether arbitrary node N denotes a reference to an atomic
@@ -2484,7 +2484,7 @@ package body Sem_Warn is
Item := First (Context_Items (Cnode));
while Present (Item) loop
if Nkind (Item) = N_With_Clause
- and then not Implicit_With (Item)
+ and then not Is_Implicit_With (Item)
and then In_Extended_Main_Source_Unit (Item)
-- Guard for no entity present. Not clear under what conditions
@@ -1494,23 +1494,6 @@ package Sinfo is
-- introduced by these use clauses have priority over global ones,
-- and outer entities must be explicitly hidden/restored on exit.
- -- Implicit_With
- -- Present in N_With_Clause nodes. The flag indicates that the clause
- -- does not comes from source and introduces an implicit dependency on
- -- a particular unit. Such implicit with clauses are generated by:
- --
- -- * ABE mechanism - The static elaboration model of both the default
- -- and the legacy ABE mechanism use with clauses to encode implicit
- -- Elaborate[_All] pragmas.
- --
- -- * Analysis - A with clause for child unit A.B.C is equivalent to
- -- a series of clauses that with A, A.B, and A.B.C. Manipulation of
- -- contexts utilizes implicit with clauses to emulate the visibility
- -- of a particular unit.
- --
- -- * RTSfind - The compiler generates code which references entities
- -- from the runtime.
-
-- Import_Interface_Present
-- This flag is set in an Interface or Import pragma if a matching
-- pragma of the other kind is also present. This is used to avoid
@@ -1740,6 +1723,25 @@ package Sinfo is
-- related to an ignored Ghost entity or encloses ignored Ghost entity.
-- This flag has no relation to Is_Ignored.
+ -- Is_Implicit_With
+ -- Present in N_With_Clause nodes. Indicates that the clause does not
+ -- come from source, or is self referential. Is_Implicit_With is True
+ -- in the following cases:
+ --
+ -- * ABE mechanism - The static elaboration model of both the default
+ -- and the legacy ABE mechanism use with clauses to encode implicit
+ -- Elaborate[_All] pragmas.
+ --
+ -- * Analysis - A with clause for child unit A.B.C is equivalent to
+ -- a series of clauses for A, A.B, and A.B.C.
+ --
+ -- * RTSfind - The compiler generates code that references entities
+ -- from the runtime.
+ --
+ -- * Self-referential withs. If a with clause on the body of X says
+ -- "with X", this is legal but useless. These are not really
+ -- implicit, but are treated as such.
+
-- Is_In_Discriminant_Check
-- This flag is present in a selected component, and is used to indicate
-- that the reference occurs within a discriminant check. The
@@ -6677,7 +6679,7 @@ package Sinfo is
-- both of the flags First_Name and Last_Name are set in this name.
-- Note: in the case of implicit with's that are installed by the
- -- Rtsfind routine, Implicit_With is set, and the Sloc is typically
+ -- Rtsfind routine, Is_Implicit_With is set, and the Sloc is typically
-- set to Standard_Location, but it is incorrect to test the Sloc
-- to find out if a with clause is implicit, test the flag instead.
@@ -6696,7 +6698,7 @@ package Sinfo is
-- Elaborate_All_Present
-- Elaborate_All_Desirable
-- Elaborate_Desirable
- -- Implicit_With
+ -- Is_Implicit_With
-- Limited_View_Installed
-- Parent_With
-- Unreferenced_In_Spec
From: Bob Duff <duff@adacore.com> Self-referential with_clauses (as in package body X says "with X;") cause trouble, such as duplicate nested instantiations when using container packages. This patch disables most of the processing by setting the Is_Implicit_With flag. It's not really implicit, but the subsequent processing behaves as if it is, and coming up with a more accurate (and much longer) name for the flag doesn't seem beneficial for such an obscure case. Note that the spec of X will be processed later, rather than upon seeing "with X;". Other cleanups, such as renaming Implicit_With to be Is_Implicit_With. gcc/ada/ChangeLog: * sem_ch10.adb: (Analyze_With_Clause): Check for self-referential with clause. Give a warning, and set Is_Implicit_With, which we are reusing in this obscure case even though it's not really implicit. (Analyze_Context): Remove check for self-referential with clause. It wasn't correct -- it only triggered for Acts_As_Spec subprograms. Corrected check is now in Analyze_With_Clause. (Implicit_With): Rename to be Is_Implicit_With. Misc cleanup, comment fixes. (Process_Spec_Clauses): Remove default for Exit_On_Self parameter. Use "exit when" instead of if statement. * sinfo.ads (Implicit_With): Rename to be Is_Implicit_With. Document new use for self-referential withs. * ali.adb (Scan_ALI): Use an aggregate to initialize Withs entry. * exp_put_image.adb (Preload_Root_Buffer_Type): Make this a once-only procedure. * sem_util.ads (Is_Ancestor_Package): Fix comment -- a libraryunit is an ancestor of itself, but this doesn't return True in that case. * sem_util.adb (Is_Ancestor_Package): Better to initialize things on their declaration. * lib-load.adb: Minor comment fix. * sem_prag.adb: Implicit_With --> Is_Implicit_With. Minor comment fix. * gen_il-fields.ads: Implicit_With --> Is_Implicit_With. * gen_il-gen-gen_nodes.adb: Likewise * lib.adb: Likewise * lib-writ.adb: Likewise * rtsfind.adb: Likewise * sem_cat.adb: Likewise * sem_ch12.adb: Likewise * sem_ch8.adb: Likewise * sem_elab.adb: Likewise * sem_warn.adb: Likewise * gcc-interface/trans.cc: (Implicit_With): Rename to be Is_Implicit_With. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/ali.adb | 32 ++++---- gcc/ada/exp_put_image.adb | 36 +++++++-- gcc/ada/gcc-interface/trans.cc | 4 +- gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_nodes.adb | 2 +- gcc/ada/lib-load.adb | 2 +- gcc/ada/lib-writ.adb | 2 +- gcc/ada/lib.adb | 2 +- gcc/ada/rtsfind.adb | 10 +-- gcc/ada/sem_cat.adb | 2 +- gcc/ada/sem_ch10.adb | 124 ++++++++++++++++--------------- gcc/ada/sem_ch12.adb | 2 +- gcc/ada/sem_ch8.adb | 2 +- gcc/ada/sem_elab.adb | 8 +- gcc/ada/sem_prag.adb | 6 +- gcc/ada/sem_util.adb | 4 +- gcc/ada/sem_util.ads | 2 +- gcc/ada/sem_warn.adb | 2 +- gcc/ada/sinfo.ads | 40 +++++----- 19 files changed, 152 insertions(+), 132 deletions(-)