From 0c7e0c3254341de04e877a58c44aba23203cf04a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 20 Feb 2014 14:42:58 +0100 Subject: [multiple changes] 2014-02-20 Ed Schonberg * sem_ch5.adb (Analyze_Iterator_Specification): Initialize properly the cursor type for subsequent volatile testing in SPARK mode, when domain is a formal container with an Iterabe aspect. 2014-02-20 Robert Dewar * errout.adb (Set_Warnings_Mode_Off): Add Reason argument. (Set_Specific_Warning_Off): Add Reason argument. * errout.ads (Set_Warnings_Mode_Off): Add Reason argument. (Set_Specific_Warning_Off): Add Reason argument. * erroutc.adb (Warnings_Entry): Add Reason field (Specific_Warning_Entry): Add Reason field. (Warnings_Suppressed): return String_Id for Reason. (Warning_Specifically_Suppressed): return String_Id for Reason. * erroutc.ads (Warnings_Entry): Add Reason field. (Specific_Warning_Entry): Add Reason field. (Set_Specific_Warning_Off): Add Reason argument. (Set_Warnings_Mode_Off): Add Reason argument. (Warnings_Suppressed): return String_Id for Reason. (Warning_Specifically_Suppressed): return String_Id for Reason. * errutil.adb (Warnings_Suppressed): returns String_Id for Reason (Warning_Specifically_Suppressed): returns String_Id for Reason * gnat_rm.texi: Document that Warning parameter is string literal or a concatenation of string literals. * par-prag.adb: New handling for Reason argument. * sem_prag.adb (Analyze_Pragma, case Warning): New handling for Reason argument. * sem_util.ads, sem_util.adb (Get_Reason_String): New procedure. * sem_warn.ads (Warnings_Off_Entry): Add reason field. * stringt.adb: Set Null_String_Id. * stringt.ads (Null_String_Id): New constant. From-SVN: r207943 --- gcc/ada/erroutc.adb | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) (limited to 'gcc/ada/erroutc.adb') diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index b31f760..8604f25 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -39,6 +39,7 @@ with Opt; use Opt; with Output; use Output; with Sinput; use Sinput; with Snames; use Snames; +with Stringt; use Stringt; with Targparm; use Targparm; with Uintp; use Uintp; @@ -1110,6 +1111,7 @@ package body Erroutc is procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String; + Reason : String_Id; Config : Boolean; Used : Boolean := False) is @@ -1118,6 +1120,7 @@ package body Erroutc is ((Start => Loc, Msg => new String'(Msg), Stop => Source_Last (Current_Source_File), + Reason => Reason, Open => True, Used => Used, Config => Config)); @@ -1163,7 +1166,7 @@ package body Erroutc is -- Set_Warnings_Mode_Off -- --------------------------- - procedure Set_Warnings_Mode_Off (Loc : Source_Ptr) is + procedure Set_Warnings_Mode_Off (Loc : Source_Ptr; Reason : String_Id) is begin -- Don't bother with entries from instantiation copies, since we will -- already have a copy in the template, which is what matters. @@ -1197,10 +1200,10 @@ package body Erroutc is -- source file. This ending point will be adjusted by a subsequent -- corresponding pragma Warnings (On). - Warnings.Increment_Last; - Warnings.Table (Warnings.Last).Start := Loc; - Warnings.Table (Warnings.Last).Stop := - Source_Last (Current_Source_File); + Warnings.Append + ((Start => Loc, + Stop => Source_Last (Current_Source_File), + Reason => Reason)); end Set_Warnings_Mode_Off; -------------------------- @@ -1342,7 +1345,7 @@ package body Erroutc is function Warning_Specifically_Suppressed (Loc : Source_Ptr; - Msg : String_Ptr) return Boolean + Msg : String_Ptr) return String_Id is function Matches (S : String; P : String) return Boolean; -- Returns true if the String S patches the pattern P, which can contain @@ -1429,36 +1432,36 @@ package body Erroutc is then if Matches (Msg.all, SWE.Msg.all) then SWE.Used := True; - return True; + return SWE.Reason; end if; end if; end; end loop; - return False; + return No_String; end Warning_Specifically_Suppressed; ------------------------- -- Warnings_Suppressed -- ------------------------- - function Warnings_Suppressed (Loc : Source_Ptr) return Boolean is + function Warnings_Suppressed (Loc : Source_Ptr) return String_Id is begin - if Warning_Mode = Suppress then - return True; - end if; - -- Loop through table of ON/OFF warnings for J in Warnings.First .. Warnings.Last loop if Warnings.Table (J).Start <= Loc and then Loc <= Warnings.Table (J).Stop then - return True; + return Warnings.Table (J).Reason; end if; end loop; - return False; + if Warning_Mode = Suppress then + return Null_String_Id; + else + return No_String; + end if; end Warnings_Suppressed; end Erroutc; -- cgit v1.1