gcc/ada/bcheck.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               B C H E C K                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                            $Revision$
  10 --                                                                          --
  11 --          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
  12 --                                                                          --
  13 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- GNAT was originally developed  by the GNAT team at  New York University. --
  25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  26 --                                                                          --
  27 ------------------------------------------------------------------------------
  28
  29 with ALI;      use ALI;
  30 with ALI.Util; use ALI.Util;
  31 with Binderr;  use Binderr;
  32 with Butil;    use Butil;
  33 with Casing;   use Casing;
  34 with Debug;    use Debug;
  35 with Fname;    use Fname;
  36 with Namet;    use Namet;
  37 with Opt;      use Opt;
  38 with Osint;
  39 with Output;   use Output;
  40 with Rident;   use Rident;
  41 with Types;    use Types;
  42
  43 package body Bcheck is
  44
  45    --  Local subprograms
  46
  47    --  The following checking subprograms make up the parts
  48    --  of the configuration consistency check.
  49
  50    procedure Check_Consistent_Dynamic_Elaboration_Checking;
  51    procedure Check_Consistent_Floating_Point_Format;
  52    procedure Check_Consistent_Locking_Policy;
  53    procedure Check_Consistent_Normalize_Scalars;
  54    procedure Check_Consistent_Queuing_Policy;
  55    procedure Check_Consistent_Zero_Cost_Exception_Handling;
  56    procedure Check_Partition_Restrictions;
  57
  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.
  61
  62    ------------------------------------
  63    -- Check_Consistent_Configuration --
  64    ------------------------------------
  65
  66    procedure Check_Configuration_Consistency is
  67    begin
  68       if Float_Format_Specified /= ' ' then
  69          Check_Consistent_Floating_Point_Format;
  70       end if;
  71
  72       if Queuing_Policy_Specified /= ' ' then
  73          Check_Consistent_Queuing_Policy;
  74       end if;
  75
  76       if Locking_Policy_Specified /= ' ' then
  77          Check_Consistent_Locking_Policy;
  78       end if;
  79
  80       if Zero_Cost_Exceptions_Specified then
  81          Check_Consistent_Zero_Cost_Exception_Handling;
  82       end if;
  83
  84       Check_Consistent_Normalize_Scalars;
  85       Check_Consistent_Dynamic_Elaboration_Checking;
  86
  87       Check_Partition_Restrictions;
  88    end Check_Configuration_Consistency;
  89
  90    ---------------------------------------------------
  91    -- Check_Consistent_Dynamic_Elaboration_Checking --
  92    ---------------------------------------------------
  93
  94    --  The rule here is that if a unit has dynamic elaboration checks,
  95    --  then any unit it withs must meeting one of the following criteria:
  96
  97    --    1. There is a pragma Elaborate_All for the with'ed unit
  98    --    2. The with'ed unit was compiled with dynamic elaboration checks
  99    --    3. The with'ed unit has pragma Preelaborate or Pure
 100    --    4. It is an internal GNAT unit (including children of GNAT)
 101
 102    procedure Check_Consistent_Dynamic_Elaboration_Checking is
 103    begin
 104       if Dynamic_Elaboration_Checks_Specified then
 105          for U in First_Unit_Entry .. Units.Last loop
 106             declare
 107                UR : Unit_Record renames Units.Table (U);
 108
 109             begin
 110                if UR.Dynamic_Elab then
 111                   for W in UR.First_With .. UR.Last_With loop
 112                      declare
 113                         WR : With_Record renames Withs.Table (W);
 114
 115                      begin
 116                         if Get_Name_Table_Info (WR.Uname) /= 0 then
 117                            declare
 118                               WU : Unit_Record renames
 119                                      Units.Table
 120                                        (Unit_Id
 121                                          (Get_Name_Table_Info (WR.Uname)));
 122
 123                            begin
 124                               --  Case 1. Elaborate_All for with'ed unit
 125
 126                               if WR.Elaborate_All then
 127                                  null;
 128
 129                               --  Case 2. With'ed unit has dynamic elab checks
 130
 131                               elsif WU.Dynamic_Elab then
 132                                  null;
 133
 134                               --  Case 3. With'ed unit is Preelaborate or Pure
 135
 136                               elsif WU.Preelab or WU.Pure then
 137                                  null;
 138
 139                               --  Case 4. With'ed unit is internal file
 140
 141                               elsif Is_Internal_File_Name (WU.Sfile) then
 142                                  null;
 143
 144                               --  Issue warning, not one of the safe cases
 145
 146                               else
 147                                  Error_Msg_Name_1 := UR.Sfile;
 148                                  Error_Msg
 149                                    ("?% has dynamic elaboration checks " &
 150                                                                  "and with's");
 151
 152                                  Error_Msg_Name_1 := WU.Sfile;
 153                                  Error_Msg
 154                                    ("?  % which has static elaboration " &
 155                                                                      "checks");
 156
 157                                  Warnings_Detected := Warnings_Detected - 1;
 158                               end if;
 159                            end;
 160                         end if;
 161                      end;
 162                   end loop;
 163                end if;
 164             end;
 165          end loop;
 166       end if;
 167    end Check_Consistent_Dynamic_Elaboration_Checking;
 168
 169    --------------------------------------------
 170    -- Check_Consistent_Floating_Point_Format --
 171    --------------------------------------------
 172
 173    --  The rule is that all files must be compiled with the same setting
 174    --  for the floating-point format.
 175
 176    procedure Check_Consistent_Floating_Point_Format is
 177    begin
 178       --  First search for a unit specifying a floating-point format and then
 179       --  check all remaining units against it.
 180
 181       Find_Format : for A1 in ALIs.First .. ALIs.Last loop
 182          if ALIs.Table (A1).Float_Format /= ' ' then
 183             Check_Format : declare
 184                Format : constant Character := ALIs.Table (A1).Float_Format;
 185             begin
 186                for A2 in A1 + 1 .. ALIs.Last loop
 187                   if ALIs.Table (A2).Float_Format /= Format then
 188                      Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 189                      Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
 190
 191                      Consistency_Error_Msg
 192                        ("% and % compiled with different " &
 193                         "floating-point representations");
 194                      exit Find_Format;
 195                   end if;
 196                end loop;
 197             end Check_Format;
 198
 199             exit Find_Format;
 200          end if;
 201       end loop Find_Format;
 202    end Check_Consistent_Floating_Point_Format;
 203
 204    -------------------------------------
 205    -- Check_Consistent_Locking_Policy --
 206    -------------------------------------
 207
 208    --  The rule is that all files for which the locking policy is
 209    --  significant must be compiled with the same setting.
 210
 211    procedure Check_Consistent_Locking_Policy is
 212    begin
 213       --  First search for a unit specifying a policy and then
 214       --  check all remaining units against it.
 215
 216       Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
 217          if ALIs.Table (A1).Locking_Policy /= ' ' then
 218             Check_Policy : declare
 219                Policy : constant Character := ALIs.Table (A1).Locking_Policy;
 220
 221             begin
 222                for A2 in A1 + 1 .. ALIs.Last loop
 223                   if ALIs.Table (A2).Locking_Policy /= ' ' and
 224                      ALIs.Table (A2).Locking_Policy /= Policy
 225                   then
 226                      Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 227                      Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
 228
 229                      Consistency_Error_Msg
 230                        ("% and % compiled with different locking policies");
 231                      exit Find_Policy;
 232                   end if;
 233                end loop;
 234             end Check_Policy;
 235
 236             exit Find_Policy;
 237          end if;
 238       end loop Find_Policy;
 239    end Check_Consistent_Locking_Policy;
 240
 241    ----------------------------------------
 242    -- Check_Consistent_Normalize_Scalars --
 243    ----------------------------------------
 244
 245    --  The rule is that if any unit is compiled with Normalized_Scalars,
 246    --  then all other units in the partition must also be compiled with
 247    --  Normalized_Scalars in effect.
 248
 249    --  There is some issue as to whether this consistency check is
 250    --  desirable, it is certainly required at the moment by the RM.
 251    --  We should keep a watch on the ARG and HRG deliberations here.
 252    --  GNAT no longer depends on this consistency (it used to do so,
 253    --  but that has been corrected in the latest version, since the
 254    --  Initialize_Scalars pragma does not require consistency.
 255
 256    procedure Check_Consistent_Normalize_Scalars is
 257    begin
 258       if Normalize_Scalars_Specified and No_Normalize_Scalars_Specified then
 259          Consistency_Error_Msg
 260               ("some but not all files compiled with Normalize_Scalars");
 261
 262          Write_Eol;
 263          Write_Str ("files compiled with Normalize_Scalars");
 264          Write_Eol;
 265
 266          for A1 in ALIs.First .. ALIs.Last loop
 267             if ALIs.Table (A1).Normalize_Scalars then
 268                Write_Str ("  ");
 269                Write_Name (ALIs.Table (A1).Sfile);
 270                Write_Eol;
 271             end if;
 272          end loop;
 273
 274          Write_Eol;
 275          Write_Str ("files compiled without Normalize_Scalars");
 276          Write_Eol;
 277
 278          for A1 in ALIs.First .. ALIs.Last loop
 279             if not ALIs.Table (A1).Normalize_Scalars then
 280                Write_Str ("  ");
 281                Write_Name (ALIs.Table (A1).Sfile);
 282                Write_Eol;
 283             end if;
 284          end loop;
 285       end if;
 286    end Check_Consistent_Normalize_Scalars;
 287
 288    -------------------------------------
 289    -- Check_Consistent_Queuing_Policy --
 290    -------------------------------------
 291
 292    --  The rule is that all files for which the queuing policy is
 293    --  significant must be compiled with the same setting.
 294
 295    procedure Check_Consistent_Queuing_Policy is
 296    begin
 297       --  First search for a unit specifying a policy and then
 298       --  check all remaining units against it.
 299
 300       Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
 301          if ALIs.Table (A1).Queuing_Policy /= ' ' then
 302             Check_Policy : declare
 303                Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
 304             begin
 305                for A2 in A1 + 1 .. ALIs.Last loop
 306                   if ALIs.Table (A2).Queuing_Policy /= ' '
 307                        and then
 308                      ALIs.Table (A2).Queuing_Policy /= Policy
 309                   then
 310                      Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 311                      Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
 312
 313                      Consistency_Error_Msg
 314                        ("% and % compiled with different queuing policies");
 315                      exit Find_Policy;
 316                   end if;
 317                end loop;
 318             end Check_Policy;
 319
 320             exit Find_Policy;
 321          end if;
 322       end loop Find_Policy;
 323    end Check_Consistent_Queuing_Policy;
 324
 325    ---------------------------------------------------
 326    -- Check_Consistent_Zero_Cost_Exception_Handling --
 327    ---------------------------------------------------
 328
 329    --  Check consistent zero cost exception handling. The rule is that
 330    --  all units must have the same exception handling mechanism.
 331
 332    procedure Check_Consistent_Zero_Cost_Exception_Handling is
 333    begin
 334       Check_Mechanism : for A1 in ALIs.First + 1 .. ALIs.Last loop
 335          if ALIs.Table (A1).Zero_Cost_Exceptions /=
 336             ALIs.Table (ALIs.First).Zero_Cost_Exceptions
 337
 338          then
 339             Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 340             Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
 341
 342             Consistency_Error_Msg ("% and % compiled with different "
 343                                             & "exception handling mechanisms");
 344          end if;
 345       end loop Check_Mechanism;
 346    end Check_Consistent_Zero_Cost_Exception_Handling;
 347
 348    ----------------------------------
 349    -- Check_Partition_Restrictions --
 350    ----------------------------------
 351
 352    --  The rule is that if a restriction is specified in any unit,
 353    --  then all units must obey the restriction. The check applies
 354    --  only to restrictions which require partition wide consistency,
 355    --  and not to internal units.
 356
 357    --  The check is done in two steps. First for every restriction
 358    --  a unit specifying that restriction is found, if any.
 359    --  Second, all units are verified against the specified restrictions.
 360
 361    procedure Check_Partition_Restrictions is
 362
 363       R : array (Partition_Restrictions) of ALI_Id := (others => No_ALI_Id);
 364       --  Record the first unit specifying each partition restriction
 365
 366       V : array (Partition_Restrictions) of ALI_Id := (others => No_ALI_Id);
 367       --  Record the last unit violating each partition restriction
 368
 369       procedure List_Applicable_Restrictions;
 370       --  Output a list of restrictions that may be applied to the partition,
 371       --  without causing bind errors.
 372
 373       ----------------------------------
 374       -- List_Applicable_Restrictions --
 375       ----------------------------------
 376
 377       procedure List_Applicable_Restrictions is
 378          Additional_Restrictions_Listed : Boolean := False;
 379
 380       begin
 381          --  List any restrictions which were not violated and not specified
 382
 383          for J in Partition_Restrictions loop
 384             if V (J) = No_ALI_Id and R (J) = No_ALI_Id then
 385                if not Additional_Restrictions_Listed then
 386                   Write_Str ("The following additional restrictions may be" &
 387                              " applied to this partition:");
 388                   Write_Eol;
 389                   Additional_Restrictions_Listed := True;
 390                end if;
 391
 392                Write_Str ("pragma Restrictions (");
 393
 394                declare
 395                   S : constant String := Restriction_Id'Image (J);
 396
 397                begin
 398                   Name_Len := S'Length;
 399                   Name_Buffer (1 .. Name_Len) := S;
 400                end;
 401
 402                Set_Casing (Mixed_Case);
 403                Write_Str (Name_Buffer (1 .. Name_Len));
 404                Write_Str (");");
 405                Write_Eol;
 406             end if;
 407          end loop;
 408       end List_Applicable_Restrictions;
 409
 410    --  Start of processing for Check_Partition_Restrictions
 411
 412    begin
 413       Find_Restrictions :
 414       for A in ALIs.First .. ALIs.Last loop
 415          for J in Partition_Restrictions loop
 416             if R (J) = No_ALI_Id and ALIs.Table (A).Restrictions (J) = 'r' then
 417                R (J) := A;
 418             end if;
 419          end loop;
 420       end loop Find_Restrictions;
 421
 422       Find_Violations :
 423       for A in ALIs.First .. ALIs.Last loop
 424          for J in Partition_Restrictions loop
 425             if ALIs.Table (A).Restrictions (J) = 'v'
 426                and then not Is_Internal_File_Name (ALIs.Table (A).Sfile)
 427             then
 428                --  A violation of a restriction was found, so check whether
 429                --  that restriction was actually in effect. If so, give an
 430                --  error message.
 431
 432                --  Note that all such violations found are reported.
 433
 434                V (J) := A;
 435
 436                if R (J) /= No_ALI_Id then
 437                   Report_Violated_Restriction : declare
 438                      M1 : constant String := "% has Restriction (";
 439                      S  : constant String := Restriction_Id'Image (J);
 440                      M2 : String (1 .. M1'Length + S'Length + 1);
 441
 442                   begin
 443                      Name_Buffer (1 .. S'Length) := S;
 444                      Name_Len := S'Length;
 445                      Set_Casing
 446                        (Units.Table (ALIs.Table (R (J)).First_Unit).Icasing);
 447
 448                      M2 (M1'Range) := M1;
 449                      M2 (M1'Length + 1 .. M2'Last - 1) :=
 450                                                    Name_Buffer (1 .. S'Length);
 451                      M2 (M2'Last) := ')';
 452
 453                      Error_Msg_Name_1 := ALIs.Table (R (J)).Sfile;
 454                      Consistency_Error_Msg (M2);
 455                      Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 456                      Consistency_Error_Msg
 457                        ("but file % violates this restriction");
 458                   end Report_Violated_Restriction;
 459                end if;
 460             end if;
 461          end loop;
 462       end loop Find_Violations;
 463
 464       if Debug_Flag_R then
 465          List_Applicable_Restrictions;
 466       end if;
 467    end Check_Partition_Restrictions;
 468
 469    -----------------------
 470    -- Check_Consistency --
 471    -----------------------
 472
 473    procedure Check_Consistency is
 474       Src : Source_Id;
 475       --  Source file Id for this Sdep entry
 476
 477    begin
 478       --  First, we go through the source table to see if there are any cases
 479       --  in which we should go after source files and compute checksums of
 480       --  the source files. We need to do this for any file for which we have
 481       --  mismatching time stamps and (so far) matching checksums.
 482
 483       for S in Source.First .. Source.Last loop
 484
 485          --  If all time stamps for a file match, then there is nothing to
 486          --  do, since we will not be checking checksums in that case anyway
 487
 488          if Source.Table (S).All_Timestamps_Match then
 489             null;
 490
 491          --  If we did not find the source file, then we can't compute its
 492          --  checksum anyway. Note that when we have a time stamp mismatch,
 493          --  we try to find the source file unconditionally (i.e. if
 494          --  Check_Source_Files is False).
 495
 496          elsif not Source.Table (S).Source_Found then
 497             null;
 498
 499          --  If we already have non-matching or missing checksums, then no
 500          --  need to try going after source file, since we won't trust the
 501          --  checksums in any case.
 502
 503          elsif not Source.Table (S).All_Checksums_Match then
 504             null;
 505
 506          --  Now we have the case where we have time stamp mismatches, and
 507          --  the source file is around, but so far all checksums match. This
 508          --  is the case where we need to compute the checksum from the source
 509          --  file, since otherwise we would ignore the time stamp mismatches,
 510          --  and that is wrong if the checksum of the source does not agree
 511          --  with the checksums in the ALI files.
 512
 513          elsif Check_Source_Files then
 514             if not Checksums_Match
 515               (Source.Table (S).Checksum,
 516                Get_File_Checksum (Source.Table (S).Sfile))
 517             then
 518                Source.Table (S).All_Checksums_Match := False;
 519             end if;
 520          end if;
 521       end loop;
 522
 523       --  Loop through ALI files
 524
 525       ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
 526
 527          --  Loop through Sdep entries in one ALI file
 528
 529          Sdep_Loop : for D in
 530            ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 531          loop
 532             if Sdep.Table (D).Dummy_Entry then
 533                goto Continue;
 534             end if;
 535
 536             Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
 537
 538             --  If the time stamps match, or all checksums match, then we
 539             --  are OK, otherwise we have a definite error.
 540
 541             if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 542               and then not Source.Table (Src).All_Checksums_Match
 543             then
 544                Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 545                Error_Msg_Name_2 := Sdep.Table (D).Sfile;
 546
 547                --  Two styles of message, depending on whether or not
 548                --  the updated file is the one that must be recompiled
 549
 550                if Error_Msg_Name_1 = Error_Msg_Name_2 then
 551                   if Tolerate_Consistency_Errors then
 552                      Error_Msg
 553                         ("?% has been modified and should be recompiled");
 554                   else
 555                      Error_Msg
 556                        ("% has been modified and must be recompiled");
 557                   end if;
 558
 559                else
 560                   if Tolerate_Consistency_Errors then
 561                      Error_Msg
 562                        ("?% should be recompiled (% has been modified)");
 563
 564                   else
 565                      Error_Msg ("% must be recompiled (% has been modified)");
 566                   end if;
 567                end if;
 568
 569                if (not Tolerate_Consistency_Errors) and Verbose_Mode then
 570                   declare
 571                      Msg : constant String := "file % has time stamp ";
 572                      Buf : String (1 .. Msg'Length + Time_Stamp_Length);
 573
 574                   begin
 575                      Buf (1 .. Msg'Length) := Msg;
 576                      Buf (Msg'Length + 1 .. Buf'Length) :=
 577                        String (Source.Table (Src).Stamp);
 578                      Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 579                      Error_Msg (Buf);
 580
 581                      Buf (Msg'Length + 1 .. Buf'Length) :=
 582                        String (Sdep.Table (D).Stamp);
 583                      Error_Msg_Name_1 := Sdep.Table (D).Sfile;
 584                      Error_Msg (Buf);
 585                   end;
 586                end if;
 587
 588                --  Exit from the loop through Sdep entries once we find one
 589                --  that does not match.
 590
 591                exit Sdep_Loop;
 592             end if;
 593
 594          <<Continue>>
 595             null;
 596          end loop Sdep_Loop;
 597       end loop ALIs_Loop;
 598    end Check_Consistency;
 599
 600    -------------------------------
 601    -- Check_Duplicated_Subunits --
 602    -------------------------------
 603
 604    procedure Check_Duplicated_Subunits is
 605    begin
 606       for J in Sdep.First .. Sdep.Last loop
 607          if Sdep.Table (J).Subunit_Name /= No_Name then
 608             Get_Decoded_Name_String (Sdep.Table (J).Subunit_Name);
 609             Name_Len := Name_Len + 2;
 610             Name_Buffer (Name_Len - 1) := '%';
 611
 612             --  See if there is a body or spec with the same name
 613
 614             for K in Boolean loop
 615                if K then
 616                   Name_Buffer (Name_Len) := 'b';
 617
 618                else
 619                   Name_Buffer (Name_Len) := 's';
 620                end if;
 621
 622                declare
 623                   Info : constant Int := Get_Name_Table_Info (Name_Find);
 624
 625                begin
 626                   if Info /= 0 then
 627                      Set_Standard_Error;
 628                      Write_Str ("error: subunit """);
 629                      Write_Name_Decoded (Sdep.Table (J).Subunit_Name);
 630                      Write_Str (""" in file """);
 631                      Write_Name_Decoded (Sdep.Table (J).Sfile);
 632                      Write_Char ('"');
 633                      Write_Eol;
 634                      Write_Str ("       has same name as unit """);
 635                      Write_Unit_Name (Units.Table (Unit_Id (Info)).Uname);
 636                      Write_Str (""" found in file """);
 637                      Write_Name_Decoded (Units.Table (Unit_Id (Info)).Sfile);
 638                      Write_Char ('"');
 639                      Write_Eol;
 640                      Write_Str ("       this is not allowed within a single "
 641                                 & "partition (RM 10.2(19))");
 642                      Write_Eol;
 643                      Osint.Exit_Program (Osint.E_Fatal);
 644                   end if;
 645                end;
 646             end loop;
 647          end if;
 648       end loop;
 649    end Check_Duplicated_Subunits;
 650
 651    --------------------
 652    -- Check_Versions --
 653    --------------------
 654
 655    procedure Check_Versions is
 656       VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
 657
 658    begin
 659       for A in ALIs.First .. ALIs.Last loop
 660          if ALIs.Table (A).Ver_Len /= VL
 661            or else ALIs.Table (A).Ver          (1 .. VL) /=
 662                    ALIs.Table (ALIs.First).Ver (1 .. VL)
 663          then
 664             Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 665             Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
 666
 667             Consistency_Error_Msg
 668                ("% and % compiled with different GNAT versions");
 669          end if;
 670       end loop;
 671    end Check_Versions;
 672
 673    ---------------------------
 674    -- Consistency_Error_Msg --
 675    ---------------------------
 676
 677    procedure Consistency_Error_Msg (Msg : String) is
 678    begin
 679       if Tolerate_Consistency_Errors then
 680
 681          --  If consistency errors are tolerated,
 682          --  output the message as a warning.
 683
 684          declare
 685             Warning_Msg : String (1 .. Msg'Length + 1);
 686
 687          begin
 688             Warning_Msg (1) := '?';
 689             Warning_Msg (2 .. Warning_Msg'Last) := Msg;
 690
 691             Error_Msg (Warning_Msg);
 692          end;
 693
 694       --  Otherwise the consistency error is a true error
 695
 696       else
 697          Error_Msg (Msg);
 698       end if;
 699    end Consistency_Error_Msg;
 700
 701 end Bcheck;