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