(Check_References.Publicly_Referenceable): A formal parameter is never publicly referenceable outside of its body.

	(Check_References.Publicly_Referenceable): A formal parameter is never
	publicly referenceable outside of its body.
	(Check_References): For an unreferenced formal parameter in an accecpt
	statement, use the same warning circuitry as for subprogram formal
	parameters.  
	(Warn_On_Unreferenced_Entity): New subprogram, taken from
	Output_Unreferenced_Messages, containing the part of that routine that
	is now reused for entry formals as described above.
	(Has_Pragma_Unreferenced_Check_Spec): New function
	(Check_References): Clean up handling of unmodified IN OUT parameters

From-SVN: r127471

1 files changed, 893 insertions, 303 deletions

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index b2141d7..087d8e8 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -35,6 +35,7 @@ with Lib;      use Lib;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
+with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Eval; use Sem_Eval;
@@ -51,6 +52,7 @@ package body Sem_Warn is
 
    --  The following table collects Id's of entities that are potentially
    --  unreferenced. See Check_Unset_Reference for further details.
+   --  ??? Check_Unset_Reference has zero information about this table.
 
    package Unreferenced_Entities is new Table.Table (
      Table_Component_Type => Entity_Id,
@@ -60,6 +62,14 @@ package body Sem_Warn is
      Table_Increment      => Alloc.Unreferenced_Entities_Increment,
      Table_Name           => "Unreferenced_Entities");
 
+   package In_Out_Warnings is new Table.Table (
+     Table_Component_Type => Entity_Id,
+     Table_Index_Type     => Nat,
+     Table_Low_Bound      => 1,
+     Table_Initial        => Alloc.In_Out_Warnings_Initial,
+     Table_Increment      => Alloc.In_Out_Warnings_Increment,
+     Table_Name           => "In_Out_Warnings");
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -68,8 +78,24 @@ package body Sem_Warn is
    --  This returns true if the entity E is declared within a generic package.
    --  The point of this is to detect variables which are not assigned within
    --  the generic, but might be assigned outside the package for any given
-   --  instance. These are cases where we leave the warnings to be posted
-   --  for the instance, when we will know more.
+   --  instance. These are cases where we leave the warnings to be posted for
+   --  the instance, when we will know more.
+
+   function Goto_Spec_Entity (E : Entity_Id) return Entity_Id;
+   --  If E is a parameter entity for a subprogram body, then this function
+   --  returns the corresponding spec entity, if not, E is returned unchanged.
+
+   function Has_Pragma_Unreferenced_Check_Spec (E : Entity_Id) return Boolean;
+   --  Tests Has_Pragma_Unreferenced flag for entity E. If E is not a formal,
+   --  this is simply the setting of the flag Has_Pragma_Unreferenced. If E is
+   --  a body formal, the setting of the flag in the corresponding spec is
+   --  also checked (and True returned if either flag is True).
+
+   function Never_Set_In_Source_Check_Spec (E : Entity_Id) return Boolean;
+   --  Tests Never_Set_In_Source status for entity E. If E is not a formal,
+   --  this is simply the setting of the flag Never_Set_In_Source. If E is
+   --  a body formal, the setting of the flag in the corresponding spec is
+   --  also checked (and False returned if either flag is False).
 
    function Operand_Has_Warnings_Suppressed (N : Node_Id) return Boolean;
    --  This function traverses the expression tree represented by the node N
@@ -77,6 +103,26 @@ package body Sem_Warn is
    --  the Warnings_Off flag is set. True is returned if such an entity is
    --  encountered, and False otherwise.
 
+   function Referenced_Check_Spec (E : Entity_Id) return Boolean;
+   --  Tests Referenced status for entity E. If E is not a formal, this is
+   --  simply the setting of the flag Referenced. If E is a body formal, the
+   --  setting of the flag in the corresponding spec is also checked (and True
+   --  returned if either flag is True).
+
+   function Referenced_As_LHS_Check_Spec (E : Entity_Id) return Boolean;
+   --  Tests Referenced_As_LHS status for entity E. If E is not a formal, this
+   --  is simply the setting of the flag Referenced_As_LHS. If E is a body
+   --  formal, the setting of the flag in the corresponding spec is also
+   --  checked (and True returned if either flag is True).
+
+   procedure Warn_On_Unreferenced_Entity
+     (Spec_E : Entity_Id;
+      Body_E : Entity_Id := Empty);
+   --  Output warnings for unreferenced entity E. For the case of an entry
+   --  formal, Body_E is the corresponding body entity for a particular
+   --  accept statement, and the message is posted on Body_E. In all other
+   --  cases, Body_E is ignored and must be Empty.
+
    --------------------------
    -- Check_Code_Statement --
    --------------------------
@@ -95,7 +141,7 @@ package body Sem_Warn is
 
       if No (Asm_Input_Value) then
          Error_Msg_F
-           ("?code statement with no inputs should usually be Volatile", N);
+           ("?code statement with no inputs should usually be Volatile!", N);
          return;
       end if;
 
@@ -103,7 +149,7 @@ package body Sem_Warn is
 
       if No (Asm_Output_Variable) then
          Error_Msg_F
-           ("?code statement with no outputs should usually be Volatile", N);
+           ("?code statement with no outputs should usually be Volatile!", N);
          return;
       end if;
 
@@ -114,9 +160,9 @@ package body Sem_Warn is
         and then Nkind (Prev (N)) = N_Code_Statement
       then
          Error_Msg_F
-           ("?code statements in sequence should usually be Volatile", N);
+           ("?code statements in sequence should usually be Volatile!", N);
          Error_Msg_F
-           ("\?(suggest using template with multiple instructions)", N);
+           ("\?(suggest using template with multiple instructions)!", N);
       end if;
    end Check_Code_Statement;
 
@@ -131,17 +177,17 @@ package body Sem_Warn is
    procedure Check_Infinite_Loop_Warning (Loop_Statement : Node_Id) is
       Iter : constant Node_Id := Iteration_Scheme (Loop_Statement);
 
-      Ref : Node_Id   := Empty;
-      --  Reference in iteration scheme to variable that may not be modified
-      --  in loop, indicating a possible infinite loop.
+      Ref : Node_Id := Empty;
+      --  Reference in iteration scheme to variable that may not be modified in
+      --  loop, indicating a possible infinite loop.
 
       Var : Entity_Id := Empty;
       --  Corresponding entity (entity of Ref)
 
       procedure Find_Var (N : Node_Id);
-      --  Inspect condition to see if it depends on a single entity
-      --  reference. If so, Ref is set to point to the reference node,
-      --  and Var is set to the referenced Entity.
+      --  Inspect condition to see if it depends on a single entity reference.
+      --  If so, Ref is set to point to the reference node, and Var is set to
+      --  the referenced Entity.
 
       function Has_Indirection (T : Entity_Id) return Boolean;
       --  If the controlling variable is an access type, or is a record type
@@ -408,12 +454,14 @@ package body Sem_Warn is
          elsif Nkind (N) = N_Procedure_Call_Statement
            or else Nkind (N) = N_Function_Call
          then
-            --  If subprogram is within the scope of the entity we are
-            --  dealing with as the loop variable, then it could modify
-            --  this parameter, so we abandon in this case. In the case
-            --  of a subprogram that is not an entity we also abandon.
+            --  If subprogram is within the scope of the entity we are dealing
+            --  with as the loop variable, then it could modify this parameter,
+            --  so we abandon in this case. In the case of a subprogram that is
+            --  not an entity we also abandon. The check for no entity being
+            --  present is a defense against previous errors.
 
             if not Is_Entity_Name (Name (N))
+              or else No (Entity (Name (N)))
               or else Scope_Within (Entity (Name (N)), Scope (Var))
             then
                return Abandon;
@@ -485,9 +533,9 @@ package body Sem_Warn is
 
       if Find_Ref (Loop_Statement) = OK then
          Error_Msg_NE
-           ("variable& is not modified in loop body?", Ref, Var);
+           ("?variable& is not modified in loop body!", Ref, Var);
          Error_Msg_N
-           ("\possible infinite loop", Ref);
+           ("\?possible infinite loop!", Ref);
       end if;
    end Check_Infinite_Loop_Warning;
 
@@ -499,6 +547,12 @@ package body Sem_Warn is
       E1 : Entity_Id;
       UR : Node_Id;
 
+      function Body_Formal
+        (E                : Entity_Id;
+         Accept_Statement : Node_Id) return Entity_Id;
+      --  For an entry formal entity from an entry declaration, find the
+      --  corrsesponding body formal from the given accept statement.
+
       function Missing_Subunits return Boolean;
       --  We suppress warnings when there are missing subunits, because this
       --  may generate too many false positives: entities in a parent may only
@@ -556,12 +610,53 @@ package body Sem_Warn is
          end if;
       end Missing_Subunits;
 
+      -----------------
+      -- Body_Formal --
+      -----------------
+
+      function Body_Formal
+        (E                : Entity_Id;
+         Accept_Statement : Node_Id) return Entity_Id
+      is
+         Body_Param : Node_Id;
+         Body_E     : Entity_Id;
+
+      begin
+         --  Loop to find matching parameter in accept statement
+
+         Body_Param := First (Parameter_Specifications (Accept_Statement));
+         while Present (Body_Param) loop
+            Body_E := Defining_Identifier (Body_Param);
+
+            if Chars (Body_E) = Chars (E) then
+               return Body_E;
+            end if;
+
+            Next (Body_Param);
+         end loop;
+
+         --  Should never fall through, should always find a match
+
+         raise Program_Error;
+      end Body_Formal;
+
       ----------------------------
       -- Output_Reference_Error --
       ----------------------------
 
       procedure Output_Reference_Error (M : String) is
       begin
+         --  Don't output message for IN OUT formal unless we have the warning
+         --  flag specifically set. It is a bit odd to distinguish IN OUT
+         --  formals from other cases. This distinction is historical in
+         --  nature. Warnings for IN OUT formals were added fairly late.
+
+         if Ekind (E1) = E_In_Out_Parameter
+           and then not Check_Unreferenced_Formals
+         then
+            return;
+         end if;
+
          --  Other than accept case, post error on defining identifier
 
          if No (Anod) then
@@ -570,30 +665,8 @@ package body Sem_Warn is
          --  Accept case, find body formal to post the message
 
          else
-            declare
-               Parm  : Node_Id;
-               Enod  : Node_Id;
-               Defid : Entity_Id;
-
-            begin
-               Enod := Anod;
-
-               if Present (Parameter_Specifications (Anod)) then
-                  Parm := First (Parameter_Specifications (Anod));
-                  while Present (Parm) loop
-                     Defid := Defining_Identifier (Parm);
+            Error_Msg_NE (M, Body_Formal (E1, Accept_Statement => Anod), E1);
 
-                     if Chars (E1) = Chars (Defid) then
-                        Enod := Defid;
-                        exit;
-                     end if;
-
-                     Next (Parm);
-                  end loop;
-               end if;
-
-               Error_Msg_NE (M, Enod, E1);
-            end;
          end if;
       end Output_Reference_Error;
 
@@ -606,6 +679,13 @@ package body Sem_Warn is
          Prev : Node_Id;
 
       begin
+         --  A formal parameter is never referenceable outside the body of its
+         --  subprogram or entry.
+
+         if Is_Formal (Ent) then
+            return False;
+         end if;
+
          --  Examine parents to look for a library level package spec. But if
          --  we find a body or block or other similar construct along the way,
          --  we cannot be referenced.
@@ -627,8 +707,8 @@ package body Sem_Warn is
                --  we will get a warning for the package entity.
 
                --  Note that generic formal parameters are themselves not
-               --  publicly referenceable in an instance, and warnings on
-               --  them are useful.
+               --  publicly referenceable in an instance, and warnings on them
+               --  are useful.
 
                when N_Generic_Package_Declaration =>
                   return
@@ -636,8 +716,8 @@ package body Sem_Warn is
                       or else List_Containing (Prev)
                         /= Generic_Formal_Declarations (P);
 
-               --  Similarly, the generic formals of a generic subprogram
-               --  are not accessible.
+               --  Similarly, the generic formals of a generic subprogram are
+               --  not accessible.
 
                when N_Generic_Subprogram_Declaration  =>
                   if Is_List_Member (Prev)
@@ -714,17 +794,19 @@ package body Sem_Warn is
            and then not Warnings_Off (Etype (E1))
            and then not Warnings_Off (Base_Type (Etype (E1)))
          then
-            --  We are interested in variables and out parameters, but we
-            --  exclude protected types, too complicated to worry about.
+            --  We are interested in variables and out/in-out parameters, but
+            --  we exclude protected types, too complicated to worry about.
 
             if Ekind (E1) = E_Variable
                  or else
-               (Ekind (E1) = E_Out_Parameter
+                ((Ekind (E1) = E_Out_Parameter
+                    or else Ekind (E1) = E_In_Out_Parameter)
                   and then not Is_Protected_Type (Current_Scope))
             then
-               --  Post warning if this object not assigned. Note that we do
-               --  not consider the implicit initialization of an access type
-               --  to be the assignment of a value for this purpose.
+               --  Case of an unassigned variable
+
+               --  First gather any Unset_Reference indication for E1. In the
+               --  case of a parameter, it is the Spec_Entity that is relevant.
 
                if Ekind (E1) = E_Out_Parameter
                  and then Present (Spec_Entity (E1))
@@ -737,7 +819,7 @@ package body Sem_Warn is
                --  If the entity is an out parameter of the current subprogram
                --  body, check the warning status of the parameter in the spec.
 
-               if Ekind (E1) = E_Out_Parameter
+               if Is_Formal (E1)
                  and then Present (Spec_Entity (E1))
                  and then Warnings_Off (Spec_Entity (E1))
                then
@@ -746,63 +828,15 @@ package body Sem_Warn is
                elsif Present (UR)
                  and then Is_Access_Type (Etype (E1))
                then
-
                   --  For access types, the only time we made a UR entry was
                   --  for a dereference, and so we post the appropriate warning
                   --  here (note that the dereference may not be explicit in
                   --  the source, for example in the case of a dispatching call
                   --  with an anonymous access controlling formal, or of an
-                  --  assignment of a pointer involving discriminant check on
-                  --  the designated object).
+                  --  assignment of a pointer involving discriminant check
+                  --  on the designated object).
 
-                  Error_Msg_NE ("& may be null?", UR, E1);
-                  goto Continue;
-
-               elsif Never_Set_In_Source (E1)
-                 and then not Generic_Package_Spec_Entity (E1)
-               then
-                  if Warn_On_No_Value_Assigned then
-
-                     --  Do not output complaint about never being assigned a
-                     --  value if a pragma Unreferenced applies to the variable
-                     --  or if it is a parameter, to the corresponding spec.
-
-                     if Has_Pragma_Unreferenced (E1)
-                       or else Has_Pragma_Unreferenced_Objects (Etype (E1))
-                       or else (Is_Formal (E1)
-                                  and then Present (Spec_Entity (E1))
-                                  and then
-                                    Has_Pragma_Unreferenced (Spec_Entity (E1)))
-                     then
-                        null;
-
-                     --  Pragma Unreferenced not set, so output message
-
-                     else
-                        if Referenced (E1) then
-                           Output_Reference_Error
-                             ("variable& is read but never assigned?");
-                        else
-                           Output_Reference_Error
-                             ("variable& is never read and never assigned?");
-                        end if;
-
-                        --  Deal with special case where this variable is
-                        --  hidden by a loop variable
-
-                        if Ekind (E1) = E_Variable
-                          and then Present (Hiding_Loop_Variable (E1))
-                        then
-                           Error_Msg_Sloc := Sloc (E1);
-                           Error_Msg_N
-                             ("declaration hides &#?",
-                              Hiding_Loop_Variable (E1));
-                           Error_Msg_N
-                             ("for loop implicitly declares loop variable?",
-                              Hiding_Loop_Variable (E1));
-                        end if;
-                     end if;
-                  end if;
+                  Error_Msg_NE ("?& may be null!", UR, E1);
                   goto Continue;
 
                --  Case of variable that could be a constant. Note that we
@@ -811,8 +845,12 @@ package body Sem_Warn is
                --  the package.
 
                elsif Warn_On_Constant
-                 and then Ekind (E1) = E_Variable
-                 and then Is_True_Constant (E1)
+                 and then ((Ekind (E1) = E_Variable
+                              and then Has_Initial_Value (E1))
+                             or else
+                            Ekind (E1) = E_In_Out_Parameter)
+                 and then Never_Set_In_Source_Check_Spec (E1)
+                 and then not Address_Taken (E1)
                  and then not Generic_Package_Spec_Entity (E1)
                then
                   --  A special case, if this variable is volatile and not
@@ -824,44 +862,203 @@ package body Sem_Warn is
                     and then not Is_Imported (E1)
                   then
                      Error_Msg_N
-                       ("& is not modified, volatile has no effect?", E1);
+                       ("?& is not modified, volatile has no effect!", E1);
+
+                  --  Another special case, Exception_Occurrence, this catches
+                  --  the case of exception choice (and a bit more too, but not
+                  --  worth doing more investigation here).
+
+                  elsif Is_RTE (Etype (E1), RE_Exception_Occurrence) then
+                     null;
+
+                  --  Here we give the warning if referenced and no pragma
+                  --  Unreferenced is present.
+
                   else
-                     Error_Msg_N
-                       ("& is not modified, could be declared constant?", E1);
+                     if Ekind (E1) = E_Variable then
+                        if Referenced_Check_Spec (E1)
+                          and then not Has_Pragma_Unreferenced_Check_Spec (E1)
+                        then
+                           Error_Msg_N
+                             ("?& is not modified, "
+                              & "could be declared constant!",
+                              E1);
+                        end if;
+
+                     else pragma Assert (Ekind (E1) = E_In_Out_Parameter);
+                        if Referenced_Check_Spec (E1)
+                          and then
+                            not Has_Pragma_Unreferenced_Check_Spec (E1)
+                        then
+                           --  Suppress warning if private type, since in this
+                           --  case it may be quite reasonable for the logical
+                           --  view to be in out, even if the implementation
+                           --  ends up using access types.
+
+                           if Has_Private_Declaration (Etype (E1)) then
+                              null;
+
+                           --  Suppress warning for any composite type, since
+                           --  for composites it seems quite reasonable to pass
+                           --  a value of the composite type and then modify
+                           --  just a component.
+
+                           elsif Is_Composite_Type (Etype (E1)) then
+                              null;
+
+                           --  Suppress warning for parameter of dispatching
+                           --  operation, since it is quite reasonable to have
+                           --  an operation that is overridden, and for some
+                           --  subclasses needs to be IN OUT and for others
+                           --  the parameter does not happen to be assigned.
+
+                           elsif Is_Dispatching_Operation
+                             (Scope (Goto_Spec_Entity (E1)))
+                           then
+                              null;
+
+                           --  OK, looks like warning for an IN OUT parameter
+                           --  that could be IN makes sense, but we delay the
+                           --  output of the warning, pending possibly finding
+                           --  out later on that the associated subprogram is
+                           --  used as a generic actual, or its address/access
+                           --  is taken. In these two cases, we suppress the
+                           --  warning because the context may force use of IN
+                           --  OUT, even if in this particular case the formal
+                           --  is not modifed.
+
+                           else
+                              In_Out_Warnings.Append (E1);
+                           end if;
+                        end if;
+                     end if;
+                  end if;
+
+                  --  Other cases of a variable never set in source
+
+               elsif Never_Set_In_Source_Check_Spec (E1)
+
+                  --  No warning if warning for this case turned off
+
+                  and then Warn_On_No_Value_Assigned
+
+                  --  No warning if address taken somewhere
+
+                  and then not Address_Taken (E1)
+
+                  --  No warning if explicit initial value
+
+                  and then not Has_Initial_Value (E1)
+
+                  --  No warning for generic package spec entities, since we
+                  --  might set them in a child unit or something like that
+
+                  and then not Generic_Package_Spec_Entity (E1)
+
+                  --  No warning if fully initialized type, except that for
+                  --  this purpose we do not consider access types to qualify
+                  --  as fully initialized types (relying on an access type
+                  --  variable being null when it is never set is a bit odd!)
+
+                  --  Also we generate warning for an out parameter that is
+                  --  never referenced, since again it seems odd to rely on
+                  --  default initialization to set an out parameter value.
+
+                 and then (Is_Access_Type (Etype (E1))
+                            or else Ekind (E1) = E_Out_Parameter
+                            or else not Is_Fully_Initialized_Type (Etype (E1)))
+               then
+                  --  Do not output complaint about never being assigned a
+                  --  value if a pragma Unreferenced applies to the variable
+                  --  we are examining, or if it is a parameter, if there is
+                  --  a pragma Unreferenced for the corresponding spec.
+
+                  if Has_Pragma_Unreferenced_Check_Spec (E1)
+                    or else Has_Pragma_Unreferenced_Objects (Etype (E1))
+                  then
+                     null;
+
+                  --  Case of unreferenced formal
+
+                  elsif Is_Formal (E1) then
+                     if Referenced_Check_Spec (E1) then
+                        Output_Reference_Error
+                          ("?formal parameter& is read but never assigned!");
+                     else
+                        Output_Reference_Error
+                          ("?formal parameter& is not referenced!");
+                     end if;
+
+                  --  Case of variable
+
+                  else
+                     if Referenced (E1) then
+                        Output_Reference_Error
+                          ("?variable& is read but never assigned!");
+                     else
+                        Output_Reference_Error
+                          ("?variable& is never read and never assigned!");
+                     end if;
+
+                     --  Deal with special case where this variable is
+                     --  hidden by a loop variable
+
+                     if Ekind (E1) = E_Variable
+                       and then Present (Hiding_Loop_Variable (E1))
+                     then
+                        Error_Msg_N
+                          ("?for loop implicitly declares loop variable!",
+                           Hiding_Loop_Variable (E1));
+
+                        Error_Msg_Sloc := Sloc (E1);
+                        Error_Msg_N
+                          ("\?declaration hides & declared#!",
+                           Hiding_Loop_Variable (E1));
+                     end if;
                   end if;
+
+                  goto Continue;
                end if;
 
-               --  Check for unset reference, note that we exclude access
-               --  types from this check, since access types do always have
-               --  a null value, and that seems legitimate in this case.
+               --  Check for unset reference
 
                if Warn_On_No_Value_Assigned and then Present (UR) then
 
-                  --  For other than access type, go back to original node
-                  --  to deal with case where original unset reference
-                  --  has been rewritten during expansion.
+                  --  For other than access type, go back to original node to
+                  --  deal with case where original unset reference has been
+                  --  rewritten during expansion.
 
-                  UR := Original_Node (UR);
-
-                  --  In some cases, the original node may be a type
-                  --  conversion or qualification, and in this case
-                  --  we want the object entity inside.
+                  --  In some cases, the original node may be a type conversion
+                  --  or qualification, and in this case we want the object
+                  --  entity inside.
 
+                  UR := Original_Node (UR);
                   while Nkind (UR) = N_Type_Conversion
                     or else Nkind (UR) = N_Qualified_Expression
                   loop
                      UR := Expression (UR);
                   end loop;
 
-                  --  Here we issue the warning, all checks completed If the
-                  --  unset reference is prefix of a selected component that
-                  --  comes from source, mention the component as well. If the
-                  --  selected component comes from expansion, all we know is
-                  --  that the entity is not fully initialized at the point of
-                  --  the reference. Locate an unintialized component to get a
-                  --  better error message.
+                  --  Here we issue the warning, all checks completed
+
+                  --  If we have a return statement, this was a case of an OUT
+                  --  parameter not being set at the time of the return. (Note:
+                  --  it can't be N_Extended_Return_Statement, because those
+                  --  are only for functions, and functions do not allow OUT
+                  --  parameters.)
+
+                  if Nkind (UR) = N_Simple_Return_Statement then
+                     Error_Msg_NE
+                       ("?OUT parameter& not set before return", UR, E1);
+
+                  --  If the unset reference is prefix of a selected component
+                  --  that comes from source, mention the component as well. If
+                  --  the selected component comes from expansion, all we know
+                  --  is that the entity is not fully initialized at the point
+                  --  of the reference. Locate an unintialized component to get
+                  --  a better error message.
 
-                  if Nkind (Parent (UR)) = N_Selected_Component then
+                  elsif Nkind (Parent (UR)) = N_Selected_Component then
                      Error_Msg_Node_2 := Selector_Name (Parent (UR));
 
                      if not Comes_From_Source (Parent (UR)) then
@@ -873,7 +1070,7 @@ package body Sem_Warn is
                            while Present (Comp) loop
                               if Ekind (Comp) = E_Component
                                 and then Nkind (Parent (Comp)) =
-                                  N_Component_Declaration
+                                                      N_Component_Declaration
                                 and then No (Expression (Parent (Comp)))
                               then
                                  Error_Msg_Node_2 := Comp;
@@ -885,12 +1082,24 @@ package body Sem_Warn is
                         end;
                      end if;
 
-                     Error_Msg_N
-                       ("`&.&` may be referenced before it has a value?",
-                        UR);
+                     --  Issue proper warning. This is a case of referencing
+                     --  a variable before it has been explicitly assigned.
+                     --  For access types, UR was only set for dereferences,
+                     --  so the issue is that the value may be null.
+
+                     if Is_Access_Type (Etype (Parent (UR))) then
+                        Error_Msg_N ("?`&.&` may be null!", UR);
+                     else
+                        Error_Msg_N
+                          ("?`&.&` may be referenced before it has a value!",
+                           UR);
+                     end if;
+
+                  --  All other cases of unset reference active
+
                   else
                      Error_Msg_N
-                       ("& may be referenced before it has a value?",
+                       ("?& may be referenced before it has a value!",
                         UR);
                   end if;
 
@@ -903,7 +1112,7 @@ package body Sem_Warn is
             --  set. The Referenced_As_LHS flag is interesting only if the
             --  Referenced flag is not set.
 
-            if not Referenced (E1)
+            if not Referenced_Check_Spec (E1)
 
                --  Check that warnings on unreferenced entities are enabled
 
@@ -912,7 +1121,7 @@ package body Sem_Warn is
                         (Check_Unreferenced_Formals and then Is_Formal (E1))
                            or else
                         (Warn_On_Modified_Unread
-                          and then Referenced_As_LHS (E1)))
+                          and then Referenced_As_LHS_Check_Spec (E1)))
 
                --  Labels, and enumeration literals, and exceptions. The
                --  warnings are also placed on local packages that cannot be
@@ -1026,17 +1235,23 @@ package body Sem_Warn is
                   --  We do not immediately flag the error. This is because we
                   --  have not expanded generic bodies yet, and they may have
                   --  the missing reference. So instead we park the entity on a
-                  --  list, for later processing. However, for the accept case,
-                  --  post the error right here, since we have the information
-                  --  now in this case.
+                  --  list, for later processing. However for the case of an
+                  --  accept statement we want to output messages now, since
+                  --  we know we already have all information at hand, and we
+                  --  also want to have separate warnings for each accept
+                  --  statement for the same entry.
 
                   if Present (Anod) then
-                     Output_Reference_Error ("& is not referenced?");
+                     pragma Assert (Is_Formal (E1));
+
+                     --  The unreferenced entity is E1, but post the warning
+                     --  on the body entity for this accept statement.
+
+                     Warn_On_Unreferenced_Entity
+                       (E1, Body_Formal (E1, Accept_Statement => Anod));
 
                   else
-                     Unreferenced_Entities.Increment_Last;
-                     Unreferenced_Entities.Table
-                       (Unreferenced_Entities.Last) := E1;
+                     Unreferenced_Entities.Append (E1);
                   end if;
                end if;
 
@@ -1051,8 +1266,7 @@ package body Sem_Warn is
               and then Instantiation_Depth (Sloc (E1)) = 0
               and then Warn_On_Redundant_Constructs
             then
-               Unreferenced_Entities.Increment_Last;
-               Unreferenced_Entities.Table (Unreferenced_Entities.Last) := E1;
+               Unreferenced_Entities.Append (E1);
 
                --  Force warning on entity
 
@@ -1084,6 +1298,68 @@ package body Sem_Warn is
    ---------------------------
 
    procedure Check_Unset_Reference (N : Node_Id) is
+      Typ : constant Entity_Id := Etype (N);
+
+      function Is_OK_Fully_Initialized return Boolean;
+      --  This function returns true if the given node N is fully initialized
+      --  so that the reference is safe as far as this routine is concerned.
+      --  Safe generally means that the type of N is a fully initialized type.
+      --  The one special case is that for access types, which are always fully
+      --  initialized, we don't consider a dereference OK since it will surely
+      --  be dereferencing a null value, which won't do.
+
+      function Prefix_Has_Dereference (Pref : Node_Id) return Boolean;
+      --  Used to test indexed or selected component or slice to see if the
+      --  evaluation of the prefix depends on a dereference, and if so, returns
+      --  True, in which case we always check the prefix, even if we know that
+      --  the referenced component is initialized. Pref is the prefix to test.
+
+      -----------------------------
+      -- Is_OK_Fully_Initialized --
+      -----------------------------
+
+      function Is_OK_Fully_Initialized return Boolean is
+      begin
+         if Is_Access_Type (Typ) and then Is_Dereferenced (N) then
+            return False;
+         else
+            return Is_Fully_Initialized_Type (Typ);
+         end if;
+      end Is_OK_Fully_Initialized;
+
+      ----------------------------
+      -- Prefix_Has_Dereference --
+      ----------------------------
+
+      function Prefix_Has_Dereference (Pref : Node_Id) return Boolean is
+      begin
+         --  If prefix is of an access type, certainly need a dereference
+
+         if Is_Access_Type (Etype (Pref)) then
+            return True;
+
+         --  If prefix is explicit dereference, that's a dereference for sure
+
+         elsif Nkind (Pref) = N_Explicit_Dereference then
+            return True;
+
+            --  If prefix is itself a component reference or slice check prefix
+
+         elsif Nkind (Pref) = N_Slice
+           or else Nkind (Pref) = N_Indexed_Component
+           or else Nkind (Pref) = N_Selected_Component
+         then
+            return Prefix_Has_Dereference (Prefix (Pref));
+
+         --  All other cases do not involve a dereference
+
+         else
+            return False;
+         end if;
+      end Prefix_Has_Dereference;
+
+   --  Start of processing for Check_Unset_Reference
+
    begin
       --  Nothing to do if warnings suppressed
 
@@ -1091,13 +1367,11 @@ package body Sem_Warn is
          return;
       end if;
 
-      --  Ignore reference to non-scalar if not from source. Almost always such
-      --  references are bogus (e.g. calls to init procs to set default
-      --  discriminant values).
+      --  Ignore reference unless it comes from source. Almost always if we
+      --  have a reference from generated code, it is bogus (e.g. calls to init
+      --  procs to set default discriminant values).
 
-      if not Comes_From_Source (N)
-        and then not Is_Scalar_Type (Etype (N))
-      then
+      if not Comes_From_Source (N) then
          return;
       end if;
 
@@ -1110,21 +1384,27 @@ package body Sem_Warn is
       --  unset reference, we check whether N is earlier before proceeding.
 
       case Nkind (N) is
+
+         --  For identifier or exanded name, examine the entity involved
+
          when N_Identifier | N_Expanded_Name =>
             declare
                E : constant Entity_Id := Entity (N);
 
             begin
                if (Ekind (E) = E_Variable
-                    or else Ekind (E) = E_Out_Parameter)
-                 and then Never_Set_In_Source (E)
+                     or else
+                   Ekind (E) = E_Out_Parameter)
+                 and then Never_Set_In_Source_Check_Spec (E)
+                 and then not Has_Initial_Value (E)
                  and then (No (Unset_Reference (E))
-                             or else Earlier_In_Extended_Unit
-                               (Sloc (N),  Sloc (Unset_Reference (E))))
+                            or else
+                              Earlier_In_Extended_Unit
+                                (Sloc (N),  Sloc (Unset_Reference (E))))
                  and then not Warnings_Off (E)
                then
                   --  We may have an unset reference. The first test is whether
-                  --  we are accessing a discriminant of a record or a
+                  --  this is an access to a discriminant of a record or a
                   --  component with default initialization. Both of these
                   --  cases can be ignored, since the actual object that is
                   --  referenced is definitely initialized. Note that this
@@ -1137,21 +1417,29 @@ package body Sem_Warn is
                   --  not the record, and still deserves an unset reference.
 
                   if Nkind (Parent (N)) = N_Selected_Component
-                    and not Is_Access_Type (Etype (N))
+                    and not Is_Access_Type (Typ)
                   then
                      declare
                         ES : constant Entity_Id :=
                                Entity (Selector_Name (Parent (N)));
-
                      begin
                         if Ekind (ES) = E_Discriminant
-                          or else Present (Expression (Declaration_Node (ES)))
+                          or else
+                            (Present (Declaration_Node (ES))
+                               and then
+                             Present (Expression (Declaration_Node (ES))))
                         then
                            return;
                         end if;
                      end;
                   end if;
 
+                  --  Exclude fully initialized types
+
+                  if Is_OK_Fully_Initialized then
+                     return;
+                  end if;
+
                   --  Here we have a potential unset reference. But before we
                   --  get worried about it, we have to make sure that the
                   --  entity declaration is in the same procedure as the
@@ -1187,13 +1475,12 @@ package body Sem_Warn is
                      --  cannot be truly uninitialized, but we still want to
                      --  warn about cases of obvious null dereference.
 
-                     if Is_Access_Type (Etype (N)) then
+                     if Is_Access_Type (Typ) then
                         Access_Type_Case : declare
                            P : Node_Id;
 
                            function Process
-                             (N    : Node_Id)
-                              return Traverse_Result;
+                             (N : Node_Id) return Traverse_Result;
                            --  Process function for instantation of Traverse
                            --  below. Checks if N contains reference to other
                            --  than a dereference.
@@ -1207,8 +1494,7 @@ package body Sem_Warn is
                            -------------
 
                            function Process
-                             (N    : Node_Id)
-                              return Traverse_Result
+                             (N : Node_Id) return Traverse_Result
                            is
                            begin
                               if Is_Entity_Name (N)
@@ -1234,18 +1520,18 @@ package body Sem_Warn is
                         --  Start of processing for Access_Type_Case
 
                         begin
-                           --  Don't bother if we are inside an instance,
-                           --  since the compilation of the generic template
-                           --  is where the warning should be issued.
+                           --  Don't bother if we are inside an instance, since
+                           --  the compilation of the generic template is where
+                           --  the warning should be issued.
 
                            if In_Instance then
                               return;
                            end if;
 
-                           --  Don't bother if this is not the main unit.
-                           --  If we try to give this warning for with'ed
-                           --  units, we get some false positives, since
-                           --  we do not record references in other units.
+                           --  Don't bother if this is not the main unit. If we
+                           --  try to give this warning for with'ed units, we
+                           --  get some false positives, since we do not record
+                           --  references in other units.
 
                            if not In_Extended_Main_Source_Unit (E)
                                 or else
@@ -1301,8 +1587,8 @@ package body Sem_Warn is
                      if Nkind (N) = N_Identifier then
                         Set_Unset_Reference (E, N);
 
-                     --  Otherwise it is an expanded name, so set the field
-                     --  of the actual identifier for the reference.
+                     --  Otherwise it is an expanded name, so set the field of
+                     --  the actual identifier for the reference.
 
                      else
                         Set_Unset_Reference (E, Selector_Name (N));
@@ -1311,25 +1597,90 @@ package body Sem_Warn is
                end if;
             end;
 
+         --  Indexed component or slice
+
          when N_Indexed_Component | N_Slice =>
-            Check_Unset_Reference (Prefix (N));
 
-         when N_Selected_Component =>
+            --  If prefix does not involve dereferencing an access type, then
+            --  we know we are OK if the component type is fully initialized,
+            --  since the component will have been set as part of the default
+            --  initialization.
 
-            if Present (Entity (Selector_Name (N)))
-              and then Ekind (Entity (Selector_Name (N))) = E_Discriminant
+            if not Prefix_Has_Dereference (Prefix (N))
+              and then Is_OK_Fully_Initialized
             then
-               --   A discriminant is always initialized
+               return;
 
-               null;
+            --  Look at prefix in access type case, or if the component is not
+            --  fully initialized.
 
             else
                Check_Unset_Reference (Prefix (N));
             end if;
 
+         --  Record component
+
+         when N_Selected_Component =>
+            declare
+               Pref : constant Node_Id   := Prefix (N);
+               Ent  : constant Entity_Id := Entity (Selector_Name (N));
+
+            begin
+               --  If prefix involves dereferencing an access type, always
+               --  check the prefix, since the issue then is whether this
+               --  access value is null.
+
+               if Prefix_Has_Dereference (Pref) then
+                  null;
+
+               --  Always go to prefix if no selector entity is set. Can this
+               --  happen in the normal case? Not clear, but it definitely can
+               --  happen in error cases.
+
+               elsif No (Ent) then
+                  null;
+
+               --  For a record component, check some cases where we have
+               --  reasonable cause to consider that the component is known to
+               --  be or probably is initialized. In this case, we don't care
+               --  if the prefix itself was explicitly initialized.
+
+               --  Discriminants are always considered initialized
+
+               elsif Ekind (Ent) = E_Discriminant then
+                  return;
+
+               --  An explicitly initialized component is certainly initialized
+
+               elsif Nkind (Parent (Ent)) = N_Component_Declaration
+                 and then Present (Expression (Parent (Ent)))
+               then
+                  return;
+
+               --  A fully initialized component is initialized
+
+               elsif Is_OK_Fully_Initialized then
+                  return;
+               end if;
+
+               --  If none of those cases apply, check the record type prefix
+
+               Check_Unset_Reference (Pref);
+            end;
+
+         --  For type conversions or qualifications examine the expression
+
          when N_Type_Conversion | N_Qualified_Expression =>
             Check_Unset_Reference (Expression (N));
 
+         --  For explicit dereference, always check prefix, which will generate
+         --  an unset reference (since this is a case of dereferencing null).
+
+         when N_Explicit_Dereference =>
+            Check_Unset_Reference (Prefix (N));
+
+         --  All other cases are not cases of an unset reference
+
          when others =>
             null;
 
@@ -1406,7 +1757,7 @@ package body Sem_Warn is
                      if Entity (Nam) = Pack then
                         Error_Msg_Qual_Level := 1;
                         Error_Msg_NE
-                          ("no entities of package& are referenced?",
+                          ("?no entities of package& are referenced!",
                              Nam, Pack);
                         Error_Msg_Qual_Level := 0;
                      end if;
@@ -1423,7 +1774,7 @@ package body Sem_Warn is
          begin
             E := First_Entity (Pack);
             while Present (E) loop
-               if Referenced (E) then
+               if Referenced_Check_Spec (E) then
                   return;
                end if;
 
@@ -1451,7 +1802,7 @@ package body Sem_Warn is
             then
                Ent := First_Entity (System_Aux_Id);
                while Present (Ent) loop
-                  if Referenced (Ent) then
+                  if Referenced_Check_Spec (Ent) then
                      return True;
                   end if;
 
@@ -1559,7 +1910,7 @@ package body Sem_Warn is
 
                      else
                         Error_Msg_N
-                          ("unit& is not referenced?", Name (Item));
+                          ("?unit& is not referenced!", Name (Item));
                      end if;
                   end if;
 
@@ -1630,7 +1981,7 @@ package body Sem_Warn is
 
                            else
                               Error_Msg_N
-                                ("no entities of & are referenced?",
+                                ("?no entities of & are referenced!",
                                  Name (Item));
 
                               --  Look for renamings of this package, and flag
@@ -1644,7 +1995,7 @@ package body Sem_Warn is
                                 and then not Warnings_Off (Lunit)
                               then
                                  Error_Msg_NE
-                                   ("no entities of & are referenced?",
+                                   ("?no entities of & are referenced!",
                                      Unit_Declaration_Node (Pack),
                                        Pack);
                               end if;
@@ -1652,16 +2003,23 @@ package body Sem_Warn is
 
                            exit;
 
-                        --  Case of next entity is referenced
-
-                        elsif Referenced (Ent)
-                          or else Referenced_As_LHS (Ent)
+                        --  Case of entity being referenced. The reference may
+                        --  come from a limited_with_clause, in which case the
+                        --  limited view of the entity carries the flag.
+
+                        elsif Referenced_Check_Spec (Ent)
+                          or else Referenced_As_LHS_Check_Spec (Ent)
+                          or else
+                            (From_With_Type (Ent)
+                              and then Is_Incomplete_Type (Ent)
+                              and then Present (Non_Limited_View (Ent))
+                              and then Referenced (Non_Limited_View (Ent)))
                         then
                            --  This means that the with is indeed fine, in that
                            --  it is definitely needed somewhere, and we can
-                           --  quit worrying about this one.
+                           --  quit worrying about this one...
 
-                           --  Except for one little detail, if either of the
+                           --  Except for one little detail: if either of the
                            --  flags was set during spec processing, this is
                            --  where we complain that the with could be moved
                            --  from the spec. If the spec contains a visible
@@ -1676,12 +2034,12 @@ package body Sem_Warn is
 
                            if Unreferenced_In_Spec (Item) then
                               Error_Msg_N
-                                ("unit& is not referenced in spec?",
+                                ("?unit& is not referenced in spec!",
                                  Name (Item));
 
                            elsif No_Entities_Ref_In_Spec (Item) then
                               Error_Msg_N
-                                ("no entities of & are referenced in spec?",
+                                ("?no entities of & are referenced in spec!",
                                  Name (Item));
 
                            else
@@ -1694,7 +2052,7 @@ package body Sem_Warn is
 
                            if not Is_Visible_Renaming then
                               Error_Msg_N
-                                ("\with clause might be moved to body?",
+                                ("\?with clause might be moved to body!",
                                  Name (Item));
                            end if;
 
@@ -1722,7 +2080,7 @@ package body Sem_Warn is
                         Set_Unreferenced_In_Spec (Item);
                      else
                         Error_Msg_N
-                          ("unit& is never instantiated?", Name (Item));
+                          ("?unit& is never instantiated!", Name (Item));
                      end if;
 
                   --  If unit was indeed instantiated, make sure that flag is
@@ -1731,9 +2089,9 @@ package body Sem_Warn is
 
                   elsif Unreferenced_In_Spec (Item) then
                      Error_Msg_N
-                       ("unit& is not instantiated in spec?", Name (Item));
+                       ("?unit& is not instantiated in spec!", Name (Item));
                      Error_Msg_N
-                       ("\with clause can be moved to body?", Name (Item));
+                       ("\?with clause can be moved to body!", Name (Item));
                   end if;
                end if;
             end if;
@@ -1809,6 +2167,53 @@ package body Sem_Warn is
       end if;
    end Generic_Package_Spec_Entity;
 
+   ----------------------
+   -- Goto_Spec_Entity --
+   ----------------------
+
+   function Goto_Spec_Entity (E : Entity_Id) return Entity_Id is
+   begin
+      if Is_Formal (E)
+        and then Present (Spec_Entity (E))
+      then
+         return Spec_Entity (E);
+      else
+         return E;
+      end if;
+   end Goto_Spec_Entity;
+
+   ----------------------------------------
+   -- Has_Pragma_Unreferenced_Check_Spec --
+   ----------------------------------------
+
+   function Has_Pragma_Unreferenced_Check_Spec
+     (E : Entity_Id) return Boolean
+   is
+   begin
+      if Is_Formal (E) and then Present (Spec_Entity (E)) then
+         return Has_Pragma_Unreferenced (E)
+                  or else
+                Has_Pragma_Unreferenced (Spec_Entity (E));
+      else
+         return Has_Pragma_Unreferenced (E);
+      end if;
+   end Has_Pragma_Unreferenced_Check_Spec;
+
+   ------------------------------------
+   -- Never_Set_In_Source_Check_Spec --
+   ------------------------------------
+
+   function Never_Set_In_Source_Check_Spec (E : Entity_Id) return Boolean is
+   begin
+      if Is_Formal (E) and then Present (Spec_Entity (E)) then
+         return Never_Set_In_Source (E)
+                  and then
+                Never_Set_In_Source (Spec_Entity (E));
+      else
+         return Never_Set_In_Source (E);
+      end if;
+   end Never_Set_In_Source_Check_Spec;
+
    -------------------------------------
    -- Operand_Has_Warnings_Suppressed --
    -------------------------------------
@@ -1856,6 +2261,72 @@ package body Sem_Warn is
          return False;
    end Operand_Has_Warnings_Suppressed;
 
+   -----------------------------------------
+   -- Output_Non_Modified_In_Out_Warnings --
+   -----------------------------------------
+
+   procedure Output_Non_Modifed_In_Out_Warnings is
+
+      function No_Warn_On_In_Out (E : Entity_Id) return Boolean;
+      --  Given a formal parameter entity E, determines if there is a reason to
+      --  suppress IN OUT warnings (not modified, could be IN) for formals of
+      --  the subprogram. We suppress these warnings if Warnings Off is set, or
+      --  if we have seen the address of the subprogram being taken, or if the
+      --  subprogram is used as a generic actual (in the latter cases the
+      --  context may force use of IN OUT, even if the parameter is not
+      --  modifies for this particular case.
+
+      -----------------------
+      -- No_Warn_On_In_Out --
+      -----------------------
+
+      function No_Warn_On_In_Out (E : Entity_Id) return Boolean is
+         S : constant Entity_Id := Scope (E);
+      begin
+         if Warnings_Off (S) then
+            return True;
+         elsif Address_Taken (S) then
+            return True;
+         elsif Used_As_Generic_Actual (S) then
+            return True;
+         elsif Present (Spec_Entity (E)) then
+            return No_Warn_On_In_Out (Spec_Entity (E));
+         else
+            return False;
+         end if;
+      end No_Warn_On_In_Out;
+
+   --  Start of processing for Output_Non_Modifed_In_Out_Warnings
+
+   begin
+      --  Loop through entities for which a warning may be needed
+
+      for J in In_Out_Warnings.First .. In_Out_Warnings.Last loop
+         declare
+            E1 : constant Entity_Id := In_Out_Warnings.Table (J);
+
+         begin
+            --  Suppress warning in specific cases (see details in comments for
+            --  No_Warn_On_In_Out).
+
+            if No_Warn_On_In_Out (E1) then
+               null;
+
+            --  Here we generate the warning
+
+            else
+               Error_Msg_N ("?formal parameter & is not modified!", E1);
+               Error_Msg_N ("\?mode could be IN instead of `IN OUT`!", E1);
+
+               --  Kill any other warnings on this entity, since this is the
+               --  one that should dominate any other unreferenced warning.
+
+               Set_Warnings_Off (E1);
+            end if;
+         end;
+      end loop;
+   end Output_Non_Modifed_In_Out_Warnings;
+
    ----------------------------------------
    -- Output_Obsolescent_Entity_Warnings --
    ----------------------------------------
@@ -2004,119 +2475,40 @@ package body Sem_Warn is
    ----------------------------------
 
    procedure Output_Unreferenced_Messages is
-      E : Entity_Id;
-
    begin
       for J in Unreferenced_Entities.First ..
                Unreferenced_Entities.Last
       loop
-         E := Unreferenced_Entities.Table (J);
-
-         if not Referenced (E) and then not Warnings_Off (E) then
-            case Ekind (E) is
-               when E_Variable =>
-
-                  --  Case of variable that is assigned but not read. We
-                  --  suppress the message if the variable is volatile, has an
-                  --  address clause, or is imported.
-
-                  if Referenced_As_LHS (E)
-                    and then No (Address_Clause (E))
-                    and then not Is_Volatile (E)
-                  then
-                     if Warn_On_Modified_Unread
-                       and then not Is_Imported (E)
-                       and then not Is_Return_Object (E)
-
-                        --  Suppress message for aliased or renamed variables,
-                        --  since there may be other entities that read the
-                        --  same memory location.
-
-                       and then not Is_Aliased (E)
-                       and then No (Renamed_Object (E))
-
-                     then
-                        Error_Msg_N
-                          ("variable & is assigned but never read?", E);
-                        Set_Last_Assignment (E, Empty);
-                     end if;
-
-                  --  Normal case of neither assigned nor read
-
-                  else
-                     --  We suppress the message for types for which a valid
-                     --  pragma Unreferenced_Objects has been given, otherwise
-                     --  we go ahead and give the message.
-
-                     if not Has_Pragma_Unreferenced_Objects (Etype (E)) then
-
-                        --  Distinguish renamed case in message
-
-                        if Present (Renamed_Object (E))
-                          and then Comes_From_Source (Renamed_Object (E))
-                        then
-                           Error_Msg_N
-                             ("renamed variable & is not referenced?", E);
-                        else
-                           Error_Msg_N
-                             ("variable & is not referenced?", E);
-                        end if;
-                     end if;
-                  end if;
-
-               when E_Constant =>
-                  if Present (Renamed_Object (E))
-                    and then Comes_From_Source (Renamed_Object (E))
-                  then
-                     Error_Msg_N ("renamed constant & is not referenced?", E);
-                  else
-                     Error_Msg_N ("constant & is not referenced?", E);
-                  end if;
-
-               when E_In_Parameter     |
-                    E_Out_Parameter    |
-                    E_In_Out_Parameter =>
-
-                  --  Do not emit message for formals of a renaming, because
-                  --  they are never referenced explicitly.
-
-                  if Nkind (Original_Node (Unit_Declaration_Node (Scope (E))))
-                    /= N_Subprogram_Renaming_Declaration
-                  then
-                     Error_Msg_N ("formal parameter & is not referenced?", E);
-                  end if;
-
-               when E_Named_Integer    |
-                    E_Named_Real       =>
-                  Error_Msg_N ("named number & is not referenced?", E);
-
-               when E_Enumeration_Literal =>
-                  Error_Msg_N ("literal & is not referenced?", E);
-
-               when E_Function         =>
-                  Error_Msg_N ("function & is not referenced?", E);
-
-               when E_Procedure         =>
-                  Error_Msg_N ("procedure & is not referenced?", E);
-
-               when E_Generic_Procedure =>
-                  Error_Msg_N
-                    ("generic procedure & is never instantiated?", E);
+         Warn_On_Unreferenced_Entity (Unreferenced_Entities.Table (J));
+      end loop;
+   end Output_Unreferenced_Messages;
 
-               when E_Generic_Function  =>
-                  Error_Msg_N ("generic function & is never instantiated?", E);
+   ---------------------------
+   -- Referenced_Check_Spec --
+   ---------------------------
 
-               when Type_Kind          =>
-                  Error_Msg_N ("type & is not referenced?", E);
+   function Referenced_Check_Spec (E : Entity_Id) return Boolean is
+   begin
+      if Is_Formal (E) and then Present (Spec_Entity (E)) then
+         return Referenced (E) or else Referenced (Spec_Entity (E));
+      else
+         return Referenced (E);
+      end if;
+   end Referenced_Check_Spec;
 
-               when others =>
-                  Error_Msg_N ("& is not referenced?", E);
-            end case;
+   ----------------------------------
+   -- Referenced_As_LHS_Check_Spec --
+   ----------------------------------
 
-            Set_Warnings_Off (E);
-         end if;
-      end loop;
-   end Output_Unreferenced_Messages;
+   function Referenced_As_LHS_Check_Spec (E : Entity_Id) return Boolean is
+   begin
+      if Is_Formal (E) and then Present (Spec_Entity (E)) then
+         return Referenced_As_LHS (E)
+           or else Referenced_As_LHS (Spec_Entity (E));
+      else
+         return Referenced_As_LHS (E);
+      end if;
+   end Referenced_As_LHS_Check_Spec;
 
    ----------------------------
    -- Set_Dot_Warning_Switch --
@@ -2785,6 +3177,204 @@ package body Sem_Warn is
       end if;
    end Warn_On_Suspicious_Index;
 
+   --------------------------------------
+   -- Warn_On_Unassigned_Out_Parameter --
+   --------------------------------------
+
+   procedure Warn_On_Unassigned_Out_Parameter
+     (Return_Node : Node_Id;
+      Scope_Id    : Entity_Id)
+   is
+      Form  : Entity_Id;
+      Form2 : Entity_Id;
+
+   begin
+      --  Ignore if procedure or return statement does not come from source
+
+      if not Comes_From_Source (Scope_Id)
+        or else not Comes_From_Source (Return_Node)
+      then
+         return;
+      end if;
+
+      --  Loop through formals
+
+      Form := First_Formal (Scope_Id);
+      while Present (Form) loop
+
+         --  We are only interested in OUT parameters that come from source
+         --  and are never set in the source, and furthermore only in scalars
+         --  since non-scalars generate too many false positives.
+
+         if Ekind (Form) = E_Out_Parameter
+           and then Never_Set_In_Source_Check_Spec (Form)
+           and then Is_Scalar_Type (Etype (Form))
+           and then not Present (Unset_Reference (Form))
+         then
+            --  Before we issue the warning, an add ad hoc defence against the
+            --  most common case of false positives with this warning which is
+            --  the case where there is a Boolean OUT parameter that has been
+            --  set, and whose meaning is "ignore the values of the other
+            --  parameters". We can't of course reliably tell this case at
+            --  compile time, but the following test kills a lot of false
+            --  positives, without generating a significant number of false
+            --  negatives (missed real warnings).
+
+            Form2 := First_Formal (Scope_Id);
+            while Present (Form2) loop
+               if Ekind (Form2) = E_Out_Parameter
+                 and then Root_Type (Etype (Form2)) = Standard_Boolean
+                 and then not Never_Set_In_Source_Check_Spec (Form2)
+               then
+                  return;
+               end if;
+
+               Next_Formal (Form2);
+            end loop;
+
+            --  Here all conditionas are met, record possible unset reference
+
+            Set_Unset_Reference (Form, Return_Node);
+         end if;
+
+         Next_Formal (Form);
+      end loop;
+   end Warn_On_Unassigned_Out_Parameter;
+
+   ---------------------------------
+   -- Warn_On_Unreferenced_Entity --
+   ---------------------------------
+
+   procedure Warn_On_Unreferenced_Entity
+     (Spec_E : Entity_Id;
+      Body_E : Entity_Id := Empty)
+   is
+      E : Entity_Id := Spec_E;
+   begin
+      if not Referenced_Check_Spec (E) and then not Warnings_Off (E) then
+         case Ekind (E) is
+            when E_Variable =>
+
+               --  Case of variable that is assigned but not read. We
+               --  suppress the message if the variable is volatile, has an
+               --  address clause, or is imported.
+
+               if Referenced_As_LHS_Check_Spec (E)
+                 and then No (Address_Clause (E))
+                 and then not Is_Volatile (E)
+               then
+                  if Warn_On_Modified_Unread
+                    and then not Is_Imported (E)
+                    and then not Is_Return_Object (E)
+
+                     --  Suppress message for aliased or renamed variables,
+                     --  since there may be other entities that read the
+                     --  same memory location.
+
+                    and then not Is_Aliased (E)
+                    and then No (Renamed_Object (E))
+
+                  then
+                     Error_Msg_N
+                       ("?variable & is assigned but never read!", E);
+                     Set_Last_Assignment (E, Empty);
+                  end if;
+
+               --  Normal case of neither assigned nor read
+
+               else
+                  --  We suppress the message for types for which a valid
+                  --  pragma Unreferenced_Objects has been given, otherwise
+                  --  we go ahead and give the message.
+
+                  if not Has_Pragma_Unreferenced_Objects (Etype (E)) then
+
+                     --  Distinguish renamed case in message
+
+                     if Present (Renamed_Object (E))
+                       and then Comes_From_Source (Renamed_Object (E))
+                     then
+                        Error_Msg_N
+                          ("?renamed variable & is not referenced!", E);
+                     else
+                        Error_Msg_N
+                          ("?variable & is not referenced!", E);
+                     end if;
+                  end if;
+               end if;
+
+            when E_Constant =>
+               if Present (Renamed_Object (E))
+                 and then Comes_From_Source (Renamed_Object (E))
+               then
+                  Error_Msg_N
+                    ("?renamed constant & is not referenced!", E);
+               else
+                  Error_Msg_N ("?constant & is not referenced!", E);
+               end if;
+
+            when E_In_Parameter     |
+                 E_In_Out_Parameter =>
+
+               --  Do not emit message for formals of a renaming, because
+               --  they are never referenced explicitly.
+
+               if Nkind (Original_Node (Unit_Declaration_Node (Scope (E))))
+                 /= N_Subprogram_Renaming_Declaration
+               then
+                  --  Suppress this message for an IN OUT parameter of a
+                  --  non-scalar type, since it is normal to have only an
+                  --  assignment in such a case.
+
+                  if Ekind (E) = E_In_Parameter
+                    or else not Referenced_As_LHS_Check_Spec (E)
+                    or else Is_Scalar_Type (E)
+                  then
+                     if Present (Body_E) then
+                        E := Body_E;
+                     end if;
+                     Error_Msg_NE
+                       ("?formal parameter & is not referenced!", E, Spec_E);
+                  end if;
+               end if;
+
+            when E_Out_Parameter    =>
+               null;
+
+            when E_Named_Integer    |
+                 E_Named_Real       =>
+               Error_Msg_N ("?named number & is not referenced!", E);
+
+            when E_Enumeration_Literal =>
+               Error_Msg_N ("?literal & is not referenced!", E);
+
+            when E_Function         =>
+               Error_Msg_N ("?function & is not referenced!", E);
+
+            when E_Procedure         =>
+               Error_Msg_N ("?procedure & is not referenced!", E);
+
+            when E_Generic_Procedure =>
+               Error_Msg_N
+                 ("?generic procedure & is never instantiated!", E);
+
+            when E_Generic_Function  =>
+               Error_Msg_N
+                 ("?generic function & is never instantiated!", E);
+
+            when Type_Kind          =>
+               Error_Msg_N ("?type & is not referenced!", E);
+
+            when others =>
+               Error_Msg_N ("?& is not referenced!", E);
+         end case;
+
+         --  Kill warnings on the entity on which the message has been posted
+
+         Set_Warnings_Off (E);
+      end if;
+   end Warn_On_Unreferenced_Entity;
+
    --------------------------------
    -- Warn_On_Useless_Assignment --
    --------------------------------
@@ -2833,7 +3423,7 @@ package body Sem_Warn is
         and then not Is_Return_Object (Ent)
         and then Present (Last_Assignment (Ent))
         and then not Warnings_Off (Ent)
-        and then not Has_Pragma_Unreferenced (Ent)
+        and then not Has_Pragma_Unreferenced_Check_Spec (Ent)
         and then not Is_Imported (Ent)
         and then not Is_Exported (Ent)
       then
@@ -2857,12 +3447,12 @@ package body Sem_Warn is
             then
                if Loc = No_Location then
                   Error_Msg_NE
-                    ("?useless assignment to&, value never referenced",
+                    ("?useless assignment to&, value never referenced!",
                      Last_Assignment (Ent), Ent);
                else
                   Error_Msg_Sloc := Loc;
                   Error_Msg_NE
-                    ("?useless assignment to&, value overwritten #",
+                    ("?useless assignment to&, value overwritten #!",
                      Last_Assignment (Ent), Ent);
                end if;