[COMMITTED,25/35] ada: Disable self-referential with_clauses

Message ID 20241025091107.485741-25-poulhies@adacore.com
State New
Headers
Series [COMMITTED,01/35] ada: Pass parameters of full access unconstrained array types by copy in calls |

Commit Message

Marc Poulhiès Oct. 25, 2024, 9:10 a.m. UTC
  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(-)
  

Patch

diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index bde73b9810b..376c710fc50 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 36254fffd61..dff9bba55a8 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 d23133d5cb6..7728e60ccb6 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 5563a9d385c..29f18a3586c 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 55d54358e46..a9c0fa42b0d 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 d5ea087a4fa..06da3691d46 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 3d43907a08b..23de685de0f 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 c465828c562..24255dac16e 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 2c1a1ee234b..f555b99c15d 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 2edd7604c47..d8928119512 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 e56fe30adae..6e4280b8f10 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 33f6f18c50b..3bc533a30de 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 760d4bebc78..0c25c95c80e 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 0b5f87bd828..23cbe1ac50d 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 b25c46830fd..00df728e950 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 12437cc5a4c..5c32b0ba9b2 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 22ee23aa4ab..cefc8e8f688 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 49e9d90b478..69e60be2966 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 78cc236a73c..8b4c2e31959 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