|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- B C H E C K --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
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 ALI; use ALI;
|
|
|
27 with ALI.Util; use ALI.Util;
|
|
|
28 with Binderr; use Binderr;
|
|
|
29 with Butil; use Butil;
|
|
|
30 with Casing; use Casing;
|
|
|
31 with Fname; use Fname;
|
|
|
32 with Namet; use Namet;
|
|
|
33 with Opt; use Opt;
|
|
|
34 with Osint;
|
|
|
35 with Output; use Output;
|
|
|
36 with Rident; use Rident;
|
|
|
37 with Types; use Types;
|
|
|
38
|
|
|
39 package body Bcheck is
|
|
|
40
|
|
|
41 -----------------------
|
|
|
42 -- Local Subprograms --
|
|
|
43 -----------------------
|
|
|
44
|
|
|
45 -- The following checking subprograms make up the parts of the
|
|
|
46 -- configuration consistency check. See bodies for details of checks.
|
|
|
47
|
|
|
48 procedure Check_Consistent_Dispatching_Policy;
|
|
|
49 procedure Check_Consistent_Dynamic_Elaboration_Checking;
|
|
|
50 procedure Check_Consistent_Interrupt_States;
|
|
|
51 procedure Check_Consistent_Locking_Policy;
|
|
|
52 procedure Check_Consistent_No_Component_Reordering;
|
|
|
53 procedure Check_Consistent_Normalize_Scalars;
|
|
|
54 procedure Check_Consistent_Optimize_Alignment;
|
|
|
55 procedure Check_Consistent_Partition_Elaboration_Policy;
|
|
|
56 procedure Check_Consistent_Queuing_Policy;
|
|
|
57 procedure Check_Consistent_Restrictions;
|
|
|
58 procedure Check_Consistent_Restriction_No_Default_Initialization;
|
|
|
59 procedure Check_Consistent_SSO_Default;
|
|
|
60 procedure Check_Consistent_Exception_Handling;
|
|
|
61
|
|
|
62 procedure Consistency_Error_Msg (Msg : String);
|
|
|
63 -- Produce an error or a warning message, depending on whether an
|
|
|
64 -- inconsistent configuration is permitted or not.
|
|
|
65
|
|
|
66 function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean;
|
|
|
67 -- Used to compare two unit names for No_Dependence checks. U1 is in
|
|
|
68 -- standard unit name format, and U2 is in literal form with periods.
|
|
|
69
|
|
|
70 -------------------------------------
|
|
|
71 -- Check_Configuration_Consistency --
|
|
|
72 -------------------------------------
|
|
|
73
|
|
|
74 procedure Check_Configuration_Consistency is
|
|
|
75 begin
|
|
|
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 No_Component_Reordering_Specified then
|
|
|
85 Check_Consistent_No_Component_Reordering;
|
|
|
86 end if;
|
|
|
87
|
|
|
88 if Partition_Elaboration_Policy_Specified /= ' ' then
|
|
|
89 Check_Consistent_Partition_Elaboration_Policy;
|
|
|
90 end if;
|
|
|
91
|
|
|
92 if SSO_Default_Specified then
|
|
|
93 Check_Consistent_SSO_Default;
|
|
|
94 end if;
|
|
|
95
|
|
|
96 if Zero_Cost_Exceptions_Specified
|
|
|
97 or else Frontend_Exceptions_Specified
|
|
|
98 then
|
|
|
99 Check_Consistent_Exception_Handling;
|
|
|
100 end if;
|
|
|
101
|
|
|
102 Check_Consistent_Normalize_Scalars;
|
|
|
103 Check_Consistent_Optimize_Alignment;
|
|
|
104 Check_Consistent_Dynamic_Elaboration_Checking;
|
|
|
105 Check_Consistent_Restrictions;
|
|
|
106 Check_Consistent_Restriction_No_Default_Initialization;
|
|
|
107 Check_Consistent_Interrupt_States;
|
|
|
108 Check_Consistent_Dispatching_Policy;
|
|
|
109 end Check_Configuration_Consistency;
|
|
|
110
|
|
|
111 -----------------------
|
|
|
112 -- Check_Consistency --
|
|
|
113 -----------------------
|
|
|
114
|
|
|
115 procedure Check_Consistency is
|
|
|
116 Src : Source_Id;
|
|
|
117 -- Source file Id for this Sdep entry
|
|
|
118
|
|
|
119 ALI_Path_Id : File_Name_Type;
|
|
|
120
|
|
|
121 begin
|
|
|
122 -- First, we go through the source table to see if there are any cases
|
|
|
123 -- in which we should go after source files and compute checksums of
|
|
|
124 -- the source files. We need to do this for any file for which we have
|
|
|
125 -- mismatching time stamps and (so far) matching checksums.
|
|
|
126
|
|
|
127 for S in Source.First .. Source.Last loop
|
|
|
128
|
|
|
129 -- If all time stamps for a file match, then there is nothing to
|
|
|
130 -- do, since we will not be checking checksums in that case anyway
|
|
|
131
|
|
|
132 if Source.Table (S).All_Timestamps_Match then
|
|
|
133 null;
|
|
|
134
|
|
|
135 -- If we did not find the source file, then we can't compute its
|
|
|
136 -- checksum anyway. Note that when we have a time stamp mismatch,
|
|
|
137 -- we try to find the source file unconditionally (i.e. if
|
|
|
138 -- Check_Source_Files is False).
|
|
|
139
|
|
|
140 elsif not Source.Table (S).Source_Found then
|
|
|
141 null;
|
|
|
142
|
|
|
143 -- If we already have non-matching or missing checksums, then no
|
|
|
144 -- need to try going after source file, since we won't trust the
|
|
|
145 -- checksums in any case.
|
|
|
146
|
|
|
147 elsif not Source.Table (S).All_Checksums_Match then
|
|
|
148 null;
|
|
|
149
|
|
|
150 -- Now we have the case where we have time stamp mismatches, and
|
|
|
151 -- the source file is around, but so far all checksums match. This
|
|
|
152 -- is the case where we need to compute the checksum from the source
|
|
|
153 -- file, since otherwise we would ignore the time stamp mismatches,
|
|
|
154 -- and that is wrong if the checksum of the source does not agree
|
|
|
155 -- with the checksums in the ALI files.
|
|
|
156
|
|
|
157 elsif Check_Source_Files then
|
|
|
158 if not Checksums_Match
|
|
|
159 (Source.Table (S).Checksum,
|
|
|
160 Get_File_Checksum (Source.Table (S).Sfile))
|
|
|
161 then
|
|
|
162 Source.Table (S).All_Checksums_Match := False;
|
|
|
163 end if;
|
|
|
164 end if;
|
|
|
165 end loop;
|
|
|
166
|
|
|
167 -- Loop through ALI files
|
|
|
168
|
|
|
169 ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
|
|
|
170
|
|
|
171 -- Loop through Sdep entries in one ALI file
|
|
|
172
|
|
|
173 Sdep_Loop : for D in
|
|
|
174 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
|
|
|
175 loop
|
|
|
176 if Sdep.Table (D).Dummy_Entry then
|
|
|
177 goto Continue;
|
|
|
178 end if;
|
|
|
179
|
|
|
180 Src := Source_Id (Get_Name_Table_Int (Sdep.Table (D).Sfile));
|
|
|
181
|
|
|
182 -- If the time stamps match, or all checksums match, then we
|
|
|
183 -- are OK, otherwise we have a definite error.
|
|
|
184
|
|
|
185 if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
|
|
|
186 and then not Source.Table (Src).All_Checksums_Match
|
|
|
187 then
|
|
|
188 Error_Msg_File_1 := ALIs.Table (A).Sfile;
|
|
|
189 Error_Msg_File_2 := Sdep.Table (D).Sfile;
|
|
|
190
|
|
|
191 -- Two styles of message, depending on whether or not
|
|
|
192 -- the updated file is the one that must be recompiled
|
|
|
193
|
|
|
194 if Error_Msg_File_1 = Error_Msg_File_2 then
|
|
|
195 if Tolerate_Consistency_Errors then
|
|
|
196 Error_Msg
|
|
|
197 ("?{ has been modified and should be recompiled");
|
|
|
198 else
|
|
|
199 Error_Msg
|
|
|
200 ("{ has been modified and must be recompiled");
|
|
|
201 end if;
|
|
|
202
|
|
|
203 else
|
|
|
204 ALI_Path_Id :=
|
|
|
205 Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
|
|
|
206
|
|
|
207 if Osint.Is_Readonly_Library (ALI_Path_Id) then
|
|
|
208 if Tolerate_Consistency_Errors then
|
|
|
209 Error_Msg ("?{ should be recompiled");
|
|
|
210 Error_Msg_File_1 := ALI_Path_Id;
|
|
|
211 Error_Msg ("?({ is obsolete and read-only)");
|
|
|
212 else
|
|
|
213 Error_Msg ("{ must be compiled");
|
|
|
214 Error_Msg_File_1 := ALI_Path_Id;
|
|
|
215 Error_Msg ("({ is obsolete and read-only)");
|
|
|
216 end if;
|
|
|
217
|
|
|
218 elsif Tolerate_Consistency_Errors then
|
|
|
219 Error_Msg
|
|
|
220 ("?{ should be recompiled ({ has been modified)");
|
|
|
221
|
|
|
222 else
|
|
|
223 Error_Msg ("{ must be recompiled ({ has been modified)");
|
|
|
224 end if;
|
|
|
225 end if;
|
|
|
226
|
|
|
227 if (not Tolerate_Consistency_Errors) and Verbose_Mode then
|
|
|
228 Error_Msg_File_1 := Source.Table (Src).Stamp_File;
|
|
|
229
|
|
|
230 if Source.Table (Src).Source_Found then
|
|
|
231 Error_Msg_File_1 :=
|
|
|
232 Osint.Full_Source_Name (Error_Msg_File_1);
|
|
|
233 else
|
|
|
234 Error_Msg_File_1 :=
|
|
|
235 Osint.Full_Lib_File_Name (Error_Msg_File_1);
|
|
|
236 end if;
|
|
|
237
|
|
|
238 Error_Msg
|
|
|
239 ("time stamp from { " & String (Source.Table (Src).Stamp));
|
|
|
240
|
|
|
241 Error_Msg_File_1 := Sdep.Table (D).Sfile;
|
|
|
242 Error_Msg
|
|
|
243 (" conflicts with { timestamp " &
|
|
|
244 String (Sdep.Table (D).Stamp));
|
|
|
245
|
|
|
246 Error_Msg_File_1 :=
|
|
|
247 Osint.Full_Lib_File_Name (ALIs.Table (A).Afile);
|
|
|
248 Error_Msg (" from {");
|
|
|
249 end if;
|
|
|
250
|
|
|
251 -- Exit from the loop through Sdep entries once we find one
|
|
|
252 -- that does not match.
|
|
|
253
|
|
|
254 exit Sdep_Loop;
|
|
|
255 end if;
|
|
|
256
|
|
|
257 <<Continue>>
|
|
|
258 null;
|
|
|
259 end loop Sdep_Loop;
|
|
|
260 end loop ALIs_Loop;
|
|
|
261 end Check_Consistency;
|
|
|
262
|
|
|
263 -----------------------------------------
|
|
|
264 -- Check_Consistent_Dispatching_Policy --
|
|
|
265 -----------------------------------------
|
|
|
266
|
|
|
267 -- The rule is that all files for which the dispatching policy is
|
|
|
268 -- significant must meet the following rules:
|
|
|
269
|
|
|
270 -- 1. All files for which a task dispatching policy is significant must
|
|
|
271 -- be compiled with the same setting.
|
|
|
272
|
|
|
273 -- 2. If a partition contains one or more Priority_Specific_Dispatching
|
|
|
274 -- pragmas it cannot contain a Task_Dispatching_Policy pragma.
|
|
|
275
|
|
|
276 -- 3. No overlap is allowed in the priority ranges specified in
|
|
|
277 -- Priority_Specific_Dispatching pragmas within the same partition.
|
|
|
278
|
|
|
279 -- 4. If a partition contains one or more Priority_Specific_Dispatching
|
|
|
280 -- pragmas then the Ceiling_Locking policy is the only one allowed for
|
|
|
281 -- the partition.
|
|
|
282
|
|
|
283 procedure Check_Consistent_Dispatching_Policy is
|
|
|
284 Max_Prio : Nat := 0;
|
|
|
285 -- Maximum priority value for which a Priority_Specific_Dispatching
|
|
|
286 -- pragma has been specified.
|
|
|
287
|
|
|
288 TDP_Pragma_Afile : ALI_Id := No_ALI_Id;
|
|
|
289 -- ALI file where a Task_Dispatching_Policy pragma appears
|
|
|
290
|
|
|
291 begin
|
|
|
292 -- Consistency checks in units specifying a Task_Dispatching_Policy
|
|
|
293
|
|
|
294 if Task_Dispatching_Policy_Specified /= ' ' then
|
|
|
295 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
|
|
|
296 if ALIs.Table (A1).Task_Dispatching_Policy /= ' ' then
|
|
|
297
|
|
|
298 -- Store the place where the first task dispatching pragma
|
|
|
299 -- appears. We may need this value for issuing consistency
|
|
|
300 -- errors if Priority_Specific_Dispatching pragmas are used.
|
|
|
301
|
|
|
302 TDP_Pragma_Afile := A1;
|
|
|
303
|
|
|
304 Check_Policy : declare
|
|
|
305 Policy : constant Character :=
|
|
|
306 ALIs.Table (A1).Task_Dispatching_Policy;
|
|
|
307
|
|
|
308 begin
|
|
|
309 for A2 in A1 + 1 .. ALIs.Last loop
|
|
|
310 if ALIs.Table (A2).Task_Dispatching_Policy /= ' '
|
|
|
311 and then
|
|
|
312 ALIs.Table (A2).Task_Dispatching_Policy /= Policy
|
|
|
313 then
|
|
|
314 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
315 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
|
|
|
316
|
|
|
317 Consistency_Error_Msg
|
|
|
318 ("{ and { compiled with different task" &
|
|
|
319 " dispatching policies");
|
|
|
320 exit Find_Policy;
|
|
|
321 end if;
|
|
|
322 end loop;
|
|
|
323 end Check_Policy;
|
|
|
324
|
|
|
325 exit Find_Policy;
|
|
|
326 end if;
|
|
|
327 end loop Find_Policy;
|
|
|
328 end if;
|
|
|
329
|
|
|
330 -- If no Priority_Specific_Dispatching entries, nothing else to do
|
|
|
331
|
|
|
332 if Specific_Dispatching.Last >= Specific_Dispatching.First then
|
|
|
333
|
|
|
334 -- Find out the maximum priority value for which one of the
|
|
|
335 -- Priority_Specific_Dispatching pragmas applies.
|
|
|
336
|
|
|
337 Max_Prio := 0;
|
|
|
338 for J in Specific_Dispatching.First .. Specific_Dispatching.Last loop
|
|
|
339 if Specific_Dispatching.Table (J).Last_Priority > Max_Prio then
|
|
|
340 Max_Prio := Specific_Dispatching.Table (J).Last_Priority;
|
|
|
341 end if;
|
|
|
342 end loop;
|
|
|
343
|
|
|
344 -- Now establish tables to be used for consistency checking
|
|
|
345
|
|
|
346 declare
|
|
|
347 -- The following record type is used to record locations of the
|
|
|
348 -- Priority_Specific_Dispatching pragmas applying to the Priority.
|
|
|
349
|
|
|
350 type Specific_Dispatching_Entry is record
|
|
|
351 Dispatching_Policy : Character := ' ';
|
|
|
352 -- First character (upper case) of corresponding policy name
|
|
|
353
|
|
|
354 Afile : ALI_Id := No_ALI_Id;
|
|
|
355 -- ALI file that generated Priority Specific Dispatching
|
|
|
356 -- entry for consistency message.
|
|
|
357
|
|
|
358 Loc : Nat := 0;
|
|
|
359 -- Line numbers from Priority_Specific_Dispatching pragma
|
|
|
360 end record;
|
|
|
361
|
|
|
362 PSD_Table : array (0 .. Max_Prio) of Specific_Dispatching_Entry :=
|
|
|
363 (others => Specific_Dispatching_Entry'
|
|
|
364 (Dispatching_Policy => ' ',
|
|
|
365 Afile => No_ALI_Id,
|
|
|
366 Loc => 0));
|
|
|
367 -- Array containing an entry per priority containing the location
|
|
|
368 -- where there is a Priority_Specific_Dispatching pragma that
|
|
|
369 -- applies to the priority.
|
|
|
370
|
|
|
371 begin
|
|
|
372 for F in ALIs.First .. ALIs.Last loop
|
|
|
373 for K in ALIs.Table (F).First_Specific_Dispatching ..
|
|
|
374 ALIs.Table (F).Last_Specific_Dispatching
|
|
|
375 loop
|
|
|
376 declare
|
|
|
377 DTK : Specific_Dispatching_Record
|
|
|
378 renames Specific_Dispatching.Table (K);
|
|
|
379 begin
|
|
|
380 -- Check whether pragma Task_Dispatching_Policy and
|
|
|
381 -- pragma Priority_Specific_Dispatching are used in the
|
|
|
382 -- same partition.
|
|
|
383
|
|
|
384 if Task_Dispatching_Policy_Specified /= ' ' then
|
|
|
385 Error_Msg_File_1 := ALIs.Table (F).Sfile;
|
|
|
386 Error_Msg_File_2 :=
|
|
|
387 ALIs.Table (TDP_Pragma_Afile).Sfile;
|
|
|
388
|
|
|
389 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
|
|
|
390
|
|
|
391 Consistency_Error_Msg
|
|
|
392 ("Priority_Specific_Dispatching at {:#" &
|
|
|
393 " incompatible with Task_Dispatching_Policy at {");
|
|
|
394 end if;
|
|
|
395
|
|
|
396 -- Ceiling_Locking must also be specified for a partition
|
|
|
397 -- with at least one Priority_Specific_Dispatching
|
|
|
398 -- pragma.
|
|
|
399
|
|
|
400 if Locking_Policy_Specified /= ' '
|
|
|
401 and then Locking_Policy_Specified /= 'C'
|
|
|
402 then
|
|
|
403 for A in ALIs.First .. ALIs.Last loop
|
|
|
404 if ALIs.Table (A).Locking_Policy /= ' '
|
|
|
405 and then ALIs.Table (A).Locking_Policy /= 'C'
|
|
|
406 then
|
|
|
407 Error_Msg_File_1 := ALIs.Table (F).Sfile;
|
|
|
408 Error_Msg_File_2 := ALIs.Table (A).Sfile;
|
|
|
409
|
|
|
410 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
|
|
|
411
|
|
|
412 Consistency_Error_Msg
|
|
|
413 ("Priority_Specific_Dispatching at {:#" &
|
|
|
414 " incompatible with Locking_Policy at {");
|
|
|
415 end if;
|
|
|
416 end loop;
|
|
|
417 end if;
|
|
|
418
|
|
|
419 -- Check overlapping priority ranges
|
|
|
420
|
|
|
421 Find_Overlapping : for Prio in
|
|
|
422 DTK.First_Priority .. DTK.Last_Priority
|
|
|
423 loop
|
|
|
424 if PSD_Table (Prio).Afile = No_ALI_Id then
|
|
|
425 PSD_Table (Prio) :=
|
|
|
426 (Dispatching_Policy => DTK.Dispatching_Policy,
|
|
|
427 Afile => F, Loc => DTK.PSD_Pragma_Line);
|
|
|
428
|
|
|
429 elsif PSD_Table (Prio).Dispatching_Policy /=
|
|
|
430 DTK.Dispatching_Policy
|
|
|
431
|
|
|
432 then
|
|
|
433 Error_Msg_File_1 :=
|
|
|
434 ALIs.Table (PSD_Table (Prio).Afile).Sfile;
|
|
|
435 Error_Msg_File_2 := ALIs.Table (F).Sfile;
|
|
|
436 Error_Msg_Nat_1 := PSD_Table (Prio).Loc;
|
|
|
437 Error_Msg_Nat_2 := DTK.PSD_Pragma_Line;
|
|
|
438
|
|
|
439 Consistency_Error_Msg
|
|
|
440 ("overlapping priority ranges at {:# and {:#");
|
|
|
441
|
|
|
442 exit Find_Overlapping;
|
|
|
443 end if;
|
|
|
444 end loop Find_Overlapping;
|
|
|
445 end;
|
|
|
446 end loop;
|
|
|
447 end loop;
|
|
|
448 end;
|
|
|
449 end if;
|
|
|
450 end Check_Consistent_Dispatching_Policy;
|
|
|
451
|
|
|
452 ---------------------------------------------------
|
|
|
453 -- Check_Consistent_Dynamic_Elaboration_Checking --
|
|
|
454 ---------------------------------------------------
|
|
|
455
|
|
|
456 -- The rule here is that if a unit has dynamic elaboration checks,
|
|
|
457 -- then any unit it withs must meet one of the following criteria:
|
|
|
458
|
|
|
459 -- 1. There is a pragma Elaborate_All for the with'ed unit
|
|
|
460 -- 2. The with'ed unit was compiled with dynamic elaboration checks
|
|
|
461 -- 3. The with'ed unit has pragma Preelaborate or Pure
|
|
|
462 -- 4. It is an internal GNAT unit (including children of GNAT)
|
|
|
463 -- 5. It is an interface of a Stand-Alone Library
|
|
|
464
|
|
|
465 procedure Check_Consistent_Dynamic_Elaboration_Checking is
|
|
|
466 begin
|
|
|
467 if Dynamic_Elaboration_Checks_Specified then
|
|
|
468 for U in First_Unit_Entry .. Units.Last loop
|
|
|
469 declare
|
|
|
470 UR : Unit_Record renames Units.Table (U);
|
|
|
471
|
|
|
472 begin
|
|
|
473 if UR.Dynamic_Elab then
|
|
|
474 for W in UR.First_With .. UR.Last_With loop
|
|
|
475 declare
|
|
|
476 WR : With_Record renames Withs.Table (W);
|
|
|
477
|
|
|
478 begin
|
|
|
479 if Get_Name_Table_Int (WR.Uname) /= 0 then
|
|
|
480 declare
|
|
|
481 WU : Unit_Record renames
|
|
|
482 Units.Table
|
|
|
483 (Unit_Id
|
|
|
484 (Get_Name_Table_Int (WR.Uname)));
|
|
|
485
|
|
|
486 begin
|
|
|
487 -- Case 1. Elaborate_All for with'ed unit
|
|
|
488
|
|
|
489 if WR.Elaborate_All then
|
|
|
490 null;
|
|
|
491
|
|
|
492 -- Case 2. With'ed unit has dynamic elab checks
|
|
|
493
|
|
|
494 elsif WU.Dynamic_Elab then
|
|
|
495 null;
|
|
|
496
|
|
|
497 -- Case 3. With'ed unit is Preelaborate or Pure
|
|
|
498
|
|
|
499 elsif WU.Preelab or else WU.Pure then
|
|
|
500 null;
|
|
|
501
|
|
|
502 -- Case 4. With'ed unit is internal file
|
|
|
503
|
|
|
504 elsif Is_Internal_File_Name (WU.Sfile) then
|
|
|
505 null;
|
|
|
506
|
|
|
507 -- Case 5. With'ed unit is a SAL interface
|
|
|
508
|
|
|
509 elsif WU.SAL_Interface then
|
|
|
510 null;
|
|
|
511
|
|
|
512 -- Issue warning, not one of the safe cases
|
|
|
513
|
|
|
514 else
|
|
|
515 Error_Msg_File_1 := UR.Sfile;
|
|
|
516 Error_Msg
|
|
|
517 ("?{ has dynamic elaboration checks " &
|
|
|
518 "and with's");
|
|
|
519
|
|
|
520 Error_Msg_File_1 := WU.Sfile;
|
|
|
521 Error_Msg
|
|
|
522 ("? { which has static elaboration " &
|
|
|
523 "checks");
|
|
|
524
|
|
|
525 Warnings_Detected := Warnings_Detected + 1;
|
|
|
526 end if;
|
|
|
527 end;
|
|
|
528 end if;
|
|
|
529 end;
|
|
|
530 end loop;
|
|
|
531 end if;
|
|
|
532 end;
|
|
|
533 end loop;
|
|
|
534 end if;
|
|
|
535 end Check_Consistent_Dynamic_Elaboration_Checking;
|
|
|
536
|
|
|
537 ---------------------------------------
|
|
|
538 -- Check_Consistent_Interrupt_States --
|
|
|
539 ---------------------------------------
|
|
|
540
|
|
|
541 -- The rule is that if the state of a given interrupt is specified
|
|
|
542 -- in more than one unit, it must be specified with a consistent state.
|
|
|
543
|
|
|
544 procedure Check_Consistent_Interrupt_States is
|
|
|
545 Max_Intrup : Nat;
|
|
|
546
|
|
|
547 begin
|
|
|
548 -- If no Interrupt_State entries, nothing to do
|
|
|
549
|
|
|
550 if Interrupt_States.Last < Interrupt_States.First then
|
|
|
551 return;
|
|
|
552 end if;
|
|
|
553
|
|
|
554 -- First find out the maximum interrupt value
|
|
|
555
|
|
|
556 Max_Intrup := 0;
|
|
|
557 for J in Interrupt_States.First .. Interrupt_States.Last loop
|
|
|
558 if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
|
|
|
559 Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
|
|
|
560 end if;
|
|
|
561 end loop;
|
|
|
562
|
|
|
563 -- Now establish tables to be used for consistency checking
|
|
|
564
|
|
|
565 declare
|
|
|
566 Istate : array (0 .. Max_Intrup) of Character := (others => 'n');
|
|
|
567 -- Interrupt state entries, 'u'/'s'/'r' or 'n' to indicate an
|
|
|
568 -- entry that has not been set.
|
|
|
569
|
|
|
570 Afile : array (0 .. Max_Intrup) of ALI_Id;
|
|
|
571 -- ALI file that generated Istate entry for consistency message
|
|
|
572
|
|
|
573 Loc : array (0 .. Max_Intrup) of Nat;
|
|
|
574 -- Line numbers from IS pragma generating Istate entry
|
|
|
575
|
|
|
576 Inum : Nat;
|
|
|
577 -- Interrupt number from entry being tested
|
|
|
578
|
|
|
579 Stat : Character;
|
|
|
580 -- Interrupt state from entry being tested
|
|
|
581
|
|
|
582 Lnum : Nat;
|
|
|
583 -- Line number from entry being tested
|
|
|
584
|
|
|
585 begin
|
|
|
586 for F in ALIs.First .. ALIs.Last loop
|
|
|
587 for K in ALIs.Table (F).First_Interrupt_State ..
|
|
|
588 ALIs.Table (F).Last_Interrupt_State
|
|
|
589 loop
|
|
|
590 Inum := Interrupt_States.Table (K).Interrupt_Id;
|
|
|
591 Stat := Interrupt_States.Table (K).Interrupt_State;
|
|
|
592 Lnum := Interrupt_States.Table (K).IS_Pragma_Line;
|
|
|
593
|
|
|
594 if Istate (Inum) = 'n' then
|
|
|
595 Istate (Inum) := Stat;
|
|
|
596 Afile (Inum) := F;
|
|
|
597 Loc (Inum) := Lnum;
|
|
|
598
|
|
|
599 elsif Istate (Inum) /= Stat then
|
|
|
600 Error_Msg_File_1 := ALIs.Table (Afile (Inum)).Sfile;
|
|
|
601 Error_Msg_File_2 := ALIs.Table (F).Sfile;
|
|
|
602 Error_Msg_Nat_1 := Loc (Inum);
|
|
|
603 Error_Msg_Nat_2 := Lnum;
|
|
|
604
|
|
|
605 Consistency_Error_Msg
|
|
|
606 ("inconsistent interrupt states at {:# and {:#");
|
|
|
607 end if;
|
|
|
608 end loop;
|
|
|
609 end loop;
|
|
|
610 end;
|
|
|
611 end Check_Consistent_Interrupt_States;
|
|
|
612
|
|
|
613 -------------------------------------
|
|
|
614 -- Check_Consistent_Locking_Policy --
|
|
|
615 -------------------------------------
|
|
|
616
|
|
|
617 -- The rule is that all files for which the locking policy is
|
|
|
618 -- significant must be compiled with the same setting.
|
|
|
619
|
|
|
620 procedure Check_Consistent_Locking_Policy is
|
|
|
621 begin
|
|
|
622 -- First search for a unit specifying a policy and then
|
|
|
623 -- check all remaining units against it.
|
|
|
624
|
|
|
625 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
|
|
|
626 if ALIs.Table (A1).Locking_Policy /= ' ' then
|
|
|
627 Check_Policy : declare
|
|
|
628 Policy : constant Character := ALIs.Table (A1).Locking_Policy;
|
|
|
629
|
|
|
630 begin
|
|
|
631 for A2 in A1 + 1 .. ALIs.Last loop
|
|
|
632 if ALIs.Table (A2).Locking_Policy /= ' '
|
|
|
633 and then
|
|
|
634 ALIs.Table (A2).Locking_Policy /= Policy
|
|
|
635 then
|
|
|
636 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
637 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
|
|
|
638
|
|
|
639 Consistency_Error_Msg
|
|
|
640 ("{ and { compiled with different locking policies");
|
|
|
641 exit Find_Policy;
|
|
|
642 end if;
|
|
|
643 end loop;
|
|
|
644 end Check_Policy;
|
|
|
645
|
|
|
646 exit Find_Policy;
|
|
|
647 end if;
|
|
|
648 end loop Find_Policy;
|
|
|
649 end Check_Consistent_Locking_Policy;
|
|
|
650
|
|
|
651 ----------------------------------------------
|
|
|
652 -- Check_Consistent_No_Component_Reordering --
|
|
|
653 ----------------------------------------------
|
|
|
654
|
|
|
655 -- This routine checks for a consistent No_Component_Reordering setting.
|
|
|
656 -- Note that internal units are excluded from this check, since we don't
|
|
|
657 -- in any case allow the pragma to affect types in internal units, and
|
|
|
658 -- there is thus no requirement to recompile the run-time with the setting.
|
|
|
659
|
|
|
660 procedure Check_Consistent_No_Component_Reordering is
|
|
|
661 OK : Boolean := True;
|
|
|
662 begin
|
|
|
663 -- Check that all entries have No_Component_Reordering set
|
|
|
664
|
|
|
665 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
666 if not Is_Internal_File_Name (ALIs.Table (A1).Sfile)
|
|
|
667 and then not ALIs.Table (A1).No_Component_Reordering
|
|
|
668 then
|
|
|
669 OK := False;
|
|
|
670 exit;
|
|
|
671 end if;
|
|
|
672 end loop;
|
|
|
673
|
|
|
674 -- All do, return
|
|
|
675
|
|
|
676 if OK then
|
|
|
677 return;
|
|
|
678 end if;
|
|
|
679
|
|
|
680 -- Here we have an inconsistency
|
|
|
681
|
|
|
682 Consistency_Error_Msg
|
|
|
683 ("some but not all files compiled with No_Component_Reordering");
|
|
|
684
|
|
|
685 Write_Eol;
|
|
|
686 Write_Str ("files compiled with No_Component_Reordering");
|
|
|
687 Write_Eol;
|
|
|
688
|
|
|
689 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
690 if not Is_Internal_File_Name (ALIs.Table (A1).Sfile)
|
|
|
691 and then ALIs.Table (A1).No_Component_Reordering
|
|
|
692 then
|
|
|
693 Write_Str (" ");
|
|
|
694 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
695 Write_Eol;
|
|
|
696 end if;
|
|
|
697 end loop;
|
|
|
698
|
|
|
699 Write_Eol;
|
|
|
700 Write_Str ("files compiled without No_Component_Reordering");
|
|
|
701 Write_Eol;
|
|
|
702
|
|
|
703 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
704 if not Is_Internal_File_Name (ALIs.Table (A1).Sfile)
|
|
|
705 and then not ALIs.Table (A1).No_Component_Reordering
|
|
|
706 then
|
|
|
707 Write_Str (" ");
|
|
|
708 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
709 Write_Eol;
|
|
|
710 end if;
|
|
|
711 end loop;
|
|
|
712 end Check_Consistent_No_Component_Reordering;
|
|
|
713
|
|
|
714 ----------------------------------------
|
|
|
715 -- Check_Consistent_Normalize_Scalars --
|
|
|
716 ----------------------------------------
|
|
|
717
|
|
|
718 -- The rule is that if any unit is compiled with Normalize_Scalars,
|
|
|
719 -- then all other units in the partition must also be compiled with
|
|
|
720 -- Normalize_Scalars in effect.
|
|
|
721
|
|
|
722 -- There is some issue as to whether this consistency check is desirable,
|
|
|
723 -- it is certainly required at the moment by the RM. We should keep a watch
|
|
|
724 -- on the ARG and HRG deliberations here. GNAT no longer depends on this
|
|
|
725 -- consistency (it used to do so, but that is no longer the case, since
|
|
|
726 -- pragma Initialize_Scalars pragma does not require consistency.)
|
|
|
727
|
|
|
728 procedure Check_Consistent_Normalize_Scalars is
|
|
|
729 begin
|
|
|
730 if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
|
|
|
731 Consistency_Error_Msg
|
|
|
732 ("some but not all files compiled with Normalize_Scalars");
|
|
|
733
|
|
|
734 Write_Eol;
|
|
|
735 Write_Str ("files compiled with Normalize_Scalars");
|
|
|
736 Write_Eol;
|
|
|
737
|
|
|
738 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
739 if ALIs.Table (A1).Normalize_Scalars then
|
|
|
740 Write_Str (" ");
|
|
|
741 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
742 Write_Eol;
|
|
|
743 end if;
|
|
|
744 end loop;
|
|
|
745
|
|
|
746 Write_Eol;
|
|
|
747 Write_Str ("files compiled without Normalize_Scalars");
|
|
|
748 Write_Eol;
|
|
|
749
|
|
|
750 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
751 if not ALIs.Table (A1).Normalize_Scalars then
|
|
|
752 Write_Str (" ");
|
|
|
753 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
754 Write_Eol;
|
|
|
755 end if;
|
|
|
756 end loop;
|
|
|
757 end if;
|
|
|
758 end Check_Consistent_Normalize_Scalars;
|
|
|
759
|
|
|
760 -----------------------------------------
|
|
|
761 -- Check_Consistent_Optimize_Alignment --
|
|
|
762 -----------------------------------------
|
|
|
763
|
|
|
764 -- The rule is that all units which depend on the global default setting
|
|
|
765 -- of Optimize_Alignment must be compiled with the same setting for this
|
|
|
766 -- default. Units which specify an explicit local value for this setting
|
|
|
767 -- are exempt from the consistency rule (this includes all internal units).
|
|
|
768
|
|
|
769 procedure Check_Consistent_Optimize_Alignment is
|
|
|
770 OA_Setting : Character := ' ';
|
|
|
771 -- Reset when we find a unit that depends on the default and does
|
|
|
772 -- not have a local specification of the Optimize_Alignment setting.
|
|
|
773
|
|
|
774 OA_Unit : Unit_Id;
|
|
|
775 -- Id of unit from which OA_Setting was set
|
|
|
776
|
|
|
777 C : Character;
|
|
|
778
|
|
|
779 begin
|
|
|
780 for U in First_Unit_Entry .. Units.Last loop
|
|
|
781 C := Units.Table (U).Optimize_Alignment;
|
|
|
782
|
|
|
783 if C /= 'L' then
|
|
|
784 if OA_Setting = ' ' then
|
|
|
785 OA_Setting := C;
|
|
|
786 OA_Unit := U;
|
|
|
787
|
|
|
788 elsif OA_Setting = C then
|
|
|
789 null;
|
|
|
790
|
|
|
791 else
|
|
|
792 Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
|
|
|
793 Error_Msg_Unit_2 := Units.Table (U).Uname;
|
|
|
794
|
|
|
795 Consistency_Error_Msg
|
|
|
796 ("$ and $ compiled with different "
|
|
|
797 & "default Optimize_Alignment settings");
|
|
|
798 return;
|
|
|
799 end if;
|
|
|
800 end if;
|
|
|
801 end loop;
|
|
|
802 end Check_Consistent_Optimize_Alignment;
|
|
|
803
|
|
|
804 ---------------------------------------------------
|
|
|
805 -- Check_Consistent_Partition_Elaboration_Policy --
|
|
|
806 ---------------------------------------------------
|
|
|
807
|
|
|
808 -- The rule is that all files for which the partition elaboration policy is
|
|
|
809 -- significant must be compiled with the same setting.
|
|
|
810
|
|
|
811 procedure Check_Consistent_Partition_Elaboration_Policy is
|
|
|
812 begin
|
|
|
813 -- First search for a unit specifying a policy and then
|
|
|
814 -- check all remaining units against it.
|
|
|
815
|
|
|
816 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
|
|
|
817 if ALIs.Table (A1).Partition_Elaboration_Policy /= ' ' then
|
|
|
818 Check_Policy : declare
|
|
|
819 Policy : constant Character :=
|
|
|
820 ALIs.Table (A1).Partition_Elaboration_Policy;
|
|
|
821
|
|
|
822 begin
|
|
|
823 for A2 in A1 + 1 .. ALIs.Last loop
|
|
|
824 if ALIs.Table (A2).Partition_Elaboration_Policy /= ' '
|
|
|
825 and then
|
|
|
826 ALIs.Table (A2).Partition_Elaboration_Policy /= Policy
|
|
|
827 then
|
|
|
828 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
829 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
|
|
|
830
|
|
|
831 Consistency_Error_Msg
|
|
|
832 ("{ and { compiled with different partition "
|
|
|
833 & "elaboration policies");
|
|
|
834 exit Find_Policy;
|
|
|
835 end if;
|
|
|
836 end loop;
|
|
|
837 end Check_Policy;
|
|
|
838
|
|
|
839 -- A No_Task_Hierarchy restriction must be specified for the
|
|
|
840 -- Sequential policy (RM H.6(6/2)).
|
|
|
841
|
|
|
842 if Partition_Elaboration_Policy_Specified = 'S'
|
|
|
843 and then not Cumulative_Restrictions.Set (No_Task_Hierarchy)
|
|
|
844 then
|
|
|
845 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
846 Error_Msg
|
|
|
847 ("{ has sequential partition elaboration policy, but no");
|
|
|
848 Error_Msg
|
|
|
849 ("pragma Restrictions (No_Task_Hierarchy) was specified");
|
|
|
850 end if;
|
|
|
851
|
|
|
852 exit Find_Policy;
|
|
|
853 end if;
|
|
|
854 end loop Find_Policy;
|
|
|
855 end Check_Consistent_Partition_Elaboration_Policy;
|
|
|
856
|
|
|
857 -------------------------------------
|
|
|
858 -- Check_Consistent_Queuing_Policy --
|
|
|
859 -------------------------------------
|
|
|
860
|
|
|
861 -- The rule is that all files for which the queuing policy is
|
|
|
862 -- significant must be compiled with the same setting.
|
|
|
863
|
|
|
864 procedure Check_Consistent_Queuing_Policy is
|
|
|
865 begin
|
|
|
866 -- First search for a unit specifying a policy and then
|
|
|
867 -- check all remaining units against it.
|
|
|
868
|
|
|
869 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
|
|
|
870 if ALIs.Table (A1).Queuing_Policy /= ' ' then
|
|
|
871 Check_Policy : declare
|
|
|
872 Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
|
|
|
873 begin
|
|
|
874 for A2 in A1 + 1 .. ALIs.Last loop
|
|
|
875 if ALIs.Table (A2).Queuing_Policy /= ' '
|
|
|
876 and then
|
|
|
877 ALIs.Table (A2).Queuing_Policy /= Policy
|
|
|
878 then
|
|
|
879 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
880 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
|
|
|
881
|
|
|
882 Consistency_Error_Msg
|
|
|
883 ("{ and { compiled with different queuing policies");
|
|
|
884 exit Find_Policy;
|
|
|
885 end if;
|
|
|
886 end loop;
|
|
|
887 end Check_Policy;
|
|
|
888
|
|
|
889 exit Find_Policy;
|
|
|
890 end if;
|
|
|
891 end loop Find_Policy;
|
|
|
892 end Check_Consistent_Queuing_Policy;
|
|
|
893
|
|
|
894 -----------------------------------
|
|
|
895 -- Check_Consistent_Restrictions --
|
|
|
896 -----------------------------------
|
|
|
897
|
|
|
898 -- The rule is that if a restriction is specified in any unit, then all
|
|
|
899 -- units must obey the restriction. The check applies only to restrictions
|
|
|
900 -- which require partition wide consistency, and not to internal units.
|
|
|
901
|
|
|
902 procedure Check_Consistent_Restrictions is
|
|
|
903 Restriction_File_Output : Boolean;
|
|
|
904 -- Shows if we have output header messages for restriction violation
|
|
|
905
|
|
|
906 procedure Print_Restriction_File (R : All_Restrictions);
|
|
|
907 -- Print header line for R if not printed yet
|
|
|
908
|
|
|
909 ----------------------------
|
|
|
910 -- Print_Restriction_File --
|
|
|
911 ----------------------------
|
|
|
912
|
|
|
913 procedure Print_Restriction_File (R : All_Restrictions) is
|
|
|
914 begin
|
|
|
915 if not Restriction_File_Output then
|
|
|
916 Restriction_File_Output := True;
|
|
|
917
|
|
|
918 -- Find an ali file specifying the restriction
|
|
|
919
|
|
|
920 for A in ALIs.First .. ALIs.Last loop
|
|
|
921 if ALIs.Table (A).Restrictions.Set (R)
|
|
|
922 and then (R in All_Boolean_Restrictions
|
|
|
923 or else ALIs.Table (A).Restrictions.Value (R) =
|
|
|
924 Cumulative_Restrictions.Value (R))
|
|
|
925 then
|
|
|
926 -- We have found that ALI file A specifies the restriction
|
|
|
927 -- that is being violated (the minimum value is specified
|
|
|
928 -- in the case of a parameter restriction).
|
|
|
929
|
|
|
930 declare
|
|
|
931 M1 : constant String := "{ has restriction ";
|
|
|
932 S : constant String := Restriction_Id'Image (R);
|
|
|
933 M2 : String (1 .. 2000); -- big enough
|
|
|
934 P : Integer;
|
|
|
935
|
|
|
936 begin
|
|
|
937 Name_Buffer (1 .. S'Length) := S;
|
|
|
938 Name_Len := S'Length;
|
|
|
939 Set_Casing (Mixed_Case);
|
|
|
940
|
|
|
941 M2 (M1'Range) := M1;
|
|
|
942 P := M1'Length + 1;
|
|
|
943 M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
|
|
|
944 P := P + S'Length;
|
|
|
945
|
|
|
946 if R in All_Parameter_Restrictions then
|
|
|
947 M2 (P .. P + 4) := " => #";
|
|
|
948 Error_Msg_Nat_1 :=
|
|
|
949 Int (Cumulative_Restrictions.Value (R));
|
|
|
950 P := P + 5;
|
|
|
951 end if;
|
|
|
952
|
|
|
953 Error_Msg_File_1 := ALIs.Table (A).Sfile;
|
|
|
954 Consistency_Error_Msg (M2 (1 .. P - 1));
|
|
|
955 Consistency_Error_Msg
|
|
|
956 ("but the following files violate this restriction:");
|
|
|
957 return;
|
|
|
958 end;
|
|
|
959 end if;
|
|
|
960 end loop;
|
|
|
961 end if;
|
|
|
962 end Print_Restriction_File;
|
|
|
963
|
|
|
964 -- Start of processing for Check_Consistent_Restrictions
|
|
|
965
|
|
|
966 begin
|
|
|
967 -- We used to have a special test here:
|
|
|
968
|
|
|
969 -- A special test, if we have a main program, then if it has an
|
|
|
970 -- allocator in the body, this is considered to be a violation of
|
|
|
971 -- the restriction No_Allocators_After_Elaboration. We just mark
|
|
|
972 -- this restriction and then the normal circuit will flag it.
|
|
|
973
|
|
|
974 -- But we don't do that any more, because in the final version of Ada
|
|
|
975 -- 2012, it is statically illegal to have an allocator in a library-
|
|
|
976 -- level subprogram, so we don't need this bind time test any more.
|
|
|
977 -- If we have a main program with parameters (which GNAT allows), then
|
|
|
978 -- allocators in that will be caught by the run-time check.
|
|
|
979
|
|
|
980 -- Loop through all restriction violations
|
|
|
981
|
|
|
982 for R in All_Restrictions loop
|
|
|
983
|
|
|
984 -- Check for violation of this restriction
|
|
|
985
|
|
|
986 if Cumulative_Restrictions.Set (R)
|
|
|
987 and then Cumulative_Restrictions.Violated (R)
|
|
|
988 and then (R in Partition_Boolean_Restrictions
|
|
|
989 or else (R in All_Parameter_Restrictions
|
|
|
990 and then
|
|
|
991 Cumulative_Restrictions.Count (R) >
|
|
|
992 Cumulative_Restrictions.Value (R)))
|
|
|
993 then
|
|
|
994 Restriction_File_Output := False;
|
|
|
995
|
|
|
996 -- Loop through files looking for violators
|
|
|
997
|
|
|
998 for A2 in ALIs.First .. ALIs.Last loop
|
|
|
999 declare
|
|
|
1000 T : ALIs_Record renames ALIs.Table (A2);
|
|
|
1001
|
|
|
1002 begin
|
|
|
1003 if T.Restrictions.Violated (R) then
|
|
|
1004
|
|
|
1005 -- We exclude predefined files from the list of
|
|
|
1006 -- violators. This should be rethought. It is not
|
|
|
1007 -- clear that this is the right thing to do, that
|
|
|
1008 -- is particularly the case for restricted runtimes.
|
|
|
1009
|
|
|
1010 if not Is_Internal_File_Name (T.Sfile) then
|
|
|
1011
|
|
|
1012 -- Case of Boolean restriction, just print file name
|
|
|
1013
|
|
|
1014 if R in All_Boolean_Restrictions then
|
|
|
1015 Print_Restriction_File (R);
|
|
|
1016 Error_Msg_File_1 := T.Sfile;
|
|
|
1017 Consistency_Error_Msg (" {");
|
|
|
1018
|
|
|
1019 -- Case of Parameter restriction where violation
|
|
|
1020 -- count exceeds restriction value, print file
|
|
|
1021 -- name and count, adding "at least" if the
|
|
|
1022 -- exact count is not known.
|
|
|
1023
|
|
|
1024 elsif R in Checked_Add_Parameter_Restrictions
|
|
|
1025 or else T.Restrictions.Count (R) >
|
|
|
1026 Cumulative_Restrictions.Value (R)
|
|
|
1027 then
|
|
|
1028 Print_Restriction_File (R);
|
|
|
1029 Error_Msg_File_1 := T.Sfile;
|
|
|
1030 Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));
|
|
|
1031
|
|
|
1032 if T.Restrictions.Unknown (R) then
|
|
|
1033 Consistency_Error_Msg
|
|
|
1034 (" { (count = at least #)");
|
|
|
1035 else
|
|
|
1036 Consistency_Error_Msg
|
|
|
1037 (" { (count = #)");
|
|
|
1038 end if;
|
|
|
1039 end if;
|
|
|
1040 end if;
|
|
|
1041 end if;
|
|
|
1042 end;
|
|
|
1043 end loop;
|
|
|
1044 end if;
|
|
|
1045 end loop;
|
|
|
1046
|
|
|
1047 -- Now deal with No_Dependence indications. Note that we put the loop
|
|
|
1048 -- through entries in the no dependency table first, since this loop
|
|
|
1049 -- is most often empty (no such pragma Restrictions in use).
|
|
|
1050
|
|
|
1051 for ND in No_Deps.First .. No_Deps.Last loop
|
|
|
1052 declare
|
|
|
1053 ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
|
|
|
1054 begin
|
|
|
1055 for J in ALIs.First .. ALIs.Last loop
|
|
|
1056 declare
|
|
|
1057 A : ALIs_Record renames ALIs.Table (J);
|
|
|
1058 begin
|
|
|
1059 for K in A.First_Unit .. A.Last_Unit loop
|
|
|
1060 declare
|
|
|
1061 U : Unit_Record renames Units.Table (K);
|
|
|
1062 begin
|
|
|
1063 -- Exclude runtime units from this check since the
|
|
|
1064 -- user does not care how a runtime unit is
|
|
|
1065 -- implemented.
|
|
|
1066
|
|
|
1067 if not Is_Internal_File_Name (U.Sfile) then
|
|
|
1068 for L in U.First_With .. U.Last_With loop
|
|
|
1069 if Same_Unit (Withs.Table (L).Uname, ND_Unit)
|
|
|
1070 then
|
|
|
1071 Error_Msg_File_1 := U.Sfile;
|
|
|
1072 Error_Msg_Name_1 := ND_Unit;
|
|
|
1073 Consistency_Error_Msg
|
|
|
1074 ("file { violates restriction " &
|
|
|
1075 "No_Dependence => %");
|
|
|
1076 end if;
|
|
|
1077 end loop;
|
|
|
1078 end if;
|
|
|
1079 end;
|
|
|
1080 end loop;
|
|
|
1081 end;
|
|
|
1082 end loop;
|
|
|
1083 end;
|
|
|
1084 end loop;
|
|
|
1085 end Check_Consistent_Restrictions;
|
|
|
1086
|
|
|
1087 ------------------------------------------------------------
|
|
|
1088 -- Check_Consistent_Restriction_No_Default_Initialization --
|
|
|
1089 ------------------------------------------------------------
|
|
|
1090
|
|
|
1091 -- The Restriction (No_Default_Initialization) has special consistency
|
|
|
1092 -- rules. The rule is that no unit compiled without this restriction
|
|
|
1093 -- that violates the restriction can WITH a unit that is compiled with
|
|
|
1094 -- the restriction.
|
|
|
1095
|
|
|
1096 procedure Check_Consistent_Restriction_No_Default_Initialization is
|
|
|
1097 begin
|
|
|
1098 -- Nothing to do if no one set this restriction
|
|
|
1099
|
|
|
1100 if not Cumulative_Restrictions.Set (No_Default_Initialization) then
|
|
|
1101 return;
|
|
|
1102 end if;
|
|
|
1103
|
|
|
1104 -- Nothing to do if no one violates the restriction
|
|
|
1105
|
|
|
1106 if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
|
|
|
1107 return;
|
|
|
1108 end if;
|
|
|
1109
|
|
|
1110 -- Otherwise we go into a full scan to find possible problems
|
|
|
1111
|
|
|
1112 for U in Units.First .. Units.Last loop
|
|
|
1113 declare
|
|
|
1114 UTE : Unit_Record renames Units.Table (U);
|
|
|
1115 ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);
|
|
|
1116
|
|
|
1117 begin
|
|
|
1118 if ATE.Restrictions.Violated (No_Default_Initialization) then
|
|
|
1119 for W in UTE.First_With .. UTE.Last_With loop
|
|
|
1120 declare
|
|
|
1121 AFN : constant File_Name_Type := Withs.Table (W).Afile;
|
|
|
1122
|
|
|
1123 begin
|
|
|
1124 -- The file name may not be present for withs of certain
|
|
|
1125 -- generic run-time files. The test can be safely left
|
|
|
1126 -- out in such cases anyway.
|
|
|
1127
|
|
|
1128 if AFN /= No_File then
|
|
|
1129 declare
|
|
|
1130 WAI : constant ALI_Id :=
|
|
|
1131 ALI_Id (Get_Name_Table_Int (AFN));
|
|
|
1132 WTE : ALIs_Record renames ALIs.Table (WAI);
|
|
|
1133
|
|
|
1134 begin
|
|
|
1135 if WTE.Restrictions.Set
|
|
|
1136 (No_Default_Initialization)
|
|
|
1137 then
|
|
|
1138 Error_Msg_Unit_1 := UTE.Uname;
|
|
|
1139 Consistency_Error_Msg
|
|
|
1140 ("unit $ compiled without restriction "
|
|
|
1141 & "No_Default_Initialization");
|
|
|
1142 Error_Msg_Unit_1 := Withs.Table (W).Uname;
|
|
|
1143 Consistency_Error_Msg
|
|
|
1144 ("withs unit $, compiled with restriction "
|
|
|
1145 & "No_Default_Initialization");
|
|
|
1146 end if;
|
|
|
1147 end;
|
|
|
1148 end if;
|
|
|
1149 end;
|
|
|
1150 end loop;
|
|
|
1151 end if;
|
|
|
1152 end;
|
|
|
1153 end loop;
|
|
|
1154 end Check_Consistent_Restriction_No_Default_Initialization;
|
|
|
1155
|
|
|
1156 ----------------------------------
|
|
|
1157 -- Check_Consistent_SSO_Default --
|
|
|
1158 ----------------------------------
|
|
|
1159
|
|
|
1160 -- This routine checks for a consistent SSO default setting. Note that
|
|
|
1161 -- internal units are excluded from this check, since we don't in any
|
|
|
1162 -- case allow the pragma to affect types in internal units, and there
|
|
|
1163 -- is thus no requirement to recompile the run-time with the default set.
|
|
|
1164
|
|
|
1165 procedure Check_Consistent_SSO_Default is
|
|
|
1166 Default : Character;
|
|
|
1167
|
|
|
1168 begin
|
|
|
1169 Default := ALIs.Table (ALIs.First).SSO_Default;
|
|
|
1170
|
|
|
1171 -- The default must be set from a non-internal unit
|
|
|
1172
|
|
|
1173 pragma Assert
|
|
|
1174 (not Is_Internal_File_Name (ALIs.Table (ALIs.First).Sfile));
|
|
|
1175
|
|
|
1176 -- Check all entries match the default above from the first entry
|
|
|
1177
|
|
|
1178 for A1 in ALIs.First + 1 .. ALIs.Last loop
|
|
|
1179 if not Is_Internal_File_Name (ALIs.Table (A1).Sfile)
|
|
|
1180 and then ALIs.Table (A1).SSO_Default /= Default
|
|
|
1181 then
|
|
|
1182 Default := '?';
|
|
|
1183 exit;
|
|
|
1184 end if;
|
|
|
1185 end loop;
|
|
|
1186
|
|
|
1187 -- All match, return
|
|
|
1188
|
|
|
1189 if Default /= '?' then
|
|
|
1190 return;
|
|
|
1191 end if;
|
|
|
1192
|
|
|
1193 -- Here we have a mismatch
|
|
|
1194
|
|
|
1195 Consistency_Error_Msg
|
|
|
1196 ("files not compiled with same Default_Scalar_Storage_Order");
|
|
|
1197
|
|
|
1198 Write_Eol;
|
|
|
1199 Write_Str ("files compiled with High_Order_First");
|
|
|
1200 Write_Eol;
|
|
|
1201
|
|
|
1202 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
1203 if ALIs.Table (A1).SSO_Default = 'H' then
|
|
|
1204 Write_Str (" ");
|
|
|
1205 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
1206 Write_Eol;
|
|
|
1207 end if;
|
|
|
1208 end loop;
|
|
|
1209
|
|
|
1210 Write_Eol;
|
|
|
1211 Write_Str ("files compiled with Low_Order_First");
|
|
|
1212 Write_Eol;
|
|
|
1213
|
|
|
1214 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
1215 if ALIs.Table (A1).SSO_Default = 'L' then
|
|
|
1216 Write_Str (" ");
|
|
|
1217 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
1218 Write_Eol;
|
|
|
1219 end if;
|
|
|
1220 end loop;
|
|
|
1221
|
|
|
1222 Write_Eol;
|
|
|
1223 Write_Str ("files compiled with no Default_Scalar_Storage_Order");
|
|
|
1224 Write_Eol;
|
|
|
1225
|
|
|
1226 for A1 in ALIs.First .. ALIs.Last loop
|
|
|
1227 if not Is_Internal_File_Name (ALIs.Table (A1).Sfile)
|
|
|
1228 and then ALIs.Table (A1).SSO_Default = ' '
|
|
|
1229 then
|
|
|
1230 Write_Str (" ");
|
|
|
1231 Write_Name (ALIs.Table (A1).Sfile);
|
|
|
1232 Write_Eol;
|
|
|
1233 end if;
|
|
|
1234 end loop;
|
|
|
1235 end Check_Consistent_SSO_Default;
|
|
|
1236
|
|
|
1237 -----------------------------------------
|
|
|
1238 -- Check_Consistent_Exception_Handling --
|
|
|
1239 -----------------------------------------
|
|
|
1240
|
|
|
1241 -- All units must have the same exception handling mechanism.
|
|
|
1242
|
|
|
1243 procedure Check_Consistent_Exception_Handling is
|
|
|
1244 begin
|
|
|
1245 Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
|
|
|
1246 if (ALIs.Table (A1).Zero_Cost_Exceptions /=
|
|
|
1247 ALIs.Table (ALIs.First).Zero_Cost_Exceptions)
|
|
|
1248 or else
|
|
|
1249 (ALIs.Table (A1).Frontend_Exceptions /=
|
|
|
1250 ALIs.Table (ALIs.First).Frontend_Exceptions)
|
|
|
1251 then
|
|
|
1252 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
|
|
|
1253 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
|
|
|
1254
|
|
|
1255 Consistency_Error_Msg
|
|
|
1256 ("{ and { compiled with different exception handling "
|
|
|
1257 & "mechanisms");
|
|
|
1258 end if;
|
|
|
1259 end loop Check_Mechanism;
|
|
|
1260 end Check_Consistent_Exception_Handling;
|
|
|
1261
|
|
|
1262 -------------------------------
|
|
|
1263 -- Check_Duplicated_Subunits --
|
|
|
1264 -------------------------------
|
|
|
1265
|
|
|
1266 procedure Check_Duplicated_Subunits is
|
|
|
1267 begin
|
|
|
1268 for J in Sdep.First .. Sdep.Last loop
|
|
|
1269 if Sdep.Table (J).Subunit_Name /= No_Name then
|
|
|
1270 Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
|
|
|
1271 Name_Len := Name_Len + 2;
|
|
|
1272 Name_Buffer (Name_Len - 1) := '%';
|
|
|
1273
|
|
|
1274 -- See if there is a body or spec with the same name
|
|
|
1275
|
|
|
1276 for K in Boolean loop
|
|
|
1277 if K then
|
|
|
1278 Name_Buffer (Name_Len) := 'b';
|
|
|
1279 else
|
|
|
1280 Name_Buffer (Name_Len) := 's';
|
|
|
1281 end if;
|
|
|
1282
|
|
|
1283 declare
|
|
|
1284 Unit : constant Unit_Name_Type := Name_Find;
|
|
|
1285 Info : constant Int := Get_Name_Table_Int (Unit);
|
|
|
1286
|
|
|
1287 begin
|
|
|
1288 if Info /= 0 then
|
|
|
1289 Set_Standard_Error;
|
|
|
1290 Write_Str ("error: subunit """);
|
|
|
1291 Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
|
|
|
1292 Write_Str (""" in file """);
|
|
|
1293 Write_Name_Decoded (Sdep.Table (J).Sfile);
|
|
|
1294 Write_Char ('"');
|
|
|
1295 Write_Eol;
|
|
|
1296 Write_Str (" has same name as unit """);
|
|
|
1297 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
|
|
|
1298 Write_Str (""" found in file """);
|
|
|
1299 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
|
|
|
1300 Write_Char ('"');
|
|
|
1301 Write_Eol;
|
|
|
1302 Write_Str (" this is not allowed within a single "
|
|
|
1303 & "partition (RM 10.2(19))");
|
|
|
1304 Write_Eol;
|
|
|
1305 Osint.Exit_Program (Osint.E_Fatal);
|
|
|
1306 end if;
|
|
|
1307 end;
|
|
|
1308 end loop;
|
|
|
1309 end if;
|
|
|
1310 end loop;
|
|
|
1311 end Check_Duplicated_Subunits;
|
|
|
1312
|
|
|
1313 --------------------
|
|
|
1314 -- Check_Versions --
|
|
|
1315 --------------------
|
|
|
1316
|
|
|
1317 procedure Check_Versions is
|
|
|
1318 VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
|
|
|
1319
|
|
|
1320 begin
|
|
|
1321 for A in ALIs.First .. ALIs.Last loop
|
|
|
1322 if ALIs.Table (A).Ver_Len /= VL
|
|
|
1323 or else ALIs.Table (A).Ver (1 .. VL) /=
|
|
|
1324 ALIs.Table (ALIs.First).Ver (1 .. VL)
|
|
|
1325 then
|
|
|
1326 Error_Msg_File_1 := ALIs.Table (A).Sfile;
|
|
|
1327 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
|
|
|
1328
|
|
|
1329 Consistency_Error_Msg
|
|
|
1330 ("{ and { compiled with different GNAT versions");
|
|
|
1331 end if;
|
|
|
1332 end loop;
|
|
|
1333 end Check_Versions;
|
|
|
1334
|
|
|
1335 ---------------------------
|
|
|
1336 -- Consistency_Error_Msg --
|
|
|
1337 ---------------------------
|
|
|
1338
|
|
|
1339 procedure Consistency_Error_Msg (Msg : String) is
|
|
|
1340 begin
|
|
|
1341 if Tolerate_Consistency_Errors then
|
|
|
1342
|
|
|
1343 -- If consistency errors are tolerated,
|
|
|
1344 -- output the message as a warning.
|
|
|
1345
|
|
|
1346 Error_Msg ('?' & Msg);
|
|
|
1347
|
|
|
1348 -- Otherwise the consistency error is a true error
|
|
|
1349
|
|
|
1350 else
|
|
|
1351 Error_Msg (Msg);
|
|
|
1352 end if;
|
|
|
1353 end Consistency_Error_Msg;
|
|
|
1354
|
|
|
1355 ---------------
|
|
|
1356 -- Same_Unit --
|
|
|
1357 ---------------
|
|
|
1358
|
|
|
1359 function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean is
|
|
|
1360 begin
|
|
|
1361 -- Note, the string U1 has a terminating %s or %b, U2 does not
|
|
|
1362
|
|
|
1363 if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
|
|
|
1364 Get_Name_String (U1);
|
|
|
1365
|
|
|
1366 declare
|
|
|
1367 U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
|
|
|
1368 begin
|
|
|
1369 Get_Name_String (U2);
|
|
|
1370 return U1_Str = Name_Buffer (1 .. Name_Len);
|
|
|
1371 end;
|
|
|
1372
|
|
|
1373 else
|
|
|
1374 return False;
|
|
|
1375 end if;
|
|
|
1376 end Same_Unit;
|
|
|
1377
|
|
|
1378 end Bcheck;
|
