gcc/ada/sem_warn.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S E M _ W A R N                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1999-2002 Free Software Foundation, Inc.          --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Alloc;
  29 with Atree;    use Atree;
  30 with Einfo;    use Einfo;
  31 with Errout;   use Errout;
  32 with Fname;    use Fname;
  33 with Lib;      use Lib;
  34 with Nlists;   use Nlists;
  35 with Opt;      use Opt;
  36 with Sem;      use Sem;
  37 with Sem_Util; use Sem_Util;
  38 with Sinfo;    use Sinfo;
  39 with Sinput;   use Sinput;
  40 with Snames;   use Snames;
  41 with Stand;    use Stand;
  42 with Table;
  43
  44 package 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    --  One entry is made in the following table for each branch of
  58    --  a conditional, e.g. an if-then-elsif-else-endif structure
  59    --  creates three entries in this table.
  60
  61    type Branch_Entry is record
  62       Sloc : Source_Ptr;
  63       --  Location for warnings associated with this branch
  64
  65       Defs : Elist_Id;
  66       --  List of entities defined for the first time in this branch. On
  67       --  exit from a conditional structure, any entity that is in the
  68       --  list of all branches is removed (and the entity flagged as
  69       --  defined by the conditional as a whole). Thus after processing
  70       --  a conditional, Defs contains a list of entities defined in this
  71       --  branch for the first time, but not defined at all in some other
  72       --  branch of the same conditional. A value of No_Elist is used to
  73       --  represent the initial empty list.
  74
  75       Next : Nat;
  76       --  Index of next branch for this conditional, zero = last branch
  77    end record;
  78
  79    package Branch_Table is new Table.Table (
  80      Table_Component_Type => Branch_Entry,
  81      Table_Index_Type     => Nat,
  82      Table_Low_Bound      => 1,
  83      Table_Initial        => Alloc.Branches_Initial,
  84      Table_Increment      => Alloc.Branches_Increment,
  85      Table_Name           => "Branches");
  86
  87    --  The following table is used to represent conditionals, there is
  88    --  one entry in this table for each conditional structure.
  89
  90    type Conditional_Entry is record
  91       If_Stmt : Boolean;
  92       --  True for IF statement, False for CASE statement
  93
  94       First_Branch : Nat;
  95       --  Index in Branch table of first branch, zero = none yet
  96
  97       Current_Branch : Nat;
  98       --  Index in Branch table of current branch, zero = none yet
  99    end record;
 100
 101    package Conditional_Table is new Table.Table (
 102      Table_Component_Type => Conditional_Entry,
 103      Table_Index_Type     => Nat,
 104      Table_Low_Bound      => 1,
 105      Table_Initial        => Alloc.Conditionals_Initial,
 106      Table_Increment      => Alloc.Conditionals_Increment,
 107      Table_Name           => "Conditionals");
 108
 109    --  The following table is a stack that keeps track of the current
 110    --  conditional. The Last entry is the top of the stack. An Empty
 111    --  entry represents the start of a compilation unit. Non-zero
 112    --  entries in the stack are indexes into the conditional table.
 113
 114    package Conditional_Stack is new Table.Table (
 115      Table_Component_Type => Nat,
 116      Table_Index_Type     => Nat,
 117      Table_Low_Bound      => 1,
 118      Table_Initial        => Alloc.Conditional_Stack_Initial,
 119      Table_Increment      => Alloc.Conditional_Stack_Increment,
 120      Table_Name           => "Conditional_Stack");
 121
 122    function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean;
 123    --  This function traverses the expression tree represented by the node
 124    --  N and determines if any sub-operand is a reference to an entity for
 125    --  which the Warnings_Off flag is set. True is returned if such an
 126    --  entity is encountered, and False otherwise.
 127
 128    ----------------------
 129    -- Check_References --
 130    ----------------------
 131
 132    procedure Check_References (E : Entity_Id; Anod : Node_Id := Empty) is
 133       E1 : Entity_Id;
 134       UR : Node_Id;
 135       PU : Node_Id;
 136
 137       procedure Output_Reference_Error (M : String);
 138       --  Used to output an error message. Deals with posting the error on
 139       --  the body formal in the accept case.
 140
 141       function Publicly_Referenceable (Ent : Entity_Id) return Boolean;
 142       --  This is true if the entity in question is potentially referenceable
 143       --  from another unit. This is true for entities in packages that are
 144       --  at the library level.
 145
 146       ----------------------------
 147       -- Output_Reference_Error --
 148       ----------------------------
 149
 150       procedure Output_Reference_Error (M : String) is
 151       begin
 152          --  Other than accept case, post error on defining identifier
 153
 154          if No (Anod) then
 155             Error_Msg_N (M, E1);
 156
 157          --  Accept case, find body formal to post the message
 158
 159          else
 160             declare
 161                Parm  : Node_Id;
 162                Enod  : Node_Id;
 163                Defid : Entity_Id;
 164
 165             begin
 166                Enod := Anod;
 167
 168                if Present (Parameter_Specifications (Anod)) then
 169                   Parm := First (Parameter_Specifications (Anod));
 170
 171                   while Present (Parm) loop
 172                      Defid := Defining_Identifier (Parm);
 173
 174                      if Chars (E1) = Chars (Defid) then
 175                         Enod := Defid;
 176                         exit;
 177                      end if;
 178
 179                      Next (Parm);
 180                   end loop;
 181                end if;
 182
 183                Error_Msg_NE (M, Enod, E1);
 184             end;
 185          end if;
 186       end Output_Reference_Error;
 187
 188       ----------------------------
 189       -- Publicly_Referenceable --
 190       ----------------------------
 191
 192       function Publicly_Referenceable (Ent : Entity_Id) return Boolean is
 193          P : Node_Id;
 194
 195       begin
 196          --  Examine parents to look for a library level package spec
 197          --  But if we find a body or block or other similar construct
 198          --  along the way, we cannot be referenced.
 199
 200          P := Parent (Ent);
 201          loop
 202             case Nkind (P) is
 203
 204                --  If we get to top of tree, then publicly referencable
 205
 206                when N_Empty =>
 207                   return True;
 208
 209                --  If we reach a generic package declaration, then always
 210                --  consider this referenceable, since any instantiation will
 211                --  have access to the entities in the generic package. Note
 212                --  that the package itself may not be instantiated, but then
 213                --  we will get a warning for the package entity
 214
 215                when N_Generic_Package_Declaration =>
 216                   return True;
 217
 218                --  If we reach any body, then definitely not referenceable
 219
 220                when N_Package_Body    |
 221                     N_Subprogram_Body |
 222                     N_Task_Body       |
 223                     N_Entry_Body      |
 224                     N_Protected_Body  |
 225                     N_Block_Statement |
 226                     N_Subunit         =>
 227                   return False;
 228
 229                --  For all other cases, keep looking up tree
 230
 231                when others =>
 232                   P := Parent (P);
 233             end case;
 234          end loop;
 235       end Publicly_Referenceable;
 236
 237    --  Start of processing for Check_References
 238
 239    begin
 240       --  No messages if warnings are suppressed, or if we have detected
 241       --  any real errors so far (this last check avoids junk messages
 242       --  resulting from errors, e.g. a subunit that is not loaded).
 243
 244       --  We also skip the messages if any subunits were not loaded (see
 245       --  comment in Sem_Ch10 to understand how this is set, and why it is
 246       --  necessary to suppress the warnings in this case).
 247
 248       if Warning_Mode = Suppress
 249         or else Serious_Errors_Detected /= 0
 250         or else Unloaded_Subunits
 251       then
 252          return;
 253       end if;
 254
 255       --  Otherwise loop through entities, looking for suspicious stuff
 256
 257       E1 := First_Entity (E);
 258       while Present (E1) loop
 259
 260          --  We only look at source entities with warning flag off
 261
 262          if Comes_From_Source (E1) and then not Warnings_Off (E1) then
 263
 264             --  We are interested in variables and out parameters, but we
 265             --  exclude protected types, too complicated to worry about.
 266
 267             if Ekind (E1) = E_Variable
 268                  or else
 269                (Ekind (E1) = E_Out_Parameter
 270                   and then not Is_Protected_Type (Current_Scope))
 271             then
 272                --  Post warning if this object not assigned. Note that we
 273                --  do not consider the implicit initialization of an access
 274                --  type to be the assignment of a value for this purpose.
 275                --  If the entity is an out parameter of the current subprogram
 276                --  body, check the warning status of the parameter in the spec.
 277
 278                if Ekind (E1) = E_Out_Parameter
 279                  and then Present (Spec_Entity (E1))
 280                  and then Warnings_Off (Spec_Entity (E1))
 281                then
 282                   null;
 283
 284                elsif Not_Source_Assigned (E1) then
 285                   Output_Reference_Error ("& is never assigned a value?");
 286
 287                   --  Deal with special case where this variable is hidden
 288                   --  by a loop variable
 289
 290                   if Ekind (E1) = E_Variable
 291                     and then Present (Hiding_Loop_Variable (E1))
 292                   then
 293                      Error_Msg_Sloc := Sloc (E1);
 294                      Error_Msg_N
 295                        ("declaration hides &#?",
 296                         Hiding_Loop_Variable (E1));
 297                      Error_Msg_N
 298                        ("for loop implicitly declares loop variable?",
 299                         Hiding_Loop_Variable (E1));
 300                   end if;
 301
 302                   goto Continue;
 303                end if;
 304
 305                --  Check for unset reference, note that we exclude access
 306                --  types from this check, since access types do always have
 307                --  a null value, and that seems legitimate in this case.
 308
 309                UR := Unset_Reference (E1);
 310                if Present (UR) then
 311
 312                   --  For access types, the only time we complain is when
 313                   --  we have a dereference (of a null value)
 314
 315                   if Is_Access_Type (Etype (E1)) then
 316                      PU := Parent (UR);
 317
 318                      if (Nkind (PU) = N_Selected_Component
 319                            or else
 320                          Nkind (PU) = N_Explicit_Dereference
 321                            or else
 322                          Nkind (PU) = N_Indexed_Component)
 323                        and then
 324                          Prefix (PU) = UR
 325                      then
 326                         Error_Msg_N ("& may be null?", UR);
 327                         goto Continue;
 328                      end if;
 329
 330                   --  For other than access type, go back to original node
 331                   --  to deal with case where original unset reference
 332                   --  has been rewritten during expansion.
 333
 334                   else
 335                      UR := Original_Node (UR);
 336
 337                      --  In some cases, the original node may be a type
 338                      --  conversion or qualification, and in this case
 339                      --  we want the object entity inside.
 340
 341                      while Nkind (UR) = N_Type_Conversion
 342                        or else Nkind (UR) = N_Qualified_Expression
 343                      loop
 344                         UR := Expression (UR);
 345                      end loop;
 346
 347                      Error_Msg_N
 348                        ("& may be referenced before it has a value?", UR);
 349                      goto Continue;
 350                   end if;
 351                end if;
 352             end if;
 353
 354             --  Then check for unreferenced variables
 355
 356             if not Referenced (E1)
 357
 358                --  Check that warnings on unreferenced entities are enabled
 359
 360               and then ((Check_Unreferenced and then not Is_Formal (E1))
 361                            or else
 362                         (Check_Unreferenced_Formals and then Is_Formal (E1)))
 363
 364                --  Warnings are placed on objects, types, subprograms,
 365                --  labels, and enumeration literals.
 366
 367                and then (Is_Object (E1)
 368                            or else
 369                          Is_Type (E1)
 370                            or else
 371                          Ekind (E1) = E_Label
 372                            or else
 373                          Ekind (E1) = E_Named_Integer
 374                            or else
 375                          Ekind (E1) = E_Named_Real
 376                            or else
 377                          Is_Overloadable (E1))
 378
 379                --  We only place warnings for the extended main unit
 380
 381                and then In_Extended_Main_Source_Unit (E1)
 382
 383                --  Exclude instantiations, since there is no reason why
 384                --  every entity in an instantiation should be referenced.
 385
 386                and then Instantiation_Location (Sloc (E1)) = No_Location
 387
 388                --  Exclude formal parameters from bodies if the corresponding
 389                --  spec entity has been referenced in the case where there is
 390                --  a separate spec.
 391
 392                and then not (Is_Formal (E1)
 393                                and then
 394                              Ekind (Scope (E1)) = E_Subprogram_Body
 395                                and then
 396                              Present (Spec_Entity (E1))
 397                                and then
 398                              Referenced (Spec_Entity (E1)))
 399
 400                --  Consider private type referenced if full view is referenced
 401
 402                and then not (Is_Private_Type (E1)
 403                                and then
 404                              Referenced (Full_View (E1)))
 405
 406                --  Don't worry about full view, only about private type
 407
 408                and then not Has_Private_Declaration (E1)
 409
 410                --  Eliminate dispatching operations from consideration, we
 411                --  cannot tell if these are referenced or not in any easy
 412                --  manner (note this also catches Adjust/Finalize/Initialize)
 413
 414                and then not Is_Dispatching_Operation (E1)
 415
 416                --  Check entity that can be publicly referenced (we do not
 417                --  give messages for such entities, since there could be
 418                --  other units, not involved in this compilation, that
 419                --  contain relevant references.
 420
 421                and then not Publicly_Referenceable (E1)
 422
 423                --  Class wide types are marked as source entities, but
 424                --  they are not really source entities, and are always
 425                --  created, so we do not care if they are not referenced.
 426
 427                and then Ekind (E1) /= E_Class_Wide_Type
 428
 429                --  Objects other than parameters of task types are allowed
 430                --  to be non-referenced, since they start up tasks!
 431
 432                and then ((Ekind (E1) /= E_Variable
 433                              and then Ekind (E1) /= E_Constant
 434                              and then Ekind (E1) /= E_Component)
 435                            or else not Is_Task_Type (Etype (E1)))
 436
 437                --  For subunits, only place warnings on the main unit
 438                --  itself, since parent units are not completely compiled
 439
 440                and then (Nkind (Unit (Cunit (Main_Unit))) /= N_Subunit
 441                            or else
 442                          Get_Source_Unit (E1) = Main_Unit)
 443             then
 444                --  Suppress warnings in internal units if not in -gnatg
 445                --  mode (these would be junk warnings for an applications
 446                --  program, since they refer to problems in internal units)
 447
 448                if GNAT_Mode
 449                  or else not
 450                    Is_Internal_File_Name
 451                      (Unit_File_Name (Get_Source_Unit (E1)))
 452                then
 453                   --  We do not immediately flag the error. This is because
 454                   --  we have not expanded generic bodies yet, and they may
 455                   --  have the missing reference. So instead we park the
 456                   --  entity on a list, for later processing. However, for
 457                   --  the accept case, post the error right here, since we
 458                   --  have the information now in this case.
 459
 460                   if Present (Anod) then
 461                      Output_Reference_Error ("& is not referenced?");
 462
 463                   else
 464                      Unreferenced_Entities.Increment_Last;
 465                      Unreferenced_Entities.Table
 466                        (Unreferenced_Entities.Last) := E1;
 467                   end if;
 468                end if;
 469             end if;
 470          end if;
 471
 472          --  Recurse into nested package or block
 473
 474          <<Continue>>
 475             if (Ekind (E1) = E_Package
 476                   and then Nkind (Parent (E1)) = N_Package_Specification)
 477               or else Ekind (E1) = E_Block
 478             then
 479                Check_References (E1);
 480             end if;
 481
 482             Next_Entity (E1);
 483       end loop;
 484    end Check_References;
 485
 486    ---------------------------
 487    -- Check_Unset_Reference --
 488    ---------------------------
 489
 490    procedure Check_Unset_Reference (N : Node_Id) is
 491    begin
 492       --  Nothing to do if warnings suppressed
 493
 494       if Warning_Mode = Suppress then
 495          return;
 496       end if;
 497
 498       --  Otherwise see what kind of node we have. If the entity already
 499       --  has an unset reference, it is not necessarily the earliest in
 500       --  the text, because resolution of the prefix of selected components
 501       --  is completed before the resolution of the selected component itself.
 502       --  as a result, given  (R /= null and then R.X > 0), the occurrences
 503       --  of R are examined in right-to-left order. If there is already an
 504       --  unset reference, we check whether N is earlier before proceeding.
 505
 506       case Nkind (N) is
 507
 508          when N_Identifier | N_Expanded_Name =>
 509             declare
 510                E  : constant Entity_Id := Entity (N);
 511
 512             begin
 513                if (Ekind (E) = E_Variable
 514                     or else Ekind (E) = E_Out_Parameter)
 515                  and then Not_Source_Assigned (E)
 516                  and then (No (Unset_Reference (E))
 517                              or else Earlier_In_Extended_Unit
 518                                (Sloc (N),  Sloc (Unset_Reference (E))))
 519                  and then not Warnings_Off (E)
 520                then
 521                   --  Here we have a potential unset reference. But before we
 522                   --  get worried about it, we have to make sure that the
 523                   --  entity declaration is in the same procedure as the
 524                   --  reference, since if they are in separate procedures,
 525                   --  then we have no idea about sequential execution.
 526
 527                   --  The tests in the loop below catch all such cases, but
 528                   --  do allow the reference to appear in a loop, block, or
 529                   --  package spec that is nested within the declaring scope.
 530                   --  As always, it is possible to construct cases where the
 531                   --  warning is wrong, that is why it is a warning!
 532
 533                   --  If the entity is an out_parameter, it is ok to read its
 534                   --  its discriminants (that was true in Ada83) so suppress
 535                   --  the message in that case as well.
 536
 537                   if Ekind (E) = E_Out_Parameter
 538                     and then Nkind (Parent (N)) = N_Selected_Component
 539                     and then Ekind (Entity (Selector_Name (Parent (N))))
 540                       = E_Discriminant
 541                   then
 542                      return;
 543                   end if;
 544
 545                   declare
 546                      SR : Entity_Id;
 547                      SE : constant Entity_Id := Scope (E);
 548
 549                   begin
 550                      SR := Current_Scope;
 551                      while SR /= SE loop
 552                         if SR = Standard_Standard
 553                           or else Is_Subprogram (SR)
 554                           or else Is_Concurrent_Body (SR)
 555                           or else Is_Concurrent_Type (SR)
 556                         then
 557                            return;
 558                         end if;
 559
 560                         SR := Scope (SR);
 561                      end loop;
 562
 563                      if Nkind (N) = N_Identifier then
 564                         Set_Unset_Reference (E, N);
 565                      else
 566                         Set_Unset_Reference (E, Selector_Name (N));
 567                      end if;
 568                   end;
 569                end if;
 570             end;
 571
 572          when N_Indexed_Component | N_Selected_Component | N_Slice =>
 573             Check_Unset_Reference (Prefix (N));
 574             return;
 575
 576          when N_Type_Conversion | N_Qualified_Expression =>
 577             Check_Unset_Reference (Expression (N));
 578
 579          when others =>
 580             null;
 581
 582       end case;
 583    end Check_Unset_Reference;
 584
 585    ------------------------
 586    -- Check_Unused_Withs --
 587    ------------------------
 588
 589    procedure Check_Unused_Withs (Spec_Unit : Unit_Number_Type := No_Unit) is
 590       Cnode : Node_Id;
 591       Item  : Node_Id;
 592       Lunit : Node_Id;
 593       Ent   : Entity_Id;
 594
 595       Munite : constant Entity_Id := Cunit_Entity (Main_Unit);
 596       --  This is needed for checking the special renaming case
 597
 598       procedure Check_One_Unit (Unit : Unit_Number_Type);
 599       --  Subsidiary procedure, performs checks for specified unit
 600
 601       --------------------
 602       -- Check_One_Unit --
 603       --------------------
 604
 605       procedure Check_One_Unit (Unit : Unit_Number_Type) is
 606          Is_Visible_Renaming : Boolean := False;
 607          Pack                : Entity_Id;
 608
 609          function Find_Package_Renaming
 610            (P : Entity_Id;
 611             L : Entity_Id) return Entity_Id;
 612          --  The only reference to a context unit may be in a renaming
 613          --  declaration. If this renaming declares a visible entity, do
 614          --  not warn that the context clause could be moved to the body,
 615          --  because the renaming may be intented to re-export the unit.
 616
 617          ---------------------------
 618          -- Find_Package_Renaming --
 619          ---------------------------
 620
 621          function Find_Package_Renaming
 622            (P : Entity_Id;
 623             L : Entity_Id) return Entity_Id
 624          is
 625             E1 : Entity_Id;
 626             R  : Entity_Id;
 627
 628          begin
 629             Is_Visible_Renaming := False;
 630             E1 := First_Entity (P);
 631
 632             while Present (E1) loop
 633                if Ekind (E1) = E_Package
 634                   and then Renamed_Object (E1) = L
 635                then
 636                   Is_Visible_Renaming := not Is_Hidden (E1);
 637                   return E1;
 638
 639                elsif Ekind (E1) = E_Package
 640                  and then No (Renamed_Object (E1))
 641                  and then not Is_Generic_Instance (E1)
 642                then
 643                   R := Find_Package_Renaming (E1, L);
 644
 645                   if Present (R) then
 646                      Is_Visible_Renaming := not Is_Hidden (R);
 647                      return R;
 648                   end if;
 649                end if;
 650
 651                Next_Entity (E1);
 652             end loop;
 653
 654             return Empty;
 655          end Find_Package_Renaming;
 656
 657       --  Start of processing for Check_One_Unit
 658
 659       begin
 660          Cnode := Cunit (Unit);
 661
 662          --  Only do check in units that are part of the extended main
 663          --  unit. This is actually a necessary restriction, because in
 664          --  the case of subprogram acting as its own specification,
 665          --  there can be with's in subunits that we will not see.
 666
 667          if not In_Extended_Main_Source_Unit (Cnode) then
 668             return;
 669
 670          --  In No_Run_Time_Mode, we remove the bodies of non-
 671          --  inlined subprograms, which may lead to spurious
 672          --  warnings, clearly undesirable.
 673
 674          elsif No_Run_Time
 675            and then Is_Predefined_File_Name (Unit_File_Name (Unit))
 676          then
 677             return;
 678          end if;
 679
 680          --  Loop through context items in this unit
 681
 682          Item := First (Context_Items (Cnode));
 683          while Present (Item) loop
 684
 685             if Nkind (Item) = N_With_Clause
 686                and then not Implicit_With (Item)
 687                and then In_Extended_Main_Source_Unit (Item)
 688             then
 689                Lunit := Entity (Name (Item));
 690
 691                --  Check if this unit is referenced
 692
 693                if not Referenced (Lunit) then
 694
 695                   --  Suppress warnings in internal units if not in -gnatg
 696                   --  mode (these would be junk warnings for an applications
 697                   --  program, since they refer to problems in internal units)
 698
 699                   if GNAT_Mode
 700                     or else not Is_Internal_File_Name (Unit_File_Name (Unit))
 701                   then
 702                      --  Here we definitely have a non-referenced unit. If
 703                      --  it is the special call for a spec unit, then just
 704                      --  set the flag to be read later.
 705
 706                      if Unit = Spec_Unit then
 707                         Set_Unreferenced_In_Spec (Item);
 708
 709                      --  Otherwise simple unreferenced message
 710
 711                      else
 712                         Error_Msg_N
 713                           ("unit& is not referenced?", Name (Item));
 714                      end if;
 715                   end if;
 716
 717                --  If main unit is a renaming of this unit, then we consider
 718                --  the with to be OK (obviously it is needed in this case!)
 719
 720                elsif Present (Renamed_Entity (Munite))
 721                   and then Renamed_Entity (Munite) = Lunit
 722                then
 723                   null;
 724
 725                --  If this unit is referenced, and it is a package, we
 726                --  do another test, to see if any of the entities in the
 727                --  package are referenced. If none of the entities are
 728                --  referenced, we still post a warning. This occurs if
 729                --  the only use of the package is in a use clause, or
 730                --  in a package renaming declaration.
 731
 732                elsif Ekind (Lunit) = E_Package then
 733
 734                   --  If Is_Instantiated is set, it means that the package
 735                   --  is implicitly instantiated (this is the case of a
 736                   --  parent instance or an actual for a generic package
 737                   --  formal), and this counts as a reference.
 738
 739                   if Is_Instantiated (Lunit) then
 740                      null;
 741
 742                   --  If no entities in package, and there is a pragma
 743                   --  Elaborate_Body present, then assume that this with
 744                   --  is done for purposes of this elaboration.
 745
 746                   elsif No (First_Entity (Lunit))
 747                     and then Has_Pragma_Elaborate_Body (Lunit)
 748                   then
 749                      null;
 750
 751                   --  Otherwise see if any entities have been referenced
 752
 753                   else
 754                      Ent  := First_Entity (Lunit);
 755
 756                      loop
 757                         --  No more entities, and we did not find one
 758                         --  that was referenced. Means we have a definite
 759                         --  case of a with none of whose entities was
 760                         --  referenced.
 761
 762                         if No (Ent) then
 763
 764                            --  If in spec, just set the flag
 765
 766                            if Unit = Spec_Unit then
 767                               Set_No_Entities_Ref_In_Spec (Item);
 768
 769                            --  Else give the warning
 770
 771                            else
 772                               Error_Msg_N
 773                                 ("no entities of & are referenced?",
 774                                  Name (Item));
 775
 776                               --  Look for renamings of this package, and
 777                               --  flag them as well. If the original package
 778                               --  has warnings off, we suppress the warning
 779                               --  on the renaming as well.
 780
 781                               Pack := Find_Package_Renaming (Munite, Lunit);
 782
 783                               if Present (Pack)
 784                                 and then not Warnings_Off (Lunit)
 785                               then
 786                                  Error_Msg_NE
 787                                    ("no entities of & are referenced?",
 788                                      Unit_Declaration_Node (Pack),
 789                                        Pack);
 790                               end if;
 791                            end if;
 792
 793                            exit;
 794
 795                         --  Case of next entity is referenced
 796
 797                         elsif Referenced (Ent) then
 798
 799                            --  This means that the with is indeed fine, in
 800                            --  that it is definitely needed somewhere, and
 801                            --  we can quite worrying about this one.
 802
 803                            --  Except for one little detail, if either of
 804                            --  the flags was set during spec processing,
 805                            --  this is where we complain that the with
 806                            --  could be moved from the spec. If the spec
 807                            --  contains a visible renaming of the package,
 808                            --  inhibit warning to move with_clause to body.
 809
 810                            if Ekind (Munite) = E_Package_Body then
 811                               Pack :=
 812                                 Find_Package_Renaming
 813                                   (Spec_Entity (Munite), Lunit);
 814                            end if;
 815
 816                            if Unreferenced_In_Spec (Item) then
 817                               Error_Msg_N
 818                                 ("unit& is not referenced in spec?",
 819                                  Name (Item));
 820
 821                            elsif No_Entities_Ref_In_Spec (Item) then
 822                               Error_Msg_N
 823                                 ("no entities of & are referenced in spec?",
 824                                  Name (Item));
 825
 826                            else
 827                               exit;
 828                            end if;
 829
 830                            if not Is_Visible_Renaming then
 831                               Error_Msg_N
 832                                 ("\with clause might be moved to body?",
 833                                  Name (Item));
 834                            end if;
 835
 836                            exit;
 837
 838                         --  Move to next entity to continue search
 839
 840                         else
 841                            Next_Entity (Ent);
 842                         end if;
 843                      end loop;
 844                   end if;
 845
 846                --  For a generic package, the only interesting kind of
 847                --  reference is an instantiation, since entities cannot
 848                --  be referenced directly.
 849
 850                elsif Is_Generic_Unit (Lunit) then
 851
 852                   --  Unit was never instantiated, set flag for case of spec
 853                   --  call, or give warning for normal call.
 854
 855                   if not Is_Instantiated (Lunit) then
 856                      if Unit = Spec_Unit then
 857                         Set_Unreferenced_In_Spec (Item);
 858                      else
 859                         Error_Msg_N
 860                           ("unit& is never instantiated?", Name (Item));
 861                      end if;
 862
 863                   --  If unit was indeed instantiated, make sure that
 864                   --  flag is not set showing it was uninstantiated in
 865                   --  the spec, and if so, give warning.
 866
 867                   elsif Unreferenced_In_Spec (Item) then
 868                      Error_Msg_N
 869                        ("unit& is not instantiated in spec?", Name (Item));
 870                      Error_Msg_N
 871                        ("\with clause can be moved to body?", Name (Item));
 872                   end if;
 873                end if;
 874             end if;
 875
 876             Next (Item);
 877          end loop;
 878
 879       end Check_One_Unit;
 880
 881    --  Start of processing for Check_Unused_Withs
 882
 883    begin
 884       if not Opt.Check_Withs
 885         or else Operating_Mode = Check_Syntax
 886       then
 887          return;
 888       end if;
 889
 890       --  Flag any unused with clauses, but skip this step if we are
 891       --  compiling a subunit on its own, since we do not have enough
 892       --  information to determine whether with's are used. We will get
 893       --  the relevant warnings when we compile the parent. This is the
 894       --  normal style of GNAT compilation in any case.
 895
 896       if Nkind (Unit (Cunit (Main_Unit))) = N_Subunit then
 897          return;
 898       end if;
 899
 900       --  Process specified units
 901
 902       if Spec_Unit = No_Unit then
 903
 904          --  For main call, check all units
 905
 906          for Unit in Main_Unit .. Last_Unit loop
 907             Check_One_Unit (Unit);
 908          end loop;
 909
 910       else
 911          --  For call for spec, check only the spec
 912
 913          Check_One_Unit (Spec_Unit);
 914       end if;
 915    end Check_Unused_Withs;
 916
 917    -------------------------------------
 918    -- Operand_Has_Warnings_Suppressed --
 919    -------------------------------------
 920
 921    function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean is
 922
 923       function Check_For_Warnings (N : Node_Id) return Traverse_Result;
 924       --  Function used to check one node to see if it is or was originally
 925       --  a reference to an entity for which Warnings are off. If so, Abandon
 926       --  is returned, otherwise OK_Orig is returned to continue the traversal
 927       --  of the original expression.
 928
 929       function Traverse is new Traverse_Func (Check_For_Warnings);
 930       --  Function used to traverse tree looking for warnings
 931
 932       ------------------------
 933       -- Check_For_Warnings --
 934       ------------------------
 935
 936       function Check_For_Warnings (N : Node_Id) return Traverse_Result is
 937          R : constant Node_Id := Original_Node (N);
 938
 939       begin
 940          if Nkind (R) in N_Has_Entity
 941            and then Present (Entity (R))
 942            and then Warnings_Off (Entity (R))
 943          then
 944             return Abandon;
 945          else
 946             return OK_Orig;
 947          end if;
 948       end Check_For_Warnings;
 949
 950    --  Start of processing for Operand_Has_Warnings_Suppressed
 951
 952    begin
 953       return Traverse (N) = Abandon;
 954
 955    --  If any exception occurs, then something has gone wrong, and this is
 956    --  only a minor aesthetic issue anyway, so just say we did not find what
 957    --  we are looking for, rather than blow up.
 958
 959    exception
 960       when others =>
 961          return False;
 962    end Operand_Has_Warnings_Suppressed;
 963
 964    ----------------------------------
 965    -- Output_Unreferenced_Messages --
 966    ----------------------------------
 967
 968    procedure Output_Unreferenced_Messages is
 969       E : Entity_Id;
 970
 971    begin
 972       for J in Unreferenced_Entities.First ..
 973                Unreferenced_Entities.Last
 974       loop
 975          E := Unreferenced_Entities.Table (J);
 976
 977          if not Referenced (E) and then not Warnings_Off (E) then
 978
 979             case Ekind (E) is
 980                when E_Variable =>
 981                   if Present (Renamed_Object (E))
 982                     and then Comes_From_Source (Renamed_Object (E))
 983                   then
 984                      Error_Msg_N ("renamed variable & is not referenced?", E);
 985                   else
 986                      Error_Msg_N ("variable & is not referenced?", E);
 987                   end if;
 988
 989                when E_Constant =>
 990                   if Present (Renamed_Object (E))
 991                     and then Comes_From_Source (Renamed_Object (E))
 992                   then
 993                      Error_Msg_N ("renamed constant & is not referenced?", E);
 994                   else
 995                      Error_Msg_N ("constant & is not referenced?", E);
 996                   end if;
 997
 998                when E_In_Parameter     |
 999                     E_Out_Parameter    |
1000                     E_In_Out_Parameter =>
1001
1002                   --  Do not emit message for formals of a renaming, because
1003                   --  they are never referenced explicitly.
1004
1005                   if Nkind (Original_Node (Unit_Declaration_Node (Scope (E))))
1006                     /= N_Subprogram_Renaming_Declaration
1007                   then
1008                      Error_Msg_N ("formal parameter & is not referenced?", E);
1009                   end if;
1010
1011                when E_Named_Integer    |
1012                     E_Named_Real       =>
1013                   Error_Msg_N ("named number & is not referenced?", E);
1014
1015                when E_Enumeration_Literal =>
1016                   Error_Msg_N ("literal & is not referenced?", E);
1017
1018                when E_Function         =>
1019                   Error_Msg_N ("function & is not referenced?", E);
1020
1021                when E_Procedure         =>
1022                   Error_Msg_N ("procedure & is not referenced?", E);
1023
1024                when Type_Kind          =>
1025                   Error_Msg_N ("type & is not referenced?", E);
1026
1027                when others =>
1028                   Error_Msg_N ("& is not referenced?", E);
1029             end case;
1030
1031             Set_Warnings_Off (E);
1032          end if;
1033       end loop;
1034    end Output_Unreferenced_Messages;
1035
1036    -----------------------------
1037    -- Warn_On_Known_Condition --
1038    -----------------------------
1039
1040    procedure Warn_On_Known_Condition (C : Node_Id) is
1041       P : Node_Id;
1042
1043    begin
1044       if Constant_Condition_Warnings
1045         and then Nkind (C) = N_Identifier
1046         and then
1047           (Entity (C) = Standard_False or else Entity (C) = Standard_True)
1048         and then Comes_From_Source (Original_Node (C))
1049         and then not In_Instance
1050       then
1051          --  See if this is in a statement or a declaration
1052
1053          P := Parent (C);
1054          loop
1055             --  If tree is not attached, do not issue warning (this is very
1056             --  peculiar, and probably arises from some other error condition)
1057
1058             if No (P) then
1059                return;
1060
1061             --  If we are in a declaration, then no warning, since in practice
1062             --  conditionals in declarations are used for intended tests which
1063             --  may be known at compile time, e.g. things like
1064
1065             --    x : constant Integer := 2 + (Word'Size = 32);
1066
1067             --  And a warning is annoying in such cases
1068
1069             elsif Nkind (P) in N_Declaration
1070                     or else
1071                   Nkind (P) in N_Later_Decl_Item
1072             then
1073                return;
1074
1075             --  Don't warn in assert pragma, since presumably tests in such
1076             --  a context are very definitely intended, and might well be
1077             --  known at compile time. Note that we have to test the original
1078             --  node, since assert pragmas get rewritten at analysis time.
1079
1080             elsif Nkind (Original_Node (P)) = N_Pragma
1081               and then Chars (Original_Node (P)) = Name_Assert
1082             then
1083                return;
1084             end if;
1085
1086             exit when Is_Statement (P);
1087             P := Parent (P);
1088          end loop;
1089
1090          --  Here we issue the warning unless some sub-operand has warnings
1091          --  set off, in which case we suppress the warning for the node.
1092
1093          if not Operand_Has_Warnings_Suppressed (C) then
1094             if Entity (C) = Standard_True then
1095                Error_Msg_N ("condition is always True?", C);
1096             else
1097                Error_Msg_N ("condition is always False?", C);
1098             end if;
1099          end if;
1100       end if;
1101    end Warn_On_Known_Condition;
1102
1103 end Sem_Warn;