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