2007-08-14 Robert Dewar <dewar@adacore.com>

	* comperr.adb: Fix problem with suppressing warning messages from gigi

	* erroutc.ads, erroutc.adb, errout.ads, 
	errout.adb (Write_Eol): Remove trailing spaces before writing the line
	(Write_Eol_Keep_Blanks): New procedure to write a line, including
	possible trailing spaces.
	(Output_Source_Line): Call Write_Eol_Keep_Blanks to output a source line
	Fix problem with suppressing warning messages from back end
	Improve handling of deleted warnings

	* gnat1drv.adb: 
	Fix problem with suppressing warning messages from back end
	Handle setting of Static_Dispatch_Tables flag.

	* prepcomp.adb: 
	Fix problem with suppressing warning messages from back end

	* exp_intr.adb: Improve handling of deleted warnings



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

1 files changed, 40 insertions, 19 deletions

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 9c2a614f78d..6f928b02c28 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -924,10 +924,19 @@ package body Erroutc is
          J := J + 1;
       end loop;
 
-      Set_Casing (Keyword_Casing (Flag_Source), All_Lower_Case);
-      Set_Msg_Quote;
-      Set_Msg_Name_Buffer;
-      Set_Msg_Quote;
+      --  Here is where we make the special exception for RM
+
+      if Name_Len = 2 and then Name_Buffer (1 .. 2) = "RM" then
+         Set_Msg_Name_Buffer;
+
+      --  Not RM: case appropriately and add surrounding quotes
+
+      else
+         Set_Casing (Keyword_Casing (Flag_Source), All_Lower_Case);
+         Set_Msg_Quote;
+         Set_Msg_Name_Buffer;
+         Set_Msg_Quote;
+      end if;
    end Set_Msg_Insertion_Reserved_Word;
 
    -------------------------------------
@@ -1038,7 +1047,11 @@ package body Erroutc is
    -- Set_Specific_Warning_Off --
    ------------------------------
 
-   procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String) is
+   procedure Set_Specific_Warning_Off
+     (Loc    : Source_Ptr;
+      Msg    : String;
+      Config : Boolean)
+   is
       pragma Assert (Msg'First = 1);
 
       Pattern : String  := Msg;
@@ -1063,17 +1076,17 @@ package body Erroutc is
          Star_End := False;
       end if;
 
-      Specific_Warnings.Increment_Last;
-      Specific_Warnings.Table (Specific_Warnings.Last) :=
-        (Start      => Loc,
-         Msg        => new String'(Msg),
-         Pattern    => new String'(Pattern (1 .. Patlen)),
-         Patlen     => Patlen,
-         Stop       => Source_Last (Current_Source_File),
-         Open       => True,
-         Used       => False,
-         Star_Start => Star_Start,
-         Star_End   => Star_End);
+      Specific_Warnings.Append
+        ((Start      => Loc,
+          Msg        => new String'(Msg),
+          Pattern    => new String'(Pattern (1 .. Patlen)),
+          Patlen     => Patlen,
+          Stop       => Source_Last (Current_Source_File),
+          Open       => True,
+          Used       => False,
+          Star_Start => Star_Start,
+          Star_End   => Star_End,
+          Config     => Config));
    end Set_Specific_Warning_Off;
 
    -----------------------------
@@ -1099,6 +1112,11 @@ package body Erroutc is
                SWE.Stop := Loc;
                SWE.Open := False;
                Err := False;
+
+               --  If a config pragma is specifically cancelled, consider
+               --  that it is no longer active as a configuration pragma.
+
+               SWE.Config := False;
                return;
             end if;
          end;
@@ -1218,7 +1236,7 @@ package body Erroutc is
          declare
             SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
          begin
-            if SWE.Start /= No_Location then
+            if not SWE.Config then
                if SWE.Open then
                   Eproc.all
                     ("?pragma Warnings Off with no matching Warnings On",
@@ -1265,11 +1283,14 @@ package body Erroutc is
             SWE : Specific_Warning_Entry renames Specific_Warnings.Table (J);
 
          begin
-            --  See if location is in range
+            --  Pragma applies if it is a configuration pragma, or if the
+            --  location is in range of a specific non-configuration pragma.
 
-            if SWE.Start = No_Location
+            if SWE.Config
               or else (SWE.Start <= Loc and then Loc <= SWE.Stop)
             then
+               --  Check if message matches, dealing with * patterns
+
                Patlen     := SWE.Patlen;
                Pattern    := SWE.Pattern;
                Star_Start := SWE.Star_Start;