1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
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
;
35 with Output
; use Output
;
36 with Rident
; use Rident
;
37 with Types
; use Types
;
39 package body Bcheck
is
41 -----------------------
42 -- Local Subprograms --
43 -----------------------
45 -- The following checking subprograms make up the parts of the
46 -- configuration consistency check. See bodies for details of checks.
48 procedure Check_Consistent_Dispatching_Policy
;
49 procedure Check_Consistent_Dynamic_Elaboration_Checking
;
50 procedure Check_Consistent_Floating_Point_Format
;
51 procedure Check_Consistent_Interrupt_States
;
52 procedure Check_Consistent_Locking_Policy
;
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_Zero_Cost_Exception_Handling
;
61 procedure Consistency_Error_Msg
(Msg
: String);
62 -- Produce an error or a warning message, depending on whether an
63 -- inconsistent configuration is permitted or not.
65 function Same_Unit
(U1
: Unit_Name_Type
; U2
: Name_Id
) return Boolean;
66 -- Used to compare two unit names for No_Dependence checks. U1 is in
67 -- standard unit name format, and U2 is in literal form with periods.
69 -------------------------------------
70 -- Check_Configuration_Consistency --
71 -------------------------------------
73 procedure Check_Configuration_Consistency
is
75 if Float_Format_Specified
/= ' ' then
76 Check_Consistent_Floating_Point_Format
;
79 if Queuing_Policy_Specified
/= ' ' then
80 Check_Consistent_Queuing_Policy
;
83 if Locking_Policy_Specified
/= ' ' then
84 Check_Consistent_Locking_Policy
;
87 if Partition_Elaboration_Policy_Specified
/= ' ' then
88 Check_Consistent_Partition_Elaboration_Policy
;
91 if Zero_Cost_Exceptions_Specified
then
92 Check_Consistent_Zero_Cost_Exception_Handling
;
95 Check_Consistent_Normalize_Scalars
;
96 Check_Consistent_Optimize_Alignment
;
97 Check_Consistent_Dynamic_Elaboration_Checking
;
98 Check_Consistent_Restrictions
;
99 Check_Consistent_Restriction_No_Default_Initialization
;
100 Check_Consistent_Interrupt_States
;
101 Check_Consistent_Dispatching_Policy
;
102 end Check_Configuration_Consistency
;
104 -----------------------
105 -- Check_Consistency --
106 -----------------------
108 procedure Check_Consistency
is
110 -- Source file Id for this Sdep entry
112 ALI_Path_Id
: File_Name_Type
;
115 -- First, we go through the source table to see if there are any cases
116 -- in which we should go after source files and compute checksums of
117 -- the source files. We need to do this for any file for which we have
118 -- mismatching time stamps and (so far) matching checksums.
120 for S
in Source
.First
.. Source
.Last
loop
122 -- If all time stamps for a file match, then there is nothing to
123 -- do, since we will not be checking checksums in that case anyway
125 if Source
.Table
(S
).All_Timestamps_Match
then
128 -- If we did not find the source file, then we can't compute its
129 -- checksum anyway. Note that when we have a time stamp mismatch,
130 -- we try to find the source file unconditionally (i.e. if
131 -- Check_Source_Files is False).
133 elsif not Source
.Table
(S
).Source_Found
then
136 -- If we already have non-matching or missing checksums, then no
137 -- need to try going after source file, since we won't trust the
138 -- checksums in any case.
140 elsif not Source
.Table
(S
).All_Checksums_Match
then
143 -- Now we have the case where we have time stamp mismatches, and
144 -- the source file is around, but so far all checksums match. This
145 -- is the case where we need to compute the checksum from the source
146 -- file, since otherwise we would ignore the time stamp mismatches,
147 -- and that is wrong if the checksum of the source does not agree
148 -- with the checksums in the ALI files.
150 elsif Check_Source_Files
then
151 if not Checksums_Match
152 (Source
.Table
(S
).Checksum
,
153 Get_File_Checksum
(Source
.Table
(S
).Sfile
))
155 Source
.Table
(S
).All_Checksums_Match
:= False;
160 -- Loop through ALI files
162 ALIs_Loop
: for A
in ALIs
.First
.. ALIs
.Last
loop
164 -- Loop through Sdep entries in one ALI file
167 ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
169 if Sdep
.Table
(D
).Dummy_Entry
then
173 Src
:= Source_Id
(Get_Name_Table_Info
(Sdep
.Table
(D
).Sfile
));
175 -- If the time stamps match, or all checksums match, then we
176 -- are OK, otherwise we have a definite error.
178 if Sdep
.Table
(D
).Stamp
/= Source
.Table
(Src
).Stamp
179 and then not Source
.Table
(Src
).All_Checksums_Match
181 Error_Msg_File_1
:= ALIs
.Table
(A
).Sfile
;
182 Error_Msg_File_2
:= Sdep
.Table
(D
).Sfile
;
184 -- Two styles of message, depending on whether or not
185 -- the updated file is the one that must be recompiled
187 if Error_Msg_File_1
= Error_Msg_File_2
then
188 if Tolerate_Consistency_Errors
then
190 ("?{ has been modified and should be recompiled");
193 ("{ has been modified and must be recompiled");
198 Osint
.Full_Lib_File_Name
(ALIs
.Table
(A
).Afile
);
200 if Osint
.Is_Readonly_Library
(ALI_Path_Id
) then
201 if Tolerate_Consistency_Errors
then
202 Error_Msg
("?{ should be recompiled");
203 Error_Msg_File_1
:= ALI_Path_Id
;
204 Error_Msg
("?({ is obsolete and read-only)");
206 Error_Msg
("{ must be compiled");
207 Error_Msg_File_1
:= ALI_Path_Id
;
208 Error_Msg
("({ is obsolete and read-only)");
211 elsif Tolerate_Consistency_Errors
then
213 ("?{ should be recompiled ({ has been modified)");
216 Error_Msg
("{ must be recompiled ({ has been modified)");
220 if (not Tolerate_Consistency_Errors
) and Verbose_Mode
then
221 Error_Msg_File_1
:= Source
.Table
(Src
).Stamp_File
;
223 if Source
.Table
(Src
).Source_Found
then
225 Osint
.Full_Source_Name
(Error_Msg_File_1
);
228 Osint
.Full_Lib_File_Name
(Error_Msg_File_1
);
232 ("time stamp from { " & String (Source
.Table
(Src
).Stamp
));
234 Error_Msg_File_1
:= Sdep
.Table
(D
).Sfile
;
236 (" conflicts with { timestamp " &
237 String (Sdep
.Table
(D
).Stamp
));
240 Osint
.Full_Lib_File_Name
(ALIs
.Table
(A
).Afile
);
241 Error_Msg
(" from {");
244 -- Exit from the loop through Sdep entries once we find one
245 -- that does not match.
254 end Check_Consistency
;
256 -----------------------------------------
257 -- Check_Consistent_Dispatching_Policy --
258 -----------------------------------------
260 -- The rule is that all files for which the dispatching policy is
261 -- significant must meet the following rules:
263 -- 1. All files for which a task dispatching policy is significant must
264 -- be compiled with the same setting.
266 -- 2. If a partition contains one or more Priority_Specific_Dispatching
267 -- pragmas it cannot contain a Task_Dispatching_Policy pragma.
269 -- 3. No overlap is allowed in the priority ranges specified in
270 -- Priority_Specific_Dispatching pragmas within the same partition.
272 -- 4. If a partition contains one or more Priority_Specific_Dispatching
273 -- pragmas then the Ceiling_Locking policy is the only one allowed for
276 procedure Check_Consistent_Dispatching_Policy
is
278 -- Maximum priority value for which a Priority_Specific_Dispatching
279 -- pragma has been specified.
281 TDP_Pragma_Afile
: ALI_Id
:= No_ALI_Id
;
282 -- ALI file where a Task_Dispatching_Policy pragma appears
285 -- Consistency checks in units specifying a Task_Dispatching_Policy
287 if Task_Dispatching_Policy_Specified
/= ' ' then
288 Find_Policy
: for A1
in ALIs
.First
.. ALIs
.Last
loop
289 if ALIs
.Table
(A1
).Task_Dispatching_Policy
/= ' ' then
291 -- Store the place where the first task dispatching pragma
292 -- appears. We may need this value for issuing consistency
293 -- errors if Priority_Specific_Dispatching pragmas are used.
295 TDP_Pragma_Afile
:= A1
;
297 Check_Policy
: declare
298 Policy
: constant Character :=
299 ALIs
.Table
(A1
).Task_Dispatching_Policy
;
302 for A2
in A1
+ 1 .. ALIs
.Last
loop
303 if ALIs
.Table
(A2
).Task_Dispatching_Policy
/= ' '
305 ALIs
.Table
(A2
).Task_Dispatching_Policy
/= Policy
307 Error_Msg_File_1
:= ALIs
.Table
(A1
).Sfile
;
308 Error_Msg_File_2
:= ALIs
.Table
(A2
).Sfile
;
310 Consistency_Error_Msg
311 ("{ and { compiled with different task" &
312 " dispatching policies");
320 end loop Find_Policy
;
323 -- If no Priority_Specific_Dispatching entries, nothing else to do
325 if Specific_Dispatching
.Last
>= Specific_Dispatching
.First
then
327 -- Find out the maximum priority value for which one of the
328 -- Priority_Specific_Dispatching pragmas applies.
331 for J
in Specific_Dispatching
.First
.. Specific_Dispatching
.Last
loop
332 if Specific_Dispatching
.Table
(J
).Last_Priority
> Max_Prio
then
333 Max_Prio
:= Specific_Dispatching
.Table
(J
).Last_Priority
;
337 -- Now establish tables to be used for consistency checking
340 -- The following record type is used to record locations of the
341 -- Priority_Specific_Dispatching pragmas applying to the Priority.
343 type Specific_Dispatching_Entry
is record
344 Dispatching_Policy
: Character := ' ';
345 -- First character (upper case) of corresponding policy name
347 Afile
: ALI_Id
:= No_ALI_Id
;
348 -- ALI file that generated Priority Specific Dispatching
349 -- entry for consistency message.
352 -- Line numbers from Priority_Specific_Dispatching pragma
355 PSD_Table
: array (0 .. Max_Prio
) of Specific_Dispatching_Entry
:=
356 (others => Specific_Dispatching_Entry
'
357 (Dispatching_Policy => ' ',
360 -- Array containing an entry per priority containing the location
361 -- where there is a Priority_Specific_Dispatching pragma that
362 -- applies to the priority.
365 for F in ALIs.First .. ALIs.Last loop
366 for K in ALIs.Table (F).First_Specific_Dispatching ..
367 ALIs.Table (F).Last_Specific_Dispatching
370 DTK : Specific_Dispatching_Record
371 renames Specific_Dispatching.Table (K);
373 -- Check whether pragma Task_Dispatching_Policy and
374 -- pragma Priority_Specific_Dispatching are used in the
377 if Task_Dispatching_Policy_Specified /= ' ' then
378 Error_Msg_File_1 := ALIs.Table (F).Sfile;
380 ALIs.Table (TDP_Pragma_Afile).Sfile;
382 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
384 Consistency_Error_Msg
385 ("Priority_Specific_Dispatching at {:#" &
386 " incompatible with Task_Dispatching_Policy at {");
389 -- Ceiling_Locking must also be specified for a partition
390 -- with at least one Priority_Specific_Dispatching
393 if Locking_Policy_Specified /= ' '
394 and then Locking_Policy_Specified /= 'C
'
396 for A in ALIs.First .. ALIs.Last loop
397 if ALIs.Table (A).Locking_Policy /= ' '
398 and then ALIs.Table (A).Locking_Policy /= 'C
'
400 Error_Msg_File_1 := ALIs.Table (F).Sfile;
401 Error_Msg_File_2 := ALIs.Table (A).Sfile;
403 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
405 Consistency_Error_Msg
406 ("Priority_Specific_Dispatching at {:#" &
407 " incompatible with Locking_Policy at {");
412 -- Check overlapping priority ranges
414 Find_Overlapping : for Prio in
415 DTK.First_Priority .. DTK.Last_Priority
417 if PSD_Table (Prio).Afile = No_ALI_Id then
419 (Dispatching_Policy => DTK.Dispatching_Policy,
420 Afile => F, Loc => DTK.PSD_Pragma_Line);
422 elsif PSD_Table (Prio).Dispatching_Policy /=
423 DTK.Dispatching_Policy
427 ALIs.Table (PSD_Table (Prio).Afile).Sfile;
428 Error_Msg_File_2 := ALIs.Table (F).Sfile;
429 Error_Msg_Nat_1 := PSD_Table (Prio).Loc;
430 Error_Msg_Nat_2 := DTK.PSD_Pragma_Line;
432 Consistency_Error_Msg
433 ("overlapping priority ranges at {:# and {:#");
435 exit Find_Overlapping;
437 end loop Find_Overlapping;
443 end Check_Consistent_Dispatching_Policy;
445 ---------------------------------------------------
446 -- Check_Consistent_Dynamic_Elaboration_Checking --
447 ---------------------------------------------------
449 -- The rule here is that if a unit has dynamic elaboration checks,
450 -- then any unit it withs must meeting one of the following criteria:
452 -- 1. There is a pragma Elaborate_All for the with'ed unit
453 -- 2. The with'ed unit was compiled with dynamic elaboration checks
454 -- 3. The with'ed unit has pragma Preelaborate or Pure
455 -- 4. It is an internal GNAT unit (including children of GNAT)
457 procedure Check_Consistent_Dynamic_Elaboration_Checking is
459 if Dynamic_Elaboration_Checks_Specified then
460 for U in First_Unit_Entry .. Units.Last loop
462 UR : Unit_Record renames Units.Table (U);
465 if UR.Dynamic_Elab then
466 for W in UR.First_With .. UR.Last_With loop
468 WR : With_Record renames Withs.Table (W);
471 if Get_Name_Table_Info (WR.Uname) /= 0 then
473 WU : Unit_Record renames
476 (Get_Name_Table_Info (WR.Uname)));
479 -- Case 1. Elaborate_All for with'ed unit
481 if WR.Elaborate_All then
484 -- Case 2. With'ed unit has dynamic elab checks
486 elsif WU.Dynamic_Elab then
489 -- Case 3. With'ed unit is Preelaborate or Pure
491 elsif WU.Preelab or else WU.Pure then
494 -- Case 4. With'ed unit is internal file
496 elsif Is_Internal_File_Name (WU.Sfile) then
499 -- Issue warning, not one of the safe cases
502 Error_Msg_File_1 := UR.Sfile;
504 ("?{ has dynamic elaboration checks " &
507 Error_Msg_File_1 := WU.Sfile;
509 ("? { which has static elaboration " &
512 Warnings_Detected := Warnings_Detected - 1;
522 end Check_Consistent_Dynamic_Elaboration_Checking;
524 --------------------------------------------
525 -- Check_Consistent_Floating_Point_Format --
526 --------------------------------------------
528 -- The rule is that all files must be compiled with the same setting
529 -- for the floating-point format.
531 procedure Check_Consistent_Floating_Point_Format is
533 -- First search for a unit specifying a floating-point format and then
534 -- check all remaining units against it.
536 Find_Format : for A1 in ALIs.First .. ALIs.Last loop
537 if ALIs.Table (A1).Float_Format /= ' ' then
538 Check_Format : declare
539 Format : constant Character := ALIs.Table (A1).Float_Format;
541 for A2 in A1 + 1 .. ALIs.Last loop
542 if ALIs.Table (A2).Float_Format /= Format then
543 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
544 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
546 Consistency_Error_Msg
547 ("{ and { compiled with different " &
548 "floating-point representations");
556 end loop Find_Format;
557 end Check_Consistent_Floating_Point_Format;
559 ---------------------------------------
560 -- Check_Consistent_Interrupt_States --
561 ---------------------------------------
563 -- The rule is that if the state of a given interrupt is specified
564 -- in more than one unit, it must be specified with a consistent state.
566 procedure Check_Consistent_Interrupt_States is
570 -- If no Interrupt_State entries, nothing to do
572 if Interrupt_States.Last < Interrupt_States.First then
576 -- First find out the maximum interrupt value
579 for J in Interrupt_States.First .. Interrupt_States.Last loop
580 if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
581 Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
585 -- Now establish tables to be used for consistency checking
588 Istate : array (0 .. Max_Intrup) of Character := (others => 'n
');
589 -- Interrupt state entries, 'u
'/'s
'/'r
' or 'n
' to indicate an
590 -- entry that has not been set.
592 Afile : array (0 .. Max_Intrup) of ALI_Id;
593 -- ALI file that generated Istate entry for consistency message
595 Loc : array (0 .. Max_Intrup) of Nat;
596 -- Line numbers from IS pragma generating Istate entry
599 -- Interrupt number from entry being tested
602 -- Interrupt state from entry being tested
605 -- Line number from entry being tested
608 for F in ALIs.First .. ALIs.Last loop
609 for K in ALIs.Table (F).First_Interrupt_State ..
610 ALIs.Table (F).Last_Interrupt_State
612 Inum := Interrupt_States.Table (K).Interrupt_Id;
613 Stat := Interrupt_States.Table (K).Interrupt_State;
614 Lnum := Interrupt_States.Table (K).IS_Pragma_Line;
616 if Istate (Inum) = 'n
' then
617 Istate (Inum) := Stat;
621 elsif Istate (Inum) /= Stat then
622 Error_Msg_File_1 := ALIs.Table (Afile (Inum)).Sfile;
623 Error_Msg_File_2 := ALIs.Table (F).Sfile;
624 Error_Msg_Nat_1 := Loc (Inum);
625 Error_Msg_Nat_2 := Lnum;
627 Consistency_Error_Msg
628 ("inconsistent interrupt states at {:# and {:#");
633 end Check_Consistent_Interrupt_States;
635 -------------------------------------
636 -- Check_Consistent_Locking_Policy --
637 -------------------------------------
639 -- The rule is that all files for which the locking policy is
640 -- significant must be compiled with the same setting.
642 procedure Check_Consistent_Locking_Policy is
644 -- First search for a unit specifying a policy and then
645 -- check all remaining units against it.
647 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
648 if ALIs.Table (A1).Locking_Policy /= ' ' then
649 Check_Policy : declare
650 Policy : constant Character := ALIs.Table (A1).Locking_Policy;
653 for A2 in A1 + 1 .. ALIs.Last loop
654 if ALIs.Table (A2).Locking_Policy /= ' '
656 ALIs.Table (A2).Locking_Policy /= Policy
658 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
659 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
661 Consistency_Error_Msg
662 ("{ and { compiled with different locking policies");
670 end loop Find_Policy;
671 end Check_Consistent_Locking_Policy;
673 ----------------------------------------
674 -- Check_Consistent_Normalize_Scalars --
675 ----------------------------------------
677 -- The rule is that if any unit is compiled with Normalized_Scalars,
678 -- then all other units in the partition must also be compiled with
679 -- Normalized_Scalars in effect.
681 -- There is some issue as to whether this consistency check is desirable,
682 -- it is certainly required at the moment by the RM. We should keep a watch
683 -- on the ARG and HRG deliberations here. GNAT no longer depends on this
684 -- consistency (it used to do so, but that is no longer the case, since
685 -- pragma Initialize_Scalars pragma does not require consistency.)
687 procedure Check_Consistent_Normalize_Scalars is
689 if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
690 Consistency_Error_Msg
691 ("some but not all files compiled with Normalize_Scalars");
694 Write_Str ("files compiled with Normalize_Scalars");
697 for A1 in ALIs.First .. ALIs.Last loop
698 if ALIs.Table (A1).Normalize_Scalars then
700 Write_Name (ALIs.Table (A1).Sfile);
706 Write_Str ("files compiled without Normalize_Scalars");
709 for A1 in ALIs.First .. ALIs.Last loop
710 if not ALIs.Table (A1).Normalize_Scalars then
712 Write_Name (ALIs.Table (A1).Sfile);
717 end Check_Consistent_Normalize_Scalars;
719 -----------------------------------------
720 -- Check_Consistent_Optimize_Alignment --
721 -----------------------------------------
723 -- The rule is that all units which depend on the global default setting
724 -- of Optimize_Alignment must be compiled with the same setting for this
725 -- default. Units which specify an explicit local value for this setting
726 -- are exempt from the consistency rule (this includes all internal units).
728 procedure Check_Consistent_Optimize_Alignment is
729 OA_Setting : Character := ' ';
730 -- Reset when we find a unit that depends on the default and does
731 -- not have a local specification of the Optimize_Alignment setting.
734 -- Id of unit from which OA_Setting was set
739 for U in First_Unit_Entry .. Units.Last loop
740 C := Units.Table (U).Optimize_Alignment;
743 if OA_Setting = ' ' then
747 elsif OA_Setting = C then
751 Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
752 Error_Msg_Unit_2 := Units.Table (U).Uname;
754 Consistency_Error_Msg
755 ("$ and $ compiled with different "
756 & "default Optimize_Alignment settings");
761 end Check_Consistent_Optimize_Alignment;
763 ---------------------------------------------------
764 -- Check_Consistent_Partition_Elaboration_Policy --
765 ---------------------------------------------------
767 -- The rule is that all files for which the partition elaboration policy is
768 -- significant must be compiled with the same setting.
770 procedure Check_Consistent_Partition_Elaboration_Policy is
772 -- First search for a unit specifying a policy and then
773 -- check all remaining units against it.
775 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
776 if ALIs.Table (A1).Partition_Elaboration_Policy /= ' ' then
777 Check_Policy : declare
778 Policy : constant Character :=
779 ALIs.Table (A1).Partition_Elaboration_Policy;
782 for A2 in A1 + 1 .. ALIs.Last loop
783 if ALIs.Table (A2).Partition_Elaboration_Policy /= ' '
785 ALIs.Table (A2).Partition_Elaboration_Policy /= Policy
787 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
788 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
790 Consistency_Error_Msg
791 ("{ and { compiled with different partition "
792 & "elaboration policies");
798 -- A No_Task_Hierarchy restriction must be specified for the
799 -- Sequential policy (RM H.6(6/2)).
801 if Partition_Elaboration_Policy_Specified = 'S
'
802 and then not Cumulative_Restrictions.Set (No_Task_Hierarchy)
804 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
806 ("{ has sequential partition elaboration policy, but no");
808 ("pragma Restrictions (No_Task_Hierarchy) was specified");
813 end loop Find_Policy;
814 end Check_Consistent_Partition_Elaboration_Policy;
816 -------------------------------------
817 -- Check_Consistent_Queuing_Policy --
818 -------------------------------------
820 -- The rule is that all files for which the queuing policy is
821 -- significant must be compiled with the same setting.
823 procedure Check_Consistent_Queuing_Policy is
825 -- First search for a unit specifying a policy and then
826 -- check all remaining units against it.
828 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
829 if ALIs.Table (A1).Queuing_Policy /= ' ' then
830 Check_Policy : declare
831 Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
833 for A2 in A1 + 1 .. ALIs.Last loop
834 if ALIs.Table (A2).Queuing_Policy /= ' '
836 ALIs.Table (A2).Queuing_Policy /= Policy
838 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
839 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
841 Consistency_Error_Msg
842 ("{ and { compiled with different queuing policies");
850 end loop Find_Policy;
851 end Check_Consistent_Queuing_Policy;
853 -----------------------------------
854 -- Check_Consistent_Restrictions --
855 -----------------------------------
857 -- The rule is that if a restriction is specified in any unit, then all
858 -- units must obey the restriction. The check applies only to restrictions
859 -- which require partition wide consistency, and not to internal units.
861 procedure Check_Consistent_Restrictions is
862 Restriction_File_Output : Boolean;
863 -- Shows if we have output header messages for restriction violation
865 procedure Print_Restriction_File (R : All_Restrictions);
866 -- Print header line for R if not printed yet
868 ----------------------------
869 -- Print_Restriction_File --
870 ----------------------------
872 procedure Print_Restriction_File (R : All_Restrictions) is
874 if not Restriction_File_Output then
875 Restriction_File_Output := True;
877 -- Find an ali file specifying the restriction
879 for A in ALIs.First .. ALIs.Last loop
880 if ALIs.Table (A).Restrictions.Set (R)
881 and then (R in All_Boolean_Restrictions
882 or else ALIs.Table (A).Restrictions.Value (R) =
883 Cumulative_Restrictions.Value (R))
885 -- We have found that ALI file A specifies the restriction
886 -- that is being violated (the minimum value is specified
887 -- in the case of a parameter restriction).
890 M1 : constant String := "{ has restriction ";
891 S : constant String := Restriction_Id'Image (R);
892 M2 : String (1 .. 2000); -- big enough!
896 Name_Buffer (1 .. S'Length) := S;
897 Name_Len := S'Length;
898 Set_Casing (Mixed_Case);
902 M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
905 if R in All_Parameter_Restrictions then
906 M2 (P .. P + 4) := " => #";
908 Int (Cumulative_Restrictions.Value (R));
912 Error_Msg_File_1 := ALIs.Table (A).Sfile;
913 Consistency_Error_Msg (M2 (1 .. P - 1));
914 Consistency_Error_Msg
915 ("but the following files violate this restriction:");
921 end Print_Restriction_File;
923 -- Start of processing for Check_Consistent_Restrictions
926 -- A special test, if we have a main program, then if it has an
927 -- allocator in the body, this is considered to be a violation of
928 -- the restriction No_Allocators_After_Elaboration. We just mark
929 -- this restriction and then the normal circuit will flag it.
932 and then ALIs.Table (ALIs.First).Main_Program /= None
933 and then not No_Main_Subprogram
934 and then ALIs.Table (ALIs.First).Allocator_In_Body
936 Cumulative_Restrictions.Violated
937 (No_Standard_Allocators_After_Elaboration) := True;
938 ALIs.Table (ALIs.First).Restrictions.Violated
939 (No_Standard_Allocators_After_Elaboration) := True;
942 -- Loop through all restriction violations
944 for R in All_Restrictions loop
946 -- Check for violation of this restriction
948 if Cumulative_Restrictions.Set (R)
949 and then Cumulative_Restrictions.Violated (R)
950 and then (R in Partition_Boolean_Restrictions
951 or else (R in All_Parameter_Restrictions
953 Cumulative_Restrictions.Count (R) >
954 Cumulative_Restrictions.Value (R)))
956 Restriction_File_Output := False;
958 -- Loop through files looking for violators
960 for A2 in ALIs.First .. ALIs.Last loop
962 T : ALIs_Record renames ALIs.Table (A2);
965 if T.Restrictions.Violated (R) then
967 -- We exclude predefined files from the list of
968 -- violators. This should be rethought. It is not
969 -- clear that this is the right thing to do, that
970 -- is particularly the case for restricted runtimes.
972 if not Is_Internal_File_Name (T.Sfile) then
974 -- Case of Boolean restriction, just print file name
976 if R in All_Boolean_Restrictions then
977 Print_Restriction_File (R);
978 Error_Msg_File_1 := T.Sfile;
979 Consistency_Error_Msg (" {");
981 -- Case of Parameter restriction where violation
982 -- count exceeds restriction value, print file
983 -- name and count, adding "at least" if the
984 -- exact count is not known.
986 elsif R in Checked_Add_Parameter_Restrictions
987 or else T.Restrictions.Count (R) >
988 Cumulative_Restrictions.Value (R)
990 Print_Restriction_File (R);
991 Error_Msg_File_1 := T.Sfile;
992 Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));
994 if T.Restrictions.Unknown (R) then
995 Consistency_Error_Msg
996 (" { (count = at least #)");
998 Consistency_Error_Msg
1009 -- Now deal with No_Dependence indications. Note that we put the loop
1010 -- through entries in the no dependency table first, since this loop
1011 -- is most often empty (no such pragma Restrictions in use).
1013 for ND in No_Deps.First .. No_Deps.Last loop
1015 ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
1017 for J in ALIs.First .. ALIs.Last loop
1019 A : ALIs_Record renames ALIs.Table (J);
1022 for K in A.First_Unit .. A.Last_Unit loop
1024 U : Unit_Record renames Units.Table (K);
1026 for L in U.First_With .. U.Last_With loop
1028 (Withs.Table (L).Uname, ND_Unit)
1030 Error_Msg_File_1 := U.Sfile;
1031 Error_Msg_Name_1 := ND_Unit;
1032 Consistency_Error_Msg
1033 ("file { violates restriction " &
1034 "No_Dependence => %");
1043 end Check_Consistent_Restrictions;
1045 ------------------------------------------------------------
1046 -- Check_Consistent_Restriction_No_Default_Initialization --
1047 ------------------------------------------------------------
1049 -- The Restriction (No_Default_Initialization) has special consistency
1050 -- rules. The rule is that no unit compiled without this restriction
1051 -- that violates the restriction can WITH a unit that is compiled with
1054 procedure Check_Consistent_Restriction_No_Default_Initialization is
1056 -- Nothing to do if no one set this restriction
1058 if not Cumulative_Restrictions.Set (No_Default_Initialization) then
1062 -- Nothing to do if no one violates the restriction
1064 if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
1068 -- Otherwise we go into a full scan to find possible problems
1070 for U in Units.First .. Units.Last loop
1072 UTE : Unit_Record renames Units.Table (U);
1073 ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);
1076 if ATE.Restrictions.Violated (No_Default_Initialization) then
1077 for W in UTE.First_With .. UTE.Last_With loop
1079 AFN : constant File_Name_Type := Withs.Table (W).Afile;
1082 -- The file name may not be present for withs of certain
1083 -- generic run-time files. The test can be safely left
1084 -- out in such cases anyway.
1086 if AFN /= No_File then
1088 WAI : constant ALI_Id :=
1089 ALI_Id (Get_Name_Table_Info (AFN));
1090 WTE : ALIs_Record renames ALIs.Table (WAI);
1093 if WTE.Restrictions.Set
1094 (No_Default_Initialization)
1096 Error_Msg_Unit_1 := UTE.Uname;
1097 Consistency_Error_Msg
1098 ("unit $ compiled without restriction "
1099 & "No_Default_Initialization");
1100 Error_Msg_Unit_1 := Withs.Table (W).Uname;
1101 Consistency_Error_Msg
1102 ("withs unit $, compiled with restriction "
1103 & "No_Default_Initialization");
1112 end Check_Consistent_Restriction_No_Default_Initialization;
1114 ---------------------------------------------------
1115 -- Check_Consistent_Zero_Cost_Exception_Handling --
1116 ---------------------------------------------------
1118 -- Check consistent zero cost exception handling. The rule is that
1119 -- all units must have the same exception handling mechanism.
1121 procedure Check_Consistent_Zero_Cost_Exception_Handling is
1123 Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
1124 if ALIs.Table (A1).Zero_Cost_Exceptions /=
1125 ALIs.Table (ALIs.First).Zero_Cost_Exceptions
1127 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
1128 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
1130 Consistency_Error_Msg ("{ and { compiled with different "
1131 & "exception handling mechanisms");
1133 end loop Check_Mechanism;
1134 end Check_Consistent_Zero_Cost_Exception_Handling;
1136 -------------------------------
1137 -- Check_Duplicated_Subunits --
1138 -------------------------------
1140 procedure Check_Duplicated_Subunits is
1142 for J in Sdep.First .. Sdep.Last loop
1143 if Sdep.Table (J).Subunit_Name /= No_Name then
1144 Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
1145 Name_Len := Name_Len + 2;
1146 Name_Buffer (Name_Len - 1) := '%';
1148 -- See if there is a body or spec with the same name
1150 for K in Boolean loop
1152 Name_Buffer (Name_Len) := 'b
';
1154 Name_Buffer (Name_Len) := 's
';
1158 Unit : constant Unit_Name_Type := Name_Find;
1159 Info : constant Int := Get_Name_Table_Info (Unit);
1164 Write_Str ("error: subunit """);
1165 Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
1166 Write_Str (""" in file """);
1167 Write_Name_Decoded (Sdep.Table (J).Sfile);
1170 Write_Str (" has same name as unit
""");
1171 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1172 Write_Str (""" found
in file
""");
1173 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1176 Write_Str (" this is not allowed within a single "
1177 & "partition (RM 10.2(19))");
1179 Osint.Exit_Program (Osint.E_Fatal);
1185 end Check_Duplicated_Subunits;
1187 --------------------
1188 -- Check_Versions --
1189 --------------------
1191 procedure Check_Versions is
1192 VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
1195 for A in ALIs.First .. ALIs.Last loop
1196 if ALIs.Table (A).Ver_Len /= VL
1197 or else ALIs.Table (A).Ver (1 .. VL) /=
1198 ALIs.Table (ALIs.First).Ver (1 .. VL)
1200 Error_Msg_File_1 := ALIs.Table (A).Sfile;
1201 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
1203 Consistency_Error_Msg
1204 ("{ and { compiled with different GNAT versions");
1209 ---------------------------
1210 -- Consistency_Error_Msg --
1211 ---------------------------
1213 procedure Consistency_Error_Msg (Msg : String) is
1215 if Tolerate_Consistency_Errors then
1217 -- If consistency errors are tolerated,
1218 -- output the message as a warning.
1220 Error_Msg ('?
' & Msg);
1222 -- Otherwise the consistency error is a true error
1227 end Consistency_Error_Msg;
1233 function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean is
1235 -- Note, the string U1 has a terminating %s or %b, U2 does not
1237 if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
1238 Get_Name_String (U1);
1241 U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
1243 Get_Name_String (U2);
1244 return U1_Str = Name_Buffer (1 .. Name_Len);