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 --          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
  10 --                                                                          --
  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.                                                      --
  21 --                                                                          --
  22 -- GNAT was originally developed  by the GNAT team at  New York University. --
  23 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  24 --                                                                          --
  25 ------------------------------------------------------------------------------
  26
  27 with ALI;      use ALI;
  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;
  34 with Opt;      use Opt;
  35 with Osint;
  36 with Output;   use Output;
  37 with Rident;   use Rident;
  38 with Types;    use Types;
  39
  40 package body Bcheck is
  41
  42    -----------------------
  43    -- Local Subprograms --
  44    -----------------------
  45
  46    --  The following checking subprograms make up the parts of the
  47    --  configuration consistency check.
  48
  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_Partition_Restrictions;
  55    procedure Check_Consistent_Queuing_Policy;
  56    procedure Check_Consistent_Zero_Cost_Exception_Handling;
  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_Consistent_Partition_Restrictions;
  88       Check_Consistent_Interrupt_States;
  89    end Check_Configuration_Consistency;
  90
  91    ---------------------------------------------------
  92    -- Check_Consistent_Dynamic_Elaboration_Checking --
  93    ---------------------------------------------------
  94
  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:
  97
  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)
 102
 103    procedure Check_Consistent_Dynamic_Elaboration_Checking is
 104    begin
 105       if Dynamic_Elaboration_Checks_Specified then
 106          for U in First_Unit_Entry .. Units.Last loop
 107             declare
 108                UR : Unit_Record renames Units.Table (U);
 109
 110             begin
 111                if UR.Dynamic_Elab then
 112                   for W in UR.First_With .. UR.Last_With loop
 113                      declare
 114                         WR : With_Record renames Withs.Table (W);
 115
 116                      begin
 117                         if Get_Name_Table_Info (WR.Uname) /= 0 then
 118                            declare
 119                               WU : Unit_Record renames
 120                                      Units.Table
 121                                        (Unit_Id
 122                                          (Get_Name_Table_Info (WR.Uname)));
 123
 124                            begin
 125                               --  Case 1. Elaborate_All for with'ed unit
 126
 127                               if WR.Elaborate_All then
 128                                  null;
 129
 130                               --  Case 2. With'ed unit has dynamic elab checks
 131
 132                               elsif WU.Dynamic_Elab then
 133                                  null;
 134
 135                               --  Case 3. With'ed unit is Preelaborate or Pure
 136
 137                               elsif WU.Preelab or WU.Pure then
 138                                  null;
 139
 140                               --  Case 4. With'ed unit is internal file
 141
 142                               elsif Is_Internal_File_Name (WU.Sfile) then
 143                                  null;
 144
 145                               --  Issue warning, not one of the safe cases
 146
 147                               else
 148                                  Error_Msg_Name_1 := UR.Sfile;
 149                                  Error_Msg
 150                                    ("?% has dynamic elaboration checks " &
 151                                                                  "and with's");
 152
 153                                  Error_Msg_Name_1 := WU.Sfile;
 154                                  Error_Msg
 155                                    ("?  % which has static elaboration " &
 156                                                                      "checks");
 157
 158                                  Warnings_Detected := Warnings_Detected - 1;
 159                               end if;
 160                            end;
 161                         end if;
 162                      end;
 163                   end loop;
 164                end if;
 165             end;
 166          end loop;
 167       end if;
 168    end Check_Consistent_Dynamic_Elaboration_Checking;
 169
 170    --------------------------------------------
 171    -- Check_Consistent_Floating_Point_Format --
 172    --------------------------------------------
 173
 174    --  The rule is that all files must be compiled with the same setting
 175    --  for the floating-point format.
 176
 177    procedure Check_Consistent_Floating_Point_Format is
 178    begin
 179       --  First search for a unit specifying a floating-point format and then
 180       --  check all remaining units against it.
 181
 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;
 186             begin
 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;
 191
 192                      Consistency_Error_Msg
 193                        ("% and % compiled with different " &
 194                         "floating-point representations");
 195                      exit Find_Format;
 196                   end if;
 197                end loop;
 198             end Check_Format;
 199
 200             exit Find_Format;
 201          end if;
 202       end loop Find_Format;
 203    end Check_Consistent_Floating_Point_Format;
 204
 205    ---------------------------------------
 206    -- Check_Consistent_Interrupt_States --
 207    ---------------------------------------
 208
 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.
 211
 212    procedure Check_Consistent_Interrupt_States is
 213       Max_Intrup : Nat;
 214
 215    begin
 216       --  If no Interrupt_State entries, nothing to do
 217
 218       if Interrupt_States.Last < Interrupt_States.First then
 219          return;
 220       end if;
 221
 222       --  First find out the maximum interrupt value
 223
 224       Max_Intrup := 0;
 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;
 228          end if;
 229       end loop;
 230
 231       --  Now establish tables to be used for consistency checking
 232
 233       declare
 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.
 237
 238          Afile : array (0 .. Max_Intrup) of ALI_Id;
 239          --  ALI file that generated Istate entry for consistency message
 240
 241          Loc : array (0 .. Max_Intrup) of Nat;
 242          --  Line numbers from IS pragma generating Istate entry
 243
 244          Inum : Nat;
 245          --  Interrupt number from entry being tested
 246
 247          Stat : Character;
 248          --  Interrupt state from entry being tested
 249
 250          Lnum : Nat;
 251          --  Line number from entry being tested
 252
 253       begin
 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
 257             loop
 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;
 261
 262                if Istate (Inum) = 'n' then
 263                   Istate (Inum) := Stat;
 264                   Afile  (Inum) := F;
 265                   Loc    (Inum) := Lnum;
 266
 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;
 272
 273                   Consistency_Error_Msg
 274                     ("inconsistent interrupt states at %:# and %:#");
 275                end if;
 276             end loop;
 277          end loop;
 278       end;
 279    end Check_Consistent_Interrupt_States;
 280
 281    -------------------------------------
 282    -- Check_Consistent_Locking_Policy --
 283    -------------------------------------
 284
 285    --  The rule is that all files for which the locking policy is
 286    --  significant must be compiled with the same setting.
 287
 288    procedure Check_Consistent_Locking_Policy is
 289    begin
 290       --  First search for a unit specifying a policy and then
 291       --  check all remaining units against it.
 292
 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;
 297
 298             begin
 299                for A2 in A1 + 1 .. ALIs.Last loop
 300                   if ALIs.Table (A2).Locking_Policy /= ' ' and
 301                      ALIs.Table (A2).Locking_Policy /= Policy
 302                   then
 303                      Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 304                      Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
 305
 306                      Consistency_Error_Msg
 307                        ("% and % compiled with different locking policies");
 308                      exit Find_Policy;
 309                   end if;
 310                end loop;
 311             end Check_Policy;
 312
 313             exit Find_Policy;
 314          end if;
 315       end loop Find_Policy;
 316    end Check_Consistent_Locking_Policy;
 317
 318    ----------------------------------------
 319    -- Check_Consistent_Normalize_Scalars --
 320    ----------------------------------------
 321
 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.
 325
 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.
 332
 333    procedure Check_Consistent_Normalize_Scalars is
 334    begin
 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");
 338
 339          Write_Eol;
 340          Write_Str ("files compiled with Normalize_Scalars");
 341          Write_Eol;
 342
 343          for A1 in ALIs.First .. ALIs.Last loop
 344             if ALIs.Table (A1).Normalize_Scalars then
 345                Write_Str ("  ");
 346                Write_Name (ALIs.Table (A1).Sfile);
 347                Write_Eol;
 348             end if;
 349          end loop;
 350
 351          Write_Eol;
 352          Write_Str ("files compiled without Normalize_Scalars");
 353          Write_Eol;
 354
 355          for A1 in ALIs.First .. ALIs.Last loop
 356             if not ALIs.Table (A1).Normalize_Scalars then
 357                Write_Str ("  ");
 358                Write_Name (ALIs.Table (A1).Sfile);
 359                Write_Eol;
 360             end if;
 361          end loop;
 362       end if;
 363    end Check_Consistent_Normalize_Scalars;
 364
 365    ---------------------------------------------
 366    -- Check_Consistent_Partition_Restrictions --
 367    ---------------------------------------------
 368
 369    --  The rule is that if a restriction is specified in any unit,
 370    --  then all units must obey the restriction. The check applies
 371    --  only to restrictions which require partition wide consistency,
 372    --  and not to internal units.
 373
 374    --  The check is done in two steps. First for every restriction
 375    --  a unit specifying that restriction is found, if any.
 376    --  Second, all units are verified against the specified restrictions.
 377
 378    procedure Check_Consistent_Partition_Restrictions is
 379       No_Restriction_List : constant array (All_Restrictions) of Boolean :=
 380         (No_Implicit_Conditionals => True,
 381          --  This could modify and pessimize generated code
 382
 383          No_Implicit_Dynamic_Code => True,
 384          --  This could modify and pessimize generated code
 385
 386          No_Implicit_Loops        => True,
 387          --  This could modify and pessimize generated code
 388
 389          No_Recursion             => True,
 390          --  Not checkable at compile time
 391
 392          No_Reentrancy            => True,
 393          --  Not checkable at compile time
 394
 395          others                   => False);
 396       --  Define those restrictions that should be output if the gnatbind -r
 397       --  switch is used. Not all restrictions are output for the reasons given
 398       --  above in the list, and this array is used to test whether the
 399       --  corresponding pragma should be listed. True means that it should not
 400       --  be listed.
 401
 402       R : array (All_Restrictions) of ALI_Id := (others => No_ALI_Id);
 403       --  Record the first unit specifying each compilation unit restriction
 404
 405       V : array (All_Restrictions) of ALI_Id := (others => No_ALI_Id);
 406       --  Record the last unit violating each partition restriction. Note
 407       --  that entries in this array that do not correspond to partition
 408       --  restrictions can never be modified.
 409
 410       Additional_Restrictions_Listed : Boolean := False;
 411       --  Set True if we have listed header for restrictions
 412
 413    begin
 414       --  Loop to find restrictions
 415
 416       for A in ALIs.First .. ALIs.Last loop
 417          for J in All_Restrictions loop
 418             if R (J) = No_ALI_Id and ALIs.Table (A).Restrictions (J) = 'r' then
 419                R (J) := A;
 420             end if;
 421          end loop;
 422       end loop;
 423
 424       --  Loop to find violations
 425
 426       for A in ALIs.First .. ALIs.Last loop
 427          for J in All_Restrictions loop
 428             if ALIs.Table (A).Restrictions (J) = 'v'
 429                and then not Is_Internal_File_Name (ALIs.Table (A).Sfile)
 430             then
 431                --  A violation of a restriction was found
 432
 433                V (J) := A;
 434
 435                --  If this is a paritition restriction, and the restriction
 436                --  was specified in some unit in the partition, then this
 437                --  is a violation of the consistency requirement, so we
 438                --  generate an appropriate error message.
 439
 440                if R (J) /= No_ALI_Id
 441                  and then J in Partition_Restrictions
 442                then
 443                   declare
 444                      M1 : constant String := "% has Restriction (";
 445                      S  : constant String := Restriction_Id'Image (J);
 446                      M2 : String (1 .. M1'Length + S'Length + 1);
 447
 448                   begin
 449                      Name_Buffer (1 .. S'Length) := S;
 450                      Name_Len := S'Length;
 451                      Set_Casing
 452                        (Units.Table (ALIs.Table (R (J)).First_Unit).Icasing);
 453
 454                      M2 (M1'Range) := M1;
 455                      M2 (M1'Length + 1 .. M2'Last - 1) :=
 456                                                    Name_Buffer (1 .. S'Length);
 457                      M2 (M2'Last) := ')';
 458
 459                      Error_Msg_Name_1 := ALIs.Table (R (J)).Sfile;
 460                      Consistency_Error_Msg (M2);
 461                      Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 462                      Consistency_Error_Msg
 463                        ("but file % violates this restriction");
 464                   end;
 465                end if;
 466             end if;
 467          end loop;
 468       end loop;
 469
 470       --  List applicable restrictions if option set
 471
 472       if List_Restrictions then
 473
 474          --  List any restrictions which were not violated and not specified
 475
 476          for J in All_Restrictions loop
 477             if V (J) = No_ALI_Id
 478               and then R (J) = No_ALI_Id
 479               and then not No_Restriction_List (J)
 480             then
 481                if not Additional_Restrictions_Listed then
 482                   Write_Eol;
 483                   Write_Line
 484                     ("The following additional restrictions may be" &
 485                      " applied to this partition:");
 486                   Additional_Restrictions_Listed := True;
 487                end if;
 488
 489                Write_Str ("pragma Restrictions (");
 490
 491                declare
 492                   S : constant String := Restriction_Id'Image (J);
 493                begin
 494                   Name_Len := S'Length;
 495                   Name_Buffer (1 .. Name_Len) := S;
 496                end;
 497
 498                Set_Casing (Mixed_Case);
 499                Write_Str (Name_Buffer (1 .. Name_Len));
 500                Write_Str (");");
 501                Write_Eol;
 502             end if;
 503          end loop;
 504       end if;
 505    end Check_Consistent_Partition_Restrictions;
 506
 507    -------------------------------------
 508    -- Check_Consistent_Queuing_Policy --
 509    -------------------------------------
 510
 511    --  The rule is that all files for which the queuing policy is
 512    --  significant must be compiled with the same setting.
 513
 514    procedure Check_Consistent_Queuing_Policy is
 515    begin
 516       --  First search for a unit specifying a policy and then
 517       --  check all remaining units against it.
 518
 519       Find_Policy : for A1 in ALIs.First .. ALIs.Last loop
 520          if ALIs.Table (A1).Queuing_Policy /= ' ' then
 521             Check_Policy : declare
 522                Policy : constant Character := ALIs.Table (A1).Queuing_Policy;
 523             begin
 524                for A2 in A1 + 1 .. ALIs.Last loop
 525                   if ALIs.Table (A2).Queuing_Policy /= ' '
 526                        and then
 527                      ALIs.Table (A2).Queuing_Policy /= Policy
 528                   then
 529                      Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 530                      Error_Msg_Name_2 := ALIs.Table (A2).Sfile;
 531
 532                      Consistency_Error_Msg
 533                        ("% and % compiled with different queuing policies");
 534                      exit Find_Policy;
 535                   end if;
 536                end loop;
 537             end Check_Policy;
 538
 539             exit Find_Policy;
 540          end if;
 541       end loop Find_Policy;
 542    end Check_Consistent_Queuing_Policy;
 543
 544    ---------------------------------------------------
 545    -- Check_Consistent_Zero_Cost_Exception_Handling --
 546    ---------------------------------------------------
 547
 548    --  Check consistent zero cost exception handling. The rule is that
 549    --  all units must have the same exception handling mechanism.
 550
 551    procedure Check_Consistent_Zero_Cost_Exception_Handling is
 552    begin
 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
 556
 557          then
 558             Error_Msg_Name_1 := ALIs.Table (A1).Sfile;
 559             Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
 560
 561             Consistency_Error_Msg ("% and % compiled with different "
 562                                             & "exception handling mechanisms");
 563          end if;
 564       end loop Check_Mechanism;
 565    end Check_Consistent_Zero_Cost_Exception_Handling;
 566
 567    -----------------------
 568    -- Check_Consistency --
 569    -----------------------
 570
 571    procedure Check_Consistency is
 572       Src : Source_Id;
 573       --  Source file Id for this Sdep entry
 574
 575    begin
 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.
 580
 581       for S in Source.First .. Source.Last loop
 582
 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
 585
 586          if Source.Table (S).All_Timestamps_Match then
 587             null;
 588
 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).
 593
 594          elsif not Source.Table (S).Source_Found then
 595             null;
 596
 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.
 600
 601          elsif not Source.Table (S).All_Checksums_Match then
 602             null;
 603
 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.
 610
 611          elsif Check_Source_Files then
 612             if not Checksums_Match
 613               (Source.Table (S).Checksum,
 614                Get_File_Checksum (Source.Table (S).Sfile))
 615             then
 616                Source.Table (S).All_Checksums_Match := False;
 617             end if;
 618          end if;
 619       end loop;
 620
 621       --  Loop through ALI files
 622
 623       ALIs_Loop : for A in ALIs.First .. ALIs.Last loop
 624
 625          --  Loop through Sdep entries in one ALI file
 626
 627          Sdep_Loop : for D in
 628            ALIs.Table (A).First_Sdep .. ALIs.Table (A).Last_Sdep
 629          loop
 630             if Sdep.Table (D).Dummy_Entry then
 631                goto Continue;
 632             end if;
 633
 634             Src := Source_Id (Get_Name_Table_Info (Sdep.Table (D).Sfile));
 635
 636             --  If the time stamps match, or all checksums match, then we
 637             --  are OK, otherwise we have a definite error.
 638
 639             if Sdep.Table (D).Stamp /= Source.Table (Src).Stamp
 640               and then not Source.Table (Src).All_Checksums_Match
 641             then
 642                Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 643                Error_Msg_Name_2 := Sdep.Table (D).Sfile;
 644
 645                --  Two styles of message, depending on whether or not
 646                --  the updated file is the one that must be recompiled
 647
 648                if Error_Msg_Name_1 = Error_Msg_Name_2 then
 649                   if Tolerate_Consistency_Errors then
 650                      Error_Msg
 651                         ("?% has been modified and should be recompiled");
 652                   else
 653                      Error_Msg
 654                        ("% has been modified and must be recompiled");
 655                   end if;
 656
 657                else
 658                   if Osint.Is_Readonly_Library (ALIs.Table (A).Afile) then
 659                      Error_Msg_Name_2 :=
 660                        Osint.Find_File ((ALIs.Table (A).Afile), Osint.Library);
 661
 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)");
 666
 667                      else
 668                         Error_Msg ("% must be compiled");
 669                         Error_Msg_Name_1 := Error_Msg_Name_2;
 670                         Error_Msg ("(% is obsolete and read-only)");
 671                      end if;
 672
 673                   elsif Tolerate_Consistency_Errors then
 674                      Error_Msg
 675                        ("?% should be recompiled (% has been modified)");
 676
 677                   else
 678                      Error_Msg ("% must be recompiled (% has been modified)");
 679                   end if;
 680                end if;
 681
 682                if (not Tolerate_Consistency_Errors) and Verbose_Mode then
 683                   declare
 684                      Msg : constant String := "% time stamp ";
 685                      Buf : String (1 .. Msg'Length + Time_Stamp_Length);
 686
 687                   begin
 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;
 692                      Error_Msg (Buf);
 693                   end;
 694
 695                   declare
 696                      Msg : constant String := " conflicts with % timestamp ";
 697                      Buf : String (1 .. Msg'Length + Time_Stamp_Length);
 698
 699                   begin
 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;
 704                      Error_Msg (Buf);
 705                   end;
 706                end if;
 707
 708                --  Exit from the loop through Sdep entries once we find one
 709                --  that does not match.
 710
 711                exit Sdep_Loop;
 712             end if;
 713
 714          <<Continue>>
 715             null;
 716          end loop Sdep_Loop;
 717       end loop ALIs_Loop;
 718    end Check_Consistency;
 719
 720    -------------------------------
 721    -- Check_Duplicated_Subunits --
 722    -------------------------------
 723
 724    procedure Check_Duplicated_Subunits is
 725    begin
 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) := '%';
 731
 732             --  See if there is a body or spec with the same name
 733
 734             for K in Boolean loop
 735                if K then
 736                   Name_Buffer (Name_Len) := 'b';
 737
 738                else
 739                   Name_Buffer (Name_Len) := 's';
 740                end if;
 741
 742                declare
 743                   Info : constant Int := Get_Name_Table_Info (Name_Find);
 744
 745                begin
 746                   if Info /= 0 then
 747                      Set_Standard_Error;
 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);
 752                      Write_Char ('"');
 753                      Write_Eol;
 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);
 758                      Write_Char ('"');
 759                      Write_Eol;
 760                      Write_Str ("       this is not allowed within a single "
 761                                 & "partition (RM 10.2(19))");
 762                      Write_Eol;
 763                      Osint.Exit_Program (Osint.E_Fatal);
 764                   end if;
 765                end;
 766             end loop;
 767          end if;
 768       end loop;
 769    end Check_Duplicated_Subunits;
 770
 771    --------------------
 772    -- Check_Versions --
 773    --------------------
 774
 775    procedure Check_Versions is
 776       VL : constant Natural := ALIs.Table (ALIs.First).Ver_Len;
 777
 778    begin
 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)
 783          then
 784             Error_Msg_Name_1 := ALIs.Table (A).Sfile;
 785             Error_Msg_Name_2 := ALIs.Table (ALIs.First).Sfile;
 786
 787             Consistency_Error_Msg
 788                ("% and % compiled with different GNAT versions");
 789          end if;
 790       end loop;
 791    end Check_Versions;
 792
 793    ---------------------------
 794    -- Consistency_Error_Msg --
 795    ---------------------------
 796
 797    procedure Consistency_Error_Msg (Msg : String) is
 798    begin
 799       if Tolerate_Consistency_Errors then
 800
 801          --  If consistency errors are tolerated,
 802          --  output the message as a warning.
 803
 804          declare
 805             Warning_Msg : String (1 .. Msg'Length + 1);
 806
 807          begin
 808             Warning_Msg (1) := '?';
 809             Warning_Msg (2 .. Warning_Msg'Last) := Msg;
 810
 811             Error_Msg (Warning_Msg);
 812          end;
 813
 814       --  Otherwise the consistency error is a true error
 815
 816       else
 817          Error_Msg (Msg);
 818       end if;
 819    end Consistency_Error_Msg;
 820
 821 end Bcheck;