2014-02-20 Ed Schonberg <schonberg@adacore.com>

	* 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  <dewar@adacore.com>

	* 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.



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

1 files changed, 29 insertions, 13 deletions

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 5469944e920..f938e9b87dc 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -267,9 +267,13 @@ package Erroutc is
    --  values in this table always reference the original template, not an
    --  instantiation copy, in the generic case.
 
+   --  Reason is the reason from the pragma Warnings (Off,..) or the null
+   --  string if no reason parameter is given.
+
    type Warnings_Entry is record
-      Start : Source_Ptr;
-      Stop  : Source_Ptr;
+      Start  : Source_Ptr;
+      Stop   : Source_Ptr;
+      Reason : String_Id;
    end record;
 
    package Warnings is new Table.Table (
@@ -282,7 +286,7 @@ package Erroutc is
 
    --  The second table is used for the specific forms of the pragma, where
    --  the first argument is ON or OFF, and the second parameter is a string
-   --  which is the entire message to suppress, or a prefix of it.
+   --  which is the pattern to match for suppressing a warning.
 
    type Specific_Warning_Entry is record
       Start : Source_Ptr;
@@ -290,6 +294,9 @@ package Erroutc is
       --  Starting and ending source pointers for the range. These are always
       --  from the same source file.
 
+      Reason : String_Id;
+      --  Reason string from pragma Warnings, or null string if none
+
       Msg : String_Ptr;
       --  Message from pragma Warnings (Off, string)
 
@@ -466,6 +473,7 @@ package Erroutc is
    procedure Set_Specific_Warning_Off
      (Loc    : Source_Ptr;
       Msg    : String;
+      Reason : String_Id;
       Config : Boolean;
       Used   : Boolean := False);
    --  This is called in response to the two argument form of pragma Warnings
@@ -473,10 +481,11 @@ package Erroutc is
    --  which identifies a specific warning to be suppressed. The first argument
    --  is the start of the suppression range, and the second argument is the
    --  string from the pragma. Loc is the location of the pragma (which is the
-   --  start of the range to suppress). Config is True for the configuration
-   --  pragma case (where there is no requirement for a matching OFF pragma).
-   --  Used is set True to disable the check that the warning actually has
-   --  has the effect of suppressing a warning.
+   --  start of the range to suppress). Reason is the reason string from the
+   --  pragma, or the null string if no reason is given. Config is True for the
+   --  configuration pragma case (where there is no requirement for a matching
+   --  OFF pragma). Used is set True to disable the check that the warning
+   --  actually has has the effect of suppressing a warning.
 
    procedure Set_Specific_Warning_On
      (Loc : Source_Ptr;
@@ -489,9 +498,10 @@ package Erroutc is
    --  string from the pragma. Err is set to True on return to report the error
    --  of no matching Warnings Off pragma preceding this one.
 
-   procedure Set_Warnings_Mode_Off (Loc : Source_Ptr);
+   procedure Set_Warnings_Mode_Off (Loc : Source_Ptr; Reason : String_Id);
    --  Called in response to a pragma Warnings (Off) to record the source
-   --  location from which warnings are to be turned off.
+   --  location from which warnings are to be turned off. Reason is the
+   --  Reason from the pragma, or the null string if none is given.
 
    procedure Set_Warnings_Mode_On (Loc : Source_Ptr);
    --  Called in response to a pragma Warnings (On) to record the source
@@ -518,18 +528,24 @@ package Erroutc is
    --  Note that the call has no effect for continuation messages (those whose
    --  first character is '\'), and all variables are left unchanged.
 
-   function Warnings_Suppressed (Loc : Source_Ptr) return Boolean;
+   function Warnings_Suppressed (Loc : Source_Ptr) return String_Id;
    --  Determines if given location is covered by a warnings off suppression
    --  range in the warnings table (or is suppressed by compilation option,
    --  which generates a warning range for the whole source file). This routine
-   --  only deals with the general ON/OFF case, not specific warnings. True
-   --  is also returned if warnings are globally suppressed.
+   --  only deals with the general ON/OFF case, not specific warnings. The
+   --  returned result is No_String if warnings are not suppressed. If warnings
+   --  are suppressed for the given location, then then corresponding Reason
+   --  parameter from the pragma is returned (or the null string if no Reason
+   --  parameter was present).
 
    function Warning_Specifically_Suppressed
      (Loc : Source_Ptr;
-      Msg : String_Ptr) return Boolean;
+      Msg : String_Ptr) return String_Id;
    --  Determines if given message to be posted at given location is suppressed
    --  by specific ON/OFF Warnings pragmas specifying this particular message.
+   --  If the warning is not suppressed then No_String is returned, otherwise
+   --  the corresponding warning string is returned (or the null string if no
+   --  Warning argument was present in the pragma).
 
    type Error_Msg_Proc is
      access procedure (Msg : String; Flag_Location : Source_Ptr);