]> git.ipfire.org Git - thirdparty/gcc.git/blame_incremental - gcc/ada/bindo-validators.adb
projects / thirdparty / gcc.git / blame_incremental
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (non-incremental) | history | HEAD
sh: Recognize >> 31 in treg_set_expr_not_const01
[thirdparty/gcc.git] / gcc / ada / bindo-validators.adb
... / ...
CommitLineData
1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- B I N D O . V A L I D A T O R S --
6-- --
7-- B o d y --
8-- --
9-- Copyright (C) 2019-2025, Free Software Foundation, Inc. --
10-- --
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. --
20-- --
21-- GNAT was originally developed by the GNAT team at New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc. --
23-- --
24------------------------------------------------------------------------------
25
26with Debug; use Debug;
27with Output; use Output;
28with Types; use Types;
29
30with Bindo.Units;
31use Bindo.Units;
32
33with Bindo.Writers;
34use Bindo.Writers;
35use Bindo.Writers.Phase_Writers;
36
37package body Bindo.Validators is
38
39 -----------------------
40 -- Local subprograms --
41 -----------------------
42
43 procedure Write_Error
44 (Msg : String;
45 Flag : out Boolean);
46 pragma Inline (Write_Error);
47 -- Write error message Msg to standard output and set flag Flag to True
48
49 ----------------------
50 -- Cycle_Validators --
51 ----------------------
52
53 package body Cycle_Validators is
54 Has_Invalid_Cycle : Boolean := False;
55 -- Flag set when the library graph contains an invalid cycle
56
57 -----------------------
58 -- Local subprograms --
59 -----------------------
60
61 procedure Validate_Cycle
62 (G : Library_Graph;
63 Cycle : Library_Graph_Cycle_Id);
64 pragma Inline (Validate_Cycle);
65 -- Ensure that a cycle meets the following requirements:
66 --
67 -- * Is of proper kind
68 -- * Has enough edges to form a circuit
69 -- * No edge is repeated
70
71 procedure Validate_Cycle_Path
72 (G : Library_Graph;
73 Cycle : Library_Graph_Cycle_Id);
74 pragma Inline (Validate_Cycle_Path);
75 -- Ensure that the path of a cycle meets the following requirements:
76 --
77 -- * No edge is repeated
78
79 --------------------
80 -- Validate_Cycle --
81 --------------------
82
83 procedure Validate_Cycle
84 (G : Library_Graph;
85 Cycle : Library_Graph_Cycle_Id)
86 is
87 Msg : constant String := "Validate_Cycle";
88
89 begin
90 pragma Assert (Present (G));
91
92 if not Present (Cycle) then
93 Write_Error (Msg, Has_Invalid_Cycle);
94
95 Write_Str (" empty cycle");
96 Write_Eol;
97 Write_Eol;
98 return;
99 end if;
100
101 if Kind (G, Cycle) = No_Cycle_Kind then
102 Write_Error (Msg, Has_Invalid_Cycle);
103
104 Write_Str (" cycle (LGC_Id_");
105 Write_Int (Int (Cycle));
106 Write_Str (") is a No_Cycle");
107 Write_Eol;
108 Write_Eol;
109 end if;
110
111 -- A cycle requires at least one edge (self cycle) to form a circuit
112
113 if Length (G, Cycle) < 1 then
114 Write_Error (Msg, Has_Invalid_Cycle);
115
116 Write_Str (" cycle (LGC_Id_");
117 Write_Int (Int (Cycle));
118 Write_Str (") does not contain enough edges");
119 Write_Eol;
120 Write_Eol;
121 end if;
122
123 Validate_Cycle_Path (G, Cycle);
124 end Validate_Cycle;
125
126 -------------------------
127 -- Validate_Cycle_Path --
128 -------------------------
129
130 procedure Validate_Cycle_Path
131 (G : Library_Graph;
132 Cycle : Library_Graph_Cycle_Id)
133 is
134 Msg : constant String := "Validate_Cycle_Path";
135
136 Edge : Library_Graph_Edge_Id;
137 Edges : LGE_Sets.Membership_Set;
138 Iter : Edges_Of_Cycle_Iterator;
139
140 begin
141 pragma Assert (Present (G));
142 pragma Assert (Present (Cycle));
143
144 -- Use a set to detect duplicate edges while traversing the cycle
145
146 Edges := LGE_Sets.Create (Length (G, Cycle));
147
148 -- Inspect the edges of the cycle, trying to catch duplicates
149
150 Iter := Iterate_Edges_Of_Cycle (G, Cycle);
151 while Has_Next (Iter) loop
152 Next (Iter, Edge);
153
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.
157
158 if LGE_Sets.Contains (Edges, Edge) then
159 Write_Error (Msg, Has_Invalid_Cycle);
160
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));
165 Write_Str (")");
166 Write_Eol;
167
168 -- Otherwise add the current edge to the set of encountered edges
169
170 else
171 LGE_Sets.Insert (Edges, Edge);
172 end if;
173 end loop;
174
175 LGE_Sets.Destroy (Edges);
176 end Validate_Cycle_Path;
177
178 ---------------------
179 -- Validate_Cycles --
180 ---------------------
181
182 procedure Validate_Cycles (G : Library_Graph) is
183 Cycle : Library_Graph_Cycle_Id;
184 Iter : All_Cycle_Iterator;
185
186 begin
187 pragma Assert (Present (G));
188
189 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
190 -- order) is not in effect.
191
192 if not Debug_Flag_Underscore_VV then
193 return;
194 end if;
195
196 Start_Phase (Cycle_Validation);
197
198 Iter := Iterate_All_Cycles (G);
199 while Has_Next (Iter) loop
200 Next (Iter, Cycle);
201
202 Validate_Cycle (G, Cycle);
203 end loop;
204
205 End_Phase (Cycle_Validation);
206
207 if Has_Invalid_Cycle then
208 raise Invalid_Cycle;
209 end if;
210 end Validate_Cycles;
211 end Cycle_Validators;
212
213 ----------------------------------
214 -- Elaboration_Order_Validators --
215 ----------------------------------
216
217 package body Elaboration_Order_Validators is
218 Has_Invalid_Data : Boolean := False;
219 -- Flag set when the elaboration order contains invalid data
220
221 -----------------------
222 -- Local subprograms --
223 -----------------------
224
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
228
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
232 -- not.
233
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
237 -- not.
238
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
242
243 procedure Validate_Unit
244 (U_Id : Unit_Id;
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.
249
250 procedure Validate_Units (Order : Unit_Id_Table);
251 pragma Inline (Validate_Units);
252 -- Validate all units in elaboration order Order
253
254 -------------------------------
255 -- Build_Elaborable_Unit_Set --
256 -------------------------------
257
258 function Build_Elaborable_Unit_Set return Unit_Sets.Membership_Set is
259 Iter : Elaborable_Units_Iterator;
260 Set : Unit_Sets.Membership_Set;
261 U_Id : Unit_Id;
262
263 begin
264 Set := Unit_Sets.Create (Number_Of_Elaborable_Units);
265 Iter := Iterate_Elaborable_Units;
266 while Has_Next (Iter) loop
267 Next (Iter, U_Id);
268
269 Unit_Sets.Insert (Set, U_Id);
270 end loop;
271
272 return Set;
273 end Build_Elaborable_Unit_Set;
274
275 --------------------------------
276 -- Report_Missing_Elaboration --
277 --------------------------------
278
279 procedure Report_Missing_Elaboration (U_Id : Unit_Id) is
280 Msg : constant String := "Report_Missing_Elaboration";
281
282 begin
283 pragma Assert (Present (U_Id));
284 Write_Error (Msg, Has_Invalid_Data);
285
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");
291 Write_Eol;
292 end Report_Missing_Elaboration;
293
294 ---------------------------------
295 -- Report_Missing_Elaborations --
296 ---------------------------------
297
298 procedure Report_Missing_Elaborations (Set : Unit_Sets.Membership_Set) is
299 Iter : Unit_Sets.Iterator;
300 U_Id : Unit_Id;
301
302 begin
303 Iter := Unit_Sets.Iterate (Set);
304 while Unit_Sets.Has_Next (Iter) loop
305 Unit_Sets.Next (Iter, U_Id);
306
307 Report_Missing_Elaboration (U_Id);
308 end loop;
309 end Report_Missing_Elaborations;
310
311 ---------------------------------
312 -- Report_Spurious_Elaboration --
313 ---------------------------------
314
315 procedure Report_Spurious_Elaboration (U_Id : Unit_Id) is
316 Msg : constant String := "Report_Spurious_Elaboration";
317
318 begin
319 pragma Assert (Present (U_Id));
320 Write_Error (Msg, Has_Invalid_Data);
321
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;
328
329 --------------------------------
330 -- Validate_Elaboration_Order --
331 --------------------------------
332
333 procedure Validate_Elaboration_Order (Order : Unit_Id_Table) is
334 begin
335 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
336 -- order) is not in effect.
337
338 if not Debug_Flag_Underscore_VV then
339 return;
340 end if;
341
342 Start_Phase (Elaboration_Order_Validation);
343
344 Validate_Units (Order);
345
346 End_Phase (Elaboration_Order_Validation);
347
348 if Has_Invalid_Data then
349 raise Invalid_Elaboration_Order;
350 end if;
351 end Validate_Elaboration_Order;
352
353 -------------------
354 -- Validate_Unit --
355 -------------------
356
357 procedure Validate_Unit
358 (U_Id : Unit_Id;
359 Elab_Set : Unit_Sets.Membership_Set)
360 is
361 begin
362 pragma Assert (Present (U_Id));
363
364 -- The current unit in the elaboration order appears within the set
365 -- of units that require elaboration. Remove it from the set.
366
367 if Unit_Sets.Contains (Elab_Set, U_Id) then
368 Unit_Sets.Delete (Elab_Set, U_Id);
369
370 -- Otherwise the current unit in the elaboration order must not be
371 -- elaborated.
372
373 else
374 Report_Spurious_Elaboration (U_Id);
375 end if;
376 end Validate_Unit;
377
378 --------------------
379 -- Validate_Units --
380 --------------------
381
382 procedure Validate_Units (Order : Unit_Id_Table) is
383 Elab_Set : Unit_Sets.Membership_Set;
384
385 begin
386 -- Collect all units in the compilation that need to be elaborated
387 -- in a set.
388
389 Elab_Set := Build_Elaborable_Unit_Set;
390
391 -- Validate each unit in the elaboration order against the set of
392 -- units that need to be elaborated.
393
394 for Index in Unit_Id_Tables.First .. Unit_Id_Tables.Last (Order) loop
395 Validate_Unit
396 (U_Id => Order.Table (Index),
397 Elab_Set => Elab_Set);
398 end loop;
399
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.
403
404 Report_Missing_Elaborations (Elab_Set);
405 Unit_Sets.Destroy (Elab_Set);
406 end Validate_Units;
407 end Elaboration_Order_Validators;
408
409 ---------------------------------
410 -- Invocation_Graph_Validators --
411 ---------------------------------
412
413 package body Invocation_Graph_Validators is
414 Has_Invalid_Data : Boolean := False;
415 -- Flag set when the invocation graph contains invalid data
416
417 -----------------------
418 -- Local subprograms --
419 -----------------------
420
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
426 -- properly set.
427
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
431 -- properly set.
432
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
438 -- properly set.
439
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
443 -- properly set.
444
445 -------------------------------
446 -- Validate_Invocation_Graph --
447 -------------------------------
448
449 procedure Validate_Invocation_Graph (G : Invocation_Graph) is
450 begin
451 pragma Assert (Present (G));
452
453 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
454 -- order) is not in effect.
455
456 if not Debug_Flag_Underscore_VV then
457 return;
458 end if;
459
460 Start_Phase (Invocation_Graph_Validation);
461
462 Validate_Invocation_Graph_Vertices (G);
463 Validate_Invocation_Graph_Edges (G);
464
465 End_Phase (Invocation_Graph_Validation);
466
467 if Has_Invalid_Data then
468 raise Invalid_Invocation_Graph;
469 end if;
470 end Validate_Invocation_Graph;
471
472 ------------------------------------
473 -- Validate_Invocation_Graph_Edge --
474 ------------------------------------
475
476 procedure Validate_Invocation_Graph_Edge
477 (G : Invocation_Graph;
478 Edge : Invocation_Graph_Edge_Id)
479 is
480 Msg : constant String := "Validate_Invocation_Graph_Edge";
481
482 begin
483 pragma Assert (Present (G));
484
485 if not Present (Edge) then
486 Write_Error (Msg, Has_Invalid_Data);
487
488 Write_Str (" empty invocation graph edge");
489 Write_Eol;
490 Write_Eol;
491 return;
492 end if;
493
494 if not Present (Relation (G, Edge)) then
495 Write_Error (Msg, Has_Invalid_Data);
496
497 Write_Str (" invocation graph edge (IGE_Id_");
498 Write_Int (Int (Edge));
499 Write_Str (") lacks Relation");
500 Write_Eol;
501 Write_Eol;
502 end if;
503
504 if not Present (Target (G, Edge)) then
505 Write_Error (Msg, Has_Invalid_Data);
506
507 Write_Str (" invocation graph edge (IGE_Id_");
508 Write_Int (Int (Edge));
509 Write_Str (") lacks Target");
510 Write_Eol;
511 Write_Eol;
512 end if;
513 end Validate_Invocation_Graph_Edge;
514
515 -------------------------------------
516 -- Validate_Invocation_Graph_Edges --
517 -------------------------------------
518
519 procedure Validate_Invocation_Graph_Edges (G : Invocation_Graph) is
520 Edge : Invocation_Graph_Edge_Id;
521 Iter : Invocation_Graphs.All_Edge_Iterator;
522
523 begin
524 pragma Assert (Present (G));
525
526 Iter := Iterate_All_Edges (G);
527 while Has_Next (Iter) loop
528 Next (Iter, Edge);
529
530 Validate_Invocation_Graph_Edge (G, Edge);
531 end loop;
532 end Validate_Invocation_Graph_Edges;
533
534 --------------------------------------
535 -- Validate_Invocation_Graph_Vertex --
536 --------------------------------------
537
538 procedure Validate_Invocation_Graph_Vertex
539 (G : Invocation_Graph;
540 Vertex : Invocation_Graph_Vertex_Id)
541 is
542 Msg : constant String := "Validate_Invocation_Graph_Vertex";
543
544 begin
545 pragma Assert (Present (G));
546
547 if not Present (Vertex) then
548 Write_Error (Msg, Has_Invalid_Data);
549
550 Write_Str (" empty invocation graph vertex");
551 Write_Eol;
552 Write_Eol;
553 return;
554 end if;
555
556 if not Present (Body_Vertex (G, Vertex)) then
557 Write_Error (Msg, Has_Invalid_Data);
558
559 Write_Str (" invocation graph vertex (IGV_Id_");
560 Write_Int (Int (Vertex));
561 Write_Str (") lacks Body_Vertex");
562 Write_Eol;
563 Write_Eol;
564 end if;
565
566 if not Present (Construct (G, Vertex)) then
567 Write_Error (Msg, Has_Invalid_Data);
568
569 Write_Str (" invocation graph vertex (IGV_Id_");
570 Write_Int (Int (Vertex));
571 Write_Str (") lacks Construct");
572 Write_Eol;
573 Write_Eol;
574 end if;
575
576 if not Present (Spec_Vertex (G, Vertex)) then
577 Write_Error (Msg, Has_Invalid_Data);
578
579 Write_Str (" invocation graph vertex (IGV_Id_");
580 Write_Int (Int (Vertex));
581 Write_Str (") lacks Spec_Vertex");
582 Write_Eol;
583 Write_Eol;
584 end if;
585 end Validate_Invocation_Graph_Vertex;
586
587 ----------------------------------------
588 -- Validate_Invocation_Graph_Vertices --
589 ----------------------------------------
590
591 procedure Validate_Invocation_Graph_Vertices (G : Invocation_Graph) is
592 Iter : Invocation_Graphs.All_Vertex_Iterator;
593 Vertex : Invocation_Graph_Vertex_Id;
594
595 begin
596 pragma Assert (Present (G));
597
598 Iter := Iterate_All_Vertices (G);
599 while Has_Next (Iter) loop
600 Next (Iter, Vertex);
601
602 Validate_Invocation_Graph_Vertex (G, Vertex);
603 end loop;
604 end Validate_Invocation_Graph_Vertices;
605 end Invocation_Graph_Validators;
606
607 ------------------------------
608 -- Library_Graph_Validators --
609 ------------------------------
610
611 package body Library_Graph_Validators is
612 Has_Invalid_Data : Boolean := False;
613 -- Flag set when the library graph contains invalid data
614
615 -----------------------
616 -- Local subprograms --
617 -----------------------
618
619 procedure Validate_Library_Graph_Edge
620 (G : Library_Graph;
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
624 -- properly set.
625
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
629 -- properly set.
630
631 procedure Validate_Library_Graph_Vertex
632 (G : Library_Graph;
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
636 -- properly set.
637
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
641 -- properly set.
642
643 ----------------------------
644 -- Validate_Library_Graph --
645 ----------------------------
646
647 procedure Validate_Library_Graph (G : Library_Graph) is
648 begin
649 pragma Assert (Present (G));
650
651 -- Nothing to do when switch -d_V (validate bindo cycles, graphs, and
652 -- order) is not in effect.
653
654 if not Debug_Flag_Underscore_VV then
655 return;
656 end if;
657
658 Start_Phase (Library_Graph_Validation);
659
660 Validate_Library_Graph_Vertices (G);
661 Validate_Library_Graph_Edges (G);
662
663 End_Phase (Library_Graph_Validation);
664
665 if Has_Invalid_Data then
666 raise Invalid_Library_Graph;
667 end if;
668 end Validate_Library_Graph;
669
670 ---------------------------------
671 -- Validate_Library_Graph_Edge --
672 ---------------------------------
673
674 procedure Validate_Library_Graph_Edge
675 (G : Library_Graph;
676 Edge : Library_Graph_Edge_Id)
677 is
678 Msg : constant String := "Validate_Library_Graph_Edge";
679
680 begin
681 pragma Assert (Present (G));
682
683 if not Present (Edge) then
684 Write_Error (Msg, Has_Invalid_Data);
685
686 Write_Str (" empty library graph edge");
687 Write_Eol;
688 Write_Eol;
689 return;
690 end if;
691
692 if Kind (G, Edge) = No_Edge then
693 Write_Error (Msg, Has_Invalid_Data);
694
695 Write_Str (" library graph edge (LGE_Id_");
696 Write_Int (Int (Edge));
697 Write_Str (") is not a valid edge");
698 Write_Eol;
699 Write_Eol;
700
701 elsif Kind (G, Edge) = Body_Before_Spec_Edge then
702 Write_Error (Msg, Has_Invalid_Data);
703
704 Write_Str (" library graph edge (LGE_Id_");
705 Write_Int (Int (Edge));
706 Write_Str (") is a Body_Before_Spec edge");
707 Write_Eol;
708 Write_Eol;
709 end if;
710
711 if not Present (Predecessor (G, Edge)) then
712 Write_Error (Msg, Has_Invalid_Data);
713
714 Write_Str (" library graph edge (LGE_Id_");
715 Write_Int (Int (Edge));
716 Write_Str (") lacks Predecessor");
717 Write_Eol;
718 Write_Eol;
719 end if;
720
721 if not Present (Successor (G, Edge)) then
722 Write_Error (Msg, Has_Invalid_Data);
723
724 Write_Str (" library graph edge (LGE_Id_");
725 Write_Int (Int (Edge));
726 Write_Str (") lacks Successor");
727 Write_Eol;
728 Write_Eol;
729 end if;
730 end Validate_Library_Graph_Edge;
731
732 ----------------------------------
733 -- Validate_Library_Graph_Edges --
734 ----------------------------------
735
736 procedure Validate_Library_Graph_Edges (G : Library_Graph) is
737 Edge : Library_Graph_Edge_Id;
738 Iter : Library_Graphs.All_Edge_Iterator;
739
740 begin
741 pragma Assert (Present (G));
742
743 Iter := Iterate_All_Edges (G);
744 while Has_Next (Iter) loop
745 Next (Iter, Edge);
746
747 Validate_Library_Graph_Edge (G, Edge);
748 end loop;
749 end Validate_Library_Graph_Edges;
750
751 -----------------------------------
752 -- Validate_Library_Graph_Vertex --
753 -----------------------------------
754
755 procedure Validate_Library_Graph_Vertex
756 (G : Library_Graph;
757 Vertex : Library_Graph_Vertex_Id)
758 is
759 Msg : constant String := "Validate_Library_Graph_Vertex";
760
761 begin
762 pragma Assert (Present (G));
763
764 if not Present (Vertex) then
765 Write_Error (Msg, Has_Invalid_Data);
766
767 Write_Str (" empty library graph vertex");
768 Write_Eol;
769 Write_Eol;
770 return;
771 end if;
772
773 if (Is_Body_With_Spec (G, Vertex)
774 or else
775 Is_Spec_With_Body (G, Vertex))
776 and then not Present (Corresponding_Item (G, Vertex))
777 then
778 Write_Error (Msg, Has_Invalid_Data);
779
780 Write_Str (" library graph vertex (LGV_Id_");
781 Write_Int (Int (Vertex));
782 Write_Str (") lacks Corresponding_Item");
783 Write_Eol;
784 Write_Eol;
785 end if;
786
787 if not Present (Unit (G, Vertex)) then
788 Write_Error (Msg, Has_Invalid_Data);
789
790 Write_Str (" library graph vertex (LGV_Id_");
791 Write_Int (Int (Vertex));
792 Write_Str (") lacks Unit");
793 Write_Eol;
794 Write_Eol;
795 end if;
796 end Validate_Library_Graph_Vertex;
797
798 -------------------------------------
799 -- Validate_Library_Graph_Vertices --
800 -------------------------------------
801
802 procedure Validate_Library_Graph_Vertices (G : Library_Graph) is
803 Iter : Library_Graphs.All_Vertex_Iterator;
804 Vertex : Library_Graph_Vertex_Id;
805
806 begin
807 pragma Assert (Present (G));
808
809 Iter := Iterate_All_Vertices (G);
810 while Has_Next (Iter) loop
811 Next (Iter, Vertex);
812
813 Validate_Library_Graph_Vertex (G, Vertex);
814 end loop;
815 end Validate_Library_Graph_Vertices;
816 end Library_Graph_Validators;
817
818 -----------------
819 -- Write_Error --
820 -----------------
821
822 procedure Write_Error
823 (Msg : String;
824 Flag : out Boolean)
825 is
826 begin
827 Write_Str ("ERROR: ");
828 Write_Str (Msg);
829 Write_Eol;
830
831 Flag := True;
832 end Write_Error;
833
834end Bindo.Validators;
Mirror of https://gcc.gnu.org/git/gcc.git