-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
elsif Debug_Flag_GG then
null;
+ -- Keep warning if message text ends in !!
+
+ elsif Msg (Msg'Last) = '!' and then Msg (Msg'Last - 1) = '!' then
+ null;
+
-- Here is where we delete a warning from a with'ed unit
else
if Error_Posted (N) then
return True;
- elsif Nkind (N) in N_Entity and then Warnings_Off (N) then
+ elsif Nkind (N) in N_Entity and then Has_Warnings_Off (N) then
return True;
elsif Is_Entity_Name (N)
and then Present (Entity (N))
- and then Warnings_Off (Entity (N))
+ and then Has_Warnings_Off (Entity (N))
then
return True;
end if;
-- The only remaining possibilities are identifiers, defining
- -- identifiers, pragmas, and pragma argument associations, i.e.
- -- nodes that have a Chars field.
+ -- identifiers, pragmas, and pragma argument associations.
- -- Internal names generally represent something gone wrong. An exception
- -- is the case of internal type names, where we try to find a reasonable
- -- external representation for the external name
+ if Nkind (Node) = N_Pragma then
+ Nam := Pragma_Name (Node);
- if Is_Internal_Name (Chars (Node))
+ -- The other cases have Chars fields, and we want to test for possible
+ -- internal names, which generally represent something gone wrong. An
+ -- exception is the case of internal type names, where we try to find a
+ -- reasonable external representation for the external name
+
+ elsif Is_Internal_Name (Chars (Node))
and then
((Is_Entity_Name (Node)
and then Present (Entity (Node))
Nam := Chars (Ent);
end if;
+ -- If not internal name, just use name in Chars field
+
else
Nam := Chars (Node);
end if;
-- reference to the Any_Type node, then the message is suppressed.
-- 6. Note that cases 2-5 only apply to error messages, not warning
- -- messages. Warning messages are only suppressed for case 1.
+ -- messages. Warning messages are only suppressed for case 1, and
+ -- when they come from other than the main extended unit.
-- This normal suppression action may be overridden in cases 2-5 (but not
-- in case 1) by setting All_Errors mode, or by setting the special
-- it, since it makes it clear that the continuation is part of an
-- unconditional message.
+ -- Insertion character !! (unconditional warning)
+
+ -- Normally warning messages issued in other than the main unit are
+ -- suppressed. If the message ends with !! then this suppression is
+ -- avoided. This is currently only used by the Compile_Time_Warning
+ -- pragma to ensure the message for a with'ed unit is output.
+
-- Insertion character ? (Question: warning message)
-- The character ? appearing anywhere in a message makes the message
-- warning instead of a normal error message, and the text of the