2005-11-14 Ed Schonberg <schonberg@adacore.com>

	    Robert Dewar  <dewar@adacore.com>

	* sem_warn.ads, sem_warn.adb (Publicly_Referenceable): Generic formals
	of a generic subprogram are not visible outside the body.
	(Set_Warning_Switch): New procedure (code to set warning mode moved
	here from Switch.C so that it can be shared by pragma processing.
	(Check_References): Special case warning for non-modified non-imported
	volatile objects.
	* par-prag.adb: Modify processing of pragma Warnings to accomodate new
	form with a string literal argument



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

3 files changed, 243 insertions, 17 deletions

diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 097ddd0caf3..5c87fa92a3b 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -233,7 +233,7 @@ function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
          elsif Id = Name_No_Dependence then
             Set_Restriction_No_Dependence
               (Unit => Expr,
-               Warn  => Prag_Id = Pragma_Restriction_Warnings);
+               Warn => Prag_Id = Pragma_Restriction_Warnings);
          end if;
 
          Next (Arg);
@@ -963,22 +963,28 @@ begin
       ---------------------
 
       --  pragma Warnings (On | Off, [LOCAL_NAME])
+      --  pragma Warnings (static_string_EXPRESSION);
 
-      --  The one argument case is processed by the parser, since it may
-      --  control parser warnings as well as semantic warnings, and in any
-      --  case we want to be absolutely sure that the range in the warnings
-      --  table is set well before any semantic analysis is performed.
+      --  The one argument ON/OFF case is processed by the parser, since it may
+      --  control parser warnings as well as semantic warnings, and in any case
+      --  we want to be absolutely sure that the range in the warnings table is
+      --  set well before any semantic analysis is performed.
 
       when Pragma_Warnings =>
          if Arg_Count = 1 then
             Check_No_Identifier (Arg1);
-            Check_Arg_Is_On_Or_Off (Arg1);
 
-            if Chars (Expression (Arg1)) = Name_On then
-               Set_Warnings_Mode_On (Pragma_Sloc);
-            else
-               Set_Warnings_Mode_Off (Pragma_Sloc);
-            end if;
+            declare
+               Argx : constant Node_Id := Expression (Arg1);
+            begin
+               if Nkind (Argx) = N_Identifier then
+                  if Chars (Argx) = Name_On then
+                     Set_Warnings_Mode_On (Pragma_Sloc);
+                  elsif Chars (Argx) = Name_Off then
+                     Set_Warnings_Mode_Off (Pragma_Sloc);
+                  end if;
+               end if;
+            end;
          end if;
 
       -----------------------
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index d3003df5400..3f3d938a848 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1999-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 1999-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -294,7 +294,20 @@ package body Sem_Warn is
                       or else List_Containing (Prev)
                         /= Generic_Formal_Declarations (P);
 
-               --  if we reach a subprogram body, entity is not referenceable
+               --  Similarly, the generic formals of a generic subprogram
+               --  are not accessible.
+
+               when N_Generic_Subprogram_Declaration  =>
+                  if Is_List_Member (Prev)
+                    and then List_Containing (Prev) =
+                               Generic_Formal_Declarations (P)
+                  then
+                     return False;
+                  else
+                     P := Parent (P);
+                  end if;
+
+               --  If we reach a subprogram body, entity is not referenceable
                --  unless it is the defining entity of the body. This will
                --  happen, e.g. when a function is an attribute renaming that
                --  is rewritten as a body.
@@ -451,8 +464,20 @@ package body Sem_Warn is
                  and then Is_True_Constant (E1)
                  and then not Generic_Package_Spec_Entity (E1)
                then
-                  Error_Msg_N
-                    ("& is not modified, could be declared constant?", E1);
+                  --  A special case, if this variable is volatile and not
+                  --  imported, it is not helpful to tell the programmer
+                  --  to mark the variable as constant, since this would be
+                  --  illegal by virtue of RM C.6(13).
+
+                  if (Is_Volatile (E1) or else Has_Volatile_Components (E1))
+                    and then not Is_Imported (E1)
+                  then
+                     Error_Msg_N
+                       ("& is not modified, volatile has no effect?", E1);
+                  else
+                     Error_Msg_N
+                       ("& is not modified, could be declared constant?", E1);
+                  end if;
                end if;
 
                --  Check for unset reference, note that we exclude access
@@ -1565,6 +1590,192 @@ package body Sem_Warn is
       end loop;
    end Output_Unreferenced_Messages;
 
+   ------------------------
+   -- Set_Warning_Switch --
+   ------------------------
+
+   function Set_Warning_Switch (C : Character) return Boolean 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;
+
+         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;
+
+         when 'b' =>
+            Warn_On_Bad_Fixed_Value         := True;
+
+         when 'B' =>
+            Warn_On_Bad_Fixed_Value         := False;
+
+         when 'c' =>
+            Constant_Condition_Warnings     := True;
+
+         when 'C' =>
+            Constant_Condition_Warnings     := False;
+
+         when 'd' =>
+            Warn_On_Dereference             := True;
+
+         when 'D' =>
+            Warn_On_Dereference             := False;
+
+         when 'e' =>
+            Warning_Mode                    := Treat_As_Error;
+
+         when 'f' =>
+            Check_Unreferenced_Formals      := True;
+
+         when 'F' =>
+            Check_Unreferenced_Formals      := False;
+
+         when 'g' =>
+            Warn_On_Unrecognized_Pragma     := True;
+
+         when 'G' =>
+            Warn_On_Unrecognized_Pragma     := False;
+
+         when 'h' =>
+            Warn_On_Hiding                  := True;
+
+         when 'H' =>
+            Warn_On_Hiding                  := False;
+
+         when 'i' =>
+            Implementation_Unit_Warnings    := True;
+
+         when 'I' =>
+            Implementation_Unit_Warnings    := False;
+
+         when 'j' =>
+            Warn_On_Obsolescent_Feature     := True;
+
+         when 'J' =>
+            Warn_On_Obsolescent_Feature     := False;
+
+         when 'k' =>
+            Warn_On_Constant                := True;
+
+         when 'K' =>
+            Warn_On_Constant                := False;
+
+         when 'l' =>
+            Elab_Warnings                   := True;
+
+         when 'L' =>
+            Elab_Warnings                   := False;
+
+         when 'm' =>
+            Warn_On_Modified_Unread         := True;
+
+         when 'M' =>
+            Warn_On_Modified_Unread         := False;
+
+         when 'n' =>
+            Warning_Mode                    := Normal;
+
+         when 'o' =>
+            Address_Clause_Overlay_Warnings := True;
+
+         when 'O' =>
+            Address_Clause_Overlay_Warnings := False;
+
+         when 'p' =>
+            Ineffective_Inline_Warnings     := True;
+
+         when 'P' =>
+            Ineffective_Inline_Warnings     := False;
+
+         when 'r' =>
+            Warn_On_Redundant_Constructs    := True;
+
+         when 'R' =>
+            Warn_On_Redundant_Constructs    := False;
+
+         when 's' =>
+            Warning_Mode                    := Suppress;
+
+         when 'u' =>
+            Check_Unreferenced              := True;
+            Check_Withs                     := True;
+            Check_Unreferenced_Formals      := True;
+
+         when 'U' =>
+            Check_Unreferenced              := False;
+            Check_Withs                     := False;
+            Check_Unreferenced_Formals      := False;
+
+         when 'v' =>
+            Warn_On_No_Value_Assigned       := True;
+
+         when 'V' =>
+            Warn_On_No_Value_Assigned       := False;
+
+         when 'x' =>
+            Warn_On_Export_Import           := True;
+
+         when 'X' =>
+            Warn_On_Export_Import           := False;
+
+         when 'y' =>
+            Warn_On_Ada_2005_Compatibility  := True;
+
+         when 'Y' =>
+            Warn_On_Ada_2005_Compatibility  := False;
+
+         when 'z' =>
+            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;
+
+         when others =>
+            return False;
+      end case;
+
+      return True;
+   end Set_Warning_Switch;
+
    -----------------------------
    -- Warn_On_Known_Condition --
    -----------------------------
diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads
index cec942733ba..be2fd6f11af 100644
--- a/gcc/ada/sem_warn.ads
+++ b/gcc/ada/sem_warn.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1999-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1999-2005, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -32,6 +32,15 @@ with Types; use Types;
 
 package Sem_Warn is
 
+   --------------------
+   -- Initialization --
+   --------------------
+
+   function Set_Warning_Switch (C : Character) return Boolean;
+   --  This function sets the warning switch or switches corresponding to
+   --  the given character. It is used for processing a -gnatw switch on the
+   --  command line, or a string literal in pragma Warnings.
+
    ------------------------------------------
    -- Routines to Handle Unused References --
    ------------------------------------------