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
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-09 Hristian Kirtchev <kirtc...@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.--- gcc/ada/bindo-augmentors.adb
+++ 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
--- gcc/ada/bindo-graphs.adb
+++ 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;
--- gcc/ada/bindo-graphs.ads
+++ 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;
--- gcc/ada/bindo-units.adb
+++ 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 --
-------------------------------
--- gcc/ada/bindo-units.ads
+++ 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);
