diff options
author | Bob Duff <duff@adacore.com> | 2024-10-01 11:29:34 -0400 |
---|---|---|
committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-10-25 11:09:03 +0200 |
commit | 58e34ecbe57586ebc3111e938ebcaa35b188f939 (patch) | |
tree | cbe27457f9ec1f795ca855e60d5f33e8e6f27543 /gcc | |
parent | 5f583c94e505fee54ecbe4b87ea081f6fd3c3874 (diff) | |
download | gcc-58e34ecbe57586ebc3111e938ebcaa35b188f939.zip gcc-58e34ecbe57586ebc3111e938ebcaa35b188f939.tar.gz gcc-58e34ecbe57586ebc3111e938ebcaa35b188f939.tar.bz2 |
ada: Disable self-referential with_clauses
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.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ali.adb | 32 | ||||
-rw-r--r-- | gcc/ada/exp_put_image.adb | 36 | ||||
-rw-r--r-- | gcc/ada/gcc-interface/trans.cc | 4 | ||||
-rw-r--r-- | gcc/ada/gen_il-fields.ads | 2 | ||||
-rw-r--r-- | gcc/ada/gen_il-gen-gen_nodes.adb | 2 | ||||
-rw-r--r-- | gcc/ada/lib-load.adb | 2 | ||||
-rw-r--r-- | gcc/ada/lib-writ.adb | 2 | ||||
-rw-r--r-- | gcc/ada/lib.adb | 2 | ||||
-rw-r--r-- | gcc/ada/rtsfind.adb | 10 | ||||
-rw-r--r-- | gcc/ada/sem_cat.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 124 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sem_elab.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 6 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 4 | ||||
-rw-r--r-- | gcc/ada/sem_util.ads | 2 | ||||
-rw-r--r-- | gcc/ada/sem_warn.adb | 2 | ||||
-rw-r--r-- | gcc/ada/sinfo.ads | 40 |
19 files changed, 152 insertions, 132 deletions
diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index bde73b9..376c710f 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -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 diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb index 36254ff..dff9bba 100644 --- a/gcc/ada/exp_put_image.adb +++ b/gcc/ada/exp_put_image.adb @@ -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; diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc index d23133d..7728e60 100644 --- a/gcc/ada/gcc-interface/trans.cc +++ b/gcc/ada/gcc-interface/trans.cc @@ -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)); diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 5563a9d..29f18a3 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -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, diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 55d5435..a9c0fa4 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -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), diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index d5ea087..06da369 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -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. diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 3d43907..23de685 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -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; diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index c465828..24255da 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -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; diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index 2c1a1ee..f555b99 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -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; diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 2edd760..d892811 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -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 diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index e56fe30..6e4280b 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -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); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 33f6f18..3bc533a 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 760d4be..0c25c95 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -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); diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 0b5f87b..23cbe1a 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -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. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index b25c468..00df728 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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 diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 12437cc..5c32b0b 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -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; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 22ee23a..cefc8e8 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -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 diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 49e9d90..69e60be 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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 diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 78cc236..8b4c2e3 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 |