diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 85 | ||||
| -rw-r--r-- | gcc/ada/ali.adb | 46 | ||||
| -rw-r--r-- | gcc/ada/ali.ads | 24 | ||||
| -rw-r--r-- | gcc/ada/bindo-diagnostics.adb | 63 | ||||
| -rw-r--r-- | gcc/ada/bindo-elaborators.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/bindo-units.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/bindo-writers.adb | 277 | ||||
| -rw-r--r-- | gcc/ada/bindo-writers.ads | 14 | ||||
| -rw-r--r-- | gcc/ada/bindo.adb | 158 | ||||
| -rw-r--r-- | gcc/ada/bindusg.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/debug.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 129 | ||||
| -rw-r--r-- | gcc/ada/switch-b.adb | 9 |
15 files changed, 765 insertions, 89 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8820113..6f04f77 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,88 @@ +2019-07-05 Hristian Kirtchev <kirtchev@adacore.com> + + * ali.adb (For_Each_Invocation_Construct, + For_Each_Invocation_Relation): New version. + (Scan_ALI): Initialize field Invocation_Graph_Encoding. + (Set_Invocation_Graph_Encoding): Update the setting of the + invocation graph encoding. + * ali.ads: Move field Invocation_Graph_Encoding from Unit_Record + to ALI_Record because the encoding applies to the whole ALI, + rather than one of the units (spec or body) for which the ALI + file was created. + (For_Each_Invocation_Construct, For_Each_Invocation_Relation): + New version. + * bindo.adb: Update the section on switches. Complete the + section of debugging elaboration order issues. + (Find_Elaboration_Order): Prepare the routine for the switch + from the old to the new elaboration order mechanism. + * bindo-diagnostics.adb (Find_And_Output_Invocation_Paths): + Manage a visited set used by Visit_Vertex. + (Output_All_Cycles_Suggestions, + Output_Dynamic_Model_Suggestions): Clarify the nature of the + suggested switch. + (Output_Elaborate_Body_Transition): Update the diagnostic to + emit a better message. + (Output_Forced_Suggestions, Output_Full_Encoding_Suggestions): + Clarify the nature of the suggested switch. + (Visit_Vertex): Update the parameter profile to add a set of + invokers visited during the transition. This set prevents + infinite exploration of the graph in case the invocations are + recursive. + * bindo-elaborators.adb: Add a use clause for + Bindo.Writers.Dependency_Writers. + (Elaborate_Units_Common): Output the library graph after it has + been augmented with invocation edges. Output just the components + instead of outputting the whole library graph again. + (Elaborate_Units_Dynamic, Elaborate_Units_Static): Output the + dependencies as expressed in the library graph. + * bindo-units.adb (Invocation_Graph_Encoding): Update the + extraction of the invocation graph encoding. + * bindo-writers.adb: Add with and use clauses for Binderr and + Butil. + (palgc, plgc): New debug routine. + (Write_Components): Moved to the spec. Add a header for the + output. + (Write_Dependencies, Write_Dependencies_Of_Vertex, + Write_Dependency_Edge): New routine. + (Write_Elaboration_Order): Update the logic to follow the format + of Binde's order output. + (Write_Library_Graph): Do not output the components every time + the graph is written. + (Write_Unit): Output the invocation graph encoding of the unit. + Output the invocation constructs and relations for the unit + only. + * bindo-writers.ads (Write_Components): Moved from the body. + (Write_Dependencies): New routine. + * bindusg.adb: Prepare the routine for the switch from the old + to the new elaboration order mechanism. + * debug.adb: Binder switch -d_O is now not associated with any + functionality. + * einfo.adb (Is_Elaboration_Target): The attribute applies to + packages, as specified by the comment on the attribute usage. + * opt.ads: Add a global flag which controls the choice between + the new and the legacy elaboration order mechanism. + * sem_elab.adb: Add Package_Target to type Target_Kind. + (Build_Elaborate_Body_Procedure, Build_Elaborate_Procedure, + Build_Elaborate_Spec_Procedure, Check_Elaboration_Scenarios, + Check_SPARK_Model_In_Effect): Use Main_Unit_Entity to obtain the + entity of the main unit. + (Create_Package_Rep): New routine. + (Create_Target_Rep): Add processing for packages. + (Declaration_Placement_Of_Node, Has_Prior_Elaboration): Use + Main_Unit_Entity to obtain the entity of the main + unit. + (Invocation_Graph_Recording_OK): Prepare the routine for the + switch from the old to the new elaboration order mechanism. + (Main_Unit_Entity): New routine. + (Meet_Elaboration_Requirement, + Process_Conditional_ABE_Variable_Reference): Use + Main_Unit_Entity to obtain the entity of the main unit. + (Process_Invocation_Instantiation): New routine. + (Process_Invocation_Scenario): Add processing for + instantiations. + * switch-b.adb (Scan_Binder_Switches): Prepare the routine for + the switch from the old to the new elaboration order mechanism. + 2019-07-05 Joffrey Huguet <huguet@adacore.com> * libgnat/a-textio.adb: Add abstract state refinment. diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index aa8b242..feea73f 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -510,6 +510,27 @@ package body ALI is end loop; end For_Each_Invocation_Construct; + ----------------------------------- + -- For_Each_Invocation_Construct -- + ----------------------------------- + + procedure For_Each_Invocation_Construct + (U_Id : Unit_Id; + Processor : Invocation_Construct_Processor_Ptr) + is + pragma Assert (Present (U_Id)); + pragma Assert (Processor /= null); + + U_Rec : Unit_Record renames Units.Table (U_Id); + + begin + for IC_Id in U_Rec.First_Invocation_Construct .. + U_Rec.Last_Invocation_Construct + loop + Processor.all (IC_Id); + end loop; + end For_Each_Invocation_Construct; + ---------------------------------- -- For_Each_Invocation_Relation -- ---------------------------------- @@ -527,6 +548,27 @@ package body ALI is end loop; end For_Each_Invocation_Relation; + ---------------------------------- + -- For_Each_Invocation_Relation -- + ---------------------------------- + + procedure For_Each_Invocation_Relation + (U_Id : Unit_Id; + Processor : Invocation_Relation_Processor_Ptr) + is + pragma Assert (Present (U_Id)); + pragma Assert (Processor /= null); + + U_Rec : Unit_Record renames Units.Table (U_Id); + + begin + for IR_Id in U_Rec.First_Invocation_Relation .. + U_Rec.Last_Invocation_Relation + loop + Processor.all (IR_Id); + end loop; + end For_Each_Invocation_Relation; + ---------- -- Hash -- ---------- @@ -1831,6 +1873,7 @@ package body ALI is First_Specific_Dispatching => Specific_Dispatching.Last + 1, First_Unit => No_Unit_Id, GNATprove_Mode => False, + Invocation_Graph_Encoding => No_Encoding, Last_Interrupt_State => Interrupt_States.Last, Last_Sdep => No_Sdep_Id, Last_Specific_Dispatching => Specific_Dispatching.Last, @@ -3807,9 +3850,10 @@ package body ALI is if Update_Units then declare Curr_Unit : Unit_Record renames Units.Table (Units.Last); + Curr_ALI : ALIs_Record renames ALIs.Table (Curr_Unit.My_ALI); begin - Curr_Unit.Invocation_Graph_Encoding := Kind; + Curr_ALI.Invocation_Graph_Encoding := Kind; end; end if; end Set_Invocation_Graph_Encoding; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 6db9e49..3fa527e 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -273,6 +273,11 @@ 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. + + Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind; + -- The encoding format used to capture information about the invocation + -- constructs and relations within the corresponding ALI file of this + -- unit. end record; No_Main_Priority : constant Int := -1; @@ -382,11 +387,6 @@ package ALI is Last_Arg : Arg_Id; -- Id of last args table entry for this file - Invocation_Graph_Encoding : Invocation_Graph_Encoding_Kind; - -- The encoding format used to capture information about the invocation - -- constructs and relations within the corresponding ALI file of this - -- unit. - First_Invocation_Construct : Invocation_Construct_Id; -- Id of the first invocation construct for this unit @@ -1271,13 +1271,25 @@ package ALI is pragma Inline (For_Each_Invocation_Construct); -- Invoke Processor on each invocation construct + procedure For_Each_Invocation_Construct + (U_Id : Unit_Id; + Processor : Invocation_Construct_Processor_Ptr); + pragma Inline (For_Each_Invocation_Construct); + -- Invoke Processor on each invocation construct of unit U_Id + type Invocation_Relation_Processor_Ptr is access procedure (IR_Id : Invocation_Relation_Id); procedure For_Each_Invocation_Relation (Processor : Invocation_Relation_Processor_Ptr); pragma Inline (For_Each_Invocation_Relation); - -- Invoker Processor on each invocation relation + -- Invoke Processor on each invocation relation + + procedure For_Each_Invocation_Relation + (U_Id : Unit_Id; + Processor : Invocation_Relation_Processor_Ptr); + pragma Inline (For_Each_Invocation_Relation); + -- Invoke Processor on each invocation relation of unit U_Id function Invocation_Construct_Kind_To_Code (Kind : Invocation_Construct_Kind) return Character; diff --git a/gcc/ada/bindo-diagnostics.adb b/gcc/ada/bindo-diagnostics.adb index a4b031d..0c9da46 100644 --- a/gcc/ada/bindo-diagnostics.adb +++ b/gcc/ada/bindo-diagnostics.adb @@ -247,6 +247,7 @@ package body Bindo.Diagnostics is Last_Vertex : Library_Graph_Vertex_Id; Elaborated_Vertex : Library_Graph_Vertex_Id; End_Vertex : Library_Graph_Vertex_Id; + Visited_Invokers : IGV_Sets.Membership_Set; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat); pragma Inline (Visit_Vertex); @@ -254,8 +255,9 @@ package body Bindo.Diagnostics is -- vertex Invoker_Vertex as part of a DFS traversal. Last_Vertex denotes -- the previous vertex in the traversal. Elaborated_Vertex is the vertex -- whose elaboration started the traversal. End_Vertex is the vertex that - -- terminates the traversal. All edges along the path are recorded in Path. - -- Path_Id is the id of the path. + -- terminates the traversal. Visited_Invoker is the set of all invokers + -- visited so far. All edges along the path are recorded in Path. Path_Id + -- is the id of the path. ------------------------- -- Diagnose_All_Cycles -- @@ -411,6 +413,7 @@ package body Bindo.Diagnostics is is Path : IGE_Lists.Doubly_Linked_List; Path_Id : Nat; + Visited : IGV_Sets.Membership_Set; begin pragma Assert (Present (Inv_Graph)); @@ -429,6 +432,7 @@ package body Bindo.Diagnostics is Path := IGE_Lists.Create; Path_Id := 1; + Visited := IGV_Sets.Create (Number_Of_Vertices (Inv_Graph)); -- Start a DFS traversal over the invocation graph, in an attempt to -- reach Destination from Source. The actual start of the path is the @@ -447,10 +451,12 @@ package body Bindo.Diagnostics is Last_Vertex => Source, Elaborated_Vertex => Source, End_Vertex => Destination, + Visited_Invokers => Visited, Path => Path, Path_Id => Path_Id); IGE_Lists.Destroy (Path); + IGV_Sets.Destroy (Visited); end Find_And_Output_Invocation_Paths; --------------------------- @@ -511,7 +517,7 @@ package body Bindo.Diagnostics is if Number_Of_Cycles (G) > 1 and then not Debug_Flag_Underscore_CC then Error_Msg_Info - (" diagnose all circularities (-d_C)"); + (" diagnose all circularities (binder switch -d_C)"); end if; end Output_All_Cycles_Suggestions; @@ -535,7 +541,7 @@ package body Bindo.Diagnostics is and then not Is_Dynamically_Elaborated (G) then Error_Msg_Info - (" use the dynamic elaboration model (-gnatE)"); + (" use the dynamic elaboration model (compiler switch -gnatE)"); end if; end Output_Dynamic_Model_Suggestions; @@ -665,17 +671,21 @@ package body Bindo.Diagnostics is pragma Assert (Present (Expected_Destination)); -- The actual and expected destination vertices match, and denote the - -- spec of a unit subject to pragma Elaborate_Body. There is no need to - -- mention the pragma because it does not affect the path of the cycle. - -- Treat the edge as a regular with edge. + -- spec or body of a unit subject to pragma Elaborate_Body. There is no + -- need to mention the pragma because it does not affect the path of the + -- cycle. Treat the edge as a regular with edge. -- -- Actual_Destination -- Source --> spec Elaborate_Body --> -- Expected_Destination + -- + -- spec Elaborate_Body + -- + -- Actual_Destination + -- Source --> body --> + -- Expected_Destination if Actual_Destination = Expected_Destination then - pragma Assert (Is_Spec (G, Actual_Destination)); - Error_Msg_Unit_1 := Name (G, Source); Error_Msg_Unit_2 := Name (G, Actual_Destination); Error_Msg_Info @@ -698,14 +708,18 @@ package body Bindo.Diagnostics is pragma Assert (Proper_Body (G, Actual_Destination) = Expected_Destination); + Error_Msg_Unit_1 := Name (G, Source); + Error_Msg_Unit_2 := Name (G, Actual_Destination); + Error_Msg_Info + (" unit $ has with clause for unit $"); + Error_Msg_Unit_1 := Name (G, Actual_Destination); Error_Msg_Info (" unit $ is subject to pragma Elaborate_Body"); - Error_Msg_Unit_1 := Name (G, Source); - Error_Msg_Unit_2 := Name (G, Expected_Destination); + Error_Msg_Unit_1 := Name (G, Expected_Destination); Error_Msg_Info - (" unit $ has with clause for unit $"); + (" unit $ is in the closure of pragma Elaborate_Body"); end if; end Output_Elaborate_Body_Transition; @@ -832,8 +846,10 @@ package body Bindo.Diagnostics is Error_Msg_Unit_1 := Name (G, Succ); Error_Msg_Unit_2 := Name (G, Pred); Error_Msg_Info - (" remove the dependency of unit $ on unit $ from argument of -f " - & "switch"); + (" remove the dependency of unit $ on unit $ from the argument of " + & "switch -f"); + Error_Msg_Info + (" remove switch -f"); end Output_Forced_Suggestions; ------------------------------ @@ -950,7 +966,8 @@ package body Bindo.Diagnostics is if Invocation_Graph_Encoding (G, Succ) /= Full_Path_Encoding then Error_Msg_Info - (" use detailed invocation information (-gnatd_F)"); + (" use detailed invocation information (compiler switch " + & "-gnatd_F)"); end if; end if; end Output_Full_Encoding_Suggestions; @@ -1410,6 +1427,7 @@ package body Bindo.Diagnostics is Last_Vertex : Library_Graph_Vertex_Id; Elaborated_Vertex : Library_Graph_Vertex_Id; End_Vertex : Library_Graph_Vertex_Id; + Visited_Invokers : IGV_Sets.Membership_Set; Path : IGE_Lists.Doubly_Linked_List; Path_Id : in out Nat) is @@ -1425,6 +1443,7 @@ package body Bindo.Diagnostics is pragma Assert (Present (Last_Vertex)); pragma Assert (Present (Elaborated_Vertex)); pragma Assert (Present (End_Vertex)); + pragma Assert (IGV_Sets.Present (Visited_Invokers)); pragma Assert (IGE_Lists.Present (Path)); -- The current invocation vertex resides within the end library vertex. @@ -1444,7 +1463,14 @@ package body Bindo.Diagnostics is -- Otherwise extend the search for the end library vertex via all edges -- to targets. - else + elsif not IGV_Sets.Contains (Visited_Invokers, Invoker) then + + -- Prepare for invoker backtracking + + IGV_Sets.Insert (Visited_Invokers, Invoker); + + -- Extend the search via all edges to targets + Iter := Iterate_Edges_To_Targets (Inv_Graph, Invoker); while Has_Next (Iter) loop Next (Iter, Edge); @@ -1466,6 +1492,7 @@ package body Bindo.Diagnostics is Last_Vertex => Invoker_Vertex, Elaborated_Vertex => Elaborated_Vertex, End_Vertex => End_Vertex, + Visited_Invokers => Visited_Invokers, Path => Path, Path_Id => Path_Id); @@ -1473,6 +1500,10 @@ package body Bindo.Diagnostics is IGE_Lists.Delete_Last (Path); end loop; + + -- Backtrack the invoker + + IGV_Sets.Delete (Visited_Invokers, Invoker); end if; end Visit_Vertex; diff --git a/gcc/ada/bindo-elaborators.adb b/gcc/ada/bindo-elaborators.adb index d26101a..762198b 100644 --- a/gcc/ada/bindo-elaborators.adb +++ b/gcc/ada/bindo-elaborators.adb @@ -52,6 +52,7 @@ use Bindo.Validators.Library_Graph_Validators; with Bindo.Writers; use Bindo.Writers; use Bindo.Writers.ALI_Writers; +use Bindo.Writers.Dependency_Writers; use Bindo.Writers.Elaboration_Order_Writers; use Bindo.Writers.Invocation_Graph_Writers; use Bindo.Writers.Library_Graph_Writers; @@ -695,12 +696,13 @@ package body Bindo.Elaborators is -- to a unit that result in extra edges within the library graph. Augment_Library_Graph (Inv_Graph, Lib_Graph); + Write_Library_Graph (Lib_Graph); -- Create and output the component graph by collapsing all library -- items into library units and traversing the library graph. - Find_Components (Lib_Graph); - Write_Library_Graph (Lib_Graph); + Find_Components (Lib_Graph); + Write_Components (Lib_Graph); -- Traverse the library graph to determine the elaboration order of -- units. @@ -742,6 +744,11 @@ package body Bindo.Elaborators is if Status = Order_OK then Order := Mix_Order; + -- Output the dependencies of vertices when switch -e (output + -- complete list of elaboration order dependencies) is active. + + Write_Dependencies (Mix_Lib_Graph); + -- The library graph contains an Elaborate_All circularity. There is -- no point in re-elaborating the units without the information from -- the invocation graph because the circularity will persist. @@ -774,6 +781,11 @@ package body Bindo.Elaborators is if Status = Order_OK then Order := Dyn_Order; + -- Output the dependencies of vertices when switch -e (output + -- complete list of elaboration order dependencies) is active. + + Write_Dependencies (Dyn_Lib_Graph); + -- Otherwise the library graph contains a circularity without the -- extra information provided by the invocation graph. Diagnose -- the circularity. @@ -820,9 +832,16 @@ package body Bindo.Elaborators is Order => Order, Status => Status); - -- The augmented library graph contains a circularity + -- The elaboration order is satisfactory. Output the dependencies of + -- vertices when switch -e (output complete list of elaboration order + -- dependencies) is active. - if Status /= Order_OK then + if Status = Order_OK then + Write_Dependencies (Lib_Graph); + + -- Otherwise the augmented library graph contains a circularity + + else Diagnose_Circularities (Inv_Graph => Inv_Graph, Lib_Graph => Lib_Graph); diff --git a/gcc/ada/bindo-units.adb b/gcc/ada/bindo-units.adb index f234f40..05b5250 100644 --- a/gcc/ada/bindo-units.adb +++ b/gcc/ada/bindo-units.adb @@ -243,9 +243,10 @@ package body Bindo.Units is pragma Assert (Present (U_Id)); U_Rec : Unit_Record renames ALI.Units.Table (U_Id); + U_ALI : ALIs_Record renames ALI.ALIs.Table (U_Rec.My_ALI); begin - return U_Rec.Invocation_Graph_Encoding; + return U_ALI.Invocation_Graph_Encoding; end Invocation_Graph_Encoding; ------------------------------- diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index 067ba1f..a3b45fc 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -23,10 +23,12 @@ -- -- ------------------------------------------------------------------------------ -with Debug; use Debug; -with Fname; use Fname; -with Opt; use Opt; -with Output; use Output; +with Binderr; use Binderr; +with Butil; use Butil; +with Debug; use Debug; +with Fname; use Fname; +with Opt; use Opt; +with Output; use Output; with Bindo.Units; use Bindo.Units; @@ -271,10 +273,19 @@ package body Bindo.Writers is Write_Int (Int (U_Rec.Last_Invocation_Relation)); Write_Str (")"); Write_Eol; + + Write_Str (" Invocation_Graph_Encoding = "); + Write_Str (Invocation_Graph_Encoding (U_Id)'Img); + Write_Eol; Write_Eol; - For_Each_Invocation_Construct (Write_Invocation_Construct'Access); - For_Each_Invocation_Relation (Write_Invocation_Relation'Access); + For_Each_Invocation_Construct + (U_Id => U_Id, + Processor => Write_Invocation_Construct'Access); + + For_Each_Invocation_Relation + (U_Id => U_Id, + Processor => Write_Invocation_Relation'Access); end Write_Unit; ----------------------- @@ -323,6 +334,18 @@ package body Bindo.Writers is pragma Inline (Write_Cyclic_Edge); -- Write cyclic edge Edge of library graph G to standard + ----------- + -- Debug -- + ----------- + + procedure palgc (G : Library_Graph) renames Write_Cycles; + pragma Unreferenced (palgc); + + procedure plgc + (G : Library_Graph; + Cycle : Library_Graph_Cycle_Id) renames Write_Cycle; + pragma Unreferenced (plgc); + ----------------- -- Write_Cycle -- ----------------- @@ -425,6 +448,178 @@ package body Bindo.Writers is end Write_Cyclic_Edge; end Cycle_Writers; + ------------------------ + -- Dependency_Writers -- + ------------------------ + + package body Dependency_Writers is + + ----------------------- + -- Local subprograms -- + ----------------------- + + procedure Write_Dependencies_Of_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id); + pragma Inline (Write_Dependencies_Of_Vertex); + -- Write the dependencies of vertex Vertex of library graph G to + -- standard output. + + procedure Write_Dependency_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id); + pragma Inline (Write_Dependency_Edge); + -- Write the dependency described by edge Edge of library graph G to + -- standard output. + + ------------------------ + -- Write_Dependencies -- + ------------------------ + + procedure Write_Dependencies (G : Library_Graph) is + Use_Formatting : constant Boolean := not Zero_Formatting; + + Iter : Library_Graphs.All_Vertex_Iterator; + Vertex : Library_Graph_Vertex_Id; + + begin + pragma Assert (Present (G)); + + -- Nothing to do when switch -e (output complete list of elaboration + -- order dependencies) is not in effect. + + if not Elab_Dependency_Output then + return; + end if; + + if Use_Formatting then + Write_Eol; + Write_Line ("ELABORATION ORDER DEPENDENCIES"); + Write_Eol; + end if; + + Info_Prefix_Suppress := True; + + Iter := Iterate_All_Vertices (G); + while Has_Next (Iter) loop + Next (Iter, Vertex); + + Write_Dependencies_Of_Vertex (G, Vertex); + end loop; + + Info_Prefix_Suppress := False; + + if Use_Formatting then + Write_Eol; + end if; + end Write_Dependencies; + + ---------------------------------- + -- Write_Dependencies_Of_Vertex -- + ---------------------------------- + + procedure Write_Dependencies_Of_Vertex + (G : Library_Graph; + Vertex : Library_Graph_Vertex_Id) + is + Edge : Library_Graph_Edge_Id; + Iter : Edges_To_Successors_Iterator; + + begin + pragma Assert (Present (G)); + pragma Assert (Present (Vertex)); + + -- Nothing to do for internal and predefined units + + if Is_Internal_Unit (G, Vertex) + or else Is_Predefined_Unit (G, Vertex) + then + return; + end if; + + Iter := Iterate_Edges_To_Successors (G, Vertex); + while Has_Next (Iter) loop + Next (Iter, Edge); + + Write_Dependency_Edge (G, Edge); + end loop; + end Write_Dependencies_Of_Vertex; + + --------------------------- + -- Write_Dependency_Edge -- + --------------------------- + + procedure Write_Dependency_Edge + (G : Library_Graph; + Edge : Library_Graph_Edge_Id) + is + pragma Assert (Present (G)); + pragma Assert (Present (Edge)); + + Pred : constant Library_Graph_Vertex_Id := Predecessor (G, Edge); + Succ : constant Library_Graph_Vertex_Id := Successor (G, Edge); + + begin + -- Nothing to do for internal and predefined units + + if Is_Internal_Unit (G, Succ) + or else Is_Predefined_Unit (G, Succ) + then + return; + end if; + + Error_Msg_Unit_1 := Name (G, Pred); + Error_Msg_Unit_2 := Name (G, Succ); + Error_Msg_Output + (Msg => " unit $ must be elaborated before unit $", + Info => True); + + Error_Msg_Unit_1 := Name (G, Succ); + Error_Msg_Unit_2 := Name (G, Pred); + + if Is_Elaborate_All_Edge (G, Edge) then + Error_Msg_Output + (Msg => + " reason: unit $ has with clause and pragma " + & "Elaborate_All for unit $", + Info => True); + + elsif Is_Elaborate_Body_Edge (G, Edge) then + Error_Msg_Output + (Msg => " reason: unit $ has with clause for unit $", + Info => True); + + elsif Is_Elaborate_Edge (G, Edge) then + Error_Msg_Output + (Msg => + " reason: unit $ has with clause and pragma Elaborate " + & "for unit $", + Info => True); + + elsif Is_Forced_Edge (G, Edge) then + Error_Msg_Output + (Msg => + " reason: unit $ has a dependency on unit $ forced by -f " + & "switch", + Info => True); + + elsif Is_Invocation_Edge (G, Edge) then + Error_Msg_Output + (Msg => + " reason: unit $ invokes a construct of unit $ at " + & "elaboration time", + Info => True); + + else + pragma Assert (Is_With_Edge (G, Edge)); + + Error_Msg_Output + (Msg => " reason: unit $ has with clause for unit $", + Info => True); + end if; + end Write_Dependency_Edge; + end Dependency_Writers; + ------------------------------- -- Elaboration_Order_Writers -- ------------------------------- @@ -448,25 +643,27 @@ package body Bindo.Writers is ----------------------------- procedure Write_Elaboration_Order (Order : Unit_Id_Table) is + Use_Formatting : constant Boolean := not Zero_Formatting; + begin - -- Nothing to do when switch -d_O (output elaboration order) is not - -- in effect. + -- Nothing to do when switch -l (output chosen elaboration order) is + -- not in effect. - if not Debug_Flag_Underscore_OO then + if not Elab_Order_Output then return; end if; - Write_Str ("Elaboration Order"); - Write_Eol; - Write_Eol; + if Use_Formatting then + Write_Eol; + Write_Str ("ELABORATION ORDER"); + Write_Eol; + end if; Write_Units (Order); - Write_Eol; - Write_Str ("Elaboration Order end"); - Write_Eol; - - Write_Eol; + if Use_Formatting then + Write_Eol; + end if; end Write_Elaboration_Order; ---------------- @@ -474,13 +671,16 @@ package body Bindo.Writers is ---------------- procedure Write_Unit (U_Id : Unit_Id) is + Use_Formatting : constant Boolean := not Zero_Formatting; + begin pragma Assert (Present (U_Id)); - Write_Str ("unit (U_Id_"); - Write_Int (Int (U_Id)); - Write_Str (") name = "); - Write_Name (Name (U_Id)); + if Use_Formatting then + Write_Str (" "); + end if; + + Write_Unit_Name (Name (U_Id)); Write_Eol; end Write_Unit; @@ -825,10 +1025,6 @@ package body Bindo.Writers is -- Write all vertices of component Comp of library graph G to standard -- output. - procedure Write_Components (G : Library_Graph); - pragma Inline (Write_Components); - -- Write all components of library graph G to standard output - procedure Write_Edges_To_Successors (G : Library_Graph; Vertex : Library_Graph_Vertex_Id); @@ -942,7 +1138,22 @@ package body Bindo.Writers is Iter : Component_Iterator; begin + -- Nothing to do when switch -d_L (output library item graph) is not + -- in effect. + + if not Debug_Flag_Underscore_LL then + return; + end if; + + Write_Str ("Library Graph components"); + Write_Eol; + Write_Eol; + if Num_Of_Comps > 0 then + Write_Str ("Components: "); + Write_Num (Int (Num_Of_Comps)); + Write_Eol; + Iter := Iterate_Components (G); while Has_Next (Iter) loop Next (Iter, Comp); @@ -952,6 +1163,11 @@ package body Bindo.Writers is else Write_Eol; end if; + + Write_Str ("Library Graph components end"); + Write_Eol; + + Write_Eol; end Write_Components; ------------------------------- @@ -1009,7 +1225,6 @@ package body Bindo.Writers is Write_Statistics (G); Write_Library_Graph_Vertices (G); - Write_Components (G); Write_Str ("Library Graph end"); Write_Eol; @@ -1231,10 +1446,12 @@ package body Bindo.Writers is --------------------- procedure Write_File_Name (Nam : File_Name_Type) is + Use_Formatting : constant Boolean := not Zero_Formatting; + begin pragma Assert (Present (Nam)); - if not Zero_Formatting then + if Use_Formatting then Write_Str (" "); end if; @@ -1296,6 +1513,8 @@ package body Bindo.Writers is ------------------------ procedure Write_Unit_Closure (Order : Unit_Id_Table) is + Use_Formatting : constant Boolean := not Zero_Formatting; + Set : Membership_Set; begin @@ -1306,7 +1525,7 @@ package body Bindo.Writers is return; end if; - if not Zero_Formatting then + if Use_Formatting then Write_Eol; Write_Line ("REFERENCED SOURCES"); end if; @@ -1320,7 +1539,7 @@ package body Bindo.Writers is Destroy (Set); - if not Zero_Formatting then + if Use_Formatting then Write_Eol; end if; end Write_Unit_Closure; diff --git a/gcc/ada/bindo-writers.ads b/gcc/ada/bindo-writers.ads index b791638..ff6b9b3 100644 --- a/gcc/ada/bindo-writers.ads +++ b/gcc/ada/bindo-writers.ads @@ -91,6 +91,17 @@ package Bindo.Writers is end Cycle_Writers; + ------------------------ + -- Dependency_Writers -- + ------------------------ + + package Dependency_Writers is + procedure Write_Dependencies (G : Library_Graph); + -- Write all elaboration dependencies of the units represented by + -- vertices of library graph G. + + end Dependency_Writers; + ------------------------------- -- Elaboration_Order_Writers -- ------------------------------- @@ -116,6 +127,9 @@ package Bindo.Writers is --------------------------- package Library_Graph_Writers is + procedure Write_Components (G : Library_Graph); + -- Write all components of library graph G to standard output + procedure Write_Library_Graph (G : Library_Graph); -- Write library graph G to standard output diff --git a/gcc/ada/bindo.adb b/gcc/ada/bindo.adb index 039fd0d..b3106ad 100644 --- a/gcc/ada/bindo.adb +++ b/gcc/ada/bindo.adb @@ -32,10 +32,10 @@ use Bindo.Elaborators; package body Bindo is --------------------------------- - -- Elaboration order mechanism -- + -- Elaboration-order mechanism -- --------------------------------- - -- The elaboration order (EO) mechanism implemented in this unit and its + -- The elaboration-order (EO) mechanism implemented in this unit and its -- children has the following objectives: -- -- * Find an ordering of all library items (historically referred to as @@ -272,7 +272,7 @@ package body Bindo is -- whose elaboration cannot be guaranteed. -- -- - A detailed traceback of the cycle, showcasing the transition - -- between units, along with any other elaboration order-related + -- between units, along with any other elaboration-order-related -- information. -- -- - A set of suggestions on how to break the cycle considering the @@ -308,18 +308,13 @@ package body Bindo is -- -- GNATbind utilizes the new bindo elaboration order -- - -- -d_O Output elaboration order - -- - -- GNATbind outputs the elaboration order in text format to standard - -- output. - -- -- -d_P Output cycle paths -- -- GNATbind output the cycle paths in text format to standard output -- - -- -d_T Output elaboration order trace information + -- -d_T Output elaboration-order trace information -- - -- GNATbind outputs trace information on elaboration order and cycle + -- GNATbind outputs trace information on elaboration-order and cycle- -- detection activities to standard output. -- -- -d_V Validate bindo cycles, graphs, and order @@ -327,12 +322,126 @@ package body Bindo is -- GNATbind validates the invocation graph, library graph along with -- its cycles, and elaboration order by detecting inconsistencies and -- producing error reports. + -- + -- -e Output complete list of elaboration-order dependencies + -- + -- GNATbind outputs the dependencies between units to standard + -- output. + -- + -- -f Force elaboration order from given file + -- + -- GNATbind applies an additional set of edges to the library graph. + -- The edges are read from a file specified by the argument of the + -- flag. + -- + -- -H Legacy elaboration-order model enabled + -- + -- GNATbind uses the library-graph and heuristics-based elaboration- + -- order model. + -- + -- -l Output chosen elaboration order + -- + -- GNATbind outputs the elaboration order in text format to standard + -- output. + -- + -- -p Pessimistic (worst-case) elaboration order + -- + -- This switch is not used in Bindo and its children. ---------------------------------------- - -- Debugging elaboration order issues -- + -- Debugging elaboration-order issues -- ---------------------------------------- - -- ??? more on this later + -- Prior to debugging elaboration-order-related issues, enable all relevant + -- debug flags to collect as much information as possible. Depending on the + -- number of files in the bind, Bindo may emit anywhere between several MBs + -- to several hundred MBs of data to standard output. The switches are: + -- + -- -d_A -d_C -d_I -d_L -d_P -d_T -d_V + -- + -- Bindo offers several debugging routines that can be invoked from gdb. + -- Those are defined in the body of Bindo.Writers, in sections denoted by + -- header Debug. For quick reference, the routines are: + -- + -- palgc -- print all library-graph cycles + -- pau -- print all units + -- pc -- print component + -- pige -- print invocation-graph edge + -- pigv -- print invocation-graph vertex + -- plgc -- print library-graph cycle + -- plge -- print library-graph edge + -- plgv -- print library-graph vertex + -- pu -- print units + -- + -- * Invalid elaboration order + -- + -- The elaboration order is invalid when: + -- + -- - A unit that requires elaboration is missing from the order + -- - A unit that does not require elaboration is present in the order + -- + -- Examine the output of the elaboration algorithm available via switch + -- -d_T to determine how the related units were included in or excluded + -- from the order. Determine whether the library graph contains all the + -- relevant edges for those units. + -- + -- Units and routines of interest: + -- Bindo.Elaborators + -- Elaborate_Library_Graph + -- Elaborate_Units_Common + -- Elaborate_Units_Dynamic + -- Elaborate_Units_Static + -- + -- * Invalid invocation graph + -- + -- The invocation graph is invalid when: + -- + -- - An edge lacks an attribute + -- - A vertex lacks an attribute + -- + -- Find the malformed edge or vertex and determine which attribute is + -- missing. Examine the contents of the invocation-related ALI tables + -- available via switch -d_A. If the invocation construct or relation + -- is missing, verify the ALI file. If the ALI lacks all the relevant + -- information, then Sem_Elab most likely failed to discover a valid + -- elaboration path. + -- + -- Units and routines of interest: + -- Bindo.Builders + -- Bindo.Graphs + -- Add_Edge + -- Add_Vertex + -- Build_Invocation_Graph + -- + -- * Invalid library graph + -- + -- The library graph is invalid when: + -- + -- - An edge lacks an attribute + -- - A vertex lacks an attribute + -- + -- Find the malformed edge or vertex and determine which attribute is + -- missing. + -- + -- Units and routines of interest: + -- Bindo.Builders + -- Bindo.Graphs + -- Add_Edge + -- Add_Vertex + -- Build_Library_Graph + -- + -- * Invalid library-graph cycle + -- + -- A library-graph cycle is invalid when: + -- + -- - It lacks enough edges to form a circuit + -- - At least one edge in the circuit is repeated + -- + -- Find the malformed cycle and determine which attribute is missing. + -- + -- Units and routines of interest: + -- Bindo.Graphs + -- Find_Cycles ---------------------------- -- Find_Elaboration_Order -- @@ -343,7 +452,28 @@ package body Bindo is Main_Lib_File : File_Name_Type) is begin - -- Use the invocation and library graph-based elaboration order when + -- ??? Enable the following code when switching from the old to the new + -- elaboration-order mechanism. + + -- Use the library graph and heuristic-based elaboration order when + -- switch -H (legacy elaboration-order mode enabled). + + -- if Legacy_Elaboration_Order then + -- Binde.Find_Elab_Order (Order, Main_Lib_File); + + -- Otherwise use the invocation and library-graph-based elaboration + -- order. + + -- else + -- Invocation_And_Library_Graph_Elaborators.Elaborate_Units + -- (Order => Order, + -- Main_Lib_File => Main_Lib_File); + -- end if; + + -- ??? Remove the following code when switching from the old to the new + -- elaboration-order mechanism. + + -- Use the invocation and library-graph-based elaboration order when -- switch -d_N (new bindo order) is in effect. if Debug_Flag_Underscore_NN then @@ -351,7 +481,7 @@ package body Bindo is (Order => Order, Main_Lib_File => Main_Lib_File); - -- Otherwise use the library graph and heuristic-based elaboration + -- Otherwise use the library-graph and heuristic-based elaboration -- order. else diff --git a/gcc/ada/bindusg.adb b/gcc/ada/bindusg.adb index 8c51d11..a4a9739 100644 --- a/gcc/ada/bindusg.adb +++ b/gcc/ada/bindusg.adb @@ -143,6 +143,14 @@ package body Bindusg is Write_Line (" -h Output this usage (help) information"); + -- ??? Enable the following code when switching from the old to the new + -- elaboration-order mechanism. + + -- Line for -H switch + + -- Write_Line + -- (" -H Legacy elaboration-order model enabled"); + -- Lines for -I switch Write_Line diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index 2635654..da4bea1 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -389,7 +389,7 @@ package body Debug is -- d_L Output library graph -- d_M -- d_N New bindo order - -- d_O Output elaboration order + -- d_O -- d_P Output cycle paths -- d_Q -- d_R @@ -1155,8 +1155,6 @@ package body Debug is -- d_N GNATBIND utilizes the elaboration order provided by bindo - -- d_O GNATBIND outputs the elaboration order of units to standard output - -- d_P GNATBIND outputs the cycle paths to standard output -- d_T GNATBIND outputs trace information of elaboration order and cycle diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index b9a9a8d..5fba0fa 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -8127,7 +8127,7 @@ package body Einfo is function Is_Elaboration_Target (Id : Entity_Id) return Boolean is begin return - Ekind_In (Id, E_Constant, E_Variable) + Ekind_In (Id, E_Constant, E_Package, E_Variable) or else Is_Entry (Id) or else Is_Generic_Unit (Id) or else Is_Subprogram (Id) diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 16b5cba..0b62af8 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -947,6 +947,11 @@ package Opt is -- Set to True when the pre-18.x access-before-elaboration model is to be -- used. Modified by use of -gnatH. + Legacy_Elaboration_Order : Boolean := False; + -- GNATBIND + -- Set to True when the pre-20.x elaboration-order model is to be used. + -- Modified by use of -H. + Link_Only : Boolean := False; -- GNATMAKE, GPRBUILD -- Set to True to skip compile and bind steps (except when Bind_Only is diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 2bd38c8..8612428 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -788,6 +788,9 @@ package body Sem_Elab is (Generic_Target, -- A generic unit being instantiated + Package_Target, + -- The package form of an instantiation + Subprogram_Target, -- An entry, operator, or subprogram being invoked, or aliased through -- 'Access or 'Unrestricted_Access. @@ -2046,6 +2049,10 @@ package body Sem_Elab is pragma Inline (Is_Same_Unit); -- Determine whether entities Unit_1 and Unit_2 denote the same unit + function Main_Unit_Entity return Entity_Id; + pragma Inline (Main_Unit_Entity); + -- Return the entity of the main unit + function Non_Private_View (Typ : Entity_Id) return Entity_Id; pragma Inline (Non_Private_View); -- Return the full view of private type Typ if available, otherwise return @@ -3955,7 +3962,7 @@ package body Sem_Elab is -- Elaboration_Checks which appears on the initial declaration of the -- main unit. - Install_Elaboration_Model (Unit_Entity (Cunit_Entity (Main_Unit))); + Install_Elaboration_Model (Unit_Entity (Main_Unit_Entity)); -- Examine the context of the main unit and record all units with prior -- elaboration with respect to it. @@ -6344,7 +6351,7 @@ package body Sem_Elab is -- because diagnostics on reads are relevant only for external -- variables. - if Is_Same_Unit (Unit_Id, Cunit_Entity (Main_Unit)) then + if Is_Same_Unit (Unit_Id, Main_Unit_Entity) then null; -- Nothing to do when the variable is already initialized. Note that @@ -8163,7 +8170,7 @@ package body Sem_Elab is -- body of A elaborated <-- problem -- -- The generation of an implicit pragma Elaborate_All (B) ensures - -- that the elaboration order mechanism will not pick the above + -- that the elaboration-order mechanism will not pick the above -- order. -- -- An implicit Elaborate is NOT generated when the unit is subject @@ -8502,10 +8509,9 @@ package body Sem_Elab is Elab_Body_OK : Boolean := False; Same_Unit_OK : Boolean := False) return Boolean is - EA_Id : constant Elaboration_Attributes_Id := - Elaboration_Attributes_Of (Unit_Id); - - Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit); + EA_Id : constant Elaboration_Attributes_Id := + Elaboration_Attributes_Of (Unit_Id); + Main_Id : constant Entity_Id := Main_Unit_Entity; Unit_Prag : constant Node_Id := Elab_Pragma (EA_Id); Unit_With : constant Node_Id := With_Clause (EA_Id); @@ -8575,7 +8581,7 @@ package body Sem_Elab is is pragma Assert (Nam_In (Req_Nam, Name_Elaborate, Name_Elaborate_All)); - Main_Id : constant Entity_Id := Cunit_Entity (Main_Unit); + Main_Id : constant Entity_Id := Main_Unit_Entity; Unit_Id : constant Entity_Id := Find_Top_Unit (Targ_Id); procedure Elaboration_Requirement_Error; @@ -10356,6 +10362,11 @@ package body Sem_Elab is pragma Inline (Create_Instantiation_Rep); -- Create the representation of instantiation Inst + function Create_Package_Rep + (Pack_Id : Entity_Id) return Target_Rep_Record; + pragma Inline (Create_Package_Rep); + -- Create the representation of package Pack_Id + function Create_Protected_Entry_Rep (PE_Id : Entity_Id) return Target_Rep_Record; pragma Inline (Create_Protected_Entry_Rep); @@ -10624,6 +10635,26 @@ package body Sem_Elab is return Rec; end Create_Instantiation_Rep; + ------------------------ + -- Create_Package_Rep -- + ------------------------ + + function Create_Package_Rep + (Pack_Id : Entity_Id) return Target_Rep_Record + is + Rec : Target_Rep_Record; + + begin + Rec.Kind := Package_Target; + + Spec_And_Body_From_Entity + (Id => Pack_Id, + Body_Decl => Rec.Body_Decl, + Spec_Decl => Rec.Spec_Decl); + + return Rec; + end Create_Package_Rep; + -------------------------------- -- Create_Protected_Entry_Rep -- -------------------------------- @@ -10846,6 +10877,9 @@ package body Sem_Elab is then Rec := Create_Subprogram_Rep (Id); + elsif Ekind (Id) = E_Package then + Rec := Create_Package_Rep (Id); + else pragma Assert (False); return Rec; @@ -11622,6 +11656,14 @@ package body Sem_Elab is -- Process invocation call scenario Call with representation Call_Rep. -- In_State is the current state of the Processing phase. + procedure Process_Invocation_Instantiation + (Inst : Node_Id; + Inst_Rep : Scenario_Rep_Id; + In_State : Processing_In_State); + pragma Inline (Process_Invocation_Instantiation); + -- Process invocation instantiation scenario Inst with representation + -- Inst_Rep. In_State is the current state of the Processing phase. + procedure Process_Invocation_Scenario (N : Node_Id; In_State : Processing_In_State); @@ -11767,7 +11809,7 @@ package body Sem_Elab is end if; Spec_And_Body_From_Entity - (Id => Cunit_Entity (Main_Unit), + (Id => Main_Unit_Entity, Body_Decl => Body_Decl, Spec_Decl => Spec_Decl); @@ -11799,7 +11841,7 @@ package body Sem_Elab is Set_Ekind (Proc_Id, E_Procedure); Set_Etype (Proc_Id, Standard_Void_Type); - Set_Scope (Proc_Id, Unique_Entity (Cunit_Entity (Main_Unit))); + Set_Scope (Proc_Id, Unique_Entity (Main_Unit_Entity)); -- Create a dummy declaration for the elaboration procedure. The -- declaration does not need to be syntactically legal, but must @@ -11830,7 +11872,7 @@ package body Sem_Elab is end if; Spec_And_Body_From_Entity - (Id => Cunit_Entity (Main_Unit), + (Id => Main_Unit_Entity, Body_Decl => Body_Decl, Spec_Decl => Spec_Decl); @@ -11995,7 +12037,7 @@ package body Sem_Elab is function Declaration_Placement_Of_Node (N : Node_Id) return Declaration_Placement_Kind is - Main_Unit_Id : constant Entity_Id := Cunit_Entity (Main_Unit); + Main_Unit_Id : constant Entity_Id := Main_Unit_Entity; N_Unit_Id : constant Entity_Id := Find_Top_Unit (N); begin @@ -12150,6 +12192,9 @@ package body Sem_Elab is Main_Cunit : constant Node_Id := Cunit (Main_Unit); begin + -- ??? Remove the following use of the debug flag when switching from + -- the old to the new elaboration-order mechanism. + -- Nothing to do when switch -gnatd_G (encode invocation graph in ALI -- files) is not in effect. @@ -12458,6 +12503,43 @@ package body Sem_Elab is end if; end Process_Invocation_Call; + -------------------------------------- + -- Process_Invocation_Instantiation -- + -------------------------------------- + + procedure Process_Invocation_Instantiation + (Inst : Node_Id; + Inst_Rep : Scenario_Rep_Id; + In_State : Processing_In_State) + is + pragma Unreferenced (Inst); + + Gen_Id : constant Entity_Id := Target (Inst_Rep); + + begin + -- Nothing to do when the generic appears within an internal unit + + if In_Internal_Unit (Gen_Id) then + return; + end if; + + -- The generic being instantiated resides within an external unit + -- + -- Main unit External unit + -- +-----------+ +-------------+ + -- | | | | + -- | Start ------------> Generic | + -- | | | | + -- +-----------+ +-------------+ + -- + -- Record the invocation path which originates from Start and reaches + -- the generic. + + if not In_Extended_Main_Code_Unit (Gen_Id) then + Record_Invocation_Path (In_State); + end if; + end Process_Invocation_Instantiation; + --------------------------------- -- Process_Invocation_Scenario -- --------------------------------- @@ -12503,6 +12585,14 @@ package body Sem_Elab is In_State => In_State); end if; end if; + + -- Instantiation + + elsif Is_Suitable_Instantiation (Scen) then + Process_Invocation_Instantiation + (Inst => Scen, + Inst_Rep => Scenario_Representation_Of (Scen, In_State), + In_State => In_State); end if; -- Remove the current scenario from the stack of active scenarios @@ -13590,6 +13680,18 @@ package body Sem_Elab is end Kill_Elaboration_Scenario; ---------------------- + -- Main_Unit_Entity -- + ---------------------- + + function Main_Unit_Entity return Entity_Id is + begin + -- Note that Cunit_Entity (Main_Unit) is not reliable in the presence of + -- generic bodies and may return an outdated entity. + + return Defining_Entity (Unit (Cunit (Main_Unit))); + end Main_Unit_Entity; + + ---------------------- -- Non_Private_View -- ---------------------- @@ -15026,8 +15128,7 @@ package body Sem_Elab is -- emitted multiple times. procedure Check_SPARK_Model_In_Effect is - Spec_Id : constant Entity_Id := - Unique_Entity (Cunit_Entity (Main_Unit)); + Spec_Id : constant Entity_Id := Unique_Entity (Main_Unit_Entity); begin -- Do not emit the warning multiple times as this creates useless diff --git a/gcc/ada/switch-b.adb b/gcc/ada/switch-b.adb index dc62ec2..eefd225 100644 --- a/gcc/ada/switch-b.adb +++ b/gcc/ada/switch-b.adb @@ -353,6 +353,15 @@ package body Switch.B is Ptr := Ptr + 1; Usage_Requested := True; + -- ??? Enable the following code when switching from the old to the + -- new elaboration-order mechanism. + + -- Processing for H switch + + -- when 'H' => + -- Ptr := Ptr + 1; + -- Legacy_Elaboration_Order := True; + -- Processing for i switch when 'i' => |