2006-10-31 Robert Dewar <dewar@adacore.com>

	    Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb: Add handling of Last_Assignment field
	(Warn_Overlay): Supply missing continuation marks in error msgs
	(Freeze_Entity): Add check for Preelaborable_Initialization

	* g-comlin.adb: Add Warnings (Off) to prevent new warning

	* g-expect.adb: Add Warnings (Off) to prevent new warning

	* lib-xref.adb: Add handling of Last_Assignment field
	(Generate_Reference): Centralize handling of pragma Obsolescent here
	(Generate_Reference): Accept an implicit reference generated for a
	default in an instance.
	(Generate_Reference): Accept a reference for a node that is not in the
	main unit, if it is the generic body corresponding to an subprogram
	instantiation.

	* xref_lib.adb: Add pragma Warnings (Off) to avoid new warnings

        * sem_warn.ads, sem_warn.adb (Set_Warning_Switch): Add processing for
	-gnatwq/Q.
	(Warn_On_Useless_Assignment): Suppress warning if enclosing inner
	exception handler.
	(Output_Obsolescent_Entity_Warnings): Rewrite to avoid any messages on
	use clauses, to avoid messages on packages used to qualify, and also
	to avoid messages from obsolescent units.
	(Warn_On_Useless_Assignments): Don't generate messages for imported
	and exported variables.
	(Warn_On_Useless_Assignments): New procedure
	(Output_Obsolescent_Entity_Warnings): New procedure
	(Check_Code_Statement): New procedure

        * einfo.ads, einfo.adb (Has_Static_Discriminants): New flag
	Change name Is_Ada_2005 to Is_Ada_2005_Only
	(Last_Assignment): New field for useless assignment warning



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@118271 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 812 insertions, 181 deletions

diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 5f8394e790a..530f0afcb3d 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -28,18 +28,23 @@ with Alloc;
 with Atree;    use Atree;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
+with Exp_Code; use Exp_Code;
 with Fname;    use Fname;
 with Lib;      use Lib;
+with Namet;    use Namet;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Sem;      use Sem;
 with Sem_Ch8;  use Sem_Ch8;
+with Sem_Eval; use Sem_Eval;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
+with Stringt;  use Stringt;
 with Table;
+with Uintp;    use Uintp;
 
 package body Sem_Warn is
 
@@ -54,83 +59,6 @@ package body Sem_Warn is
      Table_Increment      => Alloc.Unreferenced_Entities_Increment,
      Table_Name           => "Unreferenced_Entities");
 
-   ------------------------------
-   -- Handling of Conditionals --
-   ------------------------------
-
-   --  Note: this is work in progress, the data structures and general approach
-   --  are defined, but are not in use yet. ???
-
-   --  An entry is made in the following table for each branch of conditional,
-   --  e.g. an if-then-elsif-else-endif structure creates three entries in this
-   --  table.
-
-   type Branch_Entry is record
-      Sloc : Source_Ptr;
-      --  Location for warnings associated with this branch
-
-      Defs : Elist_Id;
-      --  List of entities defined for the first time in this branch. On exit
-      --  from a conditional structure, any entity that is in the list of all
-      --  branches is removed (and the entity flagged as defined by the
-      --  conditional as a whole). Thus after processing a conditional, Defs
-      --  contains a list of entities defined in this branch for the first
-      --  time, but not defined at all in some other branch of the same
-      --  conditional. A value of No_Elist is used to represent the initial
-      --  empty list.
-
-      Next : Nat;
-      --  Index of next branch for this conditional, zero = last branch
-   end record;
-
-   package Branch_Table is new Table.Table (
-     Table_Component_Type => Branch_Entry,
-     Table_Index_Type     => Nat,
-     Table_Low_Bound      => 1,
-     Table_Initial        => Alloc.Branches_Initial,
-     Table_Increment      => Alloc.Branches_Increment,
-     Table_Name           => "Branches");
-
-   --  The following table is used to represent conditionals, there is one
-   --  entry in this table for each conditional structure.
-
-   type Conditional_Entry is record
-      If_Stmt : Boolean;
-      --  True for IF statement, False for CASE statement
-
-      First_Branch : Nat;
-      --  Index in Branch table of first branch, zero = none yet
-
-      Current_Branch : Nat;
-      --  Index in Branch table of current branch, zero = none yet
-   end record;
-
-   package Conditional_Table is new Table.Table (
-     Table_Component_Type => Conditional_Entry,
-     Table_Index_Type     => Nat,
-     Table_Low_Bound      => 1,
-     Table_Initial        => Alloc.Conditionals_Initial,
-     Table_Increment      => Alloc.Conditionals_Increment,
-     Table_Name           => "Conditionals");
-
-   --  The following table is a stack that keeps track of the current
-   --  conditional. The Last entry is the top of the stack. An Empty entry
-   --  represents the start of a compilation unit. Non-zero entries in the
-   --  stack are indexes into the conditional table.
-
-   package Conditional_Stack is new Table.Table (
-     Table_Component_Type => Nat,
-     Table_Index_Type     => Nat,
-     Table_Low_Bound      => 1,
-     Table_Initial        => Alloc.Conditional_Stack_Initial,
-     Table_Increment      => Alloc.Conditional_Stack_Increment,
-     Table_Name           => "Conditional_Stack");
-
-   pragma Warnings (Off, Branch_Table);
-   pragma Warnings (Off, Conditional_Table);
-   pragma Warnings (Off, Conditional_Stack);
-   --  Not yet referenced, see note above ???
-
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -148,6 +76,49 @@ package body Sem_Warn is
    --  the Warnings_Off flag is set. True is returned if such an entity is
    --  encountered, and False otherwise.
 
+   --------------------------
+   -- Check_Code_Statement --
+   --------------------------
+
+   procedure Check_Code_Statement (N : Node_Id) is
+   begin
+      --  If volatile, nothing to worry about
+
+      if Is_Asm_Volatile (N) then
+         return;
+      end if;
+
+      --  Warn if no input or no output
+
+      Setup_Asm_Inputs (N);
+
+      if No (Asm_Input_Value) then
+         Error_Msg_F
+           ("?code statement with no inputs should usually be Volatile", N);
+         return;
+      end if;
+
+      Setup_Asm_Outputs (N);
+
+      if No (Asm_Output_Variable) then
+         Error_Msg_F
+           ("?code statement with no outputs should usually be Volatile", N);
+         return;
+      end if;
+
+      --  Check multiple code statements in a row
+
+      if Is_List_Member (N)
+        and then Present (Prev (N))
+        and then Nkind (Prev (N)) = N_Code_Statement
+      then
+         Error_Msg_F
+           ("?code statements in sequence should usually be Volatile", N);
+         Error_Msg_F
+           ("\?(suggest using template with multiple instructions)", N);
+      end if;
+   end Check_Code_Statement;
+
    ----------------------
    -- Check_References --
    ----------------------
@@ -431,8 +402,13 @@ package body Sem_Warn is
                      --  Pragma Unreferenced not set, so output message
 
                      else
-                        Output_Reference_Error
-                          ("& is never assigned a value?");
+                        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
@@ -1174,13 +1150,15 @@ package body Sem_Warn is
             then
                Lunit := Entity (Name (Item));
 
-               --  Check if this unit is referenced
-
-               if not Referenced (Lunit) then
+               --  Check if this unit is referenced (skip the check if this
+               --  is explicitly marked by a pragma Unreferenced).
 
+               if not Referenced (Lunit)
+                 and then not Has_Pragma_Unreferenced (Lunit)
+               then
                   --  Suppress warnings in internal units if not in -gnatg mode
                   --  (these would be junk warnings for an application program,
-                  --  since they refer to problems in internal units)
+                  --  since they refer to problems in internal units).
 
                   if GNAT_Mode
                     or else not Is_Internal_File_Name (Unit_File_Name (Unit))
@@ -1202,9 +1180,14 @@ package body Sem_Warn is
 
                --  If main unit is a renaming of this unit, then we consider
                --  the with to be OK (obviously it is needed in this case!)
+               --  This may be transitive: the unit in the with_clause may
+               --  itself be a renaming, in which case both it and the main
+               --  unit rename the same ultimate package.
 
                elsif Present (Renamed_Entity (Munite))
-                  and then Renamed_Entity (Munite) = Lunit
+                  and then
+                    (Renamed_Entity (Munite) = Lunit
+                      or else Renamed_Entity (Munite) = Renamed_Entity (Lunit))
                then
                   null;
 
@@ -1291,7 +1274,7 @@ package body Sem_Warn is
                         then
                            --  This means that the with is indeed fine, in that
                            --  it is definitely needed somewhere, and we can
-                           --  quite worrying about this one.
+                           --  quit worrying about this one.
 
                            --  Except for one little detail, if either of the
                            --  flags was set during spec processing, this is
@@ -1488,6 +1471,149 @@ package body Sem_Warn is
          return False;
    end Operand_Has_Warnings_Suppressed;
 
+   ----------------------------------------
+   -- Output_Obsolescent_Entity_Warnings --
+   ----------------------------------------
+
+   procedure Output_Obsolescent_Entity_Warnings (N : Node_Id; E : Entity_Id) is
+      P : constant Node_Id := Parent (N);
+      S : Entity_Id;
+
+   begin
+      S := Current_Scope;
+
+      --  Do not output message if we are the scope of standard. This means
+      --  we have a reference from a context clause from when it is originally
+      --  processed, and that's too early to tell whether it is an obsolescent
+      --  unit doing the with'ing. In Sem_Ch10.Analyze_Compilation_Unit we make
+      --  sure that we have a later call when the scope is available. This test
+      --  also eliminates all messages for use clauses, which is fine (we do
+      --  not want messages for use clauses, since they are always redundant
+      --  with respect to the associated with clause).
+
+      if S = Standard_Standard then
+         return;
+      end if;
+
+      --  Do not output message if we are in scope of an obsolescent package
+      --  or subprogram.
+
+      loop
+         if Is_Obsolescent (S) then
+            return;
+         end if;
+
+         S := Scope (S);
+         exit when S = Standard_Standard;
+      end loop;
+
+      --  Here we will output the message
+
+      Error_Msg_Sloc := Sloc (E);
+
+      --  Case of with clause
+
+      if Nkind (P) = N_With_Clause then
+         if Ekind (E) = E_Package then
+            Error_Msg_NE
+              ("?with of obsolescent package& declared#", N, E);
+         elsif Ekind (E) = E_Procedure then
+            Error_Msg_NE
+              ("?with of obsolescent procedure& declared#", N, E);
+         else
+            Error_Msg_NE
+              ("?with of obsolescent function& declared#", N, E);
+         end if;
+
+      --  If we do not have a with clause, then ignore any reference to an
+      --  obsolescent package name. We only want to give the one warning of
+      --  withing the package, not one each time it is used to qualify.
+
+      elsif Ekind (E) = E_Package then
+         return;
+
+      --  Procedure call statement
+
+      elsif Nkind (P) = N_Procedure_Call_Statement then
+         Error_Msg_NE
+           ("?call to obsolescent procedure& declared#", N, E);
+
+      --  Function call
+
+      elsif Nkind (P) = N_Function_Call then
+         Error_Msg_NE
+           ("?call to obsolescent function& declared#", N, E);
+
+      --  Reference to obsolescent type
+
+      elsif Is_Type (E) then
+         Error_Msg_NE
+           ("?reference to obsolescent type& declared#", N, E);
+
+      --  Reference to obsolescent component
+
+      elsif Ekind (E) = E_Component
+        or else Ekind (E) = E_Discriminant
+      then
+         Error_Msg_NE
+           ("?reference to obsolescent component& declared#", N, E);
+
+      --  Reference to obsolescent variable
+
+      elsif Ekind (E) = E_Variable then
+         Error_Msg_NE
+           ("?reference to obsolescent variable& declared#", N, E);
+
+      --  Reference to obsolescent constant
+
+      elsif Ekind (E) = E_Constant
+        or else Ekind (E) in Named_Kind
+      then
+         Error_Msg_NE
+           ("?reference to obsolescent constant& declared#", N, E);
+
+      --  Reference to obsolescent enumeration literal
+
+      elsif Ekind (E) = E_Enumeration_Literal then
+         Error_Msg_NE
+           ("?reference to obsolescent enumeration literal& declared#", N, E);
+
+      --  Generic message for any other case we missed
+
+      else
+         Error_Msg_NE
+           ("?reference to obsolescent entity& declared#", N, E);
+      end if;
+
+      --  Output additional warning if present
+
+      declare
+         W : constant Node_Id := Obsolescent_Warning (E);
+
+      begin
+         if Present (W) then
+
+            --  This is a warning continuation to start on a new line
+            Name_Buffer (1) := '\';
+            Name_Buffer (2) := '\';
+            Name_Buffer (3) := '?';
+            Name_Len := 3;
+
+            --  Add characters to message, and output message. Note that
+            --  we quote every character of the message since we don't
+            --  want to process any insertions.
+
+            for J in 1 .. String_Length (Strval (W)) loop
+               Add_Char_To_Name_Buffer (''');
+               Add_Char_To_Name_Buffer
+                 (Get_Character (Get_String_Char (Strval (W), J)));
+            end loop;
+
+            Error_Msg_N (Name_Buffer (1 .. Name_Len), N);
+         end if;
+      end;
+   end Output_Obsolescent_Entity_Warnings;
+
    ----------------------------------
    -- Output_Unreferenced_Messages --
    ----------------------------------
@@ -1516,9 +1642,9 @@ package body Sem_Warn is
                      if Warn_On_Modified_Unread
                        and then not Is_Imported (E)
 
-                        --  Suppress the message for aliased or renamed
-                        --  variables, since there may be other entities read
-                        --  the same memory location.
+                        --  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))
@@ -1526,19 +1652,37 @@ package body Sem_Warn is
                      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
-                     if Present (Renamed_Object (E))
-                       and then Comes_From_Source (Renamed_Object (E))
+                     --  We suppress the message for limited controlled types,
+                     --  to catch the common design pattern (known as RAII, or
+                     --  Resource Acquisition Is Initialization) which uses
+                     --  such types solely for their initialization and
+                     --  finalization semantics.
+
+                     if Is_Controlled (Etype (E))
+                       and then Is_Limited_Type (Etype (E))
                      then
-                        Error_Msg_N
-                          ("renamed variable & is not referenced?", E);
+                        null;
+
+                     --  Normal case where we want to give message
+
                      else
-                        Error_Msg_N
-                          ("variable & is not referenced?", E);
+                        --  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;
 
@@ -1604,176 +1748,192 @@ package body Sem_Warn is
    begin
       case C is
          when 'a' =>
-            Check_Unreferenced              := True;
-            Check_Unreferenced_Formals      := True;
-            Check_Withs                     := True;
-            Constant_Condition_Warnings     := True;
-            Implementation_Unit_Warnings    := True;
-            Ineffective_Inline_Warnings     := True;
-            Warn_On_Ada_2005_Compatibility  := True;
-            Warn_On_Bad_Fixed_Value         := True;
-            Warn_On_Constant                := True;
-            Warn_On_Export_Import           := True;
-            Warn_On_Modified_Unread         := True;
-            Warn_On_No_Value_Assigned       := True;
-            Warn_On_Obsolescent_Feature     := True;
-            Warn_On_Redundant_Constructs    := True;
-            Warn_On_Unchecked_Conversion    := True;
-            Warn_On_Unrecognized_Pragma     := True;
+            Check_Unreferenced                  := True;
+            Check_Unreferenced_Formals          := True;
+            Check_Withs                         := True;
+            Constant_Condition_Warnings         := True;
+            Implementation_Unit_Warnings        := True;
+            Ineffective_Inline_Warnings         := True;
+            Warn_On_Ada_2005_Compatibility      := True;
+            Warn_On_Assumed_Low_Bound           := True;
+            Warn_On_Bad_Fixed_Value             := True;
+            Warn_On_Constant                    := True;
+            Warn_On_Export_Import               := True;
+            Warn_On_Modified_Unread             := True;
+            Warn_On_No_Value_Assigned           := True;
+            Warn_On_Obsolescent_Feature         := True;
+            Warn_On_Questionable_Missing_Parens := True;
+            Warn_On_Redundant_Constructs        := True;
+            Warn_On_Unchecked_Conversion        := True;
+            Warn_On_Unrecognized_Pragma         := True;
 
          when 'A' =>
-            Check_Unreferenced              := False;
-            Check_Unreferenced_Formals      := False;
-            Check_Withs                     := False;
-            Constant_Condition_Warnings     := False;
-            Elab_Warnings                   := False;
-            Implementation_Unit_Warnings    := False;
-            Ineffective_Inline_Warnings     := False;
-            Warn_On_Ada_2005_Compatibility  := False;
-            Warn_On_Bad_Fixed_Value         := False;
-            Warn_On_Constant                := False;
-            Warn_On_Dereference             := False;
-            Warn_On_Export_Import           := False;
-            Warn_On_Hiding                  := False;
-            Warn_On_Modified_Unread         := False;
-            Warn_On_No_Value_Assigned       := False;
-            Warn_On_Obsolescent_Feature     := False;
-            Warn_On_Redundant_Constructs    := False;
-            Warn_On_Unchecked_Conversion    := False;
-            Warn_On_Unrecognized_Pragma     := False;
+            Check_Unreferenced                  := False;
+            Check_Unreferenced_Formals          := False;
+            Check_Withs                         := False;
+            Constant_Condition_Warnings         := False;
+            Elab_Warnings                       := False;
+            Implementation_Unit_Warnings        := False;
+            Ineffective_Inline_Warnings         := False;
+            Warn_On_Ada_2005_Compatibility      := False;
+            Warn_On_Bad_Fixed_Value             := False;
+            Warn_On_Constant                    := False;
+            Warn_On_Deleted_Code                := False;
+            Warn_On_Dereference                 := False;
+            Warn_On_Export_Import               := False;
+            Warn_On_Hiding                      := False;
+            Warn_On_Modified_Unread             := False;
+            Warn_On_No_Value_Assigned           := False;
+            Warn_On_Obsolescent_Feature         := False;
+            Warn_On_Questionable_Missing_Parens := True;
+            Warn_On_Redundant_Constructs        := False;
+            Warn_On_Unchecked_Conversion        := False;
+            Warn_On_Unrecognized_Pragma         := False;
 
          when 'b' =>
-            Warn_On_Bad_Fixed_Value         := True;
+            Warn_On_Bad_Fixed_Value             := True;
 
          when 'B' =>
-            Warn_On_Bad_Fixed_Value         := False;
+            Warn_On_Bad_Fixed_Value             := False;
 
          when 'c' =>
-            Constant_Condition_Warnings     := True;
+            Constant_Condition_Warnings         := True;
 
          when 'C' =>
-            Constant_Condition_Warnings     := False;
+            Constant_Condition_Warnings         := False;
 
          when 'd' =>
-            Warn_On_Dereference             := True;
+            Warn_On_Dereference                 := True;
 
          when 'D' =>
-            Warn_On_Dereference             := False;
+            Warn_On_Dereference                 := False;
 
          when 'e' =>
-            Warning_Mode                    := Treat_As_Error;
+            Warning_Mode                        := Treat_As_Error;
 
          when 'f' =>
-            Check_Unreferenced_Formals      := True;
+            Check_Unreferenced_Formals          := True;
 
          when 'F' =>
-            Check_Unreferenced_Formals      := False;
+            Check_Unreferenced_Formals          := False;
 
          when 'g' =>
-            Warn_On_Unrecognized_Pragma     := True;
+            Warn_On_Unrecognized_Pragma         := True;
 
          when 'G' =>
-            Warn_On_Unrecognized_Pragma     := False;
+            Warn_On_Unrecognized_Pragma         := False;
 
          when 'h' =>
-            Warn_On_Hiding                  := True;
+            Warn_On_Hiding                      := True;
 
          when 'H' =>
-            Warn_On_Hiding                  := False;
+            Warn_On_Hiding                      := False;
 
          when 'i' =>
-            Implementation_Unit_Warnings    := True;
+            Implementation_Unit_Warnings        := True;
 
          when 'I' =>
-            Implementation_Unit_Warnings    := False;
+            Implementation_Unit_Warnings        := False;
 
          when 'j' =>
-            Warn_On_Obsolescent_Feature     := True;
+            Warn_On_Obsolescent_Feature         := True;
 
          when 'J' =>
-            Warn_On_Obsolescent_Feature     := False;
+            Warn_On_Obsolescent_Feature         := False;
 
          when 'k' =>
-            Warn_On_Constant                := True;
+            Warn_On_Constant                    := True;
 
          when 'K' =>
-            Warn_On_Constant                := False;
+            Warn_On_Constant                    := False;
 
          when 'l' =>
-            Elab_Warnings                   := True;
+            Elab_Warnings                       := True;
 
          when 'L' =>
-            Elab_Warnings                   := False;
+            Elab_Warnings                       := False;
 
          when 'm' =>
-            Warn_On_Modified_Unread         := True;
+            Warn_On_Modified_Unread             := True;
 
          when 'M' =>
-            Warn_On_Modified_Unread         := False;
+            Warn_On_Modified_Unread             := False;
 
          when 'n' =>
-            Warning_Mode                    := Normal;
+            Warning_Mode                        := Normal;
 
          when 'o' =>
-            Address_Clause_Overlay_Warnings := True;
+            Address_Clause_Overlay_Warnings     := True;
 
          when 'O' =>
-            Address_Clause_Overlay_Warnings := False;
+            Address_Clause_Overlay_Warnings     := False;
 
          when 'p' =>
-            Ineffective_Inline_Warnings     := True;
+            Ineffective_Inline_Warnings         := True;
 
          when 'P' =>
-            Ineffective_Inline_Warnings     := False;
+            Ineffective_Inline_Warnings         := False;
+
+         when 'q' =>
+            Warn_On_Questionable_Missing_Parens := True;
+
+         when 'Q' =>
+            Warn_On_Questionable_Missing_Parens := False;
 
          when 'r' =>
-            Warn_On_Redundant_Constructs    := True;
+            Warn_On_Redundant_Constructs        := True;
 
          when 'R' =>
-            Warn_On_Redundant_Constructs    := False;
+            Warn_On_Redundant_Constructs        := False;
 
          when 's' =>
-            Warning_Mode                    := Suppress;
+            Warning_Mode                        := Suppress;
+
+         when 't' =>
+            Warn_On_Deleted_Code                := True;
+
+         when 'T' =>
+            Warn_On_Deleted_Code                := False;
 
          when 'u' =>
-            Check_Unreferenced              := True;
-            Check_Withs                     := True;
-            Check_Unreferenced_Formals      := True;
+            Check_Unreferenced                  := True;
+            Check_Withs                         := True;
+            Check_Unreferenced_Formals          := True;
 
          when 'U' =>
-            Check_Unreferenced              := False;
-            Check_Withs                     := False;
-            Check_Unreferenced_Formals      := False;
+            Check_Unreferenced                  := False;
+            Check_Withs                         := False;
+            Check_Unreferenced_Formals          := False;
 
          when 'v' =>
-            Warn_On_No_Value_Assigned       := True;
+            Warn_On_No_Value_Assigned           := True;
 
          when 'V' =>
-            Warn_On_No_Value_Assigned       := False;
+            Warn_On_No_Value_Assigned           := False;
+
+         when 'w' =>
+            Warn_On_Assumed_Low_Bound           := True;
+
+         when 'W' =>
+            Warn_On_Assumed_Low_Bound           := False;
 
          when 'x' =>
-            Warn_On_Export_Import           := True;
+            Warn_On_Export_Import               := True;
 
          when 'X' =>
-            Warn_On_Export_Import           := False;
+            Warn_On_Export_Import               := False;
 
          when 'y' =>
-            Warn_On_Ada_2005_Compatibility  := True;
+            Warn_On_Ada_2005_Compatibility      := True;
 
          when 'Y' =>
-            Warn_On_Ada_2005_Compatibility  := False;
+            Warn_On_Ada_2005_Compatibility      := False;
 
          when 'z' =>
-            Warn_On_Unchecked_Conversion    := True;
+            Warn_On_Unchecked_Conversion        := True;
 
          when 'Z' =>
-            Warn_On_Unchecked_Conversion    := False;
-
-            --  Allow and ignore 'w' so that the old
-            --  format (e.g. -gnatwuwl) will work.
-
-         when 'w' =>
-            null;
+            Warn_On_Unchecked_Conversion        := False;
 
          when others =>
             return False;
@@ -1789,6 +1949,52 @@ package body Sem_Warn is
    procedure Warn_On_Known_Condition (C : Node_Id) is
       P : Node_Id;
 
+      procedure Track (N : Node_Id; Loc : Node_Id);
+      --  Adds continuation warning(s) pointing to reason (assignment or test)
+      --  for the operand of the conditional having a known value (or at least
+      --  enough is known about the value to issue the warning). N is the node
+      --  which is judged to have a known value. Loc is the warning location.
+
+      -----------
+      -- Track --
+      -----------
+
+      procedure Track (N : Node_Id; Loc : Node_Id) is
+         Nod : constant Node_Id := Original_Node (N);
+
+      begin
+         if Nkind (Nod) in N_Op_Compare then
+            Track (Left_Opnd (Nod), Loc);
+            Track (Right_Opnd (Nod), Loc);
+
+         elsif Is_Entity_Name (Nod)
+           and then Is_Object (Entity (Nod))
+         then
+            declare
+               CV : constant Node_Id := Current_Value (Entity (Nod));
+
+            begin
+               if Present (CV) then
+                  Error_Msg_Sloc := Sloc (CV);
+
+                  if Nkind (CV) not in N_Subexpr then
+                     Error_Msg_N ("\\?(see test #)", Loc);
+
+                  elsif Nkind (Parent (CV)) =
+                          N_Case_Statement_Alternative
+                  then
+                     Error_Msg_N ("\\?(see case alternative #)", Loc);
+
+                  else
+                     Error_Msg_N ("\\?(see assignment #)", Loc);
+                  end if;
+               end if;
+            end;
+         end if;
+      end Track;
+
+   --  Start of processing for Warn_On_Known_Condition
+
    begin
       --   Argument replacement in an inlined body can make conditions static.
       --   Do not emit warnings in this case.
@@ -1869,16 +2075,441 @@ package body Sem_Warn is
                     and then Nkind (Cond) /= N_Op_Not
                   then
                      Error_Msg_NE
-                      ("object & is always True?", Cond, Original_Node (C));
+                       ("object & is always True?", Cond, Original_Node (C));
+                     Track (Original_Node (C), Cond);
+
                   else
                      Error_Msg_N ("condition is always True?", Cond);
+                     Track (Cond, Cond);
                   end if;
+
                else
                   Error_Msg_N ("condition is always False?", Cond);
+                  Track (Cond, Cond);
                end if;
             end;
          end if;
       end if;
    end Warn_On_Known_Condition;
 
+   ------------------------------
+   -- Warn_On_Suspicious_Index --
+   ------------------------------
+
+   procedure Warn_On_Suspicious_Index (Name : Entity_Id; X : Node_Id) is
+
+      Low_Bound : Uint;
+      --  Set to lower bound for a suspicious type
+
+      Ent : Entity_Id;
+      --  Entity for array reference
+
+      Typ : Entity_Id;
+      --  Array type
+
+      function Is_Suspicious_Type (Typ : Entity_Id) return Boolean;
+      --  Tests to see if Typ is a type for which we may have a suspicious
+      --  index, namely an unconstrained array type, whose lower bound is
+      --  either zero or one. If so, True is returned, and Low_Bound is set
+      --  to this lower bound. If not, False is returned, and Low_Bound is
+      --  undefined on return.
+      --
+      --  For now, we limite this to standard string types, so any other
+      --  unconstrained types return False. We may change our minds on this
+      --  later on, but strings seem the most important case.
+
+      procedure Test_Suspicious_Index;
+      --  Test if index is of suspicious type and if so, generate warning
+
+      ------------------------
+      -- Is_Suspicious_Type --
+      ------------------------
+
+      function Is_Suspicious_Type (Typ : Entity_Id) return Boolean is
+         LB : Node_Id;
+
+      begin
+         if Is_Array_Type (Typ)
+           and then not Is_Constrained (Typ)
+           and then Number_Dimensions (Typ) = 1
+           and then not Warnings_Off (Typ)
+           and then (Root_Type (Typ) = Standard_String
+                       or else
+                     Root_Type (Typ) = Standard_Wide_String
+                       or else
+                     Root_Type (Typ) = Standard_Wide_Wide_String)
+         then
+            LB := Type_Low_Bound (Etype (First_Index (Typ)));
+
+            if Compile_Time_Known_Value (LB) then
+               Low_Bound := Expr_Value (LB);
+               return Low_Bound = Uint_0 or else Low_Bound = Uint_1;
+            end if;
+         end if;
+
+         return False;
+      end Is_Suspicious_Type;
+
+      ---------------------------
+      -- Test_Suspicious_Index --
+      ---------------------------
+
+      procedure Test_Suspicious_Index is
+
+         function Length_Reference (N : Node_Id) return Boolean;
+         --  Check if node N is of the form Name'Length
+
+         procedure Warn1;
+         --  Generate first warning line
+
+         ----------------------
+         -- Length_Reference --
+         ----------------------
+
+         function Length_Reference (N : Node_Id) return Boolean is
+            R : constant Node_Id := Original_Node (N);
+         begin
+            return
+              Nkind (R) = N_Attribute_Reference
+               and then Attribute_Name (R) = Name_Length
+               and then Is_Entity_Name (Prefix (R))
+               and then Entity (Prefix (R)) = Ent;
+         end Length_Reference;
+
+         -----------
+         -- Warn1 --
+         -----------
+
+         procedure Warn1 is
+         begin
+            Error_Msg_Uint_1 := Low_Bound;
+            Error_Msg_FE ("?index for& may assume lower bound of^", X, Ent);
+         end Warn1;
+
+      --  Start of processing for Test_Suspicious_Index
+
+      begin
+         --  Nothing to do if subscript does not come from source (we don't
+         --  want to give garbage warnings on compiler expanded code, e.g. the
+         --  loops generated for slice assignments. Sucb junk warnings would
+         --  be placed on source constructs with no subscript in sight!)
+
+         if not Comes_From_Source (Original_Node (X)) then
+            return;
+         end if;
+
+         --  Case where subscript is a constant integer
+
+         if Nkind (X) = N_Integer_Literal then
+            Warn1;
+
+            --  Case where original form of subscript is an integer literal
+
+            if Nkind (Original_Node (X)) = N_Integer_Literal then
+               if Intval (X) = Low_Bound then
+                  Error_Msg_FE
+                    ("\suggested replacement: `&''First`", X, Ent);
+               else
+                  Error_Msg_Uint_1 := Intval (X) - Low_Bound;
+                  Error_Msg_FE
+                    ("\suggested replacement: `&''First + ^`", X, Ent);
+
+               end if;
+
+            --  Case where original form of subscript is more complex
+
+            else
+               --  Build string X'First - 1 + expression where the expression
+               --  is the original subscript. If the expression starts with "1
+               --  + ", then the "- 1 + 1" is elided.
+
+               Error_Msg_String (1 .. 13) := "'First - 1 + ";
+               Error_Msg_Strlen := 13;
+
+               declare
+                  Sref : Source_Ptr := Sloc (First_Node (Original_Node (X)));
+                  Tref : constant Source_Buffer_Ptr :=
+                           Source_Text (Get_Source_File_Index (Sref));
+                  --  Tref (Sref) is used to scan the subscript
+
+                  Pctr : Natural;
+                  --  Paretheses counter when scanning subscript
+
+               begin
+                  --  Tref (Sref) points to start of subscript
+
+                  --  Elide - 1 if subscript starts with 1 +
+
+                  if Tref (Sref .. Sref + 2) = "1 +" then
+                     Error_Msg_Strlen := Error_Msg_Strlen - 6;
+                     Sref := Sref + 2;
+
+                  elsif Tref (Sref .. Sref + 1) = "1+" then
+                     Error_Msg_Strlen := Error_Msg_Strlen - 6;
+                     Sref := Sref + 1;
+                  end if;
+
+                  --  Now we will copy the subscript to the string buffer
+
+                  Pctr := 0;
+                  loop
+                     --  Count parens, exit if terminating right paren. Note
+                     --  check to ignore paren appearing as character literal.
+
+                     if Tref (Sref + 1) = '''
+                          and then
+                        Tref (Sref - 1) = '''
+                     then
+                        null;
+                     else
+                        if Tref (Sref) = '(' then
+                           Pctr := Pctr + 1;
+                        elsif Tref (Sref) = ')' then
+                           exit when Pctr = 0;
+                           Pctr := Pctr - 1;
+                        end if;
+                     end if;
+
+                     --  Done if terminating double dot (slice case)
+
+                     exit when Pctr = 0
+                       and then (Tref (Sref .. Sref + 1) = ".."
+                                  or else
+                                 Tref (Sref .. Sref + 2) = " ..");
+
+                     --  Quit if we have hit EOF character, something wrong
+
+                     if Tref (Sref) = EOF then
+                        return;
+                     end if;
+
+                     --  String literals are too much of a pain to handle
+
+                     if Tref (Sref) = '"' or else Tref (Sref) = '%' then
+                        return;
+                     end if;
+
+                     --  If we have a 'Range reference, then this is a case
+                     --  where we cannot easily give a replacement. Don't try!
+
+                     if Tref (Sref .. Sref + 4) = "range"
+                       and then Tref (Sref - 1) < 'A'
+                       and then Tref (Sref + 5) < 'A'
+                     then
+                        return;
+                     end if;
+
+                     --  Else store next character
+
+                     Error_Msg_Strlen := Error_Msg_Strlen + 1;
+                     Error_Msg_String (Error_Msg_Strlen) := Tref (Sref);
+                     Sref := Sref + 1;
+
+                     --  If we get more than 40 characters then the expression
+                     --  is too long to copy, or something has gone wrong. In
+                     --  either case, just skip the attempt at a suggested fix.
+
+                     if Error_Msg_Strlen > 40 then
+                        return;
+                     end if;
+                  end loop;
+               end;
+
+               --  Replacement subscript is now in string buffer
+
+               Error_Msg_FE
+                 ("\suggested replacement: `&~`", Original_Node (X), Ent);
+            end if;
+
+         --  Case where subscript is of the form X'Length
+
+         elsif Length_Reference (X) then
+            Warn1;
+            Error_Msg_Node_2 := Ent;
+            Error_Msg_FE
+              ("\suggest replacement of `&''Length` by `&''Last`",
+               X, Ent);
+
+         --  Case where subscript is of the form X'Length - expression
+
+         elsif Nkind (X) = N_Op_Subtract
+           and then Length_Reference (Left_Opnd (X))
+         then
+            Warn1;
+            Error_Msg_Node_2 := Ent;
+            Error_Msg_FE
+              ("\suggest replacement of `&''Length` by `&''Last`",
+               Left_Opnd (X), Ent);
+         end if;
+      end Test_Suspicious_Index;
+
+   --  Start of processing for Warn_On_Suspicious_Index
+
+   begin
+      --  Only process if warnings activated
+
+      if Warn_On_Assumed_Low_Bound then
+
+         --  Test if array is simple entity name
+
+         if Is_Entity_Name (Name) then
+
+            --  Test if array is parameter of unconstrained string type
+
+            Ent := Entity (Name);
+            Typ := Etype (Ent);
+
+            if Is_Formal (Ent)
+              and then Is_Suspicious_Type (Typ)
+              and then not Low_Bound_Known (Ent)
+            then
+               Test_Suspicious_Index;
+            end if;
+         end if;
+      end if;
+   end Warn_On_Suspicious_Index;
+
+   --------------------------------
+   -- Warn_On_Useless_Assignment --
+   --------------------------------
+
+   procedure Warn_On_Useless_Assignment
+     (Ent : Entity_Id;
+      Loc : Source_Ptr := No_Location)
+   is
+      P : Node_Id;
+      X : Node_Id;
+
+      function Check_Ref (N : Node_Id) return Traverse_Result;
+      --  Used to instantiate Traverse_Func. Returns Abandon if
+      --  a reference to the entity in question is found.
+
+      function Test_No_Refs is new Traverse_Func (Check_Ref);
+
+      ---------------
+      -- Check_Ref --
+      ---------------
+
+      function Check_Ref (N : Node_Id) return Traverse_Result is
+      begin
+         --  Check reference to our identifier. We use name equality here
+         --  because the exception handlers have not yet been analyzed. This
+         --  is not quite right, but it really does not matter that we fail
+         --  to output the warning in some obscure cases of name clashes.
+
+         if Nkind (N) = N_Identifier
+           and then Chars (N) = Chars (Ent)
+         then
+            return Abandon;
+         else
+            return OK;
+         end if;
+      end Check_Ref;
+
+   --  Start of processing for Warn_On_Useless_Assignment
+
+   begin
+      --  Check if this is a case we want to warn on, a variable with
+      --  the last assignment field set, with warnings enabled, and
+      --  which is not imported or exported.
+
+      if Ekind (Ent) = E_Variable
+        and then Present (Last_Assignment (Ent))
+        and then not Warnings_Off (Ent)
+        and then not Has_Pragma_Unreferenced (Ent)
+        and then not Is_Imported (Ent)
+        and then not Is_Exported (Ent)
+      then
+         --  Before we issue the message, check covering exception handlers.
+         --  Search up tree for enclosing statement sequences and handlers
+
+         P := Parent (Last_Assignment (Ent));
+         while Present (P) loop
+
+            --  Something is really wrong if we don't find a handled
+            --  statement sequence, so just suppress the warning.
+
+            if No (P) then
+               Set_Last_Assignment (Ent, Empty);
+               return;
+
+            --  When we hit a package/subprogram body, issue warning and exit
+
+            elsif Nkind (P) = N_Subprogram_Body
+              or else Nkind (P) = N_Package_Body
+            then
+               if Loc = No_Location then
+                  Error_Msg_NE
+                    ("?useless assignment to&, value never referenced",
+                     Last_Assignment (Ent), Ent);
+               else
+                  Error_Msg_Sloc := Loc;
+                  Error_Msg_NE
+                    ("?useless assignment to&, value overwritten #",
+                     Last_Assignment (Ent), Ent);
+               end if;
+
+               Set_Last_Assignment (Ent, Empty);
+               return;
+
+            --  Enclosing handled sequence of statements
+
+            elsif Nkind (P) = N_Handled_Sequence_Of_Statements then
+
+               --  Check exception handlers present
+
+               if Present (Exception_Handlers (P)) then
+
+                  --  If we are not at the top level, we regard an inner
+                  --  exception handler as a decisive indicator that we should
+                  --  not generate the warning, since the variable in question
+                  --  may be acceessed after an exception in the outer block.
+
+                  if Nkind (Parent (P)) /= N_Subprogram_Body
+                    and then Nkind (Parent (P)) /= N_Package_Body
+                  then
+                     Set_Last_Assignment (Ent, Empty);
+                     return;
+
+                     --  Otherwise we are at the outer level. An exception
+                     --  handler is significant only if it references the
+                     --  variable in question.
+
+                  else
+                     X := First (Exception_Handlers (P));
+                     while Present (X) loop
+                        if Test_No_Refs (X) = Abandon then
+                           Set_Last_Assignment (Ent, Empty);
+                           return;
+                        end if;
+
+                        X := Next (X);
+                     end loop;
+                  end if;
+               end if;
+            end if;
+
+            P := Parent (P);
+         end loop;
+      end if;
+   end Warn_On_Useless_Assignment;
+
+   ---------------------------------
+   -- Warn_On_Useless_Assignments --
+   ---------------------------------
+
+   procedure Warn_On_Useless_Assignments (E : Entity_Id) is
+      Ent : Entity_Id;
+   begin
+      if Warn_On_Modified_Unread
+        and then In_Extended_Main_Source_Unit (E)
+      then
+         Ent := First_Entity (E);
+         while Present (Ent) loop
+            Warn_On_Useless_Assignment (Ent);
+            Next_Entity (Ent);
+         end loop;
+      end if;
+   end Warn_On_Useless_Assignments;
+
 end Sem_Warn;