835 lines
26 KiB
Ada
835 lines
26 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2020, 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;
|