-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, 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- --
procedure Set_Msg_Insertion_File_Name is
begin
- if Error_Msg_Name_1 = No_Name then
+ if Error_Msg_File_1 = No_File then
null;
- elsif Error_Msg_Name_1 = Error_Name then
+ elsif Error_Msg_File_1 = Error_File_Name then
Set_Msg_Blank;
Set_Msg_Str ("<error>");
else
Set_Msg_Blank;
- Get_Name_String (Error_Msg_Name_1);
+ Get_Name_String (Error_Msg_File_1);
Set_Msg_Quote;
Set_Msg_Name_Buffer;
Set_Msg_Quote;
end if;
- -- The following assignments ensure that the second and third percent
- -- insertion characters will correspond to the Error_Msg_Name_2 and
- -- Error_Msg_Name_3 as required. We suppress possible validity checks in
- -- case operating in -gnatVa mode, and Error_Msg_Name_2/3 is not needed
- -- and has not been set.
+ -- The following assignments ensure that the second and third {
+ -- insertion characters will correspond to the Error_Msg_File_2 and
+ -- Error_Msg_File_3 values and We suppress possible validity checks in
+ -- case operating in -gnatVa mode, and Error_Msg_File_2 or
+ -- Error_Msg_File_3 is not needed and has not been set.
declare
pragma Suppress (Range_Check);
begin
- Error_Msg_Name_1 := Error_Msg_Name_2;
- Error_Msg_Name_2 := Error_Msg_Name_3;
+ Error_Msg_File_1 := Error_Msg_File_2;
+ Error_Msg_File_2 := Error_Msg_File_3;
end;
end Set_Msg_Insertion_File_Name;
end;
end Set_Msg_Insertion_Name;
+ ------------------------------------
+ -- Set_Msg_Insertion_Name_Literal --
+ ------------------------------------
+
+ procedure Set_Msg_Insertion_Name_Literal is
+ begin
+ if Error_Msg_Name_1 = No_Name then
+ null;
+
+ elsif Error_Msg_Name_1 = Error_Name then
+ Set_Msg_Blank;
+ Set_Msg_Str ("<error>");
+
+ else
+ Set_Msg_Blank;
+ Get_Name_String (Error_Msg_Name_1);
+ Set_Msg_Quote;
+ Set_Msg_Name_Buffer;
+ Set_Msg_Quote;
+ end if;
+
+ -- The following assignments ensure that the second and third % or %%
+ -- insertion characters will correspond to the Error_Msg_Name_2 and
+ -- Error_Msg_Name_3 values and We suppress possible validity checks in
+ -- case operating in -gnatVa mode, and Error_Msg_Name_2 or
+ -- Error_Msg_Name_3 is not needed and has not been set.
+
+ declare
+ pragma Suppress (Range_Check);
+ begin
+ Error_Msg_Name_1 := Error_Msg_Name_2;
+ Error_Msg_Name_2 := Error_Msg_Name_3;
+ end;
+ end Set_Msg_Insertion_Name_Literal;
+
-------------------------------------
-- Set_Msg_Insertion_Reserved_Name --
-------------------------------------
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;
-------------------------------------
-- 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;
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;
-----------------------------
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;
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",
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;
OSDN Git Service
