]>
Commit | Line | Data |
---|---|---|
70482933 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- B C H E C K -- | |
6 | -- -- | |
7 | -- B o d y -- | |
70482933 | 8 | -- -- |
6e937c1c | 9 | -- Copyright (C) 1992-2004 Free Software Foundation, Inc. -- |
70482933 RK |
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 2, 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 COPYING. If not, write -- | |
19 | -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 23 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
70482933 RK |
24 | -- -- |
25 | ------------------------------------------------------------------------------ | |
26 | ||
27 | with ALI; use ALI; | |
28 | with ALI.Util; use ALI.Util; | |
29 | with Binderr; use Binderr; | |
30 | with Butil; use Butil; | |
31 | with Casing; use Casing; | |
70482933 RK |
32 | with Fname; use Fname; |
33 | with Namet; use Namet; | |
34 | with Opt; use Opt; | |
35 | with Osint; | |
36 | with Output; use Output; | |
37 | with Rident; use Rident; | |
38 | with Types; use Types; | |
39 | ||
40 | package body Bcheck is | |
41 | ||
fbf5a39b AC |
42 | ----------------------- |
43 | -- Local Subprograms -- | |
44 | ----------------------- | |
70482933 | 45 | |
fbf5a39b AC |
46 | -- The following checking subprograms make up the parts of the |
47 | -- configuration consistency check. | |
70482933 RK |
48 | |
49 | procedure Check_Consistent_Dynamic_Elaboration_Checking; | |
50 | procedure Check_Consistent_Floating_Point_Format; | |
fbf5a39b | 51 | procedure Check_Consistent_Interrupt_States; |
70482933 RK |
52 | procedure Check_Consistent_Locking_Policy; |
53 | procedure Check_Consistent_Normalize_Scalars; | |
54 | procedure Check_Consistent_Queuing_Policy; | |
6e937c1c | 55 | procedure Check_Consistent_Restrictions; |
70482933 | 56 | procedure Check_Consistent_Zero_Cost_Exception_Handling; |
70482933 RK |
57 | |
58 | procedure Consistency_Error_Msg (Msg : String); | |
5f3ab6fb AC |
59 | -- Produce an error or a warning message, depending on whether an |
60 | -- inconsistent configuration is permitted or not. | |
61 | ||
62 | function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean; | |
63 | -- Used to compare two unit names for No_Dependence checks. U1 is in | |
64 | -- standard unit name format, and U2 is in literal form with periods. | |
70482933 RK |
65 | |
66 | ------------------------------------ | |
67 | -- Check_Consistent_Configuration -- | |
68 | ------------------------------------ | |
69 | ||
70 | procedure Check_Configuration_Consistency is | |
71 | begin | |
72 | if Float_Format_Specified /= ' ' then | |
73 | Check_Consistent_Floating_Point_Format; | |
74 | end if; | |
75 | ||
76 | if Queuing_Policy_Specified /= ' ' then | |
77 | Check_Consistent_Queuing_Policy; | |
78 | end if; | |
79 | ||
80 | if Locking_Policy_Specified /= ' ' then | |
81 | Check_Consistent_Locking_Policy; | |
82 | end if; | |
83 | ||
84 | if Zero_Cost_Exceptions_Specified then | |
85 | Check_Consistent_Zero_Cost_Exception_Handling; | |
86 | end if; | |
87 | ||
88 | Check_Consistent_Normalize_Scalars; | |
89 | Check_Consistent_Dynamic_Elaboration_Checking; | |
90 | ||
6e937c1c | 91 | Check_Consistent_Restrictions; |
fbf5a39b | 92 | Check_Consistent_Interrupt_States; |
70482933 RK |
93 | end Check_Configuration_Consistency; |
94 | ||
95 | --------------------------------------------------- | |
96 | -- Check_Consistent_Dynamic_Elaboration_Checking -- | |
97 | --------------------------------------------------- | |
98 | ||
99 | -- The rule here is that if a unit has dynamic elaboration checks, | |
100 | -- then any unit it withs must meeting one of the following criteria: | |
101 | ||
102 | -- 1. There is a pragma Elaborate_All for the with'ed unit | |
103 | -- 2. The with'ed unit was compiled with dynamic elaboration checks | |
104 | -- 3. The with'ed unit has pragma Preelaborate or Pure | |
105 | -- 4. It is an internal GNAT unit (including children of GNAT) | |
106 | ||
107 | procedure Check_Consistent_Dynamic_Elaboration_Checking is | |
108 | begin | |
109 | if Dynamic_Elaboration_Checks_Specified then | |
110 | for U in First_Unit_Entry .. Units.Last loop | |
111 | declare | |
112 | UR : Unit_Record renames Units.Table (U); | |
113 | ||
114 | begin | |
115 | if UR.Dynamic_Elab then | |
116 | for W in UR.First_With .. UR.Last_With loop | |
117 | declare | |
118 | WR : With_Record renames Withs.Table (W); | |
119 | ||
120 | begin | |
121 | if Get_Name_Table_Info (WR.Uname) /= 0 then | |
122 | declare | |
123 | WU : Unit_Record renames | |
124 | Units.Table | |
125 | (Unit_Id | |
126 | (Get_Name_Table_Info (WR.Uname))); | |
127 | ||
128 | begin | |
129 | -- Case 1. Elaborate_All for with'ed unit | |
130 | ||
131 | if WR.Elaborate_All then | |
132 | null; | |
133 | ||
134 | -- Case 2. With'ed unit has dynamic elab checks | |
135 | ||
136 | elsif WU.Dynamic_Elab then | |
137 | null; | |
138 | ||
139 | -- Case 3. With'ed unit is Preelaborate or Pure | |
140 | ||
141 | elsif WU.Preelab or WU.Pure then | |
142 | null; | |
143 | ||
144 | -- Case 4. With'ed unit is internal file | |
145 | ||
146 | elsif Is_Internal_File_Name (WU.Sfile) then | |
147 | null; | |
148 | ||
149 | -- Issue warning, not one of the safe cases | |
150 | ||
151 | else | |
152 | Error_Msg_Name_1 := UR.Sfile; | |
153 | Error_Msg | |
154 | ("?% has dynamic elaboration checks " & | |
155 | "and with's"); | |
156 | ||
157 | Error_Msg_Name_1 := WU.Sfile; | |
158 | Error_Msg | |
159 | ("? % which has static elaboration " & | |
160 | "checks"); | |
161 | ||
162 | Warnings_Detected := Warnings_Detected - 1; | |
163 | end if; | |
164 | end; | |
165 | end if; | |
166 | end; | |
167 | end loop; | |
168 | end if; | |
169 | end; | |
170 | end loop; | |
171 | end if; | |
172 | end Check_Consistent_Dynamic_Elaboration_Checking; | |
173 | ||
174 | -------------------------------------------- | |
175 | -- Check_Consistent_Floating_Point_Format -- | |
176 | -------------------------------------------- | |
177 | ||
178 | -- The rule is that all files must be compiled with the same setting | |
179 | -- for the floating-point format. | |
180 | ||
181 | procedure Check_Consistent_Floating_Point_Format is | |
182 | begin | |
183 | -- First search for a unit specifying a floating-point format and then | |
184 | -- check all remaining units against it. | |
185 | ||
186 | Find_Format : for A1 in ALIs.First .. ALIs.Last loop | |
187 | if ALIs.Table (A1).Float_Format /= ' ' then | |
188 | Check_Format : declare | |
189 | Format : constant Character := ALIs.Table (A1).Float_Format; | |
190 | begin | |
191 | for A2 in A1 + 1 .. ALIs.Last loop | |
192 | if ALIs.Table (A2).Float_Format /= Format then | |
193 | Error_Msg_Name_1 := ALIs.Table (A1).Sfile; | |
194 | Error_Msg_Name_2 := ALIs.Table (A2).Sfile; | |
195 | ||
196 | Consistency_Error_Msg | |
197 | ("% and % compiled with different " & | |
198 | "floating-point representations"); | |
199 | exit Find_Format; | |
200 | end if; | |
201 | end loop; | |
202 | end Check_Format; | |
203 | ||
204 | exit Find_Format; | |
205 | end if; | |
206 | end loop Find_Format; | |
207 | end Check_Consistent_Floating_Point_Format; | |
208 | ||
fbf5a39b AC |
209 | --------------------------------------- |
210 | -- Check_Consistent_Interrupt_States -- | |
211 | --------------------------------------- | |
212 | ||
213 | -- The rule is that if the state of a given interrupt is specified | |
214 | -- in more than one unit, it must be specified with a consistent state. | |
215 | ||
216 | procedure Check_Consistent_Interrupt_States is | |
217 | Max_Intrup : Nat; | |
218 | ||
219 | begin | |
220 | -- If no Interrupt_State entries, nothing to do | |
221 | ||
222 | if Interrupt_States.Last < Interrupt_States.First then | |
223 | return; | |
224 | end if; | |
225 | ||
226 | -- First find out the maximum interrupt value | |
227 | ||
228 | Max_Intrup := 0; | |
229 | for J in Interrupt_States.First .. Interrupt_States.Last loop | |
230 | if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then | |
231 | Max_Intrup := Interrupt_States.Table (J).Interrupt_Id; | |
232 | end if; | |
233 | end loop; | |
234 | ||
235 | -- Now establish tables to be used for consistency checking | |
236 | ||
237 | declare | |
238 | Istate : array (0 .. Max_Intrup) of Character := (others => 'n'); | |
239 | -- Interrupt state entries, 'u'/'s'/'r' or 'n' to indicate an | |
240 | -- entry that has not been set. | |
241 | ||
242 | Afile : array (0 .. Max_Intrup) of ALI_Id; | |
243 | -- ALI file that generated Istate entry for consistency message | |
244 | ||
245 | Loc : array (0 .. Max_Intrup) of Nat; | |
246 | -- Line numbers from IS pragma generating Istate entry | |
247 | ||
248 | Inum : Nat; | |
249 | -- Interrupt number from entry being tested | |
250 | ||
251 | Stat : Character; | |
252 | -- Interrupt state from entry being tested | |
253 | ||
254 | Lnum : Nat; | |
255 | -- Line number from entry being tested | |
256 | ||
257 | begin | |
258 | for F in ALIs.First .. ALIs.Last loop | |
259 | for K in ALIs.Table (F).First_Interrupt_State .. | |
260 | ALIs.Table (F).Last_Interrupt_State | |
261 | loop | |
262 | Inum := Interrupt_States.Table (K).Interrupt_Id; | |
263 | Stat := Interrupt_States.Table (K).Interrupt_State; | |
264 | Lnum := Interrupt_States.Table (K).IS_Pragma_Line; | |
265 | ||
266 | if Istate (Inum) = 'n' then | |
267 | Istate (Inum) := Stat; | |
268 | Afile (Inum) := F; | |
269 | Loc (Inum) := Lnum; | |
270 | ||
271 | elsif Istate (Inum) /= Stat then | |
272 | Error_Msg_Name_1 := ALIs.Table (Afile (Inum)).Sfile; | |
273 | Error_Msg_Name_2 := ALIs.Table (F).Sfile; | |
274 | Error_Msg_Nat_1 := Loc (Inum); | |
275 | Error_Msg_Nat_2 := Lnum; | |
276 | ||
277 | Consistency_Error_Msg | |
278 | ("inconsistent interrupt states at %:# and %:#"); | |
279 | end if; | |
280 | end loop; | |
281 | end loop; | |
282 | end; | |
283 | end Check_Consistent_Interrupt_States; | |
284 | ||
70482933 RK |
285 | ------------------------------------- |
286 | -- Check_Consistent_Locking_Policy -- | |
287 | ------------------------------------- | |
288 | ||
289 | -- The rule is that all files for which the locking policy is | |
290 | -- significant must be compiled with the same setting. | |
291 | ||
292 | procedure Check_Consistent_Locking_Policy is | |
293 | begin | |
294 | -- First search for a unit specifying a policy and then | |
295 | -- check all remaining units against it. | |
296 | ||
297 | Find_Policy : for A1 in ALIs.First .. ALIs.Last loop | |
298 | if ALIs.Table (A1).Locking_Policy /= ' ' then | |
299 | Check_Policy : declare | |
300 | Policy : constant Character := ALIs.Table (A1).Locking_Policy; | |
301 | ||
302 | begin | |
303 | for A2 in A1 + 1 .. ALIs.Last loop | |
304 | if ALIs.Table (A2).Locking_Policy /= ' ' and | |
305 | ALIs.Table (A2).Locking_Policy /= Policy | |
306 | then | |
307 | Error_Msg_Name_1 := ALIs.Table (A1).Sfile; | |
308 | Error_Msg_Name_2 := ALIs.Table (A2).Sfile; | |
309 | ||
310 | Consistency_Error_Msg | |
311 | ("% and % compiled with different locking policies"); | |
312 | exit Find_Policy; | |
313 | end if; | |
314 | end loop; | |
315 | end Check_Policy; | |
316 | ||
317 | exit Find_Policy; | |
318 | end if; | |
319 | end loop Find_Policy; | |
320 | end Check_Consistent_Locking_Policy; | |
321 | ||
322 | ---------------------------------------- | |
323 | -- Check_Consistent_Normalize_Scalars -- | |
324 | ---------------------------------------- | |
325 | ||
326 | -- The rule is that if any unit is compiled with Normalized_Scalars, | |
327 | -- then all other units in the partition must also be compiled with | |
328 | -- Normalized_Scalars in effect. | |
329 | ||
330 | -- There is some issue as to whether this consistency check is | |
331 | -- desirable, it is certainly required at the moment by the RM. | |
332 | -- We should keep a watch on the ARG and HRG deliberations here. | |
333 | -- GNAT no longer depends on this consistency (it used to do so, | |
334 | -- but that has been corrected in the latest version, since the | |
335 | -- Initialize_Scalars pragma does not require consistency. | |
336 | ||
337 | procedure Check_Consistent_Normalize_Scalars is | |
338 | begin | |
339 | if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then | |
340 | Consistency_Error_Msg | |
341 | ("some but not all files compiled with Normalize_Scalars"); | |
342 | ||
343 | Write_Eol; | |
344 | Write_Str ("files compiled with Normalize_Scalars"); | |
345 | Write_Eol; | |
346 | ||
347 | for A1 in ALIs.First .. ALIs.Last loop | |
348 | if ALIs.Table (A1).Normalize_Scalars then | |
349 | Write_Str (" "); | |
350 | Write_Name (ALIs.Table (A1).Sfile); | |
351 | Write_Eol; | |
352 | end if; | |
353 | end loop; | |
354 | ||
355 | Write_Eol; | |
356 | Write_Str ("files compiled without Normalize_Scalars"); | |
357 | Write_Eol; | |
358 | ||
359 | for A1 in ALIs.First .. ALIs.Last loop | |
360 | if not ALIs.Table (A1).Normalize_Scalars then | |
361 | Write_Str (" "); | |
362 | Write_Name (ALIs.Table (A1).Sfile); | |
363 | Write_Eol; | |
364 | end if; | |
365 | end loop; | |
366 | end if; | |
367 | end Check_Consistent_Normalize_Scalars; | |
368 | ||
6e937c1c AC |
369 | ------------------------------------- |
370 | -- Check_Consistent_Queuing_Policy -- | |
371 | ------------------------------------- | |
70482933 | 372 | |
6e937c1c AC |
373 | -- The rule is that all files for which the queuing policy is |
374 | -- significant must be compiled with the same setting. | |
70482933 | 375 | |
6e937c1c AC |
376 | procedure Check_Consistent_Queuing_Policy is |
377 | begin | |
378 | -- First search for a unit specifying a policy and then | |
379 | -- check all remaining units against it. | |
70482933 | 380 | |
6e937c1c AC |
381 | Find_Policy : for A1 in ALIs.First .. ALIs.Last loop |
382 | if ALIs.Table (A1).Queuing_Policy /= ' ' then | |
383 | Check_Policy : declare | |
384 | Policy : constant Character := ALIs.Table (A1).Queuing_Policy; | |
385 | begin | |
386 | for A2 in A1 + 1 .. ALIs.Last loop | |
387 | if ALIs.Table (A2).Queuing_Policy /= ' ' | |
388 | and then | |
389 | ALIs.Table (A2).Queuing_Policy /= Policy | |
390 | then | |
391 | Error_Msg_Name_1 := ALIs.Table (A1).Sfile; | |
392 | Error_Msg_Name_2 := ALIs.Table (A2).Sfile; | |
70482933 | 393 | |
6e937c1c AC |
394 | Consistency_Error_Msg |
395 | ("% and % compiled with different queuing policies"); | |
396 | exit Find_Policy; | |
397 | end if; | |
398 | end loop; | |
399 | end Check_Policy; | |
70482933 | 400 | |
6e937c1c AC |
401 | exit Find_Policy; |
402 | end if; | |
403 | end loop Find_Policy; | |
404 | end Check_Consistent_Queuing_Policy; | |
70482933 | 405 | |
6e937c1c AC |
406 | ----------------------------------- |
407 | -- Check_Consistent_Restrictions -- | |
408 | ----------------------------------- | |
70482933 | 409 | |
6e937c1c AC |
410 | -- The rule is that if a restriction is specified in any unit, |
411 | -- then all units must obey the restriction. The check applies | |
412 | -- only to restrictions which require partition wide consistency, | |
413 | -- and not to internal units. | |
07fc65c4 | 414 | |
6e937c1c AC |
415 | procedure Check_Consistent_Restrictions is |
416 | Restriction_File_Output : Boolean; | |
417 | -- Shows if we have output header messages for restriction violation | |
07fc65c4 | 418 | |
6e937c1c AC |
419 | procedure Print_Restriction_File (R : All_Restrictions); |
420 | -- Print header line for R if not printed yet | |
70482933 | 421 | |
6e937c1c AC |
422 | ---------------------------- |
423 | -- Print_Restriction_File -- | |
424 | ---------------------------- | |
70482933 | 425 | |
6e937c1c AC |
426 | procedure Print_Restriction_File (R : All_Restrictions) is |
427 | begin | |
428 | if not Restriction_File_Output then | |
429 | Restriction_File_Output := True; | |
70482933 | 430 | |
2e071734 | 431 | -- Find an ali file specifying the restriction |
07fc65c4 | 432 | |
6e937c1c AC |
433 | for A in ALIs.First .. ALIs.Last loop |
434 | if ALIs.Table (A).Restrictions.Set (R) | |
435 | and then (R in All_Boolean_Restrictions | |
436 | or else ALIs.Table (A).Restrictions.Value (R) = | |
437 | Cumulative_Restrictions.Value (R)) | |
07fc65c4 | 438 | then |
6e937c1c AC |
439 | -- We have found that ALI file A specifies the restriction |
440 | -- that is being violated (the minimum value is specified | |
441 | -- in the case of a parameter restriction). | |
442 | ||
07fc65c4 | 443 | declare |
6e937c1c AC |
444 | M1 : constant String := "% has restriction "; |
445 | S : constant String := Restriction_Id'Image (R); | |
446 | M2 : String (1 .. 200); -- big enough! | |
447 | P : Integer; | |
70482933 RK |
448 | |
449 | begin | |
450 | Name_Buffer (1 .. S'Length) := S; | |
451 | Name_Len := S'Length; | |
6e937c1c | 452 | Set_Casing (Mixed_Case); |
70482933 RK |
453 | |
454 | M2 (M1'Range) := M1; | |
6e937c1c AC |
455 | P := M1'Length + 1; |
456 | M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length); | |
457 | P := P + S'Length; | |
458 | ||
459 | if R in All_Parameter_Restrictions then | |
460 | M2 (P .. P + 4) := " => #"; | |
461 | Error_Msg_Nat_1 := | |
462 | Int (Cumulative_Restrictions.Value (R)); | |
463 | P := P + 5; | |
464 | end if; | |
70482933 | 465 | |
70482933 | 466 | Error_Msg_Name_1 := ALIs.Table (A).Sfile; |
6e937c1c | 467 | Consistency_Error_Msg (M2 (1 .. P - 1)); |
70482933 | 468 | Consistency_Error_Msg |
6e937c1c | 469 | ("but the following files violate this restriction:"); |
2e071734 | 470 | return; |
07fc65c4 | 471 | end; |
70482933 | 472 | end if; |
6e937c1c AC |
473 | end loop; |
474 | end if; | |
475 | end Print_Restriction_File; | |
70482933 | 476 | |
6e937c1c | 477 | -- Start of processing for Check_Consistent_Restrictions |
07fc65c4 | 478 | |
6e937c1c AC |
479 | begin |
480 | -- Loop through all restriction violations | |
07fc65c4 | 481 | |
6e937c1c | 482 | for R in All_Restrictions loop |
07fc65c4 | 483 | |
6e937c1c | 484 | -- Check for violation of this restriction |
07fc65c4 | 485 | |
6e937c1c AC |
486 | if Cumulative_Restrictions.Set (R) |
487 | and then Cumulative_Restrictions.Violated (R) | |
488 | and then (R in Partition_Boolean_Restrictions | |
489 | or else (R in All_Parameter_Restrictions | |
490 | and then | |
491 | Cumulative_Restrictions.Count (R) > | |
492 | Cumulative_Restrictions.Value (R))) | |
493 | then | |
494 | Restriction_File_Output := False; | |
07fc65c4 | 495 | |
6e937c1c | 496 | -- Loop through files looking for violators |
07fc65c4 | 497 | |
6e937c1c | 498 | for A2 in ALIs.First .. ALIs.Last loop |
2e071734 AC |
499 | declare |
500 | T : ALIs_Record renames ALIs.Table (A2); | |
501 | ||
502 | begin | |
503 | if T.Restrictions.Violated (R) then | |
504 | ||
505 | -- We exclude predefined files from the list of | |
506 | -- violators. This should be rethought. It is not | |
507 | -- clear that this is the right thing to do, that | |
508 | -- is particularly the case for restricted runtimes. | |
509 | ||
510 | if not Is_Internal_File_Name (T.Sfile) then | |
511 | ||
512 | -- Case of Boolean restriction, just print file name | |
513 | ||
514 | if R in All_Boolean_Restrictions then | |
515 | Print_Restriction_File (R); | |
516 | Error_Msg_Name_1 := T.Sfile; | |
517 | Consistency_Error_Msg (" %"); | |
518 | ||
519 | -- Case of Parameter restriction where violation | |
520 | -- count exceeds restriction value, print file | |
521 | -- name and count, adding "at least" if the | |
522 | -- exact count is not known. | |
523 | ||
524 | elsif R in Checked_Add_Parameter_Restrictions | |
525 | or else T.Restrictions.Count (R) > | |
526 | Cumulative_Restrictions.Value (R) | |
527 | then | |
528 | Print_Restriction_File (R); | |
529 | Error_Msg_Name_1 := T.Sfile; | |
530 | Error_Msg_Nat_1 := Int (T.Restrictions.Count (R)); | |
531 | ||
532 | if T.Restrictions.Unknown (R) then | |
533 | Consistency_Error_Msg | |
534 | (" % (count = at least #)"); | |
535 | else | |
536 | Consistency_Error_Msg | |
537 | (" % (count = #)"); | |
538 | end if; | |
6e937c1c AC |
539 | end if; |
540 | end if; | |
541 | end if; | |
2e071734 | 542 | end; |
6e937c1c | 543 | end loop; |
fbf5a39b | 544 | end if; |
6e937c1c | 545 | end loop; |
5f3ab6fb AC |
546 | |
547 | -- Now deal with No_Dependence indications. Note that we put the loop | |
548 | -- through entries in the no dependency table first, since this loop | |
549 | -- is most often empty (no such pragma Restrictions in use). | |
550 | ||
551 | for ND in No_Deps.First .. No_Deps.Last loop | |
552 | declare | |
553 | ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit; | |
554 | ||
555 | begin | |
556 | for J in ALIs.First .. ALIs.Last loop | |
557 | declare | |
558 | A : ALIs_Record renames ALIs.Table (J); | |
559 | ||
560 | begin | |
561 | for K in A.First_Unit .. A.Last_Unit loop | |
562 | declare | |
563 | U : Unit_Record renames Units.Table (K); | |
564 | begin | |
565 | for L in U.First_With .. U.Last_With loop | |
566 | if Same_Unit (Withs.Table (L).Uname, ND_Unit) then | |
567 | Error_Msg_Name_1 := U.Uname; | |
568 | Error_Msg_Name_2 := ND_Unit; | |
569 | Consistency_Error_Msg | |
570 | ("unit & violates restriction " & | |
571 | "No_Dependence => %"); | |
572 | end if; | |
573 | end loop; | |
574 | end; | |
575 | end loop; | |
576 | end; | |
577 | end loop; | |
578 | end; | |
579 | end loop; | |
6e937c1c | 580 | end Check_Consistent_Restrictions; |
fbf5a39b | 581 | |
5f3ab6fb AC |
582 | --------------- |
583 | -- Same_Unit -- | |
584 | --------------- | |
585 | ||
586 | function Same_Unit (U1 : Name_Id; U2 : Name_Id) return Boolean is | |
587 | begin | |
588 | -- Note, the string U1 has a terminating %s or %b, U2 does not | |
589 | ||
590 | if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then | |
591 | Get_Name_String (U1); | |
592 | ||
593 | declare | |
594 | U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2); | |
595 | begin | |
596 | Get_Name_String (U2); | |
597 | return U1_Str = Name_Buffer (1 .. Name_Len); | |
598 | end; | |
599 | ||
600 | else | |
601 | return False; | |
602 | end if; | |
603 | end Same_Unit; | |
604 | ||
fbf5a39b AC |
605 | --------------------------------------------------- |
606 | -- Check_Consistent_Zero_Cost_Exception_Handling -- | |
607 | --------------------------------------------------- | |
608 | ||
609 | -- Check consistent zero cost exception handling. The rule is that | |
610 | -- all units must have the same exception handling mechanism. | |
611 | ||
612 | procedure Check_Consistent_Zero_Cost_Exception_Handling is | |
613 | begin | |
614 | Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop | |
615 | if ALIs.Table (A1).Zero_Cost_Exceptions /= | |
616 | ALIs.Table (ALIs.First).Zero_Cost_Exceptions | |
617 | ||
618 | then | |
619 | Error_Msg_Name_1 := ALIs.Table (A1).Sfile; | |
620 | Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile; | |
621 | ||
622 | Consistency_Error_Msg ("% and % compiled with different " | |
623 | & "exception handling mechanisms"); | |
624 | end if; | |
625 | end loop Check_Mechanism; | |
626 | end Check_Consistent_Zero_Cost_Exception_Handling; | |
70482933 RK |
627 | |
628 | ----------------------- | |
629 | -- Check_Consistency -- | |
630 | ----------------------- | |
631 | ||
632 | procedure Check_Consistency is | |
633 | Src : Source_Id; | |
634 | -- Source file Id for this Sdep entry | |
635 | ||
555360a5 AC |
636 | ALI_Path_Id : Name_Id; |
637 | ||
70482933 RK |
638 | begin |
639 | -- First, we go through the source table to see if there are any cases | |
640 | -- in which we should go after source files and compute checksums of | |
641 | -- the source files. We need to do this for any file for which we have | |
642 | -- mismatching time stamps and (so far) matching checksums. | |
643 | ||
644 | for S in Source.First .. Source.Last loop | |
645 | ||
646 | -- If all time stamps for a file match, then there is nothing to | |
647 | -- do, since we will not be checking checksums in that case anyway | |
648 | ||
649 | if Source.Table (S).All_Timestamps_Match then | |
650 | null; | |
651 | ||
652 | -- If we did not find the source file, then we can't compute its | |
653 | -- checksum anyway. Note that when we have a time stamp mismatch, | |
654 | -- we try to find the source file unconditionally (i.e. if | |
655 | -- Check_Source_Files is False). | |
656 | ||
657 | elsif not Source.Table (S).Source_Found then | |
658 | null; | |
659 | ||
660 | -- If we already have non-matching or missing checksums, then no | |
661 | -- need to try going after source file, since we won't trust the | |
662 | -- checksums in any case. | |
663 | ||
664 | elsif not Source.Table (S).All_Checksums_Match then | |
665 | null; | |
666 | ||
667 | -- Now we have the case where we have time stamp mismatches, and | |
668 | -- the source file is around, but so far all checksums match. This | |
669 | -- is the case where we need to compute the checksum from the source | |
670 | -- file, since otherwise we would ignore the time stamp mismatches, | |
671 | -- and that is wrong if the checksum of the source does not agree | |
672 | -- with the checksums in the ALI files. | |
673 | ||
674 | elsif Check_Source_Files then | |
cfac6e9f PO |
675 | if not Checksums_Match |
676 | (Source.Table (S).Checksum, | |
677 | Get_File_Checksum (Source.Table (S).Sfile)) | |
70482933 RK |
678 | then |
679 | Source.Table (S).All_Checksums_Match := False; | |
680 | end if; | |
681 | end if; | |
682 | end loop; | |
683 | ||
684 | -- Loop through ALI files | |
685 | ||
686 | ALIs_Loop : for A in ALIs.First .. ALIs.Last loop | |
687 | ||
688 | -- Loop through Sdep entries in one ALI file | |
689 | ||
690 | Sdep_Loop : for D in | |
691 | ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep | |
692 | loop | |
855ff2e1 GB |
693 | if Sdep.Table (D).Dummy_Entry then |
694 | goto Continue; | |
695 | end if; | |
696 | ||
70482933 RK |
697 | Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile)); |
698 | ||
699 | -- If the time stamps match, or all checksums match, then we | |
700 | -- are OK, otherwise we have a definite error. | |
701 | ||
702 | if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp | |
703 | and then not Source.Table (Src).All_Checksums_Match | |
704 | then | |
705 | Error_Msg_Name_1 := ALIs.Table (A).Sfile; | |
706 | Error_Msg_Name_2 := Sdep.Table (D).Sfile; | |
707 | ||
708 | -- Two styles of message, depending on whether or not | |
709 | -- the updated file is the one that must be recompiled | |
710 | ||
711 | if Error_Msg_Name_1 = Error_Msg_Name_2 then | |
712 | if Tolerate_Consistency_Errors then | |
713 | Error_Msg | |
714 | ("?% has been modified and should be recompiled"); | |
715 | else | |
716 | Error_Msg | |
717 | ("% has been modified and must be recompiled"); | |
718 | end if; | |
719 | ||
720 | else | |
555360a5 AC |
721 | ALI_Path_Id := |
722 | Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library); | |
723 | if Osint.Is_Readonly_Library (ALI_Path_Id) then | |
fbf5a39b AC |
724 | if Tolerate_Consistency_Errors then |
725 | Error_Msg ("?% should be recompiled"); | |
555360a5 | 726 | Error_Msg_Name_1 := ALI_Path_Id; |
fbf5a39b AC |
727 | Error_Msg ("?(% is obsolete and read-only)"); |
728 | ||
729 | else | |
730 | Error_Msg ("% must be compiled"); | |
555360a5 | 731 | Error_Msg_Name_1 := ALI_Path_Id; |
fbf5a39b AC |
732 | Error_Msg ("(% is obsolete and read-only)"); |
733 | end if; | |
734 | ||
735 | elsif Tolerate_Consistency_Errors then | |
70482933 RK |
736 | Error_Msg |
737 | ("?% should be recompiled (% has been modified)"); | |
738 | ||
739 | else | |
740 | Error_Msg ("% must be recompiled (% has been modified)"); | |
741 | end if; | |
742 | end if; | |
743 | ||
744 | if (not Tolerate_Consistency_Errors) and Verbose_Mode then | |
745 | declare | |
fbf5a39b | 746 | Msg : constant String := "% time stamp "; |
70482933 RK |
747 | Buf : String (1 .. Msg'Length + Time_Stamp_Length); |
748 | ||
749 | begin | |
750 | Buf (1 .. Msg'Length) := Msg; | |
751 | Buf (Msg'Length + 1 .. Buf'Length) := | |
752 | String (Source.Table (Src).Stamp); | |
fbf5a39b | 753 | Error_Msg_Name_1 := Sdep.Table (D).Sfile; |
70482933 | 754 | Error_Msg (Buf); |
fbf5a39b | 755 | end; |
70482933 | 756 | |
fbf5a39b AC |
757 | declare |
758 | Msg : constant String := " conflicts with % timestamp "; | |
759 | Buf : String (1 .. Msg'Length + Time_Stamp_Length); | |
760 | ||
761 | begin | |
762 | Buf (1 .. Msg'Length) := Msg; | |
70482933 RK |
763 | Buf (Msg'Length + 1 .. Buf'Length) := |
764 | String (Sdep.Table (D).Stamp); | |
765 | Error_Msg_Name_1 := Sdep.Table (D).Sfile; | |
766 | Error_Msg (Buf); | |
767 | end; | |
768 | end if; | |
769 | ||
770 | -- Exit from the loop through Sdep entries once we find one | |
771 | -- that does not match. | |
772 | ||
773 | exit Sdep_Loop; | |
774 | end if; | |
775 | ||
855ff2e1 GB |
776 | <<Continue>> |
777 | null; | |
70482933 RK |
778 | end loop Sdep_Loop; |
779 | end loop ALIs_Loop; | |
780 | end Check_Consistency; | |
781 | ||
782 | ------------------------------- | |
783 | -- Check_Duplicated_Subunits -- | |
784 | ------------------------------- | |
785 | ||
786 | procedure Check_Duplicated_Subunits is | |
787 | begin | |
788 | for J in Sdep.First .. Sdep.Last loop | |
789 | if Sdep.Table (J).Subunit_Name /= No_Name then | |
790 | Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name); | |
791 | Name_Len := Name_Len + 2; | |
792 | Name_Buffer (Name_Len - 1) := '%'; | |
793 | ||
794 | -- See if there is a body or spec with the same name | |
795 | ||
796 | for K in Boolean loop | |
797 | if K then | |
798 | Name_Buffer (Name_Len) := 'b'; | |
799 | ||
800 | else | |
801 | Name_Buffer (Name_Len) := 's'; | |
802 | end if; | |
803 | ||
804 | declare | |
805 | Info : constant Int := Get_Name_Table_Info (Name_Find); | |
806 | ||
807 | begin | |
808 | if Info /= 0 then | |
809 | Set_Standard_Error; | |
810 | Write_Str ("error: subunit """); | |
811 | Write_Name_Decoded (Sdep.Table (J).Subunit_Name); | |
812 | Write_Str (""" in file """); | |
813 | Write_Name_Decoded (Sdep.Table (J).Sfile); | |
814 | Write_Char ('"'); | |
815 | Write_Eol; | |
816 | Write_Str (" has same name as unit """); | |
817 | Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname); | |
818 | Write_Str (""" found in file """); | |
819 | Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile); | |
820 | Write_Char ('"'); | |
821 | Write_Eol; | |
822 | Write_Str (" this is not allowed within a single " | |
823 | & "partition (RM 10.2(19))"); | |
824 | Write_Eol; | |
825 | Osint.Exit_Program (Osint.E_Fatal); | |
826 | end if; | |
827 | end; | |
828 | end loop; | |
829 | end if; | |
830 | end loop; | |
831 | end Check_Duplicated_Subunits; | |
832 | ||
833 | -------------------- | |
834 | -- Check_Versions -- | |
835 | -------------------- | |
836 | ||
837 | procedure Check_Versions is | |
838 | VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len; | |
839 | ||
840 | begin | |
841 | for A in ALIs.First .. ALIs.Last loop | |
842 | if ALIs.Table (A).Ver_Len /= VL | |
843 | or else ALIs.Table (A).Ver (1 .. VL) /= | |
844 | ALIs.Table (ALIs.First).Ver (1 .. VL) | |
845 | then | |
846 | Error_Msg_Name_1 := ALIs.Table (A).Sfile; | |
847 | Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile; | |
848 | ||
849 | Consistency_Error_Msg | |
850 | ("% and % compiled with different GNAT versions"); | |
851 | end if; | |
852 | end loop; | |
853 | end Check_Versions; | |
854 | ||
855 | --------------------------- | |
856 | -- Consistency_Error_Msg -- | |
857 | --------------------------- | |
858 | ||
859 | procedure Consistency_Error_Msg (Msg : String) is | |
860 | begin | |
861 | if Tolerate_Consistency_Errors then | |
862 | ||
863 | -- If consistency errors are tolerated, | |
864 | -- output the message as a warning. | |
865 | ||
866 | declare | |
867 | Warning_Msg : String (1 .. Msg'Length + 1); | |
868 | ||
869 | begin | |
870 | Warning_Msg (1) := '?'; | |
871 | Warning_Msg (2 .. Warning_Msg'Last) := Msg; | |
872 | ||
873 | Error_Msg (Warning_Msg); | |
874 | end; | |
875 | ||
876 | -- Otherwise the consistency error is a true error | |
877 | ||
878 | else | |
879 | Error_Msg (Msg); | |
880 | end if; | |
881 | end Consistency_Error_Msg; | |
882 | ||
883 | end Bcheck; |