From 14f1ec15bd8860dee913a2207f598baddf13ae94 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Wed, 26 Mar 2008 08:37:35 +0100 Subject: [PATCH] errout.ads: Document new !! insertion sequence 2008-03-26 Robert Dewar * 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 !! From-SVN: r133556 --- gcc/ada/errout.adb | 28 +++++++++++++++++++--------- gcc/ada/errout.ads | 10 +++++++++- 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 -- 2.30.2