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

gcc/ada/ChangeLog

+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

gcc/ada/errout.adb

@@ -1286,9 +1286,15 @@ 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)
+         declare
+            CE : Error_Msg_Object renames Errors.Table (Cur);
+
+         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);
 
@@ -1310,6 +1316,7 @@ package body Errout is
                   Delete_Warning (F);
                end loop;
             end if;
+         end;
 
          Cur := Errors.Table (Cur).Next;
       end loop;

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

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;

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;

gcc/ada/sem_prag.adb

@@ -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