2008-03-26 Robert Dewar <dewar@adacore.com>

	* errout.ads: Document new !! insertion sequence

	* errout.adb (N_Pragma): Chars field removed, use Chars
	(Pragma_Identifier (..  instead.
	Replace use of Warnings_Off by Has_Warnings_Off
	(Error_Msg_Internal): Don't delete warning ending in !!



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

2 files changed, 28 insertions, 10 deletions

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index e0f649222d6..106af0aa5ca 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 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- --
@@ -766,6 +766,11 @@ package body Errout is
          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
@@ -1364,12 +1369,12 @@ package body Errout is
       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;
 
@@ -2392,14 +2397,17 @@ package body Errout is
       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))
@@ -2423,6 +2431,8 @@ package body Errout is
             Nam := Chars (Ent);
          end if;
 
+      --  If not internal name, just use name in Chars field
+
       else
          Nam := Chars (Node);
       end if;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index f58181eb018..b9b0616fe1c 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -120,7 +120,8 @@ package Errout is
    --        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
@@ -264,6 +265,13 @@ package Errout is
    --      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