[Ada] Encoding of with clauses in ALI files
authorHristian Kirtchev <kirtchev@adacore.com>
Thu, 11 Jan 2018 08:51:13 +0000 (08:51 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 11 Jan 2018 08:51:13 +0000 (08:51 +0000)
This patch modifies the encodings of with clauses in ALI files to adhere to the
existing API. The encodigs are as follows:

   * Explicit with clauses are encoded on a 'W' line (same as before).

   * Implicit with clauses for ancestor units are encoded on a 'W' line (same
     as before).

   * Limited_with clauses are encoded on a 'Y' line (same as before).

   * ABE and RTSfind-related with clauses are encoded on a 'Z' line.

------------
-- Source --
------------

--  case_10_func.adb

function Case_10_Func return Boolean is
begin
   return True;
end Case_10_Func;

--  case_10_gen_func.ads

generic
function Case_10_Gen_Func return Boolean;

--  case_10_gen_func.adb

function Case_10_Gen_Func return Boolean is
begin
   return True;
end Case_10_Gen_Func;

--  case_10_tasks.ads

package Case_10_Tasks is
   task type Task_Typ is
   end Task_Typ;
end Case_10_Tasks;

--  case_10_tasks.adb

package body Case_10_Tasks is
   task body Task_Typ is begin null; end Task_Typ;
end Case_10_Tasks;

--  case_10_gen.ads

with Case_10_Func;
with Case_10_Gen_Func;
with Case_10_Tasks;

generic
package Case_10_Gen is
   Val : constant Boolean := Case_10_Func;

   function Inst is new Case_10_Gen_Func;

   Tsk : Case_10_Tasks.Task_Typ;
end Case_10_Gen;

--  case_10.ads

with Case_10_Gen;

package Case_10 is
   package Inst is new Case_10_Gen;
end Case_10;

----------------------------
-- Compilation and output --
----------------------------

$ gcc -c case_10.ads
$ grep "W " case_10.ali | sort
$ grep "Z " case_10.ali | sort
W case_10_gen%s case_10_gen.ads case_10_gen.ali
Z case_10_func%b case_10_func.adb case_10_func.ali
Z case_10_gen_func%s case_10_gen_func.adb case_10_gen_func.ali  ED
Z case_10_tasks%s case_10_tasks.adb case_10_tasks.ali  AD
Z system.soft_links%s s-soflin.adb s-soflin.ali
Z system.tasking%s s-taskin.adb s-taskin.ali
Z system.tasking.stages%s  s-tassta.adb s-tassta.ali

2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

* ali.adb: Document the remaining letters available for ALI lines.
(Scan_ALI): A with clause is internal when it is encoded on a 'Z' line.
* ali.ads: Update type With_Record. Field
Implicit_With_From_Instantiation is no longer in use. Add field
Implicit_With.
* csinfo.adb (CSinfo): Remove the setup for attribute
Implicit_With_From_Instantiation.
* lib-writ.adb (Collect_Withs): Correct the logic which marks a unit as
either implicitly or explicitly withed.
(Is_Implicit_With_Clause): New routine.
(Write_ALI): Rename array Implicit_With to Has_Implicit_With to avoid
confusion with the with clause attribute by the same name.
(Write_With_Lines): Update the emission of 'W', 'Y', and 'Z' headers.
* rtsfind.adb (Maybe_Add_With): Code cleanup.
* sem_ch8.adb (Present_System_Aux): Code cleanup.
* sem_ch10.adb (Expand_With_Clause): Mark the with clause as generated
for a parent unit.
(Implicit_With_On_Parent): Mark the with clause as generated for a
parent unit.
* sem_ch12.adb (Inherit_Context): With clauses inherited by an
instantiation are no longer marked as Implicit_With_From_Instantiation
because they are already marked as implicit.
* sem_elab.adb (Ensure_Prior_Elaboration_Static): Remove the kludge
which marks implicit with clauses as related to an instantiation.
* sinfo.adb (Implicit_With_From_Instantiation): Removed.
(Parent_With): New routine.
(Set_Implicit_With_From_Instantiation): Removed.
(Set_Parent_With): New routine.
* sinfo.ads: Update the documentation of attribute Implicit_With.
Remove attribute Implicit_With_From_Instantiation along with
occurrences in nodes.  Add attribute Parent_With along with occurrences
in nodes.
(Implicit_With_From_Instantiation): Removed along with pragma Inline.
(Parent_With): New routine along with pragma Inline.
(Set_Implicit_With_From_Instantiation): Removed along with pragma Inline.
(Set_Parent_With): New routine along with pragma Inline.

From-SVN: r256490

12 files changed:
gcc/ada/ChangeLog
gcc/ada/ali.adb
gcc/ada/ali.ads
gcc/ada/csinfo.adb
gcc/ada/lib-writ.adb
gcc/ada/rtsfind.adb
gcc/ada/sem_ch10.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch8.adb
gcc/ada/sem_elab.adb
gcc/ada/sinfo.adb
gcc/ada/sinfo.ads

index d05467d69f96d63b819f123187fa4625ca3a3600..550b760849704be74cddbb6a804c1c46f4e7ede9 100644 (file)
@@ -1,3 +1,42 @@
+2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * ali.adb: Document the remaining letters available for ALI lines.
+       (Scan_ALI): A with clause is internal when it is encoded on a 'Z' line.
+       * ali.ads: Update type With_Record. Field
+       Implicit_With_From_Instantiation is no longer in use. Add field
+       Implicit_With.
+       * csinfo.adb (CSinfo): Remove the setup for attribute
+       Implicit_With_From_Instantiation.
+       * lib-writ.adb (Collect_Withs): Correct the logic which marks a unit as
+       either implicitly or explicitly withed.
+       (Is_Implicit_With_Clause): New routine.
+       (Write_ALI): Rename array Implicit_With to Has_Implicit_With to avoid
+       confusion with the with clause attribute by the same name.
+       (Write_With_Lines): Update the emission of 'W', 'Y', and 'Z' headers.
+       * rtsfind.adb (Maybe_Add_With): Code cleanup.
+       * sem_ch8.adb (Present_System_Aux): Code cleanup.
+       * sem_ch10.adb (Expand_With_Clause): Mark the with clause as generated
+       for a parent unit.
+       (Implicit_With_On_Parent): Mark the with clause as generated for a
+       parent unit.
+       * sem_ch12.adb (Inherit_Context): With clauses inherited by an
+       instantiation are no longer marked as Implicit_With_From_Instantiation
+       because they are already marked as implicit.
+       * sem_elab.adb (Ensure_Prior_Elaboration_Static): Remove the kludge
+       which marks implicit with clauses as related to an instantiation.
+       * sinfo.adb (Implicit_With_From_Instantiation): Removed.
+       (Parent_With): New routine.
+       (Set_Implicit_With_From_Instantiation): Removed.
+       (Set_Parent_With): New routine.
+       * sinfo.ads: Update the documentation of attribute Implicit_With.
+       Remove attribute Implicit_With_From_Instantiation along with
+       occurrences in nodes.  Add attribute Parent_With along with occurrences
+       in nodes.
+       (Implicit_With_From_Instantiation): Removed along with pragma Inline.
+       (Parent_With): New routine along with pragma Inline.
+       (Set_Implicit_With_From_Instantiation): Removed along with pragma Inline.
+       (Set_Parent_With): New routine along with pragma Inline.
+
 2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * sem_util.adb (Find_Enclosing_Scope): Return the unique defining
index 959b30587280b809442c1acf3f8502c34293d90a..b40e8cf6dd4070acf19b7aaeb39af76dec5fc426 100644 (file)
@@ -35,9 +35,11 @@ package body ALI is
    use ASCII;
    --  Make control characters visible
 
-   --  The following variable records which characters currently are
-   --  used as line type markers in the ALI file. This is used in
-   --  Scan_ALI to detect (or skip) invalid lines.
+   --  The following variable records which characters currently are used as
+   --  line type markers in the ALI file. This is used in Scan_ALI to detect
+   --  (or skip) invalid lines. The following letters are still available:
+   --
+   --    B G H J K O Q Z
 
    Known_ALI_Lines : constant array (Character range 'A' .. 'Z') of Boolean :=
      ('V'    => True,   -- version
@@ -2028,8 +2030,7 @@ package body ALI is
                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_From_Instantiation
-                                                           := (C = 'Z');
+               Withs.Table (Withs.Last).Implicit_With      := (C = 'Z');
 
                --  Generic case with no object file available
 
index 3fa4d99fb09c32c697de1c2180871e6919ec7de3..60454abeadeb6849cdbf1cf4eac16cff3e9931cd 100644 (file)
@@ -82,7 +82,6 @@ package ALI is
    --  Indicator of whether unit can be used as main program
 
    type ALIs_Record is record
-
       Afile : File_Name_Type;
       --  Name of ALI file
 
@@ -226,7 +225,6 @@ package ALI is
       --  Last_Specific_Dispatching = First_Specific_Dispatching - 1. That
       --  is why the 'Base reference is there, it can be one less than the
       --  lower bound of the subtype. Not set if 'S' appears in Ignore_Lines.
-
    end record;
 
    No_Main_Priority : constant Int := -1;
@@ -265,7 +263,6 @@ package ALI is
    --  Version string, taken from unit record
 
    type Unit_Record is record
-
       My_ALI : ALI_Id;
       --  Corresponding ALI entry
 
@@ -568,7 +565,6 @@ package ALI is
    --  Id of first actual entry in table
 
    type With_Record is record
-
       Uname : Unit_Name_Type;
       --  Name of Unit
 
@@ -587,17 +583,17 @@ package ALI is
       Elab_All_Desirable : Boolean;
       --  Indicates presence of AD parameter
 
-      Elab_Desirable     : Boolean;
+      Elab_Desirable : Boolean;
       --  Indicates presence of ED parameter
 
       SAL_Interface : Boolean := False;
       --  True if the Unit is an Interface of a Stand-Alone Library
 
-      Limited_With : Boolean := False;
-      --  True if unit is named in a limited_with_clause
+      Implicit_With : Boolean := False;
+      --  True if this is an implicit with generated by the compiler
 
-      Implicit_With_From_Instantiation : Boolean := False;
-      --  True if this is an implicit with from a generic instantiation
+      Limited_With : Boolean := False;
+      --  True if this is a limited_with_clause
    end record;
 
    package Withs is new Table.Table (
@@ -778,7 +774,6 @@ package ALI is
    --  successive ALI files are scanned.
 
    type Sdep_Record is record
-
       Sfile : File_Name_Type;
       --  Name of source file
 
index 1a71a2ef6db955deb34aa6b1c51ee09faa9089f1..c6608995c6f0eb3f7e2b3a4be444e382664ae651 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -218,7 +218,6 @@ begin
    Set (Special, "Has_Dynamic_Range_Check",          True);
    Set (Special, "Has_Dynamic_Length_Check",         True);
    Set (Special, "Has_Private_View",                 True);
-   Set (Special, "Implicit_With_From_Instantiation", True);
    Set (Special, "Is_Controlling_Actual",            True);
    Set (Special, "Is_Overloaded",                    True);
    Set (Special, "Is_Static_Expression",             True);
index 1ee329ee7f1a890e3d1b562d87a0ec6ebb80f77c..553bda20b5fc2afdd53cf3b8f289e76b52688335 100644 (file)
@@ -215,9 +215,9 @@ package body Lib.Writ is
       --  Array of flags to show which units have Elaborate_All_Desirable set
 
       type Yes_No is (Unknown, Yes, No);
-      Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
+      Has_Implicit_With : array (Units.First .. Last_Unit) of Yes_No;
       --  Indicates if an implicit with has been given for the unit. Yes if
-      --  certainly present, no if certainly absent, unkonwn if not known.
+      --  certainly present, No if certainly absent, Unknown if not known.
 
       Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
       --  Sorted table of source dependencies. One extra entry in case we
@@ -235,8 +235,8 @@ package body Lib.Writ is
       -----------------------
 
       procedure Collect_Withs (Cunit : Node_Id);
-      --  Collect with lines for entries in the context clause of the
-      --  given compilation unit, Cunit.
+      --  Collect with lines for entries in the context clause of the given
+      --  compilation unit, Cunit.
 
       procedure Update_Tables_From_ALI_File;
       --  Given an up to date ALI file (see Up_To_Date_ALI_file_Exists
@@ -261,9 +261,47 @@ package body Lib.Writ is
       -------------------
 
       procedure Collect_Withs (Cunit : Node_Id) is
+         function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean;
+         pragma Inline (Is_Implicit_With_Clause);
+         --  Determine whether a with clause denoted by Clause is implicit
+
+         -----------------------------
+         -- Is_Implicit_With_Clause --
+         -----------------------------
+
+         function Is_Implicit_With_Clause (Clause : Node_Id) return Boolean is
+         begin
+            --  With clauses created for ancestor units are marked as internal,
+            --  however, they emulate the semantics in Ada RM 10.1.2 (6/2),
+            --  where
+            --
+            --    with A.B;
+            --
+            --  is almost equivalent to
+            --
+            --    with A;
+            --    with A.B;
+            --
+            --  For ALI encoding purposes, they are considered to be explicit.
+            --  Note that the clauses cannot be marked as explicit because they
+            --  will be subjected to various checks related to with clauses and
+            --  possibly cause false positives.
+
+            if Parent_With (Clause) then
+               return False;
+
+            else
+               return Implicit_With (Clause);
+            end if;
+         end Is_Implicit_With_Clause;
+
+         --  Local variables
+
          Item : Node_Id;
          Unum : Unit_Number_Type;
 
+      --  Start of processing for Collect_Withs
+
       begin
          Item := First (Context_Items (Cunit));
          while Present (Item) loop
@@ -300,12 +338,28 @@ package body Lib.Writ is
                   Set_From_Limited_With (Cunit_Entity (Unum));
                end if;
 
-               if Implicit_With (Unum) /= Yes then
-                  if Implicit_With_From_Instantiation (Item) then
-                     Implicit_With (Unum) := Yes;
+               if Is_Implicit_With_Clause (Item) then
+
+                  --  A previous explicit with clause withs the unit. Retain
+                  --  this classification, as it reflects the source relations
+                  --  between units.
+
+                  if Has_Implicit_With (Unum) = No then
+                     null;
+
+                  --  Otherwise this is either the first time any clause withs
+                  --  the unit, or the unit is already implicitly withed.
+
                   else
-                     Implicit_With (Unum) := No;
+                     Has_Implicit_With (Unum) := Yes;
                   end if;
+
+               --  Otherwise the current with clause is explicit. Such clauses
+               --  take precedence over existing implicit clauses because they
+               --  reflect the source relations between unit.
+
+               else
+                  Has_Implicit_With (Unum) := No;
                end if;
             end if;
 
@@ -573,7 +627,7 @@ package body Lib.Writ is
             Elab_All_Flags     (J) := False;
             Elab_Des_Flags     (J) := False;
             Elab_All_Des_Flags (J) := False;
-            Implicit_With      (J) := Unknown;
+            Has_Implicit_With  (J) := Unknown;
          end loop;
 
          Collect_Withs (Unode);
@@ -853,14 +907,17 @@ package body Lib.Writ is
             Uname := Units.Table (Unum).Unit_Name;
             Fname := Units.Table (Unum).Unit_File_Name;
 
-            if Implicit_With (Unum) = Yes then
-               Write_Info_Initiate ('Z');
+            --  Limited with clauses must be processed first because they are
+            --  the most specific among the three kinds.
 
-            elsif Ekind (Cunit_Entity (Unum)) = E_Package
+            if Ekind (Cunit_Entity (Unum)) = E_Package
               and then From_Limited_With (Cunit_Entity (Unum))
             then
                Write_Info_Initiate ('Y');
 
+            elsif Has_Implicit_With (Unum) = Yes then
+               Write_Info_Initiate ('Z');
+
             else
                Write_Info_Initiate ('W');
             end if;
index e3af27d31f4b61a55e9364469e9d189aad4948c1..879eb45a4afdfc92fdc78e7f98d5678d9361118b 100644 (file)
@@ -1124,15 +1124,15 @@ package body Rtsfind is
          end loop;
 
          Withn :=
-            Make_With_Clause (Standard_Location,
-              Name =>
-                Make_Unit_Name
-                  (U, Defining_Unit_Name (Specification (LibUnit))));
+           Make_With_Clause (Standard_Location,
+             Name =>
+               Make_Unit_Name
+                 (U, Defining_Unit_Name (Specification (LibUnit))));
 
-         Set_Library_Unit        (Withn, Cunit (U.Unum));
          Set_Corresponding_Spec  (Withn, U.Entity);
-         Set_First_Name          (Withn, True);
-         Set_Implicit_With       (Withn, True);
+         Set_First_Name          (Withn);
+         Set_Implicit_With       (Withn);
+         Set_Library_Unit        (Withn, Cunit (U.Unum));
          Set_Next_Implicit_With  (Withn, U.First_Implicit_With);
 
          U.First_Implicit_With := Withn;
index 0616a201b79bff0f497edd09c14e74fee94885ec..4b828c9f4f0c32a567ec9901631f71f66a0fdbf2 100644 (file)
@@ -472,8 +472,8 @@ package body Sem_Ch10 is
                --  visibility analysis, but is also not redundant.
 
                elsif Nkind (Cont_Item) = N_With_Clause
-                 and then not Implicit_With (Cont_Item)
                  and then Comes_From_Source (Cont_Item)
+                 and then not Implicit_With (Cont_Item)
                  and then not Limited_Present (Cont_Item)
                  and then Cont_Item /= Clause
                  and then Entity (Name (Cont_Item)) = Nam_Ent
@@ -517,16 +517,16 @@ package body Sem_Ch10 is
 
                   begin
                      Process_Spec_Clauses
-                      (Context_List => Spec_Context_Items,
-                       Clause       => Clause,
-                       Used         => Used_In_Spec,
-                       Withed       => Withed_In_Spec);
+                       (Context_List => Spec_Context_Items,
+                        Clause       => Clause,
+                        Used         => Used_In_Spec,
+                        Withed       => Withed_In_Spec);
 
                      Process_Body_Clauses
-                      (Context_List      => Context_Items,
-                       Clause            => Clause,
-                       Used              => Used_In_Body,
-                       Used_Type_Or_Elab => Used_Type_Or_Elab);
+                       (Context_List      => Context_Items,
+                        Clause            => Clause,
+                        Used              => Used_In_Body,
+                        Used_Type_Or_Elab => Used_Type_Or_Elab);
 
                      --  "Type Elab" refers to the presence of either a use
                      --  type clause, pragmas Elaborate or Elaborate_All.
@@ -555,29 +555,29 @@ package body Sem_Ch10 is
                           ("redundant with clause in body?r?", Clause);
                      end if;
 
-                     Used_In_Body := False;
-                     Used_In_Spec := False;
+                     Used_In_Body      := False;
+                     Used_In_Spec      := False;
                      Used_Type_Or_Elab := False;
-                     Withed_In_Spec := False;
+                     Withed_In_Spec    := False;
                   end;
 
                --  Standalone package spec or body check
 
                else
                   declare
-                     Dont_Care : Boolean := False;
-                     Withed    : Boolean := False;
+                     Dummy  : Boolean := False;
+                     Withed : Boolean := False;
 
                   begin
                      --  The mechanism for examining the context clauses of a
                      --  package spec can be applied to package body clauses.
 
                      Process_Spec_Clauses
-                      (Context_List => Context_Items,
-                       Clause       => Clause,
-                       Used         => Dont_Care,
-                       Withed       => Withed,
-                       Exit_On_Self => True);
+                       (Context_List => Context_Items,
+                        Clause       => Clause,
+                        Used         => Dummy,
+                        Withed       => Withed,
+                        Exit_On_Self => True);
 
                      if Withed then
                         Error_Msg_N -- CODEFIX
@@ -1058,7 +1058,7 @@ package body Sem_Ch10 is
                if Nkind (Item) = N_With_Clause
                  and then not Implicit_With (Item)
 
-                  --  Ada 2005 (AI-50217): Ignore limited-withed units
+                 --  Ada 2005 (AI-50217): Ignore limited-withed units
 
                  and then not Limited_Present (Item)
                then
@@ -1487,8 +1487,9 @@ package body Sem_Ch10 is
                      P := Parent_Spec (Unit (N));
                      loop
                         if Unit (P) = Lib_U then
-                           Error_Msg_N ("limited with_clause cannot "
-                                        & "name ancestor", Item);
+                           Error_Msg_N
+                             ("limited with_clause cannot name ancestor",
+                              Item);
                            exit;
                         end if;
 
@@ -1539,13 +1540,11 @@ package body Sem_Ch10 is
                               then
                                  Error_Msg_Sloc := Sloc (It);
                                  Error_Msg_N
-                                   ("simultaneous visibility of limited "
-                                    & "and unlimited views not allowed",
-                                    Item);
+                                   ("simultaneous visibility of limited and "
+                                    & "unlimited views not allowed", Item);
                                  Error_Msg_NE
-                                   ("\unlimited view visible through "
-                                    & "context clause #",
-                                    Item, It);
+                                   ("\unlimited view visible through context "
+                                    & "clause #", Item, It);
                                  exit;
 
                               elsif Nkind (Unit_Name) = N_Identifier then
@@ -1572,15 +1571,15 @@ package body Sem_Ch10 is
                Analyze (Item);
             end if;
 
-            --  A limited_with does not impose an elaboration order, but
-            --  there is a semantic dependency for recompilation purposes.
+            --  A limited_with does not impose an elaboration order, but there
+            --  is a semantic dependency for recompilation purposes.
 
             if not Implicit_With (Item) then
                Version_Update (N, Library_Unit (Item));
             end if;
 
-            --  Pragmas and use clauses and with clauses other than limited
-            --  with's are ignored in this pass through the context items.
+         --  Pragmas and use clauses and with clauses other than limited with's
+         --  are ignored in this pass through the context items.
 
          else
             null;
@@ -2632,8 +2631,8 @@ package body Sem_Ch10 is
                      Error_Msg_F ("\use ""~"" instead?i?", Name (N));
                   else
                      Error_Msg_F
-                       ("\use of this unit is non-portable " &
-                        "and version-dependent?i?", Name (N));
+                       ("\use of this unit is non-portable and "
+                        & "version-dependent?i?", Name (N));
                   end if;
 
                elsif U_Kind = Ada_2005_Unit
@@ -2999,7 +2998,7 @@ package body Sem_Ch10 is
                   then
                      Error_Msg_NE
                        ("& is a nested package, not a compilation unit",
-                       Name (Item), Priv_Child);
+                        Name (Item), Priv_Child);
 
                   else
                      Error_Msg_N
@@ -3027,7 +3026,6 @@ package body Sem_Ch10 is
 
          Next (Item);
       end loop;
-
    end Check_Private_Child_Unit;
 
    ----------------------
@@ -3063,10 +3061,7 @@ package body Sem_Ch10 is
    ------------------------
 
    procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id) is
-      Loc   : constant Source_Ptr := Sloc (Nam);
-      Ent   : constant Entity_Id := Entity (Nam);
-      Withn : Node_Id;
-      P     : Node_Id;
+      Loc : constant Source_Ptr := Sloc (Nam);
 
       function Build_Unit_Name (Nam : Node_Id) return Node_Id;
       --  Build name to be used in implicit with_clause. In most cases this
@@ -3093,8 +3088,8 @@ package body Sem_Ch10 is
             if Present (Entity (Selector_Name (Nam)))
               and then Chars (Entity (Selector_Name (Nam))) /= Chars (Ent)
               and then
-                Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam))))
-                  N_Package_Renaming_Declaration
+                Nkind (Unit_Declaration_Node (Entity (Selector_Name (Nam)))) =
+                  N_Package_Renaming_Declaration
             then
                --  The name in the with_clause is of the form A.B.C, and B is
                --  given by a renaming declaration. In that case we may not
@@ -3111,14 +3106,20 @@ package body Sem_Ch10 is
 
             Result :=
               Make_Expanded_Name (Loc,
-                Chars  => Chars (Entity (Nam)),
-                Prefix => Build_Unit_Name (Prefix (Nam)),
+                Chars         => Chars (Entity (Nam)),
+                Prefix        => Build_Unit_Name (Prefix (Nam)),
                 Selector_Name => New_Occurrence_Of (Ent, Loc));
             Set_Entity (Result, Ent);
+
             return Result;
          end if;
       end Build_Unit_Name;
 
+      --  Local variables
+
+      Ent   : constant Entity_Id  := Entity (Nam);
+      Withn : Node_Id;
+
    --  Start of processing for Expand_With_Clause
 
    begin
@@ -3126,18 +3127,18 @@ package body Sem_Ch10 is
         Make_With_Clause (Loc,
           Name => Build_Unit_Name (Nam));
 
-      P := Parent (Unit_Declaration_Node (Ent));
-      Set_Library_Unit       (Withn, P);
       Set_Corresponding_Spec (Withn, Ent);
-      Set_First_Name         (Withn, True);
-      Set_Implicit_With      (Withn, True);
+      Set_First_Name         (Withn);
+      Set_Implicit_With      (Withn);
+      Set_Library_Unit       (Withn, Parent (Unit_Declaration_Node (Ent)));
+      Set_Parent_With        (Withn);
 
       --  If the unit is a package or generic package declaration, a private_
       --  with_clause on a child unit implies that the implicit with on the
       --  parent is also private.
 
-      if Nkind_In (Unit (N), N_Package_Declaration,
-                             N_Generic_Package_Declaration)
+      if Nkind_In (Unit (N), N_Generic_Package_Declaration,
+                             N_Package_Declaration)
       then
          Set_Private_Present (Withn, Private_Present (Item));
       end if;
@@ -3277,8 +3278,8 @@ package body Sem_Ch10 is
          P_Spec : Node_Id := P;
 
       begin
-         --  Ancestor may have been rewritten as a package body. Retrieve
-         --  the original spec to trace earlier ancestors.
+         --  Ancestor may have been rewritten as a package body. Retrieve the
+         --  original spec to trace earlier ancestors.
 
          if Nkind (P) = N_Package_Body
            and then Nkind (Original_Node (P)) = N_Package_Instantiation
@@ -3291,7 +3292,8 @@ package body Sem_Ch10 is
          else
             return
               Make_Selected_Component (Loc,
-                Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P_Spec))),
+                Prefix        =>
+                  Build_Ancestor_Name (Unit (Parent_Spec (P_Spec))),
                 Selector_Name => P_Ref);
          end if;
       end Build_Ancestor_Name;
@@ -3310,10 +3312,12 @@ package body Sem_Ch10 is
          else
             Result :=
               Make_Expanded_Name (Loc,
-                Chars  => Chars (P_Name),
-                Prefix => Build_Ancestor_Name (Unit (Parent_Spec (P_Unit))),
+                Chars         => Chars (P_Name),
+                Prefix        =>
+                  Build_Ancestor_Name (Unit (Parent_Spec (P_Unit))),
                 Selector_Name => New_Occurrence_Of (P_Name, Loc));
             Set_Entity (Result, P_Name);
+
             return Result;
          end if;
       end Build_Unit_Name;
@@ -3343,10 +3347,11 @@ package body Sem_Ch10 is
 
       Withn := Make_With_Clause (Loc, Name => Build_Unit_Name);
 
-      Set_Library_Unit          (Withn, P);
-      Set_Corresponding_Spec    (Withn, P_Name);
-      Set_First_Name            (Withn, True);
-      Set_Implicit_With         (Withn, True);
+      Set_Corresponding_Spec (Withn, P_Name);
+      Set_First_Name         (Withn);
+      Set_Implicit_With      (Withn);
+      Set_Library_Unit       (Withn, P);
+      Set_Parent_With        (Withn);
 
       --  Node is placed at the beginning of the context items, so that
       --  subsequent use clauses on the parent can be validated.
@@ -3913,9 +3918,9 @@ package body Sem_Ch10 is
             Set_Parent (Withn, Parent (N));
          end if;
 
-         Set_Limited_Present (Withn);
          Set_First_Name      (Withn);
          Set_Implicit_With   (Withn);
+         Set_Limited_Present (Withn);
 
          Unum :=
            Load_Unit
index 0865f7b70d878aee76e3e60ff73eda42aecac99d..0cfb4119104e8b01de1ba540c23f9aa8eebed744 100644 (file)
@@ -9106,8 +9106,8 @@ package body Sem_Ch12 is
                   Clause := First (Current_Context);
                   OK := True;
                   while Present (Clause) loop
-                     if Nkind (Clause) = N_With_Clause and then
-                       Library_Unit (Clause) = Lib_Unit
+                     if Nkind (Clause) = N_With_Clause
+                       and then Library_Unit (Clause) = Lib_Unit
                      then
                         OK := False;
                         exit;
@@ -9118,8 +9118,8 @@ package body Sem_Ch12 is
 
                   if OK then
                      New_I := New_Copy (Item);
-                     Set_Implicit_With (New_I, True);
-                     Set_Implicit_With_From_Instantiation (New_I, True);
+                     Set_Implicit_With (New_I);
+
                      Append (New_I, Current_Context);
                   end if;
                end if;
index 955db28d97de794d7ea9435e13c9deded7d2f4b1..27e55abe7aebaef70209916cf06d295dadd28aa9 100644 (file)
@@ -8935,16 +8935,17 @@ package body Sem_Ch8 is
               Make_With_Clause (Loc,
                 Name =>
                   Make_Expanded_Name (Loc,
-                    Chars  => Chars (System_Aux_Id),
-                    Prefix => New_Occurrence_Of (Scope (System_Aux_Id), Loc),
+                    Chars         => Chars (System_Aux_Id),
+                    Prefix        =>
+                      New_Occurrence_Of (Scope (System_Aux_Id), Loc),
                     Selector_Name => New_Occurrence_Of (System_Aux_Id, Loc)));
 
             Set_Entity (Name (Withn), System_Aux_Id);
 
-            Set_Library_Unit       (Withn, Cunit (Unum));
             Set_Corresponding_Spec (Withn, System_Aux_Id);
-            Set_First_Name         (Withn, True);
-            Set_Implicit_With      (Withn, True);
+            Set_First_Name         (Withn);
+            Set_Implicit_With      (Withn);
+            Set_Library_Unit       (Withn, Cunit (Unum));
 
             Insert_After (With_Sys, Withn);
             Mark_Rewrite_Insertion (Withn);
index 90746b4862eb3d1510fc35b67b1c5b0a879c0884..078c1e483f4bff0edad026c644bfc19ae2c909cf 100644 (file)
@@ -3585,16 +3585,6 @@ package body Sem_Elab is
          Set_Implicit_With (Clause);
          Set_Library_Unit  (Clause, Unit_Cunit);
 
-         --  The following is a kludge to satisfy a GPRbuild requirement. In
-         --  general, internal with clauses should be encoded on a 'Z' line in
-         --  ALI files, but due to an old bug, they are encoded as source with
-         --  clauses on a 'W' line. As a result, these "semi-implicit" clauses
-         --  introduce spurious build dependencies in GPRbuild. The only way to
-         --  eliminate this effect is to mark the implicit clauses as generated
-         --  for an instantiation.
-
-         Set_Implicit_With_From_Instantiation (Clause);
-
          Append_To (Items, Clause);
       end if;
 
@@ -11717,7 +11707,7 @@ package body Sem_Elab is
 
       begin
          Set_Library_Unit  (CW, Library_Unit (Itm));
-         Set_Implicit_With (CW, True);
+         Set_Implicit_With (CW);
 
          --  Set elaborate all desirable on copy and then append the copy to
          --  the list of body with's and we are done.
index 1790b56ff4c17f67cf29c3cfd16a2bf83f764f69..c1193d717d6da133802129c4f290ae3957f70a3b 100644 (file)
@@ -1680,14 +1680,6 @@ package body Sinfo is
       return Flag16 (N);
    end Implicit_With;
 
-   function Implicit_With_From_Instantiation
-      (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_With_Clause);
-      return Flag12 (N);
-   end Implicit_With_From_Instantiation;
-
    function Interface_List
       (N : Node_Id) return List_Id is
    begin
@@ -2766,6 +2758,14 @@ package body Sinfo is
       return Node4 (N);
    end Parent_Spec;
 
+   function Parent_With
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      return Flag1 (N);
+   end Parent_With;
+
    function Position
       (N : Node_Id) return Node_Id is
    begin
@@ -5147,14 +5147,6 @@ package body Sinfo is
       Set_Flag16 (N, Val);
    end Set_Implicit_With;
 
-   procedure Set_Implicit_With_From_Instantiation
-      (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_With_Clause);
-      Set_Flag12 (N, Val);
-   end Set_Implicit_With_From_Instantiation;
-
    procedure Set_Interface_List
       (N : Node_Id; Val : List_Id) is
    begin
@@ -6233,6 +6225,14 @@ package body Sinfo is
       Set_Node4 (N, Val); -- semantic field, no parent set
    end Set_Parent_Spec;
 
+   procedure Set_Parent_With
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_With_Clause);
+      Set_Flag1 (N, Val);
+   end Set_Parent_With;
+
    procedure Set_Position
       (N : Node_Id; Val : Node_Id) is
    begin
index 19585936c49b84bf5445de69a0542da138dba580..0702f3c600101bf372773a6ad0f843e5126628f3 100644 (file)
@@ -1589,25 +1589,32 @@ package Sinfo is
    --    expansion of the same attribute in the said context.
 
    --  Hidden_By_Use_Clause (Elist5-Sem)
-   --     An entity list present in use clauses that appear within
-   --     instantiations. For the resolution of local entities, entities
-   --     introduced by these use clauses have priority over global ones, and
-   --     outer entities must be explicitly hidden/restored on exit.
+   --    An entity list present in use clauses that appear within
+   --    instantiations. For the resolution of local entities, entities
+   --    introduced by these use clauses have priority over global ones,
+   --    and outer entities must be explicitly hidden/restored on exit.
 
    --  Implicit_With (Flag16-Sem)
-   --    This flag is set in the N_With_Clause node that is implicitly
-   --    generated for runtime units that are loaded by the expander or in
-   --    GNATprove mode, and also for package System, if it is loaded
-   --    implicitly by a use of the 'Address or 'Tag attribute.
-   --    ??? There are other implicit with clauses as well.
-
-   --  Implicit_With_From_Instantiation (Flag12-Sem)
-   --     Set in N_With_Clause nodes from generic instantiations.
+   --    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 (Flag16-Sem)
-   --     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
-   --     generating some unwanted error messages.
+   --    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
+   --    generating some unwanted error messages.
 
    --  Includes_Infinities (Flag11-Sem)
    --    This flag is present in N_Range nodes. It is set for the range of
@@ -2217,6 +2224,12 @@ package Sinfo is
    --    package specification. This field is Empty for library bodies (the
    --    parent spec in this case can be found from the corresponding spec).
 
+   --  Parent_With (Flag1-Sem)
+   --    Present in N_With_Clause nodes. The flag indicates that the clause
+   --    was generated for an ancestor unit to provide proper visibility. A
+   --    with clause for child unit A.B.C produces two implicit parent with
+   --    clauses for A and A.B.
+
    --  Premature_Use (Node5-Sem)
    --    Present in N_Incomplete_Type_Declaration node. Used for improved
    --    error diagnostics: if there is a premature usage of an incomplete
@@ -6748,6 +6761,8 @@ package Sinfo is
       --  Sloc points to first token of library unit name
       --  Withed_Body (Node1-Sem)
       --  Name (Node2)
+      --  Private_Present (Flag15) set if with_clause has private keyword
+      --  Limited_Present (Flag17) set if LIMITED is present
       --  Next_Implicit_With (Node3-Sem)
       --  Library_Unit (Node4-Sem)
       --  Corresponding_Spec (Node5-Sem)
@@ -6758,11 +6773,9 @@ package Sinfo is
       --  Elaborate_All_Present (Flag14-Sem)
       --  Elaborate_All_Desirable (Flag9-Sem)
       --  Elaborate_Desirable (Flag11-Sem)
-      --  Private_Present (Flag15) set if with_clause has private keyword
       --  Implicit_With (Flag16-Sem)
-      --  Implicit_With_From_Instantiation (Flag12-Sem)
-      --  Limited_Present (Flag17) set if LIMITED is present
       --  Limited_View_Installed (Flag18-Sem)
+      --  Parent_With (Flag1-Sem)
       --  Unreferenced_In_Spec (Flag7-Sem)
       --  No_Entities_Ref_In_Spec (Flag8-Sem)
 
@@ -9736,9 +9749,6 @@ package Sinfo is
    function Implicit_With
      (N : Node_Id) return Boolean;    -- Flag16
 
-   function Implicit_With_From_Instantiation
-     (N : Node_Id) return Boolean;    -- Flag12
-
    function Import_Interface_Present
      (N : Node_Id) return Boolean;    -- Flag16
 
@@ -10072,6 +10082,9 @@ package Sinfo is
    function Parent_Spec
      (N : Node_Id) return Node_Id;    -- Node4
 
+   function Parent_With
+     (N : Node_Id) return Boolean;    -- Flag1
+
    function Position
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -10837,9 +10850,6 @@ package Sinfo is
    procedure Set_Implicit_With
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
-   procedure Set_Implicit_With_From_Instantiation
-     (N : Node_Id; Val : Boolean := True);    -- Flag12
-
    procedure Set_Import_Interface_Present
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
@@ -11173,6 +11183,9 @@ package Sinfo is
    procedure Set_Parent_Spec
      (N : Node_Id; Val : Node_Id);            -- Node4
 
+   procedure Set_Parent_With
+     (N : Node_Id; Val : Boolean := True);    -- Flag1
+
    procedure Set_Position
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -13438,7 +13451,6 @@ package Sinfo is
    pragma Inline (High_Bound);
    pragma Inline (Identifier);
    pragma Inline (Implicit_With);
-   pragma Inline (Implicit_With_From_Instantiation);
    pragma Inline (Interface_List);
    pragma Inline (Interface_Present);
    pragma Inline (Includes_Infinities);
@@ -13552,6 +13564,7 @@ package Sinfo is
    pragma Inline (Parameter_Specifications);
    pragma Inline (Parameter_Type);
    pragma Inline (Parent_Spec);
+   pragma Inline (Parent_With);
    pragma Inline (Position);
    pragma Inline (Pragma_Argument_Associations);
    pragma Inline (Pragma_Identifier);
@@ -13915,6 +13928,7 @@ package Sinfo is
    pragma Inline (Set_Parameter_Specifications);
    pragma Inline (Set_Parameter_Type);
    pragma Inline (Set_Parent_Spec);
+   pragma Inline (Set_Parent_With);
    pragma Inline (Set_Position);
    pragma Inline (Set_Pragma_Argument_Associations);
    pragma Inline (Set_Pragma_Identifier);