errout.adb: Minor reformattin (Finalize): Take templates into account for warning suppression.

2011-11-23  Robert Dewar  <dewar@adacore.com>

	* errout.adb: Minor reformattin (Finalize): Take templates into
	account for warning suppression.
	* errout.ads (Set_Specific_Warning_Off): Add Used parameter.
	* erroutc.adb: Minor reformatting (Finalize): Take generic
	templates into account for warning suppress.
	* erroutc.ads (Set_Specific_Warning_Off): Add Used parameter.
	* sem_prag.adb: Minor reformatting (Analyze_Pragma,
	case Warnings): Provide Used parameter in call to
	Set_Specific_Warnings_Off (to deal with generic template case).

From-SVN: r181658

6 files changed, 72 insertions, 38 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c9169fa6262..1f574e2246c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2011-11-23  Robert Dewar  <dewar@adacore.com>
+
+	* errout.adb: Minor reformattin (Finalize): Take templates into
+	account for warning suppression.
+	* errout.ads (Set_Specific_Warning_Off): Add Used parameter.
+	* erroutc.adb: Minor reformatting (Finalize): Take generic
+	templates into account for warning suppress.
+	* erroutc.ads (Set_Specific_Warning_Off): Add Used parameter.
+	* sem_prag.adb: Minor reformatting (Analyze_Pragma,
+	case Warnings): Provide Used parameter in call to
+	Set_Specific_Warnings_Off (to deal with generic template case).
+
 2011-11-23  Pascal Obry  <obry@adacore.com>
 
 	* sem_prag.adb (Process_Convention): Better error message for
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 5993132cf81..c40179a5f7a 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1286,30 +1286,37 @@ package body Errout is
 
       Cur := First_Error_Msg;
       while Cur /= No_Error_Msg loop
-         if not Errors.Table (Cur).Deleted
-           and then Warning_Specifically_Suppressed
-                      (Errors.Table (Cur).Sptr, Errors.Table (Cur).Text)
-         then
-            Delete_Warning (Cur);
+         declare
+            CE : Error_Msg_Object renames Errors.Table (Cur);
 
-            --  If this is a continuation, delete previous messages
+         begin
+            if not CE.Deleted
+              and then
+                (Warning_Specifically_Suppressed (CE.Sptr, CE.Text)
+                   or else
+                 Warning_Specifically_Suppressed (CE.Optr, CE.Text))
+            then
+               Delete_Warning (Cur);
 
-            F := Cur;
-            while Errors.Table (F).Msg_Cont loop
-               F := Errors.Table (F).Prev;
-               Delete_Warning (F);
-            end loop;
+               --  If this is a continuation, delete previous messages
 
-            --  Delete any following continuations
+               F := Cur;
+               while Errors.Table (F).Msg_Cont loop
+                  F := Errors.Table (F).Prev;
+                  Delete_Warning (F);
+               end loop;
 
-            F := Cur;
-            loop
-               F := Errors.Table (F).Next;
-               exit when F = No_Error_Msg;
-               exit when not Errors.Table (F).Msg_Cont;
-               Delete_Warning (F);
-            end loop;
-         end if;
+               --  Delete any following continuations
+
+               F := Cur;
+               loop
+                  F := Errors.Table (F).Next;
+                  exit when F = No_Error_Msg;
+                  exit when not Errors.Table (F).Msg_Cont;
+                  Delete_Warning (F);
+               end loop;
+            end if;
+         end;
 
          Cur := Errors.Table (Cur).Next;
       end loop;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 5c1c92ce6b5..ea83a8a7b45 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -771,7 +771,8 @@ package Errout is
    procedure Set_Specific_Warning_Off
      (Loc    : Source_Ptr;
       Msg    : String;
-      Config : Boolean)
+      Config : Boolean;
+      Used   : Boolean := False)
      renames Erroutc.Set_Specific_Warning_Off;
    --  This is called in response to the two argument form of pragma Warnings
    --  where the first argument is OFF, and the second argument is the prefix
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 649238018a1..f58a49a8a5a 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -1081,7 +1081,8 @@ package body Erroutc is
    procedure Set_Specific_Warning_Off
      (Loc    : Source_Ptr;
       Msg    : String;
-      Config : Boolean)
+      Config : Boolean;
+      Used   : Boolean := False)
    is
    begin
       Specific_Warnings.Append
@@ -1089,7 +1090,7 @@ package body Erroutc is
           Msg        => new String'(Msg),
           Stop       => Source_Last (Current_Source_File),
           Open       => True,
-          Used       => False,
+          Used       => Used,
           Config     => Config));
    end Set_Specific_Warning_Off;
 
@@ -1135,16 +1136,16 @@ package body Erroutc is
 
    procedure Set_Warnings_Mode_Off (Loc : Source_Ptr) is
    begin
-      --  Don't bother with entries from instantiation copies, since we
-      --  will already have a copy in the template, which is what matters
+      --  Don't bother with entries from instantiation copies, since we will
+      --  already have a copy in the template, which is what matters.
 
       if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then
          return;
       end if;
 
-      --  If last entry in table already covers us, this is a redundant
-      --  pragma Warnings (Off) and can be ignored. This also handles the
-      --  case where all warnings are suppressed by command line switch.
+      --  If last entry in table already covers us, this is a redundant pragma
+      --  Warnings (Off) and can be ignored. This also handles the case where
+      --  all warnings are suppressed by command line switch.
 
       if Warnings.Last >= Warnings.First
         and then Warnings.Table (Warnings.Last).Start <= Loc
@@ -1152,9 +1153,9 @@ package body Erroutc is
       then
          return;
 
-      --  Otherwise establish a new entry, extending from the location of
-      --  the pragma to the end of the current source file. This ending
-      --  point will be adjusted by a subsequent pragma Warnings (On).
+      --  Otherwise establish a new entry, extending from the location of the
+      --  pragma to the end of the current source file. This ending point will
+      --  be adjusted by a subsequent pragma Warnings (On).
 
       else
          Warnings.Increment_Last;
@@ -1170,8 +1171,8 @@ package body Erroutc is
 
    procedure Set_Warnings_Mode_On (Loc : Source_Ptr) is
    begin
-      --  Don't bother with entries from instantiation copies, since we
-      --  will already have a copy in the template, which is what matters
+      --  Don't bother with entries from instantiation copies, since we will
+      --  already have a copy in the template, which is what matters.
 
       if Instantiation (Get_Source_File_Index (Loc)) /= No_Location then
          return;
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index a2ac46329d4..6c077b0f2e3 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -445,7 +445,8 @@ package Erroutc is
    procedure Set_Specific_Warning_Off
      (Loc    : Source_Ptr;
       Msg    : String;
-      Config : Boolean);
+      Config : Boolean;
+      Used   : Boolean := False);
    --  This is called in response to the two argument form of pragma Warnings
    --  where the first argument is OFF, and the second argument is a string
    --  which identifies a specific warning to be suppressed. The first argument
@@ -453,6 +454,8 @@ package Erroutc is
    --  string from the pragma. Loc is the location of the pragma (which is the
    --  start of the range to suppress). Config is True for the configuration
    --  pragma case (where there is no requirement for a matching OFF pragma).
+   --  Used is set True to disable the check that the warning actually has
+   --  has the effect of suppressing a warning.
 
    procedure Set_Specific_Warning_On
      (Loc : Source_Ptr;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c63e9da9eb4..a21358bd791 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -14528,7 +14528,7 @@ package body Sem_Prag is
                      end;
                   end if;
 
-                  --  Two or more arguments (must be two)
+               --  Two or more arguments (must be two)
 
                else
                   Check_Arg_Is_One_Of (Arg1, Name_On, Name_Off);
@@ -14547,8 +14547,7 @@ package body Sem_Prag is
                      --  the formal may be wrapped in a conversion if the
                      --  actual is a conversion. Retrieve the real entity name.
 
-                     if (In_Instance_Body
-                          or else In_Inlined_Body)
+                     if (In_Instance_Body or else In_Inlined_Body)
                        and then Nkind (E_Id) = N_Unchecked_Type_Conversion
                      then
                         E_Id := Expression (E_Id);
@@ -14612,10 +14611,21 @@ package body Sem_Prag is
                         --  In any other case, an error will be signalled (ON
                         --  with no matching OFF).
 
+                        --  Note: We set Used if we are inside a generic to
+                        --  disable the test that the non-config case actually
+                        --  cancels a warning. That's because we can't be sure
+                        --  there isn't an instantiation in some other unit
+                        --  where a warning is suppressed.
+
+                        --  We could do a little better here by checking if the
+                        --  generic unit we are inside is public, but for now
+                        --  we don't bother with that refinement.
+
                         if Chars (Argx) = Name_Off then
                            Set_Specific_Warning_Off
                              (Loc, Name_Buffer (1 .. Name_Len),
-                              Config => Is_Configuration_Pragma);
+                              Config => Is_Configuration_Pragma,
+                              Used   => Inside_A_Generic or else In_Instance);
 
                         elsif Chars (Argx) = Name_On then
                            Set_Specific_Warning_On