1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S E M _ W A R N -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1999-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 Alloc; 28with Atree; use Atree; 29with Einfo; use Einfo; 30with Errout; use Errout; 31with Fname; use Fname; 32with Lib; use Lib; 33with Nlists; use Nlists; 34with Opt; use Opt; 35with Sem; use Sem; 36with Sem_Ch8; use Sem_Ch8; 37with Sem_Util; use Sem_Util; 38with Sinfo; use Sinfo; 39with Sinput; use Sinput; 40with Snames; use Snames; 41with Stand; use Stand; 42with Table; 43 44package body Sem_Warn is 45 46 -- The following table collects Id's of entities that are potentially 47 -- unreferenced. See Check_Unset_Reference for further details. 48 49 package Unreferenced_Entities is new Table.Table ( 50 Table_Component_Type => Entity_Id, 51 Table_Index_Type => Nat, 52 Table_Low_Bound => 1, 53 Table_Initial => Alloc.Unreferenced_Entities_Initial, 54 Table_Increment => Alloc.Unreferenced_Entities_Increment, 55 Table_Name => "Unreferenced_Entities"); 56 57 ------------------------------ 58 -- Handling of Conditionals -- 59 ------------------------------ 60 61 -- Note: this is work in progress, the data structures and general 62 -- approach are defined, but are not in use yet. ??? 63 64 -- One entry is made in the following table for each branch of 65 -- a conditional, e.g. an if-then-elsif-else-endif structure 66 -- creates three entries in this table. 67 68 type Branch_Entry is record 69 Sloc : Source_Ptr; 70 -- Location for warnings associated with this branch 71 72 Defs : Elist_Id; 73 -- List of entities defined for the first time in this branch. On 74 -- exit from a conditional structure, any entity that is in the 75 -- list of all branches is removed (and the entity flagged as 76 -- defined by the conditional as a whole). Thus after processing 77 -- a conditional, Defs contains a list of entities defined in this 78 -- branch for the first time, but not defined at all in some other 79 -- branch of the same conditional. A value of No_Elist is used to 80 -- represent the initial empty list. 81 82 Next : Nat; 83 -- Index of next branch for this conditional, zero = last branch 84 end record; 85 86 package Branch_Table is new Table.Table ( 87 Table_Component_Type => Branch_Entry, 88 Table_Index_Type => Nat, 89 Table_Low_Bound => 1, 90 Table_Initial => Alloc.Branches_Initial, 91 Table_Increment => Alloc.Branches_Increment, 92 Table_Name => "Branches"); 93 94 -- The following table is used to represent conditionals, there is 95 -- one entry in this table for each conditional structure. 96 97 type Conditional_Entry is record 98 If_Stmt : Boolean; 99 -- True for IF statement, False for CASE statement 100 101 First_Branch : Nat; 102 -- Index in Branch table of first branch, zero = none yet 103 104 Current_Branch : Nat; 105 -- Index in Branch table of current branch, zero = none yet 106 end record; 107 108 package Conditional_Table is new Table.Table ( 109 Table_Component_Type => Conditional_Entry, 110 Table_Index_Type => Nat, 111 Table_Low_Bound => 1, 112 Table_Initial => Alloc.Conditionals_Initial, 113 Table_Increment => Alloc.Conditionals_Increment, 114 Table_Name => "Conditionals"); 115 116 -- The following table is a stack that keeps track of the current 117 -- conditional. The Last entry is the top of the stack. An Empty 118 -- entry represents the start of a compilation unit. Non-zero 119 -- entries in the stack are indexes into the conditional table. 120 121 package Conditional_Stack is new Table.Table ( 122 Table_Component_Type => Nat, 123 Table_Index_Type => Nat, 124 Table_Low_Bound => 1, 125 Table_Initial => Alloc.Conditional_Stack_Initial, 126 Table_Increment => Alloc.Conditional_Stack_Increment, 127 Table_Name => "Conditional_Stack"); 128 129 pragma Warnings (Off, Branch_Table); 130 pragma Warnings (Off, Conditional_Table); 131 pragma Warnings (Off, Conditional_Stack); 132 -- Not yet referenced, see note above ??? 133 134 ----------------------- 135 -- Local Subprograms -- 136 ----------------------- 137 138 function Generic_Package_Spec_Entity (E : Entity_Id) return Boolean; 139 -- This returns true if the entity E is declared within a generic package. 140 -- The point of this is to detect variables which are not assigned within 141 -- the generic, but might be assigned outside the package for any given 142 -- instance. These are cases where we leave the warnings to be posted 143 -- for the instance, when we will know more. 144 145 function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean; 146 -- This function traverses the expression tree represented by the node 147 -- N and determines if any sub-operand is a reference to an entity for 148 -- which the Warnings_Off flag is set. True is returned if such an 149 -- entity is encountered, and False otherwise. 150 151 ---------------------- 152 -- Check_References -- 153 ---------------------- 154 155 procedure Check_References (E : Entity_Id; Anod : Node_Id := Empty) is 156 E1 : Entity_Id; 157 UR : Node_Id; 158 159 function Missing_Subunits return Boolean; 160 -- We suppress warnings when there are missing subunits, because this 161 -- may generate too many false positives: entities in a parent may 162 -- only be referenced in one of the subunits. We make an exception 163 -- for subunits that contain no other stubs. 164 165 procedure Output_Reference_Error (M : String); 166 -- Used to output an error message. Deals with posting the error on 167 -- the body formal in the accept case. 168 169 function Publicly_Referenceable (Ent : Entity_Id) return Boolean; 170 -- This is true if the entity in question is potentially referenceable 171 -- from another unit. This is true for entities in packages that are 172 -- at the library level. 173 174 ----------------------- 175 -- Missing_Subunits -- 176 ----------------------- 177 178 function Missing_Subunits return Boolean is 179 D : Node_Id; 180 181 begin 182 if not Unloaded_Subunits then 183 184 -- Normal compilation, all subunits are present 185 186 return False; 187 188 elsif E /= Main_Unit_Entity then 189 190 -- No warnings on a stub that is not the main unit 191 192 return True; 193 194 elsif Nkind (Unit_Declaration_Node (E)) in N_Proper_Body then 195 D := First (Declarations (Unit_Declaration_Node (E))); 196 197 while Present (D) loop 198 199 -- No warnings if the proper body contains nested stubs 200 201 if Nkind (D) in N_Body_Stub then 202 return True; 203 end if; 204 205 Next (D); 206 end loop; 207 208 return False; 209 210 else 211 -- Missing stubs elsewhere 212 213 return True; 214 end if; 215 end Missing_Subunits; 216 217 ---------------------------- 218 -- Output_Reference_Error -- 219 ---------------------------- 220 221 procedure Output_Reference_Error (M : String) is 222 begin 223 -- Other than accept case, post error on defining identifier 224 225 if No (Anod) then 226 Error_Msg_N (M, E1); 227 228 -- Accept case, find body formal to post the message 229 230 else 231 declare 232 Parm : Node_Id; 233 Enod : Node_Id; 234 Defid : Entity_Id; 235 236 begin 237 Enod := Anod; 238 239 if Present (Parameter_Specifications (Anod)) then 240 Parm := First (Parameter_Specifications (Anod)); 241 242 while Present (Parm) loop 243 Defid := Defining_Identifier (Parm); 244 245 if Chars (E1) = Chars (Defid) then 246 Enod := Defid; 247 exit; 248 end if; 249 250 Next (Parm); 251 end loop; 252 end if; 253 254 Error_Msg_NE (M, Enod, E1); 255 end; 256 end if; 257 end Output_Reference_Error; 258 259 ---------------------------- 260 -- Publicly_Referenceable -- 261 ---------------------------- 262 263 function Publicly_Referenceable (Ent : Entity_Id) return Boolean is 264 P : Node_Id; 265 Prev : Node_Id; 266 267 begin 268 -- Examine parents to look for a library level package spec 269 -- But if we find a body or block or other similar construct 270 -- along the way, we cannot be referenced. 271 272 Prev := Ent; 273 P := Parent (Ent); 274 loop 275 case Nkind (P) is 276 277 -- If we get to top of tree, then publicly referenceable 278 279 when N_Empty => 280 return True; 281 282 -- If we reach a generic package declaration, then always 283 -- consider this referenceable, since any instantiation will 284 -- have access to the entities in the generic package. Note 285 -- that the package itself may not be instantiated, but then 286 -- we will get a warning for the package entity 287 -- Note that generic formal parameters are themselves not 288 -- publicly referenceable in an instance, and warnings on 289 -- them are useful. 290 291 when N_Generic_Package_Declaration => 292 return 293 not Is_List_Member (Prev) 294 or else List_Containing (Prev) 295 /= Generic_Formal_Declarations (P); 296 297 -- if we reach a subprogram body, entity is not referenceable 298 -- unless it is the defining entity of the body. This will 299 -- happen, e.g. when a function is an attribute renaming that 300 -- is rewritten as a body. 301 302 when N_Subprogram_Body => 303 if Ent /= Defining_Entity (P) then 304 return False; 305 else 306 P := Parent (P); 307 end if; 308 309 -- If we reach any other body, definitely not referenceable 310 311 when N_Package_Body | 312 N_Task_Body | 313 N_Entry_Body | 314 N_Protected_Body | 315 N_Block_Statement | 316 N_Subunit => 317 return False; 318 319 -- For all other cases, keep looking up tree 320 321 when others => 322 Prev := P; 323 P := Parent (P); 324 end case; 325 end loop; 326 end Publicly_Referenceable; 327 328 -- Start of processing for Check_References 329 330 begin 331 -- No messages if warnings are suppressed, or if we have detected 332 -- any real errors so far (this last check avoids junk messages 333 -- resulting from errors, e.g. a subunit that is not loaded). 334 335 if Warning_Mode = Suppress 336 or else Serious_Errors_Detected /= 0 337 then 338 return; 339 end if; 340 341 -- We also skip the messages if any subunits were not loaded (see 342 -- comment in Sem_Ch10 to understand how this is set, and why it is 343 -- necessary to suppress the warnings in this case). 344 345 if Missing_Subunits then 346 return; 347 end if; 348 349 -- Otherwise loop through entities, looking for suspicious stuff 350 351 E1 := First_Entity (E); 352 while Present (E1) loop 353 354 -- We only look at source entities with warning flag off 355 356 if Comes_From_Source (E1) and then not Warnings_Off (E1) then 357 358 -- We are interested in variables and out parameters, but we 359 -- exclude protected types, too complicated to worry about. 360 361 if Ekind (E1) = E_Variable 362 or else 363 (Ekind (E1) = E_Out_Parameter 364 and then not Is_Protected_Type (Current_Scope)) 365 then 366 -- Post warning if this object not assigned. Note that we 367 -- do not consider the implicit initialization of an access 368 -- type to be the assignment of a value for this purpose. 369 370 -- If the entity is an out parameter of the current subprogram 371 -- body, check the warning status of the parameter in the spec. 372 373 if Ekind (E1) = E_Out_Parameter 374 and then Present (Spec_Entity (E1)) 375 and then Warnings_Off (Spec_Entity (E1)) 376 then 377 null; 378 379 elsif Never_Set_In_Source (E1) 380 and then not Generic_Package_Spec_Entity (E1) 381 then 382 if Warn_On_No_Value_Assigned then 383 384 -- Do not output complaint about never being assigned a 385 -- value if a pragma Unreferenced applies to the variable 386 -- or if it is a parameter, to the corresponding spec. 387 388 if Has_Pragma_Unreferenced (E1) 389 or else (Is_Formal (E1) 390 and then Present (Spec_Entity (E1)) 391 and then 392 Has_Pragma_Unreferenced (Spec_Entity (E1))) 393 then 394 null; 395 396 -- Pragma Unreferenced not set, so output message 397 398 else 399 Output_Reference_Error 400 ("& is never assigned a value?"); 401 402 -- Deal with special case where this variable is 403 -- hidden by a loop variable 404 405 if Ekind (E1) = E_Variable 406 and then Present (Hiding_Loop_Variable (E1)) 407 then 408 Error_Msg_Sloc := Sloc (E1); 409 Error_Msg_N 410 ("declaration hides &#?", 411 Hiding_Loop_Variable (E1)); 412 Error_Msg_N 413 ("for loop implicitly declares loop variable?", 414 Hiding_Loop_Variable (E1)); 415 end if; 416 end if; 417 end if; 418 goto Continue; 419 420 -- Case of variable that could be a constant. Note that we 421 -- never signal such messages for generic package entities, 422 -- since a given instance could have modifications outside 423 -- the package. 424 425 elsif Warn_On_Constant 426 and then Ekind (E1) = E_Variable 427 and then Is_True_Constant (E1) 428 and then not Generic_Package_Spec_Entity (E1) 429 then 430 Error_Msg_N 431 ("& is not modified, could be declared constant?", E1); 432 end if; 433 434 -- Check for unset reference, note that we exclude access 435 -- types from this check, since access types do always have 436 -- a null value, and that seems legitimate in this case. 437 438 if Ekind (E1) = E_Out_Parameter 439 and then Present (Spec_Entity (E1)) 440 then 441 UR := Unset_Reference (Spec_Entity (E1)); 442 else 443 UR := Unset_Reference (E1); 444 end if; 445 446 if Warn_On_No_Value_Assigned and then Present (UR) then 447 448 -- For access types, the only time we made a UR entry 449 -- was for a dereference, and so we post the appropriate 450 -- warning here. The issue is not that the value is not 451 -- initialized here, but that it is null. 452 453 if Is_Access_Type (Etype (E1)) then 454 Error_Msg_NE ("& may be null?", UR, E1); 455 goto Continue; 456 457 -- For other than access type, go back to original node 458 -- to deal with case where original unset reference 459 -- has been rewritten during expansion. 460 461 else 462 UR := Original_Node (UR); 463 464 -- In some cases, the original node may be a type 465 -- conversion or qualification, and in this case 466 -- we want the object entity inside. 467 468 while Nkind (UR) = N_Type_Conversion 469 or else Nkind (UR) = N_Qualified_Expression 470 loop 471 UR := Expression (UR); 472 end loop; 473 474 -- Here we issue the warning, all checks completed 475 476 if Nkind (Parent (UR)) = N_Selected_Component then 477 Error_Msg_Node_2 := Selector_Name (Parent (UR)); 478 Error_Msg_N 479 ("`&.&` may be referenced before it has a value?", 480 UR); 481 else 482 Error_Msg_N 483 ("& may be referenced before it has a value?", 484 UR); 485 end if; 486 487 goto Continue; 488 end if; 489 end if; 490 end if; 491 492 -- Then check for unreferenced entities. Note that we are only 493 -- interested in entities which do not have the Referenced flag 494 -- set. The Referenced_As_LHS flag is interesting only if the 495 -- Referenced flag is not set. 496 497 if not Referenced (E1) 498 499 -- Check that warnings on unreferenced entities are enabled 500 501 and then ((Check_Unreferenced and then not Is_Formal (E1)) 502 or else 503 (Check_Unreferenced_Formals and then Is_Formal (E1)) 504 or else 505 (Warn_On_Modified_Unread 506 and then Referenced_As_LHS (E1))) 507 508 -- Labels, and enumeration literals, and exceptions. The 509 -- warnings are also placed on local packages that cannot 510 -- be referenced from elsewhere, including those declared 511 -- within a package body. 512 513 and then (Is_Object (E1) 514 or else 515 Is_Type (E1) 516 or else 517 Ekind (E1) = E_Label 518 or else 519 Ekind (E1) = E_Exception 520 or else 521 Ekind (E1) = E_Named_Integer 522 or else 523 Ekind (E1) = E_Named_Real 524 or else 525 Is_Overloadable (E1) 526 or else 527 (Ekind (E1) = E_Package 528 and then 529 (Ekind (E) = E_Function 530 or else Ekind (E) = E_Package_Body 531 or else Ekind (E) = E_Procedure 532 or else Ekind (E) = E_Block))) 533 534 -- Exclude instantiations, since there is no reason why 535 -- every entity in an instantiation should be referenced. 536 537 and then Instantiation_Location (Sloc (E1)) = No_Location 538 539 -- Exclude formal parameters from bodies if the corresponding 540 -- spec entity has been referenced in the case where there is 541 -- a separate spec. 542 543 and then not (Is_Formal (E1) 544 and then 545 Ekind (Scope (E1)) = E_Subprogram_Body 546 and then 547 Present (Spec_Entity (E1)) 548 and then 549 Referenced (Spec_Entity (E1))) 550 551 -- Consider private type referenced if full view is referenced 552 -- If there is not full view, this is a generic type on which 553 -- warnings are also useful. 554 555 and then 556 not (Is_Private_Type (E1) 557 and then 558 Present (Full_View (E1)) 559 and then Referenced (Full_View (E1))) 560 561 -- Don't worry about full view, only about private type 562 563 and then not Has_Private_Declaration (E1) 564 565 -- Eliminate dispatching operations from consideration, we 566 -- cannot tell if these are referenced or not in any easy 567 -- manner (note this also catches Adjust/Finalize/Initialize) 568 569 and then not Is_Dispatching_Operation (E1) 570 571 -- Check entity that can be publicly referenced (we do not 572 -- give messages for such entities, since there could be 573 -- other units, not involved in this compilation, that 574 -- contain relevant references. 575 576 and then not Publicly_Referenceable (E1) 577 578 -- Class wide types are marked as source entities, but 579 -- they are not really source entities, and are always 580 -- created, so we do not care if they are not referenced. 581 582 and then Ekind (E1) /= E_Class_Wide_Type 583 584 -- Objects other than parameters of task types are allowed 585 -- to be non-referenced, since they start up tasks! 586 587 and then ((Ekind (E1) /= E_Variable 588 and then Ekind (E1) /= E_Constant 589 and then Ekind (E1) /= E_Component) 590 or else not Is_Task_Type (Etype (E1))) 591 592 -- For subunits, only place warnings on the main unit 593 -- itself, since parent units are not completely compiled 594 595 and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit 596 or else 597 Get_Source_Unit (E1) = Main_Unit) 598 then 599 -- Suppress warnings in internal units if not in -gnatg 600 -- mode (these would be junk warnings for an applications 601 -- program, since they refer to problems in internal units) 602 603 if GNAT_Mode 604 or else not 605 Is_Internal_File_Name 606 (Unit_File_Name (Get_Source_Unit (E1))) 607 then 608 -- We do not immediately flag the error. This is because 609 -- we have not expanded generic bodies yet, and they may 610 -- have the missing reference. So instead we park the 611 -- entity on a list, for later processing. However, for 612 -- the accept case, post the error right here, since we 613 -- have the information now in this case. 614 615 if Present (Anod) then 616 Output_Reference_Error ("& is not referenced?"); 617 618 else 619 Unreferenced_Entities.Increment_Last; 620 Unreferenced_Entities.Table 621 (Unreferenced_Entities.Last) := E1; 622 end if; 623 end if; 624 625 -- Generic units are referenced in the generic body, 626 -- but if they are not public and never instantiated 627 -- we want to force a warning on them. We treat them 628 -- as redundant constructs to minimize noise. 629 630 elsif Is_Generic_Subprogram (E1) 631 and then not Is_Instantiated (E1) 632 and then not Publicly_Referenceable (E1) 633 and then Instantiation_Depth (Sloc (E1)) = 0 634 and then Warn_On_Redundant_Constructs 635 then 636 Unreferenced_Entities.Increment_Last; 637 Unreferenced_Entities.Table (Unreferenced_Entities.Last) := E1; 638 639 -- Force warning on entity. 640 641 Set_Referenced (E1, False); 642 end if; 643 end if; 644 645 -- Recurse into nested package or block. Do not recurse into a 646 -- formal package, because the correponding body is not analyzed. 647 648 <<Continue>> 649 if ((Ekind (E1) = E_Package or else Ekind (E1) = E_Generic_Package) 650 and then Nkind (Parent (E1)) = N_Package_Specification 651 and then 652 Nkind (Original_Node (Unit_Declaration_Node (E1))) 653 /= N_Formal_Package_Declaration) 654 655 or else Ekind (E1) = E_Block 656 then 657 Check_References (E1); 658 end if; 659 660 Next_Entity (E1); 661 end loop; 662 end Check_References; 663 664 --------------------------- 665 -- Check_Unset_Reference -- 666 --------------------------- 667 668 procedure Check_Unset_Reference (N : Node_Id) is 669 begin 670 -- Nothing to do if warnings suppressed 671 672 if Warning_Mode = Suppress then 673 return; 674 end if; 675 676 -- Ignore reference to non-scalar if not from source. Almost always 677 -- such references are bogus (e.g. calls to init procs to set 678 -- default discriminant values). 679 680 if not Comes_From_Source (N) 681 and then not Is_Scalar_Type (Etype (N)) 682 then 683 return; 684 end if; 685 686 -- Otherwise see what kind of node we have. If the entity already 687 -- has an unset reference, it is not necessarily the earliest in 688 -- the text, because resolution of the prefix of selected components 689 -- is completed before the resolution of the selected component itself. 690 -- as a result, given (R /= null and then R.X > 0), the occurrences 691 -- of R are examined in right-to-left order. If there is already an 692 -- unset reference, we check whether N is earlier before proceeding. 693 694 case Nkind (N) is 695 when N_Identifier | N_Expanded_Name => 696 declare 697 E : constant Entity_Id := Entity (N); 698 699 begin 700 if (Ekind (E) = E_Variable 701 or else Ekind (E) = E_Out_Parameter) 702 and then Never_Set_In_Source (E) 703 and then (No (Unset_Reference (E)) 704 or else Earlier_In_Extended_Unit 705 (Sloc (N), Sloc (Unset_Reference (E)))) 706 and then not Warnings_Off (E) 707 then 708 -- We may have an unset reference. The first test is 709 -- whether we are accessing a discriminant of a record 710 -- or a component with default initialization. Both of 711 -- these cases can be ignored, since the actual object 712 -- that is referenced is definitely initialized. Note 713 -- that this covers the case of reading discriminants 714 -- of an out parameter, which is OK even in Ada 83. 715 716 -- Note that we are only interested in a direct reference 717 -- to a record component here. If the reference is via an 718 -- access type, then the access object is being referenced, 719 -- not the record, and still deserves an unset reference. 720 721 if Nkind (Parent (N)) = N_Selected_Component 722 and not Is_Access_Type (Etype (N)) 723 then 724 declare 725 ES : constant Entity_Id := 726 Entity (Selector_Name (Parent (N))); 727 728 begin 729 if Ekind (ES) = E_Discriminant 730 or else Present (Expression (Declaration_Node (ES))) 731 then 732 return; 733 end if; 734 end; 735 end if; 736 737 -- Here we have a potential unset reference. But before we 738 -- get worried about it, we have to make sure that the 739 -- entity declaration is in the same procedure as the 740 -- reference, since if they are in separate procedures, 741 -- then we have no idea about sequential execution. 742 743 -- The tests in the loop below catch all such cases, but 744 -- do allow the reference to appear in a loop, block, or 745 -- package spec that is nested within the declaring scope. 746 -- As always, it is possible to construct cases where the 747 -- warning is wrong, that is why it is a warning! 748 749 declare 750 SR : Entity_Id; 751 SE : constant Entity_Id := Scope (E); 752 753 begin 754 SR := Current_Scope; 755 while SR /= SE loop 756 if SR = Standard_Standard 757 or else Is_Subprogram (SR) 758 or else Is_Concurrent_Body (SR) 759 or else Is_Concurrent_Type (SR) 760 then 761 return; 762 end if; 763 764 SR := Scope (SR); 765 end loop; 766 767 -- Case of reference has an access type. This is a 768 -- special case since access types are always set to 769 -- null so cannot be truly uninitialized, but we still 770 -- want to warn about cases of obvious null dereference. 771 772 if Is_Access_Type (Etype (N)) then 773 declare 774 P : Node_Id; 775 776 function Process 777 (N : Node_Id) 778 return Traverse_Result; 779 -- Process function for instantation of Traverse 780 -- below. Checks if N contains reference to E 781 -- other than a dereference. 782 783 function Ref_In (Nod : Node_Id) return Boolean; 784 -- Determines whether Nod contains a reference 785 -- to the entity E that is not a dereference. 786 787 function Process 788 (N : Node_Id) 789 return Traverse_Result 790 is 791 begin 792 if Is_Entity_Name (N) 793 and then Entity (N) = E 794 and then not Is_Dereferenced (N) 795 then 796 return Abandon; 797 else 798 return OK; 799 end if; 800 end Process; 801 802 function Ref_In (Nod : Node_Id) return Boolean is 803 function Traverse is new Traverse_Func (Process); 804 805 begin 806 return Traverse (Nod) = Abandon; 807 end Ref_In; 808 809 begin 810 -- Don't bother if we are inside an instance, 811 -- since the compilation of the generic template 812 -- is where the warning should be issued. 813 814 if In_Instance then 815 return; 816 end if; 817 818 -- Don't bother if this is not the main unit. 819 -- If we try to give this warning for with'ed 820 -- units, we get some false positives, since 821 -- we do not record references in other units. 822 823 if not In_Extended_Main_Source_Unit (E) 824 or else 825 not In_Extended_Main_Source_Unit (N) 826 then 827 return; 828 end if; 829 830 -- We are only interested in deferences 831 832 if not Is_Dereferenced (N) then 833 return; 834 end if; 835 836 -- One more check, don't bother with references 837 -- that are inside conditional statements or while 838 -- loops if the condition references the entity in 839 -- question. This avoids most false positives. 840 841 P := Parent (N); 842 loop 843 P := Parent (P); 844 exit when No (P); 845 846 if (Nkind (P) = N_If_Statement 847 or else 848 Nkind (P) = N_Elsif_Part) 849 and then Ref_In (Condition (P)) 850 then 851 return; 852 853 elsif Nkind (P) = N_Loop_Statement 854 and then Present (Iteration_Scheme (P)) 855 and then 856 Ref_In (Condition (Iteration_Scheme (P))) 857 then 858 return; 859 end if; 860 end loop; 861 end; 862 end if; 863 864 -- Here we definitely have a case for giving a warning 865 -- for a reference to an unset value. But we don't give 866 -- the warning now. Instead we set the Unset_Reference 867 -- field of the identifier involved. The reason for this 868 -- is that if we find the variable is never ever assigned 869 -- a value then that warning is more important and there 870 -- is no point in giving the reference warning. 871 872 -- If this is an identifier, set the field directly 873 874 if Nkind (N) = N_Identifier then 875 Set_Unset_Reference (E, N); 876 877 -- Otherwise it is an expanded name, so set the field 878 -- of the actual identifier for the reference. 879 880 else 881 Set_Unset_Reference (E, Selector_Name (N)); 882 end if; 883 end; 884 end if; 885 end; 886 887 when N_Indexed_Component | N_Slice => 888 Check_Unset_Reference (Prefix (N)); 889 890 when N_Selected_Component => 891 892 if Present (Entity (Selector_Name (N))) 893 and then Ekind (Entity (Selector_Name (N))) = E_Discriminant 894 then 895 -- A discriminant is always initialized 896 897 null; 898 899 else 900 Check_Unset_Reference (Prefix (N)); 901 end if; 902 903 when N_Type_Conversion | N_Qualified_Expression => 904 Check_Unset_Reference (Expression (N)); 905 906 when others => 907 null; 908 909 end case; 910 end Check_Unset_Reference; 911 912 ------------------------ 913 -- Check_Unused_Withs -- 914 ------------------------ 915 916 procedure Check_Unused_Withs (Spec_Unit : Unit_Number_Type := No_Unit) is 917 Cnode : Node_Id; 918 Item : Node_Id; 919 Lunit : Node_Id; 920 Ent : Entity_Id; 921 922 Munite : constant Entity_Id := Cunit_Entity (Main_Unit); 923 -- This is needed for checking the special renaming case 924 925 procedure Check_One_Unit (Unit : Unit_Number_Type); 926 -- Subsidiary procedure, performs checks for specified unit 927 928 -------------------- 929 -- Check_One_Unit -- 930 -------------------- 931 932 procedure Check_One_Unit (Unit : Unit_Number_Type) is 933 Is_Visible_Renaming : Boolean := False; 934 Pack : Entity_Id; 935 936 procedure Check_Inner_Package (Pack : Entity_Id); 937 -- Pack is a package local to a unit in a with_clause. Both the 938 -- unit and Pack are referenced. If none of the entities in Pack 939 -- are referenced, then the only occurrence of Pack is in a use 940 -- clause or a pragma, and a warning is worthwhile as well. 941 942 function Check_System_Aux return Boolean; 943 -- Before giving a warning on a with_clause for System, check 944 -- whether a system extension is present. 945 946 function Find_Package_Renaming 947 (P : Entity_Id; 948 L : Entity_Id) return Entity_Id; 949 -- The only reference to a context unit may be in a renaming 950 -- declaration. If this renaming declares a visible entity, do 951 -- not warn that the context clause could be moved to the body, 952 -- because the renaming may be intented to re-export the unit. 953 954 ------------------------- 955 -- Check_Inner_Package -- 956 ------------------------- 957 958 procedure Check_Inner_Package (Pack : Entity_Id) is 959 E : Entity_Id; 960 Un : constant Node_Id := Sinfo.Unit (Cnode); 961 962 function Check_Use_Clause (N : Node_Id) return Traverse_Result; 963 -- If N is a use_clause for Pack, emit warning. 964 965 procedure Check_Use_Clauses is new 966 Traverse_Proc (Check_Use_Clause); 967 968 ---------------------- 969 -- Check_Use_Clause -- 970 ---------------------- 971 972 function Check_Use_Clause (N : Node_Id) return Traverse_Result is 973 Nam : Node_Id; 974 975 begin 976 if Nkind (N) = N_Use_Package_Clause then 977 Nam := First (Names (N)); 978 979 while Present (Nam) loop 980 if Entity (Nam) = Pack then 981 Error_Msg_Qual_Level := 1; 982 Error_Msg_NE 983 ("no entities of package& are referenced?", 984 Nam, Pack); 985 Error_Msg_Qual_Level := 0; 986 end if; 987 988 Next (Nam); 989 end loop; 990 end if; 991 992 return OK; 993 end Check_Use_Clause; 994 995 -- Start of processing for Check_Inner_Package 996 997 begin 998 E := First_Entity (Pack); 999 1000 while Present (E) loop 1001 if Referenced (E) then 1002 return; 1003 end if; 1004 1005 Next_Entity (E); 1006 end loop; 1007 1008 -- No entities of the package are referenced. Check whether 1009 -- the reference to the package itself is a use clause, and 1010 -- if so place a warning on it. 1011 1012 Check_Use_Clauses (Un); 1013 end Check_Inner_Package; 1014 1015 ---------------------- 1016 -- Check_System_Aux -- 1017 ---------------------- 1018 1019 function Check_System_Aux return Boolean is 1020 Ent : Entity_Id; 1021 1022 begin 1023 if Chars (Lunit) = Name_System 1024 and then Scope (Lunit) = Standard_Standard 1025 and then Present_System_Aux 1026 then 1027 Ent := First_Entity (System_Aux_Id); 1028 1029 while Present (Ent) loop 1030 if Referenced (Ent) then 1031 return True; 1032 end if; 1033 1034 Next_Entity (Ent); 1035 end loop; 1036 end if; 1037 1038 return False; 1039 end Check_System_Aux; 1040 1041 --------------------------- 1042 -- Find_Package_Renaming -- 1043 --------------------------- 1044 1045 function Find_Package_Renaming 1046 (P : Entity_Id; 1047 L : Entity_Id) return Entity_Id 1048 is 1049 E1 : Entity_Id; 1050 R : Entity_Id; 1051 1052 begin 1053 Is_Visible_Renaming := False; 1054 E1 := First_Entity (P); 1055 1056 while Present (E1) loop 1057 if Ekind (E1) = E_Package 1058 and then Renamed_Object (E1) = L 1059 then 1060 Is_Visible_Renaming := not Is_Hidden (E1); 1061 return E1; 1062 1063 elsif Ekind (E1) = E_Package 1064 and then No (Renamed_Object (E1)) 1065 and then not Is_Generic_Instance (E1) 1066 then 1067 R := Find_Package_Renaming (E1, L); 1068 1069 if Present (R) then 1070 Is_Visible_Renaming := not Is_Hidden (R); 1071 return R; 1072 end if; 1073 end if; 1074 1075 Next_Entity (E1); 1076 end loop; 1077 1078 return Empty; 1079 end Find_Package_Renaming; 1080 1081 -- Start of processing for Check_One_Unit 1082 1083 begin 1084 Cnode := Cunit (Unit); 1085 1086 -- Only do check in units that are part of the extended main 1087 -- unit. This is actually a necessary restriction, because in 1088 -- the case of subprogram acting as its own specification, 1089 -- there can be with's in subunits that we will not see. 1090 1091 if not In_Extended_Main_Source_Unit (Cnode) then 1092 return; 1093 1094 -- In configurable run time mode, we remove the bodies of 1095 -- non-inlined subprograms, which may lead to spurious warnings, 1096 -- which are clearly undesirable. 1097 1098 elsif Configurable_Run_Time_Mode 1099 and then Is_Predefined_File_Name (Unit_File_Name (Unit)) 1100 then 1101 return; 1102 end if; 1103 1104 -- Loop through context items in this unit 1105 1106 Item := First (Context_Items (Cnode)); 1107 while Present (Item) loop 1108 if Nkind (Item) = N_With_Clause 1109 and then not Implicit_With (Item) 1110 and then In_Extended_Main_Source_Unit (Item) 1111 then 1112 Lunit := Entity (Name (Item)); 1113 1114 -- Check if this unit is referenced 1115 1116 if not Referenced (Lunit) then 1117 1118 -- Suppress warnings in internal units if not in -gnatg 1119 -- mode (these would be junk warnings for an applications 1120 -- program, since they refer to problems in internal units) 1121 1122 if GNAT_Mode 1123 or else not Is_Internal_File_Name (Unit_File_Name (Unit)) 1124 then 1125 -- Here we definitely have a non-referenced unit. If 1126 -- it is the special call for a spec unit, then just 1127 -- set the flag to be read later. 1128 1129 if Unit = Spec_Unit then 1130 Set_Unreferenced_In_Spec (Item); 1131 1132 -- Otherwise simple unreferenced message 1133 1134 else 1135 Error_Msg_N 1136 ("unit& is not referenced?", Name (Item)); 1137 end if; 1138 end if; 1139 1140 -- If main unit is a renaming of this unit, then we consider 1141 -- the with to be OK (obviously it is needed in this case!) 1142 1143 elsif Present (Renamed_Entity (Munite)) 1144 and then Renamed_Entity (Munite) = Lunit 1145 then 1146 null; 1147 1148 -- If this unit is referenced, and it is a package, we 1149 -- do another test, to see if any of the entities in the 1150 -- package are referenced. If none of the entities are 1151 -- referenced, we still post a warning. This occurs if 1152 -- the only use of the package is in a use clause, or 1153 -- in a package renaming declaration. 1154 1155 elsif Ekind (Lunit) = E_Package then 1156 1157 -- If Is_Instantiated is set, it means that the package 1158 -- is implicitly instantiated (this is the case of a 1159 -- parent instance or an actual for a generic package 1160 -- formal), and this counts as a reference. 1161 1162 if Is_Instantiated (Lunit) then 1163 null; 1164 1165 -- If no entities in package, and there is a pragma 1166 -- Elaborate_Body present, then assume that this with 1167 -- is done for purposes of this elaboration. 1168 1169 elsif No (First_Entity (Lunit)) 1170 and then Has_Pragma_Elaborate_Body (Lunit) 1171 then 1172 null; 1173 1174 -- Otherwise see if any entities have been referenced 1175 1176 else 1177 Ent := First_Entity (Lunit); 1178 loop 1179 -- No more entities, and we did not find one 1180 -- that was referenced. Means we have a definite 1181 -- case of a with none of whose entities was 1182 -- referenced. 1183 1184 if No (Ent) then 1185 1186 -- If in spec, just set the flag 1187 1188 if Unit = Spec_Unit then 1189 Set_No_Entities_Ref_In_Spec (Item); 1190 1191 elsif Check_System_Aux then 1192 null; 1193 1194 -- Else give the warning 1195 1196 else 1197 Error_Msg_N 1198 ("no entities of & are referenced?", 1199 Name (Item)); 1200 1201 -- Look for renamings of this package, and 1202 -- flag them as well. If the original package 1203 -- has warnings off, we suppress the warning 1204 -- on the renaming as well. 1205 1206 Pack := Find_Package_Renaming (Munite, Lunit); 1207 1208 if Present (Pack) 1209 and then not Warnings_Off (Lunit) 1210 then 1211 Error_Msg_NE 1212 ("no entities of & are referenced?", 1213 Unit_Declaration_Node (Pack), 1214 Pack); 1215 end if; 1216 end if; 1217 1218 exit; 1219 1220 -- Case of next entity is referenced 1221 1222 elsif Referenced (Ent) 1223 or else Referenced_As_LHS (Ent) 1224 then 1225 -- This means that the with is indeed fine, in 1226 -- that it is definitely needed somewhere, and 1227 -- we can quite worrying about this one. 1228 1229 -- Except for one little detail, if either of 1230 -- the flags was set during spec processing, 1231 -- this is where we complain that the with 1232 -- could be moved from the spec. If the spec 1233 -- contains a visible renaming of the package, 1234 -- inhibit warning to move with_clause to body. 1235 1236 if Ekind (Munite) = E_Package_Body then 1237 Pack := 1238 Find_Package_Renaming 1239 (Spec_Entity (Munite), Lunit); 1240 end if; 1241 1242 if Unreferenced_In_Spec (Item) then 1243 Error_Msg_N 1244 ("unit& is not referenced in spec?", 1245 Name (Item)); 1246 1247 elsif No_Entities_Ref_In_Spec (Item) then 1248 Error_Msg_N 1249 ("no entities of & are referenced in spec?", 1250 Name (Item)); 1251 1252 else 1253 if Ekind (Ent) = E_Package then 1254 Check_Inner_Package (Ent); 1255 end if; 1256 1257 exit; 1258 end if; 1259 1260 if not Is_Visible_Renaming then 1261 Error_Msg_N 1262 ("\with clause might be moved to body?", 1263 Name (Item)); 1264 end if; 1265 1266 exit; 1267 1268 -- Move to next entity to continue search 1269 1270 else 1271 Next_Entity (Ent); 1272 end if; 1273 end loop; 1274 end if; 1275 1276 -- For a generic package, the only interesting kind of 1277 -- reference is an instantiation, since entities cannot 1278 -- be referenced directly. 1279 1280 elsif Is_Generic_Unit (Lunit) then 1281 1282 -- Unit was never instantiated, set flag for case of spec 1283 -- call, or give warning for normal call. 1284 1285 if not Is_Instantiated (Lunit) then 1286 if Unit = Spec_Unit then 1287 Set_Unreferenced_In_Spec (Item); 1288 else 1289 Error_Msg_N 1290 ("unit& is never instantiated?", Name (Item)); 1291 end if; 1292 1293 -- If unit was indeed instantiated, make sure that 1294 -- flag is not set showing it was uninstantiated in 1295 -- the spec, and if so, give warning. 1296 1297 elsif Unreferenced_In_Spec (Item) then 1298 Error_Msg_N 1299 ("unit& is not instantiated in spec?", Name (Item)); 1300 Error_Msg_N 1301 ("\with clause can be moved to body?", Name (Item)); 1302 end if; 1303 end if; 1304 end if; 1305 1306 Next (Item); 1307 end loop; 1308 1309 end Check_One_Unit; 1310 1311 -- Start of processing for Check_Unused_Withs 1312 1313 begin 1314 if not Opt.Check_Withs 1315 or else Operating_Mode = Check_Syntax 1316 then 1317 return; 1318 end if; 1319 1320 -- Flag any unused with clauses, but skip this step if we are 1321 -- compiling a subunit on its own, since we do not have enough 1322 -- information to determine whether with's are used. We will get 1323 -- the relevant warnings when we compile the parent. This is the 1324 -- normal style of GNAT compilation in any case. 1325 1326 if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit then 1327 return; 1328 end if; 1329 1330 -- Process specified units 1331 1332 if Spec_Unit = No_Unit then 1333 1334 -- For main call, check all units 1335 1336 for Unit in Main_Unit .. Last_Unit loop 1337 Check_One_Unit (Unit); 1338 end loop; 1339 1340 else 1341 -- For call for spec, check only the spec 1342 1343 Check_One_Unit (Spec_Unit); 1344 end if; 1345 end Check_Unused_Withs; 1346 1347 --------------------------------- 1348 -- Generic_Package_Spec_Entity -- 1349 --------------------------------- 1350 1351 function Generic_Package_Spec_Entity (E : Entity_Id) return Boolean is 1352 S : Entity_Id; 1353 1354 begin 1355 if Is_Package_Body_Entity (E) then 1356 return False; 1357 1358 else 1359 S := Scope (E); 1360 1361 loop 1362 if S = Standard_Standard then 1363 return False; 1364 1365 elsif Ekind (S) = E_Generic_Package then 1366 return True; 1367 1368 elsif Ekind (S) = E_Package then 1369 S := Scope (S); 1370 1371 else 1372 return False; 1373 end if; 1374 end loop; 1375 end if; 1376 end Generic_Package_Spec_Entity; 1377 1378 ------------------------------------- 1379 -- Operand_Has_Warnings_Suppressed -- 1380 ------------------------------------- 1381 1382 function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean is 1383 1384 function Check_For_Warnings (N : Node_Id) return Traverse_Result; 1385 -- Function used to check one node to see if it is or was originally 1386 -- a reference to an entity for which Warnings are off. If so, Abandon 1387 -- is returned, otherwise OK_Orig is returned to continue the traversal 1388 -- of the original expression. 1389 1390 function Traverse is new Traverse_Func (Check_For_Warnings); 1391 -- Function used to traverse tree looking for warnings 1392 1393 ------------------------ 1394 -- Check_For_Warnings -- 1395 ------------------------ 1396 1397 function Check_For_Warnings (N : Node_Id) return Traverse_Result is 1398 R : constant Node_Id := Original_Node (N); 1399 1400 begin 1401 if Nkind (R) in N_Has_Entity 1402 and then Present (Entity (R)) 1403 and then Warnings_Off (Entity (R)) 1404 then 1405 return Abandon; 1406 else 1407 return OK_Orig; 1408 end if; 1409 end Check_For_Warnings; 1410 1411 -- Start of processing for Operand_Has_Warnings_Suppressed 1412 1413 begin 1414 return Traverse (N) = Abandon; 1415 1416 -- If any exception occurs, then something has gone wrong, and this is 1417 -- only a minor aesthetic issue anyway, so just say we did not find what 1418 -- we are looking for, rather than blow up. 1419 1420 exception 1421 when others => 1422 return False; 1423 end Operand_Has_Warnings_Suppressed; 1424 1425 ---------------------------------- 1426 -- Output_Unreferenced_Messages -- 1427 ---------------------------------- 1428 1429 procedure Output_Unreferenced_Messages is 1430 E : Entity_Id; 1431 1432 begin 1433 for J in Unreferenced_Entities.First .. 1434 Unreferenced_Entities.Last 1435 loop 1436 E := Unreferenced_Entities.Table (J); 1437 1438 if not Referenced (E) and then not Warnings_Off (E) then 1439 case Ekind (E) is 1440 when E_Variable => 1441 1442 -- Case of variable that is assigned but not read. We 1443 -- suppress the message if the variable is volatile, 1444 -- has an address clause, or is imported. 1445 1446 if Referenced_As_LHS (E) 1447 and then No (Address_Clause (E)) 1448 and then not Is_Volatile (E) 1449 then 1450 if Warn_On_Modified_Unread 1451 and then not Is_Imported (E) 1452 then 1453 Error_Msg_N 1454 ("variable & is assigned but never read?", E); 1455 end if; 1456 1457 -- Normal case of neither assigned nor read 1458 1459 else 1460 if Present (Renamed_Object (E)) 1461 and then Comes_From_Source (Renamed_Object (E)) 1462 then 1463 Error_Msg_N 1464 ("renamed variable & is not referenced?", E); 1465 else 1466 Error_Msg_N 1467 ("variable & is not referenced?", E); 1468 end if; 1469 end if; 1470 1471 when E_Constant => 1472 if Present (Renamed_Object (E)) 1473 and then Comes_From_Source (Renamed_Object (E)) 1474 then 1475 Error_Msg_N ("renamed constant & is not referenced?", E); 1476 else 1477 Error_Msg_N ("constant & is not referenced?", E); 1478 end if; 1479 1480 when E_In_Parameter | 1481 E_Out_Parameter | 1482 E_In_Out_Parameter => 1483 1484 -- Do not emit message for formals of a renaming, because 1485 -- they are never referenced explicitly. 1486 1487 if Nkind (Original_Node (Unit_Declaration_Node (Scope (E)))) 1488 /= N_Subprogram_Renaming_Declaration 1489 then 1490 Error_Msg_N ("formal parameter & is not referenced?", E); 1491 end if; 1492 1493 when E_Named_Integer | 1494 E_Named_Real => 1495 Error_Msg_N ("named number & is not referenced?", E); 1496 1497 when E_Enumeration_Literal => 1498 Error_Msg_N ("literal & is not referenced?", E); 1499 1500 when E_Function => 1501 Error_Msg_N ("function & is not referenced?", E); 1502 1503 when E_Procedure => 1504 Error_Msg_N ("procedure & is not referenced?", E); 1505 1506 when E_Generic_Procedure => 1507 Error_Msg_N 1508 ("generic procedure & is never instantiated?", E); 1509 1510 when E_Generic_Function => 1511 Error_Msg_N ("generic function & is never instantiated?", E); 1512 1513 when Type_Kind => 1514 Error_Msg_N ("type & is not referenced?", E); 1515 1516 when others => 1517 Error_Msg_N ("& is not referenced?", E); 1518 end case; 1519 1520 Set_Warnings_Off (E); 1521 end if; 1522 end loop; 1523 end Output_Unreferenced_Messages; 1524 1525 ----------------------------- 1526 -- Warn_On_Known_Condition -- 1527 ----------------------------- 1528 1529 procedure Warn_On_Known_Condition (C : Node_Id) is 1530 P : Node_Id; 1531 1532 begin 1533 -- Argument replacement in an inlined body can make conditions 1534 -- static. Do not emit warnings in this case. 1535 1536 if In_Inlined_Body then 1537 return; 1538 end if; 1539 1540 if Constant_Condition_Warnings 1541 and then Nkind (C) = N_Identifier 1542 and then 1543 (Entity (C) = Standard_False or else Entity (C) = Standard_True) 1544 and then Comes_From_Source (Original_Node (C)) 1545 and then not In_Instance 1546 then 1547 -- See if this is in a statement or a declaration 1548 1549 P := Parent (C); 1550 loop 1551 -- If tree is not attached, do not issue warning (this is very 1552 -- peculiar, and probably arises from some other error condition) 1553 1554 if No (P) then 1555 return; 1556 1557 -- If we are in a declaration, then no warning, since in practice 1558 -- conditionals in declarations are used for intended tests which 1559 -- may be known at compile time, e.g. things like 1560 1561 -- x : constant Integer := 2 + (Word'Size = 32); 1562 1563 -- And a warning is annoying in such cases 1564 1565 elsif Nkind (P) in N_Declaration 1566 or else 1567 Nkind (P) in N_Later_Decl_Item 1568 then 1569 return; 1570 1571 -- Don't warn in assert pragma, since presumably tests in such 1572 -- a context are very definitely intended, and might well be 1573 -- known at compile time. Note that we have to test the original 1574 -- node, since assert pragmas get rewritten at analysis time. 1575 1576 elsif Nkind (Original_Node (P)) = N_Pragma 1577 and then Chars (Original_Node (P)) = Name_Assert 1578 then 1579 return; 1580 end if; 1581 1582 exit when Is_Statement (P); 1583 P := Parent (P); 1584 end loop; 1585 1586 -- Here we issue the warning unless some sub-operand has warnings 1587 -- set off, in which case we suppress the warning for the node. 1588 1589 if not Operand_Has_Warnings_Suppressed (C) then 1590 if Entity (C) = Standard_True then 1591 Error_Msg_N ("condition is always True?", C); 1592 else 1593 Error_Msg_N ("condition is always False?", C); 1594 end if; 1595 end if; 1596 end if; 1597 end Warn_On_Known_Condition; 1598 1599end Sem_Warn; 1600