+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,
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
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,
-- not been visited yet.
elsif not LGV_Sets.Contains (Visited_Vertices, Vertex) then
+ Trace_Vertex (G, Vertex, Indent);
-- Prepare for vertex backtracking
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 --
-----------------------------------------
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;
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;
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));
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;
-- 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;
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 --
-------------------------------
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);