[Ada] Elaboration order v4.0 and generic instantiations

This patch updates the library graph augmentation mechanism of the
elaboration order v4.0 to emulate a particular behavior of the v3.0
scheme involving generic instantiations. If a unit without any
elaboration code instantiates a generic without any elaboration code,
the invocation edge from the instance to the generic body is not
considered for library graph augmentation.

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

--  gen_pack1.ads

generic
   type Element_Type is private;

package Gen_Pack1 is
   procedure Read;
end Gen_Pack1;

--  gen_pack1.adb

with Types1;

package body Gen_Pack1 is
   procedure Read is null;
end Gen_Pack1;

--  types1.ads

with Gen_Pack1;

package Types1 is
   procedure Read;

   package Optional_Numbers is new Gen_Pack1 (Positive);
end Types1;

--  main1.adb

with Types1;

procedure Main1 is
begin
   Types1.Optional_Numbers.Read;
end Main1;

-----------------
-- Compilation --
-----------------

$ gnatmake -q main1.adb

2019-07-09  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* bindo-augmentors.adb (Visit_Elaboration_Root): Do not start a
	DFS from an elaboration root whose corresponding unit lacks
	elaboration code. This behavior mimics that of the old
	elaboration order mechanism.
	* bindo-graphs.adb (Find_All_Cycles_Through_Vertex): Move the
	vertex tracing within the functional branches of the routine.
	This prevents spurious trace output.
	(Has_No_Elaboration_Code): New routine.
	(Trace_Cycle, Trace_Edge): Update the various Ids to use the
	"standard" trace format.
	* bindo-graphs.ads (Has_No_Elaboration_Code): New routine.
	* bindo-units.ads, bindo-units.adb (Has_No_Elaboration_Code):
	New routine.

From-SVN: r273288

6 files changed, 74 insertions, 7 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a2c6066..b191e2d 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2019-07-09  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* bindo-augmentors.adb (Visit_Elaboration_Root): Do not start a
+	DFS from an elaboration root whose corresponding unit lacks
+	elaboration code. This behavior mimics that of the old
+	elaboration order mechanism.
+	* bindo-graphs.adb (Find_All_Cycles_Through_Vertex): Move the
+	vertex tracing within the functional branches of the routine.
+	This prevents spurious trace output.
+	(Has_No_Elaboration_Code): New routine.
+	(Trace_Cycle, Trace_Edge): Update the various Ids to use the
+	"standard" trace format.
+	* bindo-graphs.ads (Has_No_Elaboration_Code): New routine.
+	* bindo-units.ads, bindo-units.adb (Has_No_Elaboration_Code):
+	New routine.
+
 2019-07-09  Piotr Trojanek  <trojanek@adacore.com>
 
 	* ali.ads, bindo-graphs.adb, bindo-validators.adb, clean.adb,
diff --git a/gcc/ada/bindo-augmentors.adb b/gcc/ada/bindo-augmentors.adb
index bb68a2e..e0e2338 100644
--- a/gcc/ada/bindo-augmentors.adb
+++ b/gcc/ada/bindo-augmentors.adb
@@ -152,6 +152,17 @@ package body Bindo.Augmentors is
          Visited : IGV_Sets.Membership_Set;
 
       begin
+         --  Nothing to do when the unit where the elaboration root resides
+         --  lacks elaboration code. This implies that any invocation edges
+         --  going out of the unit are unwanted. This behavior emulates the
+         --  old elaboration order mechanism.
+
+         if Has_No_Elaboration_Code (Lib_Graph, Root_Vertex) then
+            return;
+         end if;
+
+         --  Prepare the global data
+
          Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph));
 
          Visit_Vertex
diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb
index 26b0c27..c3ae738 100644
--- a/gcc/ada/bindo-graphs.adb
+++ b/gcc/ada/bindo-graphs.adb
@@ -2356,13 +2356,13 @@ package body Bindo.Graphs is
             return;
          end if;
 
-         Trace_Vertex (G, Vertex, Indent);
-
          --  The current vertex denotes the end vertex of the cycle and closes
          --  the circuit. Normalize the cycle such that it is rotated with its
          --  most significant edge first, and record it for diagnostics.
 
          if LGV_Sets.Contains (End_Vertices, Vertex) then
+            Trace_Vertex (G, Vertex, Indent);
+
             Normalize_And_Add_Cycle
               (G                     => G,
                Most_Significant_Edge => Most_Significant_Edge,
@@ -2374,6 +2374,7 @@ package body Bindo.Graphs is
          --  not been visited yet.
 
          elsif not LGV_Sets.Contains (Visited_Vertices, Vertex) then
+            Trace_Vertex (G, Vertex, Indent);
 
             --  Prepare for vertex backtracking
 
@@ -2859,6 +2860,21 @@ package body Bindo.Graphs is
          return DG.Has_Next (DG.Outgoing_Edge_Iterator (Iter));
       end Has_Next;
 
+      -----------------------------
+      -- Has_No_Elaboration_Code --
+      -----------------------------
+
+      function Has_No_Elaboration_Code
+        (G      : Library_Graph;
+         Vertex : Library_Graph_Vertex_Id) return Boolean
+      is
+      begin
+         pragma Assert (Present (G));
+         pragma Assert (Present (Vertex));
+
+         return Has_No_Elaboration_Code (Unit (G, Vertex));
+      end Has_No_Elaboration_Code;
+
       -----------------------------------------
       -- Hash_Library_Graph_Cycle_Attributes --
       -----------------------------------------
@@ -4878,7 +4894,7 @@ package body Bindo.Graphs is
             Next (Iter, Edge);
 
             Indent_By (Edge_Indent);
-            Write_Str ("library graph edge (Edge_");
+            Write_Str ("library graph edge (LGE_Id_");
             Write_Int (Int (Edge));
             Write_Str (")");
             Write_Eol;
@@ -4912,7 +4928,7 @@ package body Bindo.Graphs is
          end if;
 
          Indent_By (Indent);
-         Write_Str ("library graph edge (Edge_");
+         Write_Str ("library graph edge (LGE_Id_");
          Write_Int (Int (Edge));
          Write_Str (")");
          Write_Eol;
@@ -4923,14 +4939,14 @@ package body Bindo.Graphs is
          Write_Eol;
 
          Indent_By  (Attr_Indent);
-         Write_Str  ("Predecessor (Vertex_");
+         Write_Str  ("Predecessor (LGV_Id_");
          Write_Int  (Int (Pred));
          Write_Str  (") name = ");
          Write_Name (Name (G, Pred));
          Write_Eol;
 
          Indent_By  (Attr_Indent);
-         Write_Str  ("Successor   (Vertex_");
+         Write_Str  ("Successor   (LGV_Id_");
          Write_Int  (Int (Succ));
          Write_Str  (") name = ");
          Write_Name (Name (G, Succ));
@@ -4977,7 +4993,7 @@ package body Bindo.Graphs is
          end if;
 
          Indent_By (Indent);
-         Write_Str ("library graph vertex (Vertex_");
+         Write_Str ("library graph vertex (LGV_Id_");
          Write_Int (Int (Vertex));
          Write_Str (")");
          Write_Eol;
diff --git a/gcc/ada/bindo-graphs.ads b/gcc/ada/bindo-graphs.ads
index 53bc4ee..86ba823 100644
--- a/gcc/ada/bindo-graphs.ads
+++ b/gcc/ada/bindo-graphs.ads
@@ -1028,6 +1028,13 @@ package Bindo.Graphs is
       --  Determine whether library graph G contains a cycle involving pragma
       --  Elaborate_All.
 
+      function Has_No_Elaboration_Code
+        (G      : Library_Graph;
+         Vertex : Library_Graph_Vertex_Id) return Boolean;
+      pragma Inline (Has_No_Elaboration_Code);
+      --  Determine whether vertex Vertex of library graph G represents a unit
+      --  that lacks elaboration code.
+
       function In_Same_Component
         (G     : Library_Graph;
          Left  : Library_Graph_Vertex_Id;
diff --git a/gcc/ada/bindo-units.adb b/gcc/ada/bindo-units.adb
index 05b5250..8b8fc28 100644
--- a/gcc/ada/bindo-units.adb
+++ b/gcc/ada/bindo-units.adb
@@ -199,6 +199,19 @@ package body Bindo.Units is
       return Unit_Sets.Has_Next (Unit_Sets.Iterator (Iter));
    end Has_Next;
 
+   -----------------------------
+   -- Has_No_Elaboration_Code --
+   -----------------------------
+
+   function Has_No_Elaboration_Code (U_Id : Unit_Id) return Boolean is
+      pragma Assert (Present (U_Id));
+
+      U_Rec : Unit_Record renames ALI.Units.Table (U_Id);
+
+   begin
+      return U_Rec.No_Elab;
+   end Has_No_Elaboration_Code;
+
    -------------------------------
    -- Hash_Invocation_Signature --
    -------------------------------
diff --git a/gcc/ada/bindo-units.ads b/gcc/ada/bindo-units.ads
index 3749393..5f045c8 100644
--- a/gcc/ada/bindo-units.ads
+++ b/gcc/ada/bindo-units.ads
@@ -81,6 +81,10 @@ package Bindo.Units is
    pragma Inline (For_Each_Unit);
    --  Invoke Processor on each unit in the bind
 
+   function Has_No_Elaboration_Code (U_Id : Unit_Id) return Boolean;
+   pragma Inline (Has_No_Elaboration_Code);
+   --  Determine whether unit U_Id lacks elaboration code
+
    function Hash_Invocation_Signature
      (IS_Id : Invocation_Signature_Id) return Bucket_Range_Type;
    pragma Inline (Hash_Invocation_Signature);