1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2012, 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_Queuing_Policy
;
56 procedure Check_Consistent_Restrictions
;
57 procedure Check_Consistent_Restriction_No_Default_Initialization
;
58 procedure Check_Consistent_Zero_Cost_Exception_Handling
;
60 procedure Consistency_Error_Msg
(Msg
: String);
61 -- Produce an error or a warning message, depending on whether an
62 -- inconsistent configuration is permitted or not.
64 function Same_Unit
(U1
: Unit_Name_Type
; U2
: Name_Id
) return Boolean;
65 -- Used to compare two unit names for No_Dependence checks. U1 is in
66 -- standard unit name format, and U2 is in literal form with periods.
68 -------------------------------------
69 -- Check_Configuration_Consistency --
70 -------------------------------------
72 procedure Check_Configuration_Consistency
is
74 if Float_Format_Specified
/= ' ' then
75 Check_Consistent_Floating_Point_Format
;
78 if Queuing_Policy_Specified
/= ' ' then
79 Check_Consistent_Queuing_Policy
;
82 if Locking_Policy_Specified
/= ' ' then
83 Check_Consistent_Locking_Policy
;
86 if Zero_Cost_Exceptions_Specified
then
87 Check_Consistent_Zero_Cost_Exception_Handling
;
90 Check_Consistent_Normalize_Scalars
;
91 Check_Consistent_Optimize_Alignment
;
92 Check_Consistent_Dynamic_Elaboration_Checking
;
93 Check_Consistent_Restrictions
;
94 Check_Consistent_Restriction_No_Default_Initialization
;
95 Check_Consistent_Interrupt_States
;
96 Check_Consistent_Dispatching_Policy
;
97 end Check_Configuration_Consistency
;
99 -----------------------
100 -- Check_Consistency --
101 -----------------------
103 procedure Check_Consistency
is
105 -- Source file Id for this Sdep entry
107 ALI_Path_Id
: File_Name_Type
;
110 -- First, we go through the source table to see if there are any cases
111 -- in which we should go after source files and compute checksums of
112 -- the source files. We need to do this for any file for which we have
113 -- mismatching time stamps and (so far) matching checksums.
115 for S
in Source
.First
.. Source
.Last
loop
117 -- If all time stamps for a file match, then there is nothing to
118 -- do, since we will not be checking checksums in that case anyway
120 if Source
.Table
(S
).All_Timestamps_Match
then
123 -- If we did not find the source file, then we can't compute its
124 -- checksum anyway. Note that when we have a time stamp mismatch,
125 -- we try to find the source file unconditionally (i.e. if
126 -- Check_Source_Files is False).
128 elsif not Source
.Table
(S
).Source_Found
then
131 -- If we already have non-matching or missing checksums, then no
132 -- need to try going after source file, since we won't trust the
133 -- checksums in any case.
135 elsif not Source
.Table
(S
).All_Checksums_Match
then
138 -- Now we have the case where we have time stamp mismatches, and
139 -- the source file is around, but so far all checksums match. This
140 -- is the case where we need to compute the checksum from the source
141 -- file, since otherwise we would ignore the time stamp mismatches,
142 -- and that is wrong if the checksum of the source does not agree
143 -- with the checksums in the ALI files.
145 elsif Check_Source_Files
then
146 if not Checksums_Match
147 (Source
.Table
(S
).Checksum
,
148 Get_File_Checksum
(Source
.Table
(S
).Sfile
))
150 Source
.Table
(S
).All_Checksums_Match
:= False;
155 -- Loop through ALI files
157 ALIs_Loop
: for A
in ALIs
.First
.. ALIs
.Last
loop
159 -- Loop through Sdep entries in one ALI file
162 ALIs
.Table
(A
).First_Sdep
.. ALIs
.Table
(A
).Last_Sdep
164 if Sdep
.Table
(D
).Dummy_Entry
then
168 Src
:= Source_Id
(Get_Name_Table_Info
(Sdep
.Table
(D
).Sfile
));
170 -- If the time stamps match, or all checksums match, then we
171 -- are OK, otherwise we have a definite error.
173 if Sdep
.Table
(D
).Stamp
/= Source
.Table
(Src
).Stamp
174 and then not Source
.Table
(Src
).All_Checksums_Match
176 Error_Msg_File_1
:= ALIs
.Table
(A
).Sfile
;
177 Error_Msg_File_2
:= Sdep
.Table
(D
).Sfile
;
179 -- Two styles of message, depending on whether or not
180 -- the updated file is the one that must be recompiled
182 if Error_Msg_File_1
= Error_Msg_File_2
then
183 if Tolerate_Consistency_Errors
then
185 ("?{ has been modified and should be recompiled");
188 ("{ has been modified and must be recompiled");
193 Osint
.Full_Lib_File_Name
(ALIs
.Table
(A
).Afile
);
195 if Osint
.Is_Readonly_Library
(ALI_Path_Id
) then
196 if Tolerate_Consistency_Errors
then
197 Error_Msg
("?{ should be recompiled");
198 Error_Msg_File_1
:= ALI_Path_Id
;
199 Error_Msg
("?({ is obsolete and read-only)");
201 Error_Msg
("{ must be compiled");
202 Error_Msg_File_1
:= ALI_Path_Id
;
203 Error_Msg
("({ is obsolete and read-only)");
206 elsif Tolerate_Consistency_Errors
then
208 ("?{ should be recompiled ({ has been modified)");
211 Error_Msg
("{ must be recompiled ({ has been modified)");
215 if (not Tolerate_Consistency_Errors
) and Verbose_Mode
then
216 Error_Msg_File_1
:= Sdep
.Table
(D
).Sfile
;
218 ("{ time stamp " & String (Source
.Table
(Src
).Stamp
));
220 Error_Msg_File_1
:= Sdep
.Table
(D
).Sfile
;
221 -- Something wrong here, should be different file ???
224 (" conflicts with { timestamp " &
225 String (Sdep
.Table
(D
).Stamp
));
228 -- Exit from the loop through Sdep entries once we find one
229 -- that does not match.
238 end Check_Consistency
;
240 -----------------------------------------
241 -- Check_Consistent_Dispatching_Policy --
242 -----------------------------------------
244 -- The rule is that all files for which the dispatching policy is
245 -- significant must meet the following rules:
247 -- 1. All files for which a task dispatching policy is significant must
248 -- be compiled with the same setting.
250 -- 2. If a partition contains one or more Priority_Specific_Dispatching
251 -- pragmas it cannot contain a Task_Dispatching_Policy pragma.
253 -- 3. No overlap is allowed in the priority ranges specified in
254 -- Priority_Specific_Dispatching pragmas within the same partition.
256 -- 4. If a partition contains one or more Priority_Specific_Dispatching
257 -- pragmas then the Ceiling_Locking policy is the only one allowed for
260 procedure Check_Consistent_Dispatching_Policy
is
262 -- Maximum priority value for which a Priority_Specific_Dispatching
263 -- pragma has been specified.
265 TDP_Pragma_Afile
: ALI_Id
:= No_ALI_Id
;
266 -- ALI file where a Task_Dispatching_Policy pragma appears
269 -- Consistency checks in units specifying a Task_Dispatching_Policy
271 if Task_Dispatching_Policy_Specified
/= ' ' then
272 Find_Policy
: for A1
in ALIs
.First
.. ALIs
.Last
loop
273 if ALIs
.Table
(A1
).Task_Dispatching_Policy
/= ' ' then
275 -- Store the place where the first task dispatching pragma
276 -- appears. We may need this value for issuing consistency
277 -- errors if Priority_Specific_Dispatching pragmas are used.
279 TDP_Pragma_Afile
:= A1
;
281 Check_Policy
: declare
282 Policy
: constant Character :=
283 ALIs
.Table
(A1
).Task_Dispatching_Policy
;
286 for A2
in A1
+ 1 .. ALIs
.Last
loop
287 if ALIs
.Table
(A2
).Task_Dispatching_Policy
/= ' '
289 ALIs
.Table
(A2
).Task_Dispatching_Policy
/= Policy
291 Error_Msg_File_1
:= ALIs
.Table
(A1
).Sfile
;
292 Error_Msg_File_2
:= ALIs
.Table
(A2
).Sfile
;
294 Consistency_Error_Msg
295 ("{ and { compiled with different task" &
296 " dispatching policies");
304 end loop Find_Policy
;
307 -- If no Priority_Specific_Dispatching entries, nothing else to do
309 if Specific_Dispatching
.Last
>= Specific_Dispatching
.First
then
311 -- Find out the maximum priority value for which one of the
312 -- Priority_Specific_Dispatching pragmas applies.
315 for J
in Specific_Dispatching
.First
.. Specific_Dispatching
.Last
loop
316 if Specific_Dispatching
.Table
(J
).Last_Priority
> Max_Prio
then
317 Max_Prio
:= Specific_Dispatching
.Table
(J
).Last_Priority
;
321 -- Now establish tables to be used for consistency checking
324 -- The following record type is used to record locations of the
325 -- Priority_Specific_Dispatching pragmas applying to the Priority.
327 type Specific_Dispatching_Entry
is record
328 Dispatching_Policy
: Character := ' ';
329 -- First character (upper case) of corresponding policy name
331 Afile
: ALI_Id
:= No_ALI_Id
;
332 -- ALI file that generated Priority Specific Dispatching
333 -- entry for consistency message.
336 -- Line numbers from Priority_Specific_Dispatching pragma
339 PSD_Table
: array (0 .. Max_Prio
) of Specific_Dispatching_Entry
:=
340 (others => Specific_Dispatching_Entry
'
341 (Dispatching_Policy => ' ',
344 -- Array containing an entry per priority containing the location
345 -- where there is a Priority_Specific_Dispatching pragma that
346 -- applies to the priority.
349 for F in ALIs.First .. ALIs.Last loop
350 for K in ALIs.Table (F).First_Specific_Dispatching ..
351 ALIs.Table (F).Last_Specific_Dispatching
354 DTK : Specific_Dispatching_Record
355 renames Specific_Dispatching.Table (K);
357 -- Check whether pragma Task_Dispatching_Policy and
358 -- pragma Priority_Specific_Dispatching are used in the
361 if Task_Dispatching_Policy_Specified /= ' ' then
362 Error_Msg_File_1 := ALIs.Table (F).Sfile;
364 ALIs.Table (TDP_Pragma_Afile).Sfile;
366 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
368 Consistency_Error_Msg
369 ("Priority_Specific_Dispatching at {:#" &
370 " incompatible with Task_Dispatching_Policy at {");
373 -- Ceiling_Locking must also be specified for a partition
374 -- with at least one Priority_Specific_Dispatching
377 if Locking_Policy_Specified /= ' '
378 and then Locking_Policy_Specified /= 'C
'
380 for A in ALIs.First .. ALIs.Last loop
381 if ALIs.Table (A).Locking_Policy /= ' '
382 and then ALIs.Table (A).Locking_Policy /= 'C
'
384 Error_Msg_File_1 := ALIs.Table (F).Sfile;
385 Error_Msg_File_2 := ALIs.Table (A).Sfile;
387 Error_Msg_Nat_1 := DTK.PSD_Pragma_Line;
389 Consistency_Error_Msg
390 ("Priority_Specific_Dispatching at {:#" &
391 " incompatible with Locking_Policy at {");
396 -- Check overlapping priority ranges
398 Find_Overlapping : for Prio in
399 DTK.First_Priority .. DTK.Last_Priority
401 if PSD_Table (Prio).Afile = No_ALI_Id then
403 (Dispatching_Policy => DTK.Dispatching_Policy,
404 Afile => F, Loc => DTK.PSD_Pragma_Line);
406 elsif PSD_Table (Prio).Dispatching_Policy /=
407 DTK.Dispatching_Policy
411 ALIs.Table (PSD_Table (Prio).Afile).Sfile;
412 Error_Msg_File_2 := ALIs.Table (F).Sfile;
413 Error_Msg_Nat_1 := PSD_Table (Prio).Loc;
414 Error_Msg_Nat_2 := DTK.PSD_Pragma_Line;
416 Consistency_Error_Msg
417 ("overlapping priority ranges at {:# and {:#");
419 exit Find_Overlapping;
421 end loop Find_Overlapping;
427 end Check_Consistent_Dispatching_Policy;
429 ---------------------------------------------------
430 -- Check_Consistent_Dynamic_Elaboration_Checking --
431 ---------------------------------------------------
433 -- The rule here is that if a unit has dynamic elaboration checks,
434 -- then any unit it withs must meeting one of the following criteria:
436 -- 1. There is a pragma Elaborate_All for the with'ed unit
437 -- 2. The with'ed unit was compiled with dynamic elaboration checks
438 -- 3. The with'ed unit has pragma Preelaborate or Pure
439 -- 4. It is an internal GNAT unit (including children of GNAT)
441 procedure Check_Consistent_Dynamic_Elaboration_Checking is
443 if Dynamic_Elaboration_Checks_Specified then
444 for U in First_Unit_Entry .. Units.Last loop
446 UR : Unit_Record renames Units.Table (U);
449 if UR.Dynamic_Elab then
450 for W in UR.First_With .. UR.Last_With loop
452 WR : With_Record renames Withs.Table (W);
455 if Get_Name_Table_Info (WR.Uname) /= 0 then
457 WU : Unit_Record renames
460 (Get_Name_Table_Info (WR.Uname)));
463 -- Case 1. Elaborate_All for with'ed unit
465 if WR.Elaborate_All then
468 -- Case 2. With'ed unit has dynamic elab checks
470 elsif WU.Dynamic_Elab then
473 -- Case 3. With'ed unit is Preelaborate or Pure
475 elsif WU.Preelab or else WU.Pure then
478 -- Case 4. With'ed unit is internal file
480 elsif Is_Internal_File_Name (WU.Sfile) then
483 -- Issue warning, not one of the safe cases
486 Error_Msg_File_1 := UR.Sfile;
488 ("?{ has dynamic elaboration checks " &
491 Error_Msg_File_1 := WU.Sfile;
493 ("? { which has static elaboration " &
496 Warnings_Detected := Warnings_Detected - 1;
506 end Check_Consistent_Dynamic_Elaboration_Checking;
508 --------------------------------------------
509 -- Check_Consistent_Floating_Point_Format --
510 --------------------------------------------
512 -- The rule is that all files must be compiled with the same setting
513 -- for the floating-point format.
515 procedure Check_Consistent_Floating_Point_Format is
517 -- First search for a unit specifying a floating-point format and then
518 -- check all remaining units against it.
520 Find_Format : for A1 in ALIs.First .. ALIs.Last loop
521 if ALIs.Table (A1).Float_Format /= ' ' then
522 Check_Format : declare
523 Format : constant Character := ALIs.Table (A1).Float_Format;
525 for A2 in A1 + 1 .. ALIs.Last loop
526 if ALIs.Table (A2).Float_Format /= Format then
527 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
528 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
530 Consistency_Error_Msg
531 ("{ and { compiled with different " &
532 "floating-point representations");
540 end loop Find_Format;
541 end Check_Consistent_Floating_Point_Format;
543 ---------------------------------------
544 -- Check_Consistent_Interrupt_States --
545 ---------------------------------------
547 -- The rule is that if the state of a given interrupt is specified
548 -- in more than one unit, it must be specified with a consistent state.
550 procedure Check_Consistent_Interrupt_States is
554 -- If no Interrupt_State entries, nothing to do
556 if Interrupt_States.Last < Interrupt_States.First then
560 -- First find out the maximum interrupt value
563 for J in Interrupt_States.First .. Interrupt_States.Last loop
564 if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
565 Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
569 -- Now establish tables to be used for consistency checking
572 Istate : array (0 .. Max_Intrup) of Character := (others => 'n
');
573 -- Interrupt state entries, 'u
'/'s
'/'r
' or 'n
' to indicate an
574 -- entry that has not been set.
576 Afile : array (0 .. Max_Intrup) of ALI_Id;
577 -- ALI file that generated Istate entry for consistency message
579 Loc : array (0 .. Max_Intrup) of Nat;
580 -- Line numbers from IS pragma generating Istate entry
583 -- Interrupt number from entry being tested
586 -- Interrupt state from entry being tested
589 -- Line number from entry being tested
592 for F in ALIs.First .. ALIs.Last loop
593 for K in ALIs.Table (F).First_Interrupt_State ..
594 ALIs.Table (F).Last_Interrupt_State
596 Inum := Interrupt_States.Table (K).Interrupt_Id;
597 Stat := Interrupt_States.Table (K).Interrupt_State;
598 Lnum := Interrupt_States.Table (K).IS_Pragma_Line;
600 if Istate (Inum) = 'n
' then
601 Istate (Inum) := Stat;
605 elsif Istate (Inum) /= Stat then
606 Error_Msg_File_1 := ALIs.Table (Afile (Inum)).Sfile;
607 Error_Msg_File_2 := ALIs.Table (F).Sfile;
608 Error_Msg_Nat_1 := Loc (Inum);
609 Error_Msg_Nat_2 := Lnum;
611 Consistency_Error_Msg
612 ("inconsistent interrupt states at {:# and {:#");
617 end Check_Consistent_Interrupt_States;
619 -------------------------------------
620 -- Check_Consistent_Locking_Policy --
621 -------------------------------------
623 -- The rule is that all files for which the locking policy is
624 -- significant must be compiled with the same setting.
626 procedure Check_Consistent_Locking_Policy is
628 -- First search for a unit specifying a policy and then
629 -- check all remaining units against it.
631 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
632 if ALIs.Table (A1).Locking_Policy /= ' ' then
633 Check_Policy : declare
634 Policy : constant Character := ALIs.Table (A1).Locking_Policy;
637 for A2 in A1 + 1 .. ALIs.Last loop
638 if ALIs.Table (A2).Locking_Policy /= ' '
640 ALIs.Table (A2).Locking_Policy /= Policy
642 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
643 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
645 Consistency_Error_Msg
646 ("{ and { compiled with different locking policies");
654 end loop Find_Policy;
655 end Check_Consistent_Locking_Policy;
657 ----------------------------------------
658 -- Check_Consistent_Normalize_Scalars --
659 ----------------------------------------
661 -- The rule is that if any unit is compiled with Normalized_Scalars,
662 -- then all other units in the partition must also be compiled with
663 -- Normalized_Scalars in effect.
665 -- There is some issue as to whether this consistency check is desirable,
666 -- it is certainly required at the moment by the RM. We should keep a watch
667 -- on the ARG and HRG deliberations here. GNAT no longer depends on this
668 -- consistency (it used to do so, but that is no longer the case, since
669 -- pragma Initialize_Scalars pragma does not require consistency.)
671 procedure Check_Consistent_Normalize_Scalars is
673 if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
674 Consistency_Error_Msg
675 ("some but not all files compiled with Normalize_Scalars");
678 Write_Str ("files compiled with Normalize_Scalars");
681 for A1 in ALIs.First .. ALIs.Last loop
682 if ALIs.Table (A1).Normalize_Scalars then
684 Write_Name (ALIs.Table (A1).Sfile);
690 Write_Str ("files compiled without Normalize_Scalars");
693 for A1 in ALIs.First .. ALIs.Last loop
694 if not ALIs.Table (A1).Normalize_Scalars then
696 Write_Name (ALIs.Table (A1).Sfile);
701 end Check_Consistent_Normalize_Scalars;
703 -----------------------------------------
704 -- Check_Consistent_Optimize_Alignment --
705 -----------------------------------------
707 -- The rule is that all units which depend on the global default setting
708 -- of Optimize_Alignment must be compiled with the same setting for this
709 -- default. Units which specify an explicit local value for this setting
710 -- are exempt from the consistency rule (this includes all internal units).
712 procedure Check_Consistent_Optimize_Alignment is
713 OA_Setting : Character := ' ';
714 -- Reset when we find a unit that depends on the default and does
715 -- not have a local specification of the Optimize_Alignment setting.
718 -- Id of unit from which OA_Setting was set
723 for U in First_Unit_Entry .. Units.Last loop
724 C := Units.Table (U).Optimize_Alignment;
727 if OA_Setting = ' ' then
731 elsif OA_Setting = C then
735 Error_Msg_Unit_1 := Units.Table (OA_Unit).Uname;
736 Error_Msg_Unit_2 := Units.Table (U).Uname;
738 Consistency_Error_Msg
739 ("$ and $ compiled with different "
740 & "default Optimize_Alignment settings");
745 end Check_Consistent_Optimize_Alignment;
747 -------------------------------------
748 -- Check_Consistent_Queuing_Policy --
749 -------------------------------------
751 -- The rule is that all files for which the queuing policy is
752 -- significant must be compiled with the same setting.
754 procedure Check_Consistent_Queuing_Policy is
756 -- First search for a unit specifying a policy and then
757 -- check all remaining units against it.
759 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
760 if ALIs.Table (A1).Queuing_Policy /= ' ' then
761 Check_Policy : declare
762 Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
764 for A2 in A1 + 1 .. ALIs.Last loop
765 if ALIs.Table (A2).Queuing_Policy /= ' '
767 ALIs.Table (A2).Queuing_Policy /= Policy
769 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
770 Error_Msg_File_2 := ALIs.Table (A2).Sfile;
772 Consistency_Error_Msg
773 ("{ and { compiled with different queuing policies");
781 end loop Find_Policy;
782 end Check_Consistent_Queuing_Policy;
784 -----------------------------------
785 -- Check_Consistent_Restrictions --
786 -----------------------------------
788 -- The rule is that if a restriction is specified in any unit, then all
789 -- units must obey the restriction. The check applies only to restrictions
790 -- which require partition wide consistency, and not to internal units.
792 procedure Check_Consistent_Restrictions is
793 Restriction_File_Output : Boolean;
794 -- Shows if we have output header messages for restriction violation
796 procedure Print_Restriction_File (R : All_Restrictions);
797 -- Print header line for R if not printed yet
799 ----------------------------
800 -- Print_Restriction_File --
801 ----------------------------
803 procedure Print_Restriction_File (R : All_Restrictions) is
805 if not Restriction_File_Output then
806 Restriction_File_Output := True;
808 -- Find an ali file specifying the restriction
810 for A in ALIs.First .. ALIs.Last loop
811 if ALIs.Table (A).Restrictions.Set (R)
812 and then (R in All_Boolean_Restrictions
813 or else ALIs.Table (A).Restrictions.Value (R) =
814 Cumulative_Restrictions.Value (R))
816 -- We have found that ALI file A specifies the restriction
817 -- that is being violated (the minimum value is specified
818 -- in the case of a parameter restriction).
821 M1 : constant String := "{ has restriction ";
822 S : constant String := Restriction_Id'Image (R);
823 M2 : String (1 .. 2000); -- big enough!
827 Name_Buffer (1 .. S'Length) := S;
828 Name_Len := S'Length;
829 Set_Casing (Mixed_Case);
833 M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
836 if R in All_Parameter_Restrictions then
837 M2 (P .. P + 4) := " => #";
839 Int (Cumulative_Restrictions.Value (R));
843 Error_Msg_File_1 := ALIs.Table (A).Sfile;
844 Consistency_Error_Msg (M2 (1 .. P - 1));
845 Consistency_Error_Msg
846 ("but the following files violate this restriction:");
852 end Print_Restriction_File;
854 -- Start of processing for Check_Consistent_Restrictions
857 -- A special test, if we have a main program, then if it has an
858 -- allocator in the body, this is considered to be a violation of
859 -- the restriction No_Allocators_After_Elaboration. We just mark
860 -- this restriction and then the normal circuit will flag it.
863 and then ALIs.Table (ALIs.First).Main_Program /= None
864 and then not No_Main_Subprogram
865 and then ALIs.Table (ALIs.First).Allocator_In_Body
867 Cumulative_Restrictions.Violated
868 (No_Allocators_After_Elaboration) := True;
869 ALIs.Table (ALIs.First).Restrictions.Violated
870 (No_Allocators_After_Elaboration) := True;
873 -- Loop through all restriction violations
875 for R in All_Restrictions loop
877 -- Check for violation of this restriction
879 if Cumulative_Restrictions.Set (R)
880 and then Cumulative_Restrictions.Violated (R)
881 and then (R in Partition_Boolean_Restrictions
882 or else (R in All_Parameter_Restrictions
884 Cumulative_Restrictions.Count (R) >
885 Cumulative_Restrictions.Value (R)))
887 Restriction_File_Output := False;
889 -- Loop through files looking for violators
891 for A2 in ALIs.First .. ALIs.Last loop
893 T : ALIs_Record renames ALIs.Table (A2);
896 if T.Restrictions.Violated (R) then
898 -- We exclude predefined files from the list of
899 -- violators. This should be rethought. It is not
900 -- clear that this is the right thing to do, that
901 -- is particularly the case for restricted runtimes.
903 if not Is_Internal_File_Name (T.Sfile) then
905 -- Case of Boolean restriction, just print file name
907 if R in All_Boolean_Restrictions then
908 Print_Restriction_File (R);
909 Error_Msg_File_1 := T.Sfile;
910 Consistency_Error_Msg (" {");
912 -- Case of Parameter restriction where violation
913 -- count exceeds restriction value, print file
914 -- name and count, adding "at least" if the
915 -- exact count is not known.
917 elsif R in Checked_Add_Parameter_Restrictions
918 or else T.Restrictions.Count (R) >
919 Cumulative_Restrictions.Value (R)
921 Print_Restriction_File (R);
922 Error_Msg_File_1 := T.Sfile;
923 Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));
925 if T.Restrictions.Unknown (R) then
926 Consistency_Error_Msg
927 (" { (count = at least #)");
929 Consistency_Error_Msg
940 -- Now deal with No_Dependence indications. Note that we put the loop
941 -- through entries in the no dependency table first, since this loop
942 -- is most often empty (no such pragma Restrictions in use).
944 for ND in No_Deps.First .. No_Deps.Last loop
946 ND_Unit : constant Name_Id := No_Deps.Table (ND).No_Dep_Unit;
948 for J in ALIs.First .. ALIs.Last loop
950 A : ALIs_Record renames ALIs.Table (J);
953 for K in A.First_Unit .. A.Last_Unit loop
955 U : Unit_Record renames Units.Table (K);
957 for L in U.First_With .. U.Last_With loop
959 (Withs.Table (L).Uname, ND_Unit)
961 Error_Msg_File_1 := U.Sfile;
962 Error_Msg_Name_1 := ND_Unit;
963 Consistency_Error_Msg
964 ("file { violates restriction " &
965 "No_Dependence => %");
974 end Check_Consistent_Restrictions;
976 ------------------------------------------------------------
977 -- Check_Consistent_Restriction_No_Default_Initialization --
978 ------------------------------------------------------------
980 -- The Restriction (No_Default_Initialization) has special consistency
981 -- rules. The rule is that no unit compiled without this restriction
982 -- that violates the restriction can WITH a unit that is compiled with
985 procedure Check_Consistent_Restriction_No_Default_Initialization is
987 -- Nothing to do if no one set this restriction
989 if not Cumulative_Restrictions.Set (No_Default_Initialization) then
993 -- Nothing to do if no one violates the restriction
995 if not Cumulative_Restrictions.Violated (No_Default_Initialization) then
999 -- Otherwise we go into a full scan to find possible problems
1001 for U in Units.First .. Units.Last loop
1003 UTE : Unit_Record renames Units.Table (U);
1004 ATE : ALIs_Record renames ALIs.Table (UTE.My_ALI);
1007 if ATE.Restrictions.Violated (No_Default_Initialization) then
1008 for W in UTE.First_With .. UTE.Last_With loop
1010 AFN : constant File_Name_Type := Withs.Table (W).Afile;
1013 -- The file name may not be present for withs of certain
1014 -- generic run-time files. The test can be safely left
1015 -- out in such cases anyway.
1017 if AFN /= No_File then
1019 WAI : constant ALI_Id :=
1020 ALI_Id (Get_Name_Table_Info (AFN));
1021 WTE : ALIs_Record renames ALIs.Table (WAI);
1024 if WTE.Restrictions.Set
1025 (No_Default_Initialization)
1027 Error_Msg_Unit_1 := UTE.Uname;
1028 Consistency_Error_Msg
1029 ("unit $ compiled without restriction "
1030 & "No_Default_Initialization");
1031 Error_Msg_Unit_1 := Withs.Table (W).Uname;
1032 Consistency_Error_Msg
1033 ("withs unit $, compiled with restriction "
1034 & "No_Default_Initialization");
1043 end Check_Consistent_Restriction_No_Default_Initialization;
1045 ---------------------------------------------------
1046 -- Check_Consistent_Zero_Cost_Exception_Handling --
1047 ---------------------------------------------------
1049 -- Check consistent zero cost exception handling. The rule is that
1050 -- all units must have the same exception handling mechanism.
1052 procedure Check_Consistent_Zero_Cost_Exception_Handling is
1054 Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
1055 if ALIs.Table (A1).Zero_Cost_Exceptions /=
1056 ALIs.Table (ALIs.First).Zero_Cost_Exceptions
1058 Error_Msg_File_1 := ALIs.Table (A1).Sfile;
1059 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
1061 Consistency_Error_Msg ("{ and { compiled with different "
1062 & "exception handling mechanisms");
1064 end loop Check_Mechanism;
1065 end Check_Consistent_Zero_Cost_Exception_Handling;
1067 -------------------------------
1068 -- Check_Duplicated_Subunits --
1069 -------------------------------
1071 procedure Check_Duplicated_Subunits is
1073 for J in Sdep.First .. Sdep.Last loop
1074 if Sdep.Table (J).Subunit_Name /= No_Name then
1075 Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
1076 Name_Len := Name_Len + 2;
1077 Name_Buffer (Name_Len - 1) := '%';
1079 -- See if there is a body or spec with the same name
1081 for K in Boolean loop
1083 Name_Buffer (Name_Len) := 'b
';
1085 Name_Buffer (Name_Len) := 's
';
1089 Unit : constant Unit_Name_Type := Name_Find;
1090 Info : constant Int := Get_Name_Table_Info (Unit);
1095 Write_Str ("error: subunit """);
1096 Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
1097 Write_Str (""" in file """);
1098 Write_Name_Decoded (Sdep.Table (J).Sfile);
1101 Write_Str (" has same name as unit
""");
1102 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
1103 Write_Str (""" found
in file
""");
1104 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
1107 Write_Str (" this is not allowed within a single "
1108 & "partition (RM 10.2(19))");
1110 Osint.Exit_Program (Osint.E_Fatal);
1116 end Check_Duplicated_Subunits;
1118 --------------------
1119 -- Check_Versions --
1120 --------------------
1122 procedure Check_Versions is
1123 VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
1126 for A in ALIs.First .. ALIs.Last loop
1127 if ALIs.Table (A).Ver_Len /= VL
1128 or else ALIs.Table (A).Ver (1 .. VL) /=
1129 ALIs.Table (ALIs.First).Ver (1 .. VL)
1131 Error_Msg_File_1 := ALIs.Table (A).Sfile;
1132 Error_Msg_File_2 := ALIs.Table (ALIs.First).Sfile;
1134 Consistency_Error_Msg
1135 ("{ and { compiled with different GNAT versions");
1140 ---------------------------
1141 -- Consistency_Error_Msg --
1142 ---------------------------
1144 procedure Consistency_Error_Msg (Msg : String) is
1146 if Tolerate_Consistency_Errors then
1148 -- If consistency errors are tolerated,
1149 -- output the message as a warning.
1151 Error_Msg ('?
' & Msg);
1153 -- Otherwise the consistency error is a true error
1158 end Consistency_Error_Msg;
1164 function Same_Unit (U1 : Unit_Name_Type; U2 : Name_Id) return Boolean is
1166 -- Note, the string U1 has a terminating %s or %b, U2 does not
1168 if Length_Of_Name (U1) - 2 = Length_Of_Name (U2) then
1169 Get_Name_String (U1);
1172 U1_Str : constant String := Name_Buffer (1 .. Name_Len - 2);
1174 Get_Name_String (U2);
1175 return U1_Str = Name_Buffer (1 .. Name_Len);