| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- B I N D O . V A L I D A T O R S -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 2019-2022, 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- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Debug; use Debug; |
| with Output; use Output; |
| with Types; use Types; |
| |
| with Bindo.Units; |
| use Bindo.Units; |
| |
| with Bindo.Writers; |
| use Bindo.Writers; |
| use Bindo.Writers.Phase_Writers; |
| |
| package body Bindo.Validators is |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Write_Error |
| (Msg : String; |
| Flag : out Boolean); |
| pragma Inline (Write_Error); |
| -- Write error message Msg to standard output and set flag Flag to True |
| |
| ---------------------- |
| -- Cycle_Validators -- |
| ---------------------- |
| |
| package body Cycle_Validators is |
| Has_Invalid_Cycle : Boolean := False; |
| -- Flag set when the library graph contains an invalid cycle |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Validate_Cycle |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id); |
| pragma Inline (Validate_Cycle); |
| -- Ensure that a cycle meets the following requirements: |
| -- |
| -- * Is of proper kind |
| -- * Has enough edges to form a circuit |
| -- * No edge is repeated |
| |
| procedure Validate_Cycle_Path |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id); |
| pragma Inline (Validate_Cycle_Path); |
| -- Ensure that the path of a cycle meets the following requirements: |
| -- |
| -- * No edge is repeated |
| |
| -------------------- |
| -- Validate_Cycle -- |
| -------------------- |
| |
| procedure Validate_Cycle |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id) |
| is |
| Msg : constant String := "Validate_Cycle"; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| if not Present (Cycle) then |
| Write_Error (Msg, Has_Invalid_Cycle); |
| |
| Write_Str (" empty cycle"); |
| Write_Eol; |
| Write_Eol; |
| return; |
| end if; |
| |
| if Kind (G, Cycle) = No_Cycle_Kind then |
| Write_Error (Msg, Has_Invalid_Cycle); |
| |
| Write_Str (" cycle (LGC_Id_"); |
| Write_Int (Int (Cycle)); |
| Write_Str (") is a No_Cycle"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| -- A cycle requires at least one edge (self cycle) to form a circuit |
| |
| if Length (G, Cycle) < 1 then |
| Write_Error (Msg, Has_Invalid_Cycle); |
| |
| Write_Str (" cycle (LGC_Id_"); |
| Write_Int (Int (Cycle)); |
| Write_Str (") does not contain enough edges"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| Validate_Cycle_Path (G, Cycle); |
| end Validate_Cycle; |
| |
| ------------------------- |
| -- Validate_Cycle_Path -- |
| ------------------------- |
| |
| procedure Validate_Cycle_Path |
| (G : Library_Graph; |
| Cycle : Library_Graph_Cycle_Id) |
| is |
| Msg : constant String := "Validate_Cycle_Path"; |
| |
| Edge : Library_Graph_Edge_Id; |
| Edges : LGE_Sets.Membership_Set; |
| Iter : Edges_Of_Cycle_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| pragma Assert (Present (Cycle)); |
| |
| -- Use a set to detect duplicate edges while traversing the cycle |
| |
| Edges := LGE_Sets.Create (Length (G, Cycle)); |
| |
| -- Inspect the edges of the cycle, trying to catch duplicates |
| |
| Iter := Iterate_Edges_Of_Cycle (G, Cycle); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| -- The current edge has already been encountered while traversing |
| -- the cycle. This indicates that the cycle is malformed as edges |
| -- are not repeated in the circuit. |
| |
| if LGE_Sets.Contains (Edges, Edge) then |
| Write_Error (Msg, Has_Invalid_Cycle); |
| |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") is repeated in cycle (LGC_Id_"); |
| Write_Int (Int (Cycle)); |
| Write_Str (")"); |
| Write_Eol; |
| |
| -- Otherwise add the current edge to the set of encountered edges |
| |
| else |
| LGE_Sets.Insert (Edges, Edge); |
| end if; |
| end loop; |
| |
| LGE_Sets.Destroy (Edges); |
| end Validate_Cycle_Path; |
| |
| --------------------- |
| -- Validate_Cycles -- |
| --------------------- |
| |
| procedure Validate_Cycles (G : Library_Graph) is |
| Cycle : Library_Graph_Cycle_Id; |
| Iter : All_Cycle_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and |
| -- order) is not in effect. |
| |
| if not Debug_Flag_Underscore_VV then |
| return; |
| end if; |
| |
| Start_Phase (Cycle_Validation); |
| |
| Iter := Iterate_All_Cycles (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Cycle); |
| |
| Validate_Cycle (G, Cycle); |
| end loop; |
| |
| End_Phase (Cycle_Validation); |
| |
| if Has_Invalid_Cycle then |
| raise Invalid_Cycle; |
| end if; |
| end Validate_Cycles; |
| end Cycle_Validators; |
| |
| ---------------------------------- |
| -- Elaboration_Order_Validators -- |
| ---------------------------------- |
| |
| package body Elaboration_Order_Validators is |
| Has_Invalid_Data : Boolean := False; |
| -- Flag set when the elaboration order contains invalid data |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set; |
| pragma Inline (Build_Elaborable_Unit_Set); |
| -- Create a set from all units that need to be elaborated |
| |
| procedure Report_Missing_Elaboration (U_Id : Unit_Id); |
| pragma Inline (Report_Missing_Elaboration); |
| -- Emit an error concerning unit U_Id that must be elaborated, but was |
| -- not. |
| |
| procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set); |
| pragma Inline (Report_Missing_Elaborations); |
| -- Emit errors on all units in set Set that must be elaborated, but were |
| -- not. |
| |
| procedure Report_Spurious_Elaboration (U_Id : Unit_Id); |
| pragma Inline (Report_Spurious_Elaboration); |
| -- Emit an error concerning unit U_Id that is incorrectly elaborated |
| |
| procedure Validate_Unit |
| (U_Id : Unit_Id; |
| Elab_Set : Unit_Sets.Membership_Set); |
| pragma Inline (Validate_Unit); |
| -- Validate the elaboration status of unit U_Id. Elab_Set is the set of |
| -- all units that need to be elaborated. |
| |
| procedure Validate_Units (Order : Unit_Id_Table); |
| pragma Inline (Validate_Units); |
| -- Validate all units in elaboration order Order |
| |
| ------------------------------- |
| -- Build_Elaborable_Unit_Set -- |
| ------------------------------- |
| |
| function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set is |
| Iter : Elaborable_Units_Iterator; |
| Set : Unit_Sets.Membership_Set; |
| U_Id : Unit_Id; |
| |
| begin |
| Set := Unit_Sets.Create (Number_Of_Elaborable_Units); |
| Iter := Iterate_Elaborable_Units; |
| while Has_Next (Iter) loop |
| Next (Iter, U_Id); |
| |
| Unit_Sets.Insert (Set, U_Id); |
| end loop; |
| |
| return Set; |
| end Build_Elaborable_Unit_Set; |
| |
| -------------------------------- |
| -- Report_Missing_Elaboration -- |
| -------------------------------- |
| |
| procedure Report_Missing_Elaboration (U_Id : Unit_Id) is |
| Msg : constant String := "Report_Missing_Elaboration"; |
| |
| begin |
| pragma Assert (Present (U_Id)); |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str ("unit (U_Id_"); |
| Write_Int (Int (U_Id)); |
| Write_Str (") name = "); |
| Write_Name (Name (U_Id)); |
| Write_Str (" must be elaborated"); |
| Write_Eol; |
| end Report_Missing_Elaboration; |
| |
| --------------------------------- |
| -- Report_Missing_Elaborations -- |
| --------------------------------- |
| |
| procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set) is |
| Iter : Unit_Sets.Iterator; |
| U_Id : Unit_Id; |
| |
| begin |
| Iter := Unit_Sets.Iterate (Set); |
| while Unit_Sets.Has_Next (Iter) loop |
| Unit_Sets.Next (Iter, U_Id); |
| |
| Report_Missing_Elaboration (U_Id); |
| end loop; |
| end Report_Missing_Elaborations; |
| |
| --------------------------------- |
| -- Report_Spurious_Elaboration -- |
| --------------------------------- |
| |
| procedure Report_Spurious_Elaboration (U_Id : Unit_Id) is |
| Msg : constant String := "Report_Spurious_Elaboration"; |
| |
| begin |
| pragma Assert (Present (U_Id)); |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str ("unit (U_Id_"); |
| Write_Int (Int (U_Id)); |
| Write_Str (") name = "); |
| Write_Name (Name (U_Id)); |
| Write_Str (" must not be elaborated"); |
| end Report_Spurious_Elaboration; |
| |
| -------------------------------- |
| -- Validate_Elaboration_Order -- |
| -------------------------------- |
| |
| procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is |
| begin |
| -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and |
| -- order) is not in effect. |
| |
| if not Debug_Flag_Underscore_VV then |
| return; |
| end if; |
| |
| Start_Phase (Elaboration_Order_Validation); |
| |
| Validate_Units (Order); |
| |
| End_Phase (Elaboration_Order_Validation); |
| |
| if Has_Invalid_Data then |
| raise Invalid_Elaboration_Order; |
| end if; |
| end Validate_Elaboration_Order; |
| |
| ------------------- |
| -- Validate_Unit -- |
| ------------------- |
| |
| procedure Validate_Unit |
| (U_Id : Unit_Id; |
| Elab_Set : Unit_Sets.Membership_Set) |
| is |
| begin |
| pragma Assert (Present (U_Id)); |
| |
| -- The current unit in the elaboration order appears within the set |
| -- of units that require elaboration. Remove it from the set. |
| |
| if Unit_Sets.Contains (Elab_Set, U_Id) then |
| Unit_Sets.Delete (Elab_Set, U_Id); |
| |
| -- Otherwise the current unit in the elaboration order must not be |
| -- elaborated. |
| |
| else |
| Report_Spurious_Elaboration (U_Id); |
| end if; |
| end Validate_Unit; |
| |
| -------------------- |
| -- Validate_Units -- |
| -------------------- |
| |
| procedure Validate_Units (Order : Unit_Id_Table) is |
| Elab_Set : Unit_Sets.Membership_Set; |
| |
| begin |
| -- Collect all units in the compilation that need to be elaborated |
| -- in a set. |
| |
| Elab_Set := Build_Elaborable_Unit_Set; |
| |
| -- Validate each unit in the elaboration order against the set of |
| -- units that need to be elaborated. |
| |
| for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop |
| Validate_Unit |
| (U_Id => Order.Table (Index), |
| Elab_Set => Elab_Set); |
| end loop; |
| |
| -- At this point all units that need to be elaborated should have |
| -- been eliminated from the set. Report any units that are missing |
| -- their elaboration. |
| |
| Report_Missing_Elaborations (Elab_Set); |
| Unit_Sets.Destroy (Elab_Set); |
| end Validate_Units; |
| end Elaboration_Order_Validators; |
| |
| --------------------------------- |
| -- Invocation_Graph_Validators -- |
| --------------------------------- |
| |
| package body Invocation_Graph_Validators is |
| Has_Invalid_Data : Boolean := False; |
| -- Flag set when the invocation graph contains invalid data |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Validate_Invocation_Graph_Edge |
| (G : Invocation_Graph; |
| Edge : Invocation_Graph_Edge_Id); |
| pragma Inline (Validate_Invocation_Graph_Edge); |
| -- Verify that the attributes of edge Edge of invocation graph G are |
| -- properly set. |
| |
| procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph); |
| pragma Inline (Validate_Invocation_Graph_Edges); |
| -- Verify that the attributes of all edges of invocation graph G are |
| -- properly set. |
| |
| procedure Validate_Invocation_Graph_Vertex |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id); |
| pragma Inline (Validate_Invocation_Graph_Vertex); |
| -- Verify that the attributes of vertex Vertex of invocation graph G are |
| -- properly set. |
| |
| procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph); |
| pragma Inline (Validate_Invocation_Graph_Vertices); |
| -- Verify that the attributes of all vertices of invocation graph G are |
| -- properly set. |
| |
| ------------------------------- |
| -- Validate_Invocation_Graph -- |
| ------------------------------- |
| |
| procedure Validate_Invocation_Graph (G : Invocation_Graph) is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and |
| -- order) is not in effect. |
| |
| if not Debug_Flag_Underscore_VV then |
| return; |
| end if; |
| |
| Start_Phase (Invocation_Graph_Validation); |
| |
| Validate_Invocation_Graph_Vertices (G); |
| Validate_Invocation_Graph_Edges (G); |
| |
| End_Phase (Invocation_Graph_Validation); |
| |
| if Has_Invalid_Data then |
| raise Invalid_Invocation_Graph; |
| end if; |
| end Validate_Invocation_Graph; |
| |
| ------------------------------------ |
| -- Validate_Invocation_Graph_Edge -- |
| ------------------------------------ |
| |
| procedure Validate_Invocation_Graph_Edge |
| (G : Invocation_Graph; |
| Edge : Invocation_Graph_Edge_Id) |
| is |
| Msg : constant String := "Validate_Invocation_Graph_Edge"; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| if not Present (Edge) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" empty invocation graph edge"); |
| Write_Eol; |
| Write_Eol; |
| return; |
| end if; |
| |
| if not Present (Relation (G, Edge)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" invocation graph edge (IGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") lacks Relation"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Target (G, Edge)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" invocation graph edge (IGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") lacks Target"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| end Validate_Invocation_Graph_Edge; |
| |
| ------------------------------------- |
| -- Validate_Invocation_Graph_Edges -- |
| ------------------------------------- |
| |
| procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is |
| Edge : Invocation_Graph_Edge_Id; |
| Iter : Invocation_Graphs.All_Edge_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Edges (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Validate_Invocation_Graph_Edge (G, Edge); |
| end loop; |
| end Validate_Invocation_Graph_Edges; |
| |
| -------------------------------------- |
| -- Validate_Invocation_Graph_Vertex -- |
| -------------------------------------- |
| |
| procedure Validate_Invocation_Graph_Vertex |
| (G : Invocation_Graph; |
| Vertex : Invocation_Graph_Vertex_Id) |
| is |
| Msg : constant String := "Validate_Invocation_Graph_Vertex"; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| if not Present (Vertex) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" empty invocation graph vertex"); |
| Write_Eol; |
| Write_Eol; |
| return; |
| end if; |
| |
| if not Present (Body_Vertex (G, Vertex)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" invocation graph vertex (IGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") lacks Body_Vertex"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Construct (G, Vertex)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" invocation graph vertex (IGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") lacks Construct"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Spec_Vertex (G, Vertex)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" invocation graph vertex (IGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") lacks Spec_Vertex"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| end Validate_Invocation_Graph_Vertex; |
| |
| ---------------------------------------- |
| -- Validate_Invocation_Graph_Vertices -- |
| ---------------------------------------- |
| |
| procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is |
| Iter : Invocation_Graphs.All_Vertex_Iterator; |
| Vertex : Invocation_Graph_Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Validate_Invocation_Graph_Vertex (G, Vertex); |
| end loop; |
| end Validate_Invocation_Graph_Vertices; |
| end Invocation_Graph_Validators; |
| |
| ------------------------------ |
| -- Library_Graph_Validators -- |
| ------------------------------ |
| |
| package body Library_Graph_Validators is |
| Has_Invalid_Data : Boolean := False; |
| -- Flag set when the library graph contains invalid data |
| |
| ----------------------- |
| -- Local subprograms -- |
| ----------------------- |
| |
| procedure Validate_Library_Graph_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id); |
| pragma Inline (Validate_Library_Graph_Edge); |
| -- Verify that the attributes of edge Edge of library graph G are |
| -- properly set. |
| |
| procedure Validate_Library_Graph_Edges (G : Library_Graph); |
| pragma Inline (Validate_Library_Graph_Edges); |
| -- Verify that the attributes of all edges of library graph G are |
| -- properly set. |
| |
| procedure Validate_Library_Graph_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id); |
| pragma Inline (Validate_Library_Graph_Vertex); |
| -- Verify that the attributes of vertex Vertex of library graph G are |
| -- properly set. |
| |
| procedure Validate_Library_Graph_Vertices (G : Library_Graph); |
| pragma Inline (Validate_Library_Graph_Vertices); |
| -- Verify that the attributes of all vertices of library graph G are |
| -- properly set. |
| |
| ---------------------------- |
| -- Validate_Library_Graph -- |
| ---------------------------- |
| |
| procedure Validate_Library_Graph (G : Library_Graph) is |
| begin |
| pragma Assert (Present (G)); |
| |
| -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and |
| -- order) is not in effect. |
| |
| if not Debug_Flag_Underscore_VV then |
| return; |
| end if; |
| |
| Start_Phase (Library_Graph_Validation); |
| |
| Validate_Library_Graph_Vertices (G); |
| Validate_Library_Graph_Edges (G); |
| |
| End_Phase (Library_Graph_Validation); |
| |
| if Has_Invalid_Data then |
| raise Invalid_Library_Graph; |
| end if; |
| end Validate_Library_Graph; |
| |
| --------------------------------- |
| -- Validate_Library_Graph_Edge -- |
| --------------------------------- |
| |
| procedure Validate_Library_Graph_Edge |
| (G : Library_Graph; |
| Edge : Library_Graph_Edge_Id) |
| is |
| Msg : constant String := "Validate_Library_Graph_Edge"; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| if not Present (Edge) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" empty library graph edge"); |
| Write_Eol; |
| Write_Eol; |
| return; |
| end if; |
| |
| if Kind (G, Edge) = No_Edge then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") is not a valid edge"); |
| Write_Eol; |
| Write_Eol; |
| |
| elsif Kind (G, Edge) = Body_Before_Spec_Edge then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") is a Body_Before_Spec edge"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Predecessor (G, Edge)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") lacks Predecessor"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Successor (G, Edge)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph edge (LGE_Id_"); |
| Write_Int (Int (Edge)); |
| Write_Str (") lacks Successor"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| end Validate_Library_Graph_Edge; |
| |
| ---------------------------------- |
| -- Validate_Library_Graph_Edges -- |
| ---------------------------------- |
| |
| procedure Validate_Library_Graph_Edges (G : Library_Graph) is |
| Edge : Library_Graph_Edge_Id; |
| Iter : Library_Graphs.All_Edge_Iterator; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Edges (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Edge); |
| |
| Validate_Library_Graph_Edge (G, Edge); |
| end loop; |
| end Validate_Library_Graph_Edges; |
| |
| ----------------------------------- |
| -- Validate_Library_Graph_Vertex -- |
| ----------------------------------- |
| |
| procedure Validate_Library_Graph_Vertex |
| (G : Library_Graph; |
| Vertex : Library_Graph_Vertex_Id) |
| is |
| Msg : constant String := "Validate_Library_Graph_Vertex"; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| if not Present (Vertex) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" empty library graph vertex"); |
| Write_Eol; |
| Write_Eol; |
| return; |
| end if; |
| |
| if (Is_Body_With_Spec (G, Vertex) |
| or else |
| Is_Spec_With_Body (G, Vertex)) |
| and then not Present (Corresponding_Item (G, Vertex)) |
| then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph vertex (LGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") lacks Corresponding_Item"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| |
| if not Present (Unit (G, Vertex)) then |
| Write_Error (Msg, Has_Invalid_Data); |
| |
| Write_Str (" library graph vertex (LGV_Id_"); |
| Write_Int (Int (Vertex)); |
| Write_Str (") lacks Unit"); |
| Write_Eol; |
| Write_Eol; |
| end if; |
| end Validate_Library_Graph_Vertex; |
| |
| ------------------------------------- |
| -- Validate_Library_Graph_Vertices -- |
| ------------------------------------- |
| |
| procedure Validate_Library_Graph_Vertices (G : Library_Graph) is |
| Iter : Library_Graphs.All_Vertex_Iterator; |
| Vertex : Library_Graph_Vertex_Id; |
| |
| begin |
| pragma Assert (Present (G)); |
| |
| Iter := Iterate_All_Vertices (G); |
| while Has_Next (Iter) loop |
| Next (Iter, Vertex); |
| |
| Validate_Library_Graph_Vertex (G, Vertex); |
| end loop; |
| end Validate_Library_Graph_Vertices; |
| end Library_Graph_Validators; |
| |
| ----------------- |
| -- Write_Error -- |
| ----------------- |
| |
| procedure Write_Error |
| (Msg : String; |
| Flag : out Boolean) |
| is |
| begin |
| Write_Str ("ERROR: "); |
| Write_Str (Msg); |
| Write_Eol; |
| |
| Flag := True; |
| end Write_Error; |
| |
| end Bindo.Validators; |
