1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
28 with ALI.Util; use ALI.Util;
29 with Binderr; use Binderr;
30 with Butil; use Butil;
31 with Casing; use Casing;
32 with Fname; use Fname;
33 with Namet; use Namet;
36 with Output; use Output;
37 with Rident; use Rident;
38 with Types; use Types;
40 package body Bcheck is
42 -----------------------
43 -- Local Subprograms --
44 -----------------------
46 -- The following checking subprograms make up the parts of the
47 -- configuration consistency check.
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_Queuing_Policy;
55 procedure Check_Consistent_Restrictions;
56 procedure Check_Consistent_Zero_Cost_Exception_Handling;
58 procedure Consistency_Error_Msg (Msg : String);
59 -- Produce an error or a warning message, depending on whether
60 -- an inconsistent configuration is permitted or not.
62 ------------------------------------
63 -- Check_Consistent_Configuration --
64 ------------------------------------
66 procedure Check_Configuration_Consistency is
68 if Float_Format_Specified /= ' ' then
69 Check_Consistent_Floating_Point_Format;
72 if Queuing_Policy_Specified /= ' ' then
73 Check_Consistent_Queuing_Policy;
76 if Locking_Policy_Specified /= ' ' then
77 Check_Consistent_Locking_Policy;
80 if Zero_Cost_Exceptions_Specified then
81 Check_Consistent_Zero_Cost_Exception_Handling;
84 Check_Consistent_Normalize_Scalars;
85 Check_Consistent_Dynamic_Elaboration_Checking;
87 Check_Consistent_Restrictions;
88 Check_Consistent_Interrupt_States;
89 end Check_Configuration_Consistency;
91 ---------------------------------------------------
92 -- Check_Consistent_Dynamic_Elaboration_Checking --
93 ---------------------------------------------------
95 -- The rule here is that if a unit has dynamic elaboration checks,
96 -- then any unit it withs must meeting one of the following criteria:
98 -- 1. There is a pragma Elaborate_All for the with'ed unit
99 -- 2. The with'ed unit was compiled with dynamic elaboration checks
100 -- 3. The with'ed unit has pragma Preelaborate or Pure
101 -- 4. It is an internal GNAT unit (including children of GNAT)
103 procedure Check_Consistent_Dynamic_Elaboration_Checking is
105 if Dynamic_Elaboration_Checks_Specified then
106 for U in First_Unit_Entry .. Units.Last loop
108 UR : Unit_Record renames Units.Table (U);
111 if UR.Dynamic_Elab then
112 for W in UR.First_With .. UR.Last_With loop
114 WR : With_Record renames Withs.Table (W);
117 if Get_Name_Table_Info (WR.Uname) /= 0 then
119 WU : Unit_Record renames
122 (Get_Name_Table_Info (WR.Uname)));
125 -- Case 1. Elaborate_All for with'ed unit
127 if WR.Elaborate_All then
130 -- Case 2. With'ed unit has dynamic elab checks
132 elsif WU.Dynamic_Elab then
135 -- Case 3. With'ed unit is Preelaborate or Pure
137 elsif WU.Preelab or WU.Pure then
140 -- Case 4. With'ed unit is internal file
142 elsif Is_Internal_File_Name (WU.Sfile) then
145 -- Issue warning, not one of the safe cases
148 Error_Msg_Name_1 := UR.Sfile;
150 ("?% has dynamic elaboration checks " &
153 Error_Msg_Name_1 := WU.Sfile;
155 ("? % which has static elaboration " &
158 Warnings_Detected := Warnings_Detected - 1;
168 end Check_Consistent_Dynamic_Elaboration_Checking;
170 --------------------------------------------
171 -- Check_Consistent_Floating_Point_Format --
172 --------------------------------------------
174 -- The rule is that all files must be compiled with the same setting
175 -- for the floating-point format.
177 procedure Check_Consistent_Floating_Point_Format is
179 -- First search for a unit specifying a floating-point format and then
180 -- check all remaining units against it.
182 Find_Format : for A1 in ALIs.First .. ALIs.Last loop
183 if ALIs.Table (A1).Float_Format /= ' ' then
184 Check_Format : declare
185 Format : constant Character := ALIs.Table (A1).Float_Format;
187 for A2 in A1 + 1 .. ALIs.Last loop
188 if ALIs.Table (A2).Float_Format /= Format then
189 Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
190 Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
192 Consistency_Error_Msg
193 ("% and % compiled with different " &
194 "floating-point representations");
202 end loop Find_Format;
203 end Check_Consistent_Floating_Point_Format;
205 ---------------------------------------
206 -- Check_Consistent_Interrupt_States --
207 ---------------------------------------
209 -- The rule is that if the state of a given interrupt is specified
210 -- in more than one unit, it must be specified with a consistent state.
212 procedure Check_Consistent_Interrupt_States is
216 -- If no Interrupt_State entries, nothing to do
218 if Interrupt_States.Last < Interrupt_States.First then
222 -- First find out the maximum interrupt value
225 for J in Interrupt_States.First .. Interrupt_States.Last loop
226 if Interrupt_States.Table (J).Interrupt_Id > Max_Intrup then
227 Max_Intrup := Interrupt_States.Table (J).Interrupt_Id;
231 -- Now establish tables to be used for consistency checking
234 Istate : array (0 .. Max_Intrup) of Character := (others => 'n');
235 -- Interrupt state entries, 'u'/'s'/'r' or 'n' to indicate an
236 -- entry that has not been set.
238 Afile : array (0 .. Max_Intrup) of ALI_Id;
239 -- ALI file that generated Istate entry for consistency message
241 Loc : array (0 .. Max_Intrup) of Nat;
242 -- Line numbers from IS pragma generating Istate entry
245 -- Interrupt number from entry being tested
248 -- Interrupt state from entry being tested
251 -- Line number from entry being tested
254 for F in ALIs.First .. ALIs.Last loop
255 for K in ALIs.Table (F).First_Interrupt_State ..
256 ALIs.Table (F).Last_Interrupt_State
258 Inum := Interrupt_States.Table (K).Interrupt_Id;
259 Stat := Interrupt_States.Table (K).Interrupt_State;
260 Lnum := Interrupt_States.Table (K).IS_Pragma_Line;
262 if Istate (Inum) = 'n' then
263 Istate (Inum) := Stat;
267 elsif Istate (Inum) /= Stat then
268 Error_Msg_Name_1 := ALIs.Table (Afile (Inum)).Sfile;
269 Error_Msg_Name_2 := ALIs.Table (F).Sfile;
270 Error_Msg_Nat_1 := Loc (Inum);
271 Error_Msg_Nat_2 := Lnum;
273 Consistency_Error_Msg
274 ("inconsistent interrupt states at %:# and %:#");
279 end Check_Consistent_Interrupt_States;
281 -------------------------------------
282 -- Check_Consistent_Locking_Policy --
283 -------------------------------------
285 -- The rule is that all files for which the locking policy is
286 -- significant must be compiled with the same setting.
288 procedure Check_Consistent_Locking_Policy is
290 -- First search for a unit specifying a policy and then
291 -- check all remaining units against it.
293 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
294 if ALIs.Table (A1).Locking_Policy /= ' ' then
295 Check_Policy : declare
296 Policy : constant Character := ALIs.Table (A1).Locking_Policy;
299 for A2 in A1 + 1 .. ALIs.Last loop
300 if ALIs.Table (A2).Locking_Policy /= ' ' and
301 ALIs.Table (A2).Locking_Policy /= Policy
303 Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
304 Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
306 Consistency_Error_Msg
307 ("% and % compiled with different locking policies");
315 end loop Find_Policy;
316 end Check_Consistent_Locking_Policy;
318 ----------------------------------------
319 -- Check_Consistent_Normalize_Scalars --
320 ----------------------------------------
322 -- The rule is that if any unit is compiled with Normalized_Scalars,
323 -- then all other units in the partition must also be compiled with
324 -- Normalized_Scalars in effect.
326 -- There is some issue as to whether this consistency check is
327 -- desirable, it is certainly required at the moment by the RM.
328 -- We should keep a watch on the ARG and HRG deliberations here.
329 -- GNAT no longer depends on this consistency (it used to do so,
330 -- but that has been corrected in the latest version, since the
331 -- Initialize_Scalars pragma does not require consistency.
333 procedure Check_Consistent_Normalize_Scalars is
335 if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
336 Consistency_Error_Msg
337 ("some but not all files compiled with Normalize_Scalars");
340 Write_Str ("files compiled with Normalize_Scalars");
343 for A1 in ALIs.First .. ALIs.Last loop
344 if ALIs.Table (A1).Normalize_Scalars then
346 Write_Name (ALIs.Table (A1).Sfile);
352 Write_Str ("files compiled without Normalize_Scalars");
355 for A1 in ALIs.First .. ALIs.Last loop
356 if not ALIs.Table (A1).Normalize_Scalars then
358 Write_Name (ALIs.Table (A1).Sfile);
363 end Check_Consistent_Normalize_Scalars;
365 -------------------------------------
366 -- Check_Consistent_Queuing_Policy --
367 -------------------------------------
369 -- The rule is that all files for which the queuing policy is
370 -- significant must be compiled with the same setting.
372 procedure Check_Consistent_Queuing_Policy is
374 -- First search for a unit specifying a policy and then
375 -- check all remaining units against it.
377 Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
378 if ALIs.Table (A1).Queuing_Policy /= ' ' then
379 Check_Policy : declare
380 Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
382 for A2 in A1 + 1 .. ALIs.Last loop
383 if ALIs.Table (A2).Queuing_Policy /= ' '
385 ALIs.Table (A2).Queuing_Policy /= Policy
387 Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
388 Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
390 Consistency_Error_Msg
391 ("% and % compiled with different queuing policies");
399 end loop Find_Policy;
400 end Check_Consistent_Queuing_Policy;
402 -----------------------------------
403 -- Check_Consistent_Restrictions --
404 -----------------------------------
406 -- The rule is that if a restriction is specified in any unit,
407 -- then all units must obey the restriction. The check applies
408 -- only to restrictions which require partition wide consistency,
409 -- and not to internal units.
411 procedure Check_Consistent_Restrictions is
412 Restriction_File_Output : Boolean;
413 -- Shows if we have output header messages for restriction violation
415 procedure Print_Restriction_File (R : All_Restrictions);
416 -- Print header line for R if not printed yet
418 ----------------------------
419 -- Print_Restriction_File --
420 ----------------------------
422 procedure Print_Restriction_File (R : All_Restrictions) is
424 if not Restriction_File_Output then
425 Restriction_File_Output := True;
427 -- Find an ali file specifying the restriction
429 for A in ALIs.First .. ALIs.Last loop
430 if ALIs.Table (A).Restrictions.Set (R)
431 and then (R in All_Boolean_Restrictions
432 or else ALIs.Table (A).Restrictions.Value (R) =
433 Cumulative_Restrictions.Value (R))
435 -- We have found that ALI file A specifies the restriction
436 -- that is being violated (the minimum value is specified
437 -- in the case of a parameter restriction).
440 M1 : constant String := "% has restriction ";
441 S : constant String := Restriction_Id'Image (R);
442 M2 : String (1 .. 200); -- big enough!
446 Name_Buffer (1 .. S'Length) := S;
447 Name_Len := S'Length;
448 Set_Casing (Mixed_Case);
452 M2 (P .. P + S'Length - 1) := Name_Buffer (1 .. S'Length);
455 if R in All_Parameter_Restrictions then
456 M2 (P .. P + 4) := " => #";
458 Int (Cumulative_Restrictions.Value (R));
462 Error_Msg_Name_1 := ALIs.Table (A).Sfile;
463 Consistency_Error_Msg (M2 (1 .. P - 1));
464 Consistency_Error_Msg
465 ("but the following files violate this restriction:");
471 end Print_Restriction_File;
473 -- Start of processing for Check_Consistent_Restrictions
476 -- Loop through all restriction violations
478 for R in All_Restrictions loop
480 -- Check for violation of this restriction
482 if Cumulative_Restrictions.Set (R)
483 and then Cumulative_Restrictions.Violated (R)
484 and then (R in Partition_Boolean_Restrictions
485 or else (R in All_Parameter_Restrictions
487 Cumulative_Restrictions.Count (R) >
488 Cumulative_Restrictions.Value (R)))
490 Restriction_File_Output := False;
492 -- Loop through files looking for violators
494 for A2 in ALIs.First .. ALIs.Last loop
496 T : ALIs_Record renames ALIs.Table (A2);
499 if T.Restrictions.Violated (R) then
501 -- We exclude predefined files from the list of
502 -- violators. This should be rethought. It is not
503 -- clear that this is the right thing to do, that
504 -- is particularly the case for restricted runtimes.
506 if not Is_Internal_File_Name (T.Sfile) then
508 -- Case of Boolean restriction, just print file name
510 if R in All_Boolean_Restrictions then
511 Print_Restriction_File (R);
512 Error_Msg_Name_1 := T.Sfile;
513 Consistency_Error_Msg (" %");
515 -- Case of Parameter restriction where violation
516 -- count exceeds restriction value, print file
517 -- name and count, adding "at least" if the
518 -- exact count is not known.
520 elsif R in Checked_Add_Parameter_Restrictions
521 or else T.Restrictions.Count (R) >
522 Cumulative_Restrictions.Value (R)
524 Print_Restriction_File (R);
525 Error_Msg_Name_1 := T.Sfile;
526 Error_Msg_Nat_1 := Int (T.Restrictions.Count (R));
528 if T.Restrictions.Unknown (R) then
529 Consistency_Error_Msg
530 (" % (count = at least #)");
532 Consistency_Error_Msg
542 end Check_Consistent_Restrictions;
544 ---------------------------------------------------
545 -- Check_Consistent_Zero_Cost_Exception_Handling --
546 ---------------------------------------------------
548 -- Check consistent zero cost exception handling. The rule is that
549 -- all units must have the same exception handling mechanism.
551 procedure Check_Consistent_Zero_Cost_Exception_Handling is
553 Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
554 if ALIs.Table (A1).Zero_Cost_Exceptions /=
555 ALIs.Table (ALIs.First).Zero_Cost_Exceptions
558 Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
559 Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
561 Consistency_Error_Msg ("% and % compiled with different "
562 & "exception handling mechanisms");
564 end loop Check_Mechanism;
565 end Check_Consistent_Zero_Cost_Exception_Handling;
567 -----------------------
568 -- Check_Consistency --
569 -----------------------
571 procedure Check_Consistency is
573 -- Source file Id for this Sdep entry
576 -- First, we go through the source table to see if there are any cases
577 -- in which we should go after source files and compute checksums of
578 -- the source files. We need to do this for any file for which we have
579 -- mismatching time stamps and (so far) matching checksums.
581 for S in Source.First .. Source.Last loop
583 -- If all time stamps for a file match, then there is nothing to
584 -- do, since we will not be checking checksums in that case anyway
586 if Source.Table (S).All_Timestamps_Match then
589 -- If we did not find the source file, then we can't compute its
590 -- checksum anyway. Note that when we have a time stamp mismatch,
591 -- we try to find the source file unconditionally (i.e. if
592 -- Check_Source_Files is False).
594 elsif not Source.Table (S).Source_Found then
597 -- If we already have non-matching or missing checksums, then no
598 -- need to try going after source file, since we won't trust the
599 -- checksums in any case.
601 elsif not Source.Table (S).All_Checksums_Match then
604 -- Now we have the case where we have time stamp mismatches, and
605 -- the source file is around, but so far all checksums match. This
606 -- is the case where we need to compute the checksum from the source
607 -- file, since otherwise we would ignore the time stamp mismatches,
608 -- and that is wrong if the checksum of the source does not agree
609 -- with the checksums in the ALI files.
611 elsif Check_Source_Files then
612 if not Checksums_Match
613 (Source.Table (S).Checksum,
614 Get_File_Checksum (Source.Table (S).Sfile))
616 Source.Table (S).All_Checksums_Match := False;
621 -- Loop through ALI files
623 ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
625 -- Loop through Sdep entries in one ALI file
628 ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
630 if Sdep.Table (D).Dummy_Entry then
634 Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
636 -- If the time stamps match, or all checksums match, then we
637 -- are OK, otherwise we have a definite error.
639 if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
640 and then not Source.Table (Src).All_Checksums_Match
642 Error_Msg_Name_1 := ALIs.Table (A).Sfile;
643 Error_Msg_Name_2 := Sdep.Table (D).Sfile;
645 -- Two styles of message, depending on whether or not
646 -- the updated file is the one that must be recompiled
648 if Error_Msg_Name_1 = Error_Msg_Name_2 then
649 if Tolerate_Consistency_Errors then
651 ("?% has been modified and should be recompiled");
654 ("% has been modified and must be recompiled");
658 if Osint.Is_Readonly_Library (ALIs.Table (A).Afile) then
660 Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
662 if Tolerate_Consistency_Errors then
663 Error_Msg ("?% should be recompiled");
664 Error_Msg_Name_1 := Error_Msg_Name_2;
665 Error_Msg ("?(% is obsolete and read-only)");
668 Error_Msg ("% must be compiled");
669 Error_Msg_Name_1 := Error_Msg_Name_2;
670 Error_Msg ("(% is obsolete and read-only)");
673 elsif Tolerate_Consistency_Errors then
675 ("?% should be recompiled (% has been modified)");
678 Error_Msg ("% must be recompiled (% has been modified)");
682 if (not Tolerate_Consistency_Errors) and Verbose_Mode then
684 Msg : constant String := "% time stamp ";
685 Buf : String (1 .. Msg'Length + Time_Stamp_Length);
688 Buf (1 .. Msg'Length) := Msg;
689 Buf (Msg'Length + 1 .. Buf'Length) :=
690 String (Source.Table (Src).Stamp);
691 Error_Msg_Name_1 := Sdep.Table (D).Sfile;
696 Msg : constant String := " conflicts with % timestamp ";
697 Buf : String (1 .. Msg'Length + Time_Stamp_Length);
700 Buf (1 .. Msg'Length) := Msg;
701 Buf (Msg'Length + 1 .. Buf'Length) :=
702 String (Sdep.Table (D).Stamp);
703 Error_Msg_Name_1 := Sdep.Table (D).Sfile;
708 -- Exit from the loop through Sdep entries once we find one
709 -- that does not match.
718 end Check_Consistency;
720 -------------------------------
721 -- Check_Duplicated_Subunits --
722 -------------------------------
724 procedure Check_Duplicated_Subunits is
726 for J in Sdep.First .. Sdep.Last loop
727 if Sdep.Table (J).Subunit_Name /= No_Name then
728 Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
729 Name_Len := Name_Len + 2;
730 Name_Buffer (Name_Len - 1) := '%';
732 -- See if there is a body or spec with the same name
734 for K in Boolean loop
736 Name_Buffer (Name_Len) := 'b';
739 Name_Buffer (Name_Len) := 's';
743 Info : constant Int := Get_Name_Table_Info (Name_Find);
748 Write_Str ("error: subunit """);
749 Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
750 Write_Str (""" in file """);
751 Write_Name_Decoded (Sdep.Table (J).Sfile);
754 Write_Str (" has same name as unit """);
755 Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
756 Write_Str (""" found in file """);
757 Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
760 Write_Str (" this is not allowed within a single "
761 & "partition (RM 10.2(19))");
763 Osint.Exit_Program (Osint.E_Fatal);
769 end Check_Duplicated_Subunits;
775 procedure Check_Versions is
776 VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
779 for A in ALIs.First .. ALIs.Last loop
780 if ALIs.Table (A).Ver_Len /= VL
781 or else ALIs.Table (A).Ver (1 .. VL) /=
782 ALIs.Table (ALIs.First).Ver (1 .. VL)
784 Error_Msg_Name_1 := ALIs.Table (A).Sfile;
785 Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
787 Consistency_Error_Msg
788 ("% and % compiled with different GNAT versions");
793 ---------------------------
794 -- Consistency_Error_Msg --
795 ---------------------------
797 procedure Consistency_Error_Msg (Msg : String) is
799 if Tolerate_Consistency_Errors then
801 -- If consistency errors are tolerated,
802 -- output the message as a warning.
805 Warning_Msg : String (1 .. Msg'Length + 1);
808 Warning_Msg (1) := '?';
809 Warning_Msg (2 .. Warning_Msg'Last) := Msg;
811 Error_Msg (Warning_Msg);
814 -- Otherwise the consistency error is a true error
819 end Consistency_Error_Msg;