diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-14 08:37:51 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-08-14 08:37:51 +0000 |
commit | 150564b2b4f5163e7fdf6249beec48291ce66491 (patch) | |
tree | eb32487d160f5457a47e310d937e95ab6a78e61e /gcc/ada/erroutc.adb | |
parent | 93f0c209778b7b51d4a7c3df2c4872e27e661f32 (diff) | |
download | ppe42-gcc-150564b2b4f5163e7fdf6249beec48291ce66491.tar.gz ppe42-gcc-150564b2b4f5163e7fdf6249beec48291ce66491.zip |
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
Diffstat (limited to 'gcc/ada/erroutc.adb')
-rw-r--r-- | gcc/ada/erroutc.adb | 59 |
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; |