Patchwork [Ada] New Z lines in ALI files for implicit withs from instantiation

login
register
mail settings
Submitter Arnaud Charlet
Date April 2, 2012, 10:52 a.m.
Message ID <20120402105214.GA25628@adacore.com>
Download mbox | patch
Permalink /patch/150108/
State New
Headers show

Comments

Arnaud Charlet - April 2, 2012, 10:52 a.m.
Units that are only withed from generic instantiation are now put in the
ALI file as Z lines instead of W lines.
There is no impact on GNAT tools. This is for the benefit of gprbuild.
The test for this is to have a unit A instantiating a generic unit B,
the body of which import a package C. In tha ALI file for A, there should
be a Z line for package C.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-04-02  Vincent Celier  <celier@adacore.com>

	* ali.adb (Scan_Ali): Recognize Z lines. Set
	Implicit_With_From_Instantiation to True in the With_Record for
	Z lines.
	* ali.ads (With_Record): New Boolean component
	Implicit_With_From_Instantiation, defaulted to False.
	* csinfo.adb: Indicate that Implicit_With_From_Instantiation
	is special
	* lib-writ.adb (Write_ALI): New array Implicit_With.
	(Collect_Withs): Set Implicit_With for the unit is it is not Yes.
	(Write_With_Lines): Write a Z line instead of a W line if
	Implicit_With is Yes for the unit.
	* sem_ch12.adb (Inherit_Context): Only add a unit in the context
	if it is not there yet.
	* sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12)
	added.

Patch

Index: csinfo.adb
===================================================================
--- csinfo.adb	(revision 186067)
+++ csinfo.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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,6 +218,7 @@ 
    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: sinfo.adb
===================================================================
--- sinfo.adb	(revision 186067)
+++ sinfo.adb	(working copy)
@@ -1624,6 +1624,14 @@ 
       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
@@ -4704,6 +4712,14 @@ 
       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
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 186076)
+++ sinfo.ads	(working copy)
@@ -1226,6 +1226,9 @@ 
    --    '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.
+
    --  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
@@ -5805,6 +5808,7 @@ 
       --  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)
       --  Unreferenced_In_Spec (Flag7-Sem)
@@ -8592,6 +8596,9 @@ 
    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
 
@@ -9573,6 +9580,9 @@ 
    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
 
@@ -11959,6 +11969,7 @@ 
    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);
Index: lib-writ.adb
===================================================================
--- lib-writ.adb	(revision 186067)
+++ lib-writ.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -196,6 +196,10 @@ 
       Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean;
       --  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;
+
       Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2));
       --  Sorted table of source dependencies. One extra entry in case we
       --  have to add a dummy entry for System.
@@ -276,6 +280,15 @@ 
                else
                   Set_From_With_Type (Cunit_Entity (Unum));
                end if;
+
+               if Implicit_With (Unum) /= Yes then
+                  if Implicit_With_From_Instantiation (Item) then
+                     Implicit_With (Unum) := Yes;
+
+                  else
+                     Implicit_With (Unum) := No;
+                  end if;
+               end if;
             end if;
 
             Next (Item);
@@ -552,6 +565,7 @@ 
             Elab_All_Flags     (J) := False;
             Elab_Des_Flags     (J) := False;
             Elab_All_Des_Flags (J) := False;
+            Implicit_With      (J) := Unknown;
          end loop;
 
          Collect_Withs (Unode);
@@ -770,10 +784,14 @@ 
             Uname  := Units.Table (Unum).Unit_Name;
             Fname  := Units.Table (Unum).Unit_File_Name;
 
-            if Ekind (Cunit_Entity (Unum)) = E_Package
+            if Implicit_With (Unum) = Yes then
+               Write_Info_Initiate ('Z');
+
+            elsif Ekind (Cunit_Entity (Unum)) = E_Package
               and then From_With_Type (Cunit_Entity (Unum))
             then
                Write_Info_Initiate ('Y');
+
             else
                Write_Info_Initiate ('W');
             end if;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 186070)
+++ sem_ch12.adb	(working copy)
@@ -7761,6 +7761,9 @@ 
       Item            : Node_Id;
       New_I           : Node_Id;
 
+      Clause : Node_Id;
+      OK     : Boolean;
+
    begin
       if Nkind (Parent (Gen_Decl)) = N_Compilation_Unit then
 
@@ -7782,17 +7785,30 @@ 
          while Present (Item) loop
             if Nkind (Item) = N_With_Clause then
 
-               --  Take care to prevent direct cyclic with's, which can happen
-               --  if the generic body with's the current unit. Such a case
-               --  would result in binder errors (or run-time errors if the
-               --  -gnatE switch is in effect), but we want to prevent it here,
-               --  because Sem.Walk_Library_Items doesn't like cycles. Note
-               --  that we don't bother to detect indirect cycles.
+               --  Take care to prevent direct cyclic with's.
 
                if Library_Unit (Item) /= Current_Unit then
-                  New_I := New_Copy (Item);
-                  Set_Implicit_With (New_I, True);
-                  Append (New_I, Current_Context);
+                  --  Do not add a unit if it is already in the context
+
+                  Clause := First (Current_Context);
+                  OK := True;
+                  while Present (Clause) loop
+                     if Nkind (Clause) = N_With_Clause and then
+                       Chars (Name (Clause)) = Chars (Name (Item))
+                     then
+                        OK := False;
+                        exit;
+                     end if;
+
+                     Next (Clause);
+                  end loop;
+
+                  if OK then
+                     New_I := New_Copy (Item);
+                     Set_Implicit_With (New_I, True);
+                     Set_Implicit_With_From_Instantiation (New_I, True);
+                     Append (New_I, Current_Context);
+                  end if;
                end if;
             end if;
 
Index: ali.adb
===================================================================
--- ali.adb	(revision 186067)
+++ ali.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -55,6 +55,7 @@ 
       'X'    => True,   -- xref
       'S'    => True,   -- specific dispatching
       'Y'    => True,   -- limited_with
+      'Z'    => True,   -- implicit with from instantiation
       'C'    => True,   -- SCO information
       'F'    => True,   -- Alfa information
       others => False);
@@ -782,7 +783,8 @@ 
       --  Acquire lines to be ignored
 
       if Read_Xref then
-         Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True);
+         Ignore :=
+           ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True);
 
       --  Read_Lines parameter given
 
@@ -1717,7 +1719,7 @@ 
 
          With_Loop : loop
             Check_Unknown_Line;
-            exit With_Loop when C /= 'W' and then C /= 'Y';
+            exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z';
 
             if Ignore ('W') then
                Skip_Line;
@@ -1733,6 +1735,8 @@ 
                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');
 
                --  Generic case with no object file available
 
Index: ali.ads
===================================================================
--- ali.ads	(revision 186067)
+++ ali.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -558,6 +558,9 @@ 
 
       Limited_With : Boolean := False;
       --  True if unit is named in a limited_with_clause
+
+      Implicit_With_From_Instantiation : Boolean := False;
+      --  True if this is an implicit with from a generic instantiation
    end record;
 
    package Withs is new Table.Table (