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 27with ALI; use ALI; 28with ALI.Util; use ALI.Util; 29with Binderr; use Binderr; 30with Butil; use Butil; 31with Casing; use Casing; 32with Fname; use Fname; 33with Namet; use Namet; 34with Opt; use Opt; 35with Osint; 36with Output; use Output; 37with Rident; use Rident; 38with Types; use Types; 39 40package 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 821end Bcheck; 822