1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- B I N D O . V A L I D A T O R S --
9 -- Copyright (C) 2019-2020, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Debug; use Debug;
27 with Output; use Output;
28 with Types; use Types;
35 use Bindo.Writers.Phase_Writers;
37 package body Bindo.Validators is
39 -----------------------
40 -- Local subprograms --
41 -----------------------
46 pragma Inline (Write_Error);
47 -- Write error message Msg to standard output and set flag Flag to True
49 ----------------------
50 -- Cycle_Validators --
51 ----------------------
53 package body Cycle_Validators is
54 Has_Invalid_Cycle : Boolean := False;
55 -- Flag set when the library graph contains an invalid cycle
57 -----------------------
58 -- Local subprograms --
59 -----------------------
61 procedure Validate_Cycle
63 Cycle : Library_Graph_Cycle_Id);
64 pragma Inline (Validate_Cycle);
65 -- Ensure that a cycle meets the following requirements:
67 -- * Is of proper kind
68 -- * Has enough edges to form a circuit
69 -- * No edge is repeated
71 procedure Validate_Cycle_Path
73 Cycle : Library_Graph_Cycle_Id);
74 pragma Inline (Validate_Cycle_Path);
75 -- Ensure that the path of a cycle meets the following requirements:
77 -- * No edge is repeated
83 procedure Validate_Cycle
85 Cycle : Library_Graph_Cycle_Id)
87 Msg : constant String := "Validate_Cycle";
90 pragma Assert (Present (G));
92 if not Present (Cycle) then
93 Write_Error (Msg, Has_Invalid_Cycle);
95 Write_Str (" empty cycle");
101 if Kind (G, Cycle) = No_Cycle_Kind then
102 Write_Error (Msg, Has_Invalid_Cycle);
104 Write_Str (" cycle (LGC_Id_");
105 Write_Int (Int (Cycle));
106 Write_Str (") is a No_Cycle");
111 -- A cycle requires at least one edge (self cycle) to form a circuit
113 if Length (G, Cycle) < 1 then
114 Write_Error (Msg, Has_Invalid_Cycle);
116 Write_Str (" cycle (LGC_Id_");
117 Write_Int (Int (Cycle));
118 Write_Str (") does not contain enough edges");
123 Validate_Cycle_Path (G, Cycle);
126 -------------------------
127 -- Validate_Cycle_Path --
128 -------------------------
130 procedure Validate_Cycle_Path
132 Cycle : Library_Graph_Cycle_Id)
134 Msg : constant String := "Validate_Cycle_Path";
136 Edge : Library_Graph_Edge_Id;
137 Edges : LGE_Sets.Membership_Set;
138 Iter : Edges_Of_Cycle_Iterator;
141 pragma Assert (Present (G));
142 pragma Assert (Present (Cycle));
144 -- Use a set to detect duplicate edges while traversing the cycle
146 Edges := LGE_Sets.Create (Length (G, Cycle));
148 -- Inspect the edges of the cycle, trying to catch duplicates
150 Iter := Iterate_Edges_Of_Cycle (G, Cycle);
151 while Has_Next (Iter) loop
154 -- The current edge has already been encountered while traversing
155 -- the cycle. This indicates that the cycle is malformed as edges
156 -- are not repeated in the circuit.
158 if LGE_Sets.Contains (Edges, Edge) then
159 Write_Error (Msg, Has_Invalid_Cycle);
161 Write_Str (" library graph edge (LGE_Id_");
162 Write_Int (Int (Edge));
163 Write_Str (") is repeated in cycle (LGC_Id_");
164 Write_Int (Int (Cycle));
168 -- Otherwise add the current edge to the set of encountered edges
171 LGE_Sets.Insert (Edges, Edge);
175 LGE_Sets.Destroy (Edges);
176 end Validate_Cycle_Path;
178 ---------------------
179 -- Validate_Cycles --
180 ---------------------
182 procedure Validate_Cycles (G : Library_Graph) is
183 Cycle : Library_Graph_Cycle_Id;
184 Iter : All_Cycle_Iterator;
187 pragma Assert (Present (G));
189 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
190 -- order) is not in effect.
192 if not Debug_Flag_Underscore_VV then
196 Start_Phase (Cycle_Validation);
198 Iter := Iterate_All_Cycles (G);
199 while Has_Next (Iter) loop
202 Validate_Cycle (G, Cycle);
205 End_Phase (Cycle_Validation);
207 if Has_Invalid_Cycle then
211 end Cycle_Validators;
213 ----------------------------------
214 -- Elaboration_Order_Validators --
215 ----------------------------------
217 package body Elaboration_Order_Validators is
218 Has_Invalid_Data : Boolean := False;
219 -- Flag set when the elaboration order contains invalid data
221 -----------------------
222 -- Local subprograms --
223 -----------------------
225 function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set;
226 pragma Inline (Build_Elaborable_Unit_Set);
227 -- Create a set from all units that need to be elaborated
229 procedure Report_Missing_Elaboration (U_Id : Unit_Id);
230 pragma Inline (Report_Missing_Elaboration);
231 -- Emit an error concerning unit U_Id that must be elaborated, but was
234 procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set);
235 pragma Inline (Report_Missing_Elaborations);
236 -- Emit errors on all units in set Set that must be elaborated, but were
239 procedure Report_Spurious_Elaboration (U_Id : Unit_Id);
240 pragma Inline (Report_Spurious_Elaboration);
241 -- Emit an error concerning unit U_Id that is incorrectly elaborated
243 procedure Validate_Unit
245 Elab_Set : Unit_Sets.Membership_Set);
246 pragma Inline (Validate_Unit);
247 -- Validate the elaboration status of unit U_Id. Elab_Set is the set of
248 -- all units that need to be elaborated.
250 procedure Validate_Units (Order : Unit_Id_Table);
251 pragma Inline (Validate_Units);
252 -- Validate all units in elaboration order Order
254 -------------------------------
255 -- Build_Elaborable_Unit_Set --
256 -------------------------------
258 function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set is
259 Iter : Elaborable_Units_Iterator;
260 Set : Unit_Sets.Membership_Set;
264 Set := Unit_Sets.Create (Number_Of_Elaborable_Units);
265 Iter := Iterate_Elaborable_Units;
266 while Has_Next (Iter) loop
269 Unit_Sets.Insert (Set, U_Id);
273 end Build_Elaborable_Unit_Set;
275 --------------------------------
276 -- Report_Missing_Elaboration --
277 --------------------------------
279 procedure Report_Missing_Elaboration (U_Id : Unit_Id) is
280 Msg : constant String := "Report_Missing_Elaboration";
283 pragma Assert (Present (U_Id));
284 Write_Error (Msg, Has_Invalid_Data);
286 Write_Str ("unit (U_Id_");
287 Write_Int (Int (U_Id));
288 Write_Str (") name = ");
289 Write_Name (Name (U_Id));
290 Write_Str (" must be elaborated");
292 end Report_Missing_Elaboration;
294 ---------------------------------
295 -- Report_Missing_Elaborations --
296 ---------------------------------
298 procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set) is
299 Iter : Unit_Sets.Iterator;
303 Iter := Unit_Sets.Iterate (Set);
304 while Unit_Sets.Has_Next (Iter) loop
305 Unit_Sets.Next (Iter, U_Id);
307 Report_Missing_Elaboration (U_Id);
309 end Report_Missing_Elaborations;
311 ---------------------------------
312 -- Report_Spurious_Elaboration --
313 ---------------------------------
315 procedure Report_Spurious_Elaboration (U_Id : Unit_Id) is
316 Msg : constant String := "Report_Spurious_Elaboration";
319 pragma Assert (Present (U_Id));
320 Write_Error (Msg, Has_Invalid_Data);
322 Write_Str ("unit (U_Id_");
323 Write_Int (Int (U_Id));
324 Write_Str (") name = ");
325 Write_Name (Name (U_Id));
326 Write_Str (" must not be elaborated");
327 end Report_Spurious_Elaboration;
329 --------------------------------
330 -- Validate_Elaboration_Order --
331 --------------------------------
333 procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is
335 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
336 -- order) is not in effect.
338 if not Debug_Flag_Underscore_VV then
342 Start_Phase (Elaboration_Order_Validation);
344 Validate_Units (Order);
346 End_Phase (Elaboration_Order_Validation);
348 if Has_Invalid_Data then
349 raise Invalid_Elaboration_Order;
351 end Validate_Elaboration_Order;
357 procedure Validate_Unit
359 Elab_Set : Unit_Sets.Membership_Set)
362 pragma Assert (Present (U_Id));
364 -- The current unit in the elaboration order appears within the set
365 -- of units that require elaboration. Remove it from the set.
367 if Unit_Sets.Contains (Elab_Set, U_Id) then
368 Unit_Sets.Delete (Elab_Set, U_Id);
370 -- Otherwise the current unit in the elaboration order must not be
374 Report_Spurious_Elaboration (U_Id);
382 procedure Validate_Units (Order : Unit_Id_Table) is
383 Elab_Set : Unit_Sets.Membership_Set;
386 -- Collect all units in the compilation that need to be elaborated
389 Elab_Set := Build_Elaborable_Unit_Set;
391 -- Validate each unit in the elaboration order against the set of
392 -- units that need to be elaborated.
394 for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop
396 (U_Id => Order.Table (Index),
397 Elab_Set => Elab_Set);
400 -- At this point all units that need to be elaborated should have
401 -- been eliminated from the set. Report any units that are missing
402 -- their elaboration.
404 Report_Missing_Elaborations (Elab_Set);
405 Unit_Sets.Destroy (Elab_Set);
407 end Elaboration_Order_Validators;
409 ---------------------------------
410 -- Invocation_Graph_Validators --
411 ---------------------------------
413 package body Invocation_Graph_Validators is
414 Has_Invalid_Data : Boolean := False;
415 -- Flag set when the invocation graph contains invalid data
417 -----------------------
418 -- Local subprograms --
419 -----------------------
421 procedure Validate_Invocation_Graph_Edge
422 (G : Invocation_Graph;
423 Edge : Invocation_Graph_Edge_Id);
424 pragma Inline (Validate_Invocation_Graph_Edge);
425 -- Verify that the attributes of edge Edge of invocation graph G are
428 procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph);
429 pragma Inline (Validate_Invocation_Graph_Edges);
430 -- Verify that the attributes of all edges of invocation graph G are
433 procedure Validate_Invocation_Graph_Vertex
434 (G : Invocation_Graph;
435 Vertex : Invocation_Graph_Vertex_Id);
436 pragma Inline (Validate_Invocation_Graph_Vertex);
437 -- Verify that the attributes of vertex Vertex of invocation graph G are
440 procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph);
441 pragma Inline (Validate_Invocation_Graph_Vertices);
442 -- Verify that the attributes of all vertices of invocation graph G are
445 -------------------------------
446 -- Validate_Invocation_Graph --
447 -------------------------------
449 procedure Validate_Invocation_Graph (G : Invocation_Graph) is
451 pragma Assert (Present (G));
453 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
454 -- order) is not in effect.
456 if not Debug_Flag_Underscore_VV then
460 Start_Phase (Invocation_Graph_Validation);
462 Validate_Invocation_Graph_Vertices (G);
463 Validate_Invocation_Graph_Edges (G);
465 End_Phase (Invocation_Graph_Validation);
467 if Has_Invalid_Data then
468 raise Invalid_Invocation_Graph;
470 end Validate_Invocation_Graph;
472 ------------------------------------
473 -- Validate_Invocation_Graph_Edge --
474 ------------------------------------
476 procedure Validate_Invocation_Graph_Edge
477 (G : Invocation_Graph;
478 Edge : Invocation_Graph_Edge_Id)
480 Msg : constant String := "Validate_Invocation_Graph_Edge";
483 pragma Assert (Present (G));
485 if not Present (Edge) then
486 Write_Error (Msg, Has_Invalid_Data);
488 Write_Str (" empty invocation graph edge");
494 if not Present (Relation (G, Edge)) then
495 Write_Error (Msg, Has_Invalid_Data);
497 Write_Str (" invocation graph edge (IGE_Id_");
498 Write_Int (Int (Edge));
499 Write_Str (") lacks Relation");
504 if not Present (Target (G, Edge)) then
505 Write_Error (Msg, Has_Invalid_Data);
507 Write_Str (" invocation graph edge (IGE_Id_");
508 Write_Int (Int (Edge));
509 Write_Str (") lacks Target");
513 end Validate_Invocation_Graph_Edge;
515 -------------------------------------
516 -- Validate_Invocation_Graph_Edges --
517 -------------------------------------
519 procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is
520 Edge : Invocation_Graph_Edge_Id;
521 Iter : Invocation_Graphs.All_Edge_Iterator;
524 pragma Assert (Present (G));
526 Iter := Iterate_All_Edges (G);
527 while Has_Next (Iter) loop
530 Validate_Invocation_Graph_Edge (G, Edge);
532 end Validate_Invocation_Graph_Edges;
534 --------------------------------------
535 -- Validate_Invocation_Graph_Vertex --
536 --------------------------------------
538 procedure Validate_Invocation_Graph_Vertex
539 (G : Invocation_Graph;
540 Vertex : Invocation_Graph_Vertex_Id)
542 Msg : constant String := "Validate_Invocation_Graph_Vertex";
545 pragma Assert (Present (G));
547 if not Present (Vertex) then
548 Write_Error (Msg, Has_Invalid_Data);
550 Write_Str (" empty invocation graph vertex");
556 if not Present (Body_Vertex (G, Vertex)) then
557 Write_Error (Msg, Has_Invalid_Data);
559 Write_Str (" invocation graph vertex (IGV_Id_");
560 Write_Int (Int (Vertex));
561 Write_Str (") lacks Body_Vertex");
566 if not Present (Construct (G, Vertex)) then
567 Write_Error (Msg, Has_Invalid_Data);
569 Write_Str (" invocation graph vertex (IGV_Id_");
570 Write_Int (Int (Vertex));
571 Write_Str (") lacks Construct");
576 if not Present (Spec_Vertex (G, Vertex)) then
577 Write_Error (Msg, Has_Invalid_Data);
579 Write_Str (" invocation graph vertex (IGV_Id_");
580 Write_Int (Int (Vertex));
581 Write_Str (") lacks Spec_Vertex");
585 end Validate_Invocation_Graph_Vertex;
587 ----------------------------------------
588 -- Validate_Invocation_Graph_Vertices --
589 ----------------------------------------
591 procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is
592 Iter : Invocation_Graphs.All_Vertex_Iterator;
593 Vertex : Invocation_Graph_Vertex_Id;
596 pragma Assert (Present (G));
598 Iter := Iterate_All_Vertices (G);
599 while Has_Next (Iter) loop
602 Validate_Invocation_Graph_Vertex (G, Vertex);
604 end Validate_Invocation_Graph_Vertices;
605 end Invocation_Graph_Validators;
607 ------------------------------
608 -- Library_Graph_Validators --
609 ------------------------------
611 package body Library_Graph_Validators is
612 Has_Invalid_Data : Boolean := False;
613 -- Flag set when the library graph contains invalid data
615 -----------------------
616 -- Local subprograms --
617 -----------------------
619 procedure Validate_Library_Graph_Edge
621 Edge : Library_Graph_Edge_Id);
622 pragma Inline (Validate_Library_Graph_Edge);
623 -- Verify that the attributes of edge Edge of library graph G are
626 procedure Validate_Library_Graph_Edges (G : Library_Graph);
627 pragma Inline (Validate_Library_Graph_Edges);
628 -- Verify that the attributes of all edges of library graph G are
631 procedure Validate_Library_Graph_Vertex
633 Vertex : Library_Graph_Vertex_Id);
634 pragma Inline (Validate_Library_Graph_Vertex);
635 -- Verify that the attributes of vertex Vertex of library graph G are
638 procedure Validate_Library_Graph_Vertices (G : Library_Graph);
639 pragma Inline (Validate_Library_Graph_Vertices);
640 -- Verify that the attributes of all vertices of library graph G are
643 ----------------------------
644 -- Validate_Library_Graph --
645 ----------------------------
647 procedure Validate_Library_Graph (G : Library_Graph) is
649 pragma Assert (Present (G));
651 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
652 -- order) is not in effect.
654 if not Debug_Flag_Underscore_VV then
658 Start_Phase (Library_Graph_Validation);
660 Validate_Library_Graph_Vertices (G);
661 Validate_Library_Graph_Edges (G);
663 End_Phase (Library_Graph_Validation);
665 if Has_Invalid_Data then
666 raise Invalid_Library_Graph;
668 end Validate_Library_Graph;
670 ---------------------------------
671 -- Validate_Library_Graph_Edge --
672 ---------------------------------
674 procedure Validate_Library_Graph_Edge
676 Edge : Library_Graph_Edge_Id)
678 Msg : constant String := "Validate_Library_Graph_Edge";
681 pragma Assert (Present (G));
683 if not Present (Edge) then
684 Write_Error (Msg, Has_Invalid_Data);
686 Write_Str (" empty library graph edge");
692 if Kind (G, Edge) = No_Edge then
693 Write_Error (Msg, Has_Invalid_Data);
695 Write_Str (" library graph edge (LGE_Id_");
696 Write_Int (Int (Edge));
697 Write_Str (") is not a valid edge");
701 elsif Kind (G, Edge) = Body_Before_Spec_Edge then
702 Write_Error (Msg, Has_Invalid_Data);
704 Write_Str (" library graph edge (LGE_Id_");
705 Write_Int (Int (Edge));
706 Write_Str (") is a Body_Before_Spec edge");
711 if not Present (Predecessor (G, Edge)) then
712 Write_Error (Msg, Has_Invalid_Data);
714 Write_Str (" library graph edge (LGE_Id_");
715 Write_Int (Int (Edge));
716 Write_Str (") lacks Predecessor");
721 if not Present (Successor (G, Edge)) then
722 Write_Error (Msg, Has_Invalid_Data);
724 Write_Str (" library graph edge (LGE_Id_");
725 Write_Int (Int (Edge));
726 Write_Str (") lacks Successor");
730 end Validate_Library_Graph_Edge;
732 ----------------------------------
733 -- Validate_Library_Graph_Edges --
734 ----------------------------------
736 procedure Validate_Library_Graph_Edges (G : Library_Graph) is
737 Edge : Library_Graph_Edge_Id;
738 Iter : Library_Graphs.All_Edge_Iterator;
741 pragma Assert (Present (G));
743 Iter := Iterate_All_Edges (G);
744 while Has_Next (Iter) loop
747 Validate_Library_Graph_Edge (G, Edge);
749 end Validate_Library_Graph_Edges;
751 -----------------------------------
752 -- Validate_Library_Graph_Vertex --
753 -----------------------------------
755 procedure Validate_Library_Graph_Vertex
757 Vertex : Library_Graph_Vertex_Id)
759 Msg : constant String := "Validate_Library_Graph_Vertex";
762 pragma Assert (Present (G));
764 if not Present (Vertex) then
765 Write_Error (Msg, Has_Invalid_Data);
767 Write_Str (" empty library graph vertex");
773 if (Is_Body_With_Spec (G, Vertex)
775 Is_Spec_With_Body (G, Vertex))
776 and then not Present (Corresponding_Item (G, Vertex))
778 Write_Error (Msg, Has_Invalid_Data);
780 Write_Str (" library graph vertex (LGV_Id_");
781 Write_Int (Int (Vertex));
782 Write_Str (") lacks Corresponding_Item");
787 if not Present (Unit (G, Vertex)) then
788 Write_Error (Msg, Has_Invalid_Data);
790 Write_Str (" library graph vertex (LGV_Id_");
791 Write_Int (Int (Vertex));
792 Write_Str (") lacks Unit");
796 end Validate_Library_Graph_Vertex;
798 -------------------------------------
799 -- Validate_Library_Graph_Vertices --
800 -------------------------------------
802 procedure Validate_Library_Graph_Vertices (G : Library_Graph) is
803 Iter : Library_Graphs.All_Vertex_Iterator;
804 Vertex : Library_Graph_Vertex_Id;
807 pragma Assert (Present (G));
809 Iter := Iterate_All_Vertices (G);
810 while Has_Next (Iter) loop
813 Validate_Library_Graph_Vertex (G, Vertex);
815 end Validate_Library_Graph_Vertices;
816 end Library_Graph_Validators;
822 procedure Write_Error
827 Write_Str ("ERROR: ");
834 end Bindo.Validators;