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