erroutc.ads, [...] (Set_Specific_Warning_On): New procedure

2006-10-31  Robert Dewar  <dewar@adacore.com>

	* erroutc.ads, erroutc.adb (Set_Specific_Warning_On): New procedure
	(Set_Specific_Warning_Off): New procedure
	(Warning_Specifically_Suppressed): New function
	(Validate_Specific_Warnings): New procedure
	(Output_Msg_Text): Complete rewrite to support -gnatjnn

	* err_vars.ads: Implement insertion character ~ (insert string)

From-SVN: r118252

gcc/ada/err_vars.ads

@@ -132,4 +132,9 @@ package Err_Vars is
    --  Used if current message contains a < insertion character to indicate
    --  if the current message is a warning message.
 
+   Error_Msg_String : String (1 .. 4096);
+   Error_Msg_Strlen : Natural;
+   --  Used if current message contains a ~ insertion character to indicate
+   --  insertion of the string Error_Msg_String (1 .. Error_Msg_Strlen).
+
 end Err_Vars;

gcc/ada/erroutc.ads

@@ -41,6 +41,10 @@ package Erroutc is
    --  Msg_Cont parameter in Error_Msg_Internal and then set True if a \
    --  insertion character is encountered.
 
+   Continuation_New_Line : Boolean := False;
+   --  Indicates if current message was a continuation line marked with \\ to
+   --  force a new line. Set True if \\ encountered.
+
    Flag_Source : Source_File_Index;
    --  Source file index for source file where error is being posted
 
@@ -140,7 +144,8 @@ package Erroutc is
       --  Text of error message, fully expanded with all insertions
 
       Next : Error_Msg_Id;
-      --  Pointer to next message in error chain
+      --  Pointer to next message in error chain. A value of No_Error_Msg
+      --  indicates the end of the chain.
 
       Sfile : Source_File_Index;
       --  Source table index of source file. In the case of an error that
@@ -218,9 +223,12 @@ package Erroutc is
    --------------------------
 
    --  Pragma Warnings allows warnings to be turned off for a specified
-   --  region of code, and the following tabl is the data structure used
+   --  region of code, and the following tables are the data structure used
    --  to keep track of these regions.
 
+   --  The first table is used for the basic command line control, and for
+   --  the forms of Warning with a single ON or OFF parameter
+
    --  It contains pairs of source locations, the first being the start
    --  location for a warnings off region, and the second being the end
    --  location. When a pragma Warnings (Off) is encountered, a new entry
@@ -247,6 +255,49 @@ package Erroutc is
      Table_Increment      => 200,
      Table_Name           => "Warnings");
 
+   --  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.
+
+   type Specific_Warning_Entry is record
+      Start : Source_Ptr;
+      Stop  : Source_Ptr;
+      --  Starting and ending source pointers for the range. These are always
+      --  from the same source file. Start is set to No_Location for the case
+      --  of a configuration pragma.
+
+      Msg : String_Ptr;
+      --  Message from pragma Warnings (Off, string)
+
+      Pattern : String_Ptr;
+      --  Same as Msg, excluding initial and final asterisks if present. The
+      --  lower bound of this string is always one.
+
+      Patlen : Natural;
+      --  Length of pattern string (excluding initial/final asterisks)
+
+      Open : Boolean;
+      --  Set to True if OFF has been encountered with no matchin ON
+
+      Used : Boolean;
+      --  Set to True if entry has been used to suppress a warning
+
+      Star_Start : Boolean;
+      --  True if given pattern had * at start
+
+      Star_End : Boolean;
+      --  True if given pattern had * at end
+
+   end record;
+
+   package Specific_Warnings is new Table.Table (
+     Table_Component_Type => Specific_Warning_Entry,
+     Table_Index_Type     => Natural,
+     Table_Low_Bound      => 1,
+     Table_Initial        => 100,
+     Table_Increment      => 200,
+     Table_Name           => "Specific_Warnings");
+
    -----------------
    -- Subprograms --
    -----------------
@@ -292,9 +343,11 @@ package Erroutc is
    --  as all blanks, avoiding output of junk line numbers.
 
    procedure Output_Msg_Text (E : Error_Msg_Id);
-   --  Outputs characters of text in the text of the error message E, excluding
-   --  any final exclamation point. Note that no end of line is output, the
-   --  caller is responsible for adding the end of line.
+   --  Outputs characters of text in the text of the error message E. Note that
+   --  no end of line is output, the caller is responsible for adding the end
+   --  of line. If Error_Msg_Line_Length is non-zero, this is the routine that
+   --  splits the line generating multiple lines of output, and in this case
+   --  the last line has no terminating end of line character.
 
    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
    --  All error messages whose location is in the range From .. To (not
@@ -375,6 +428,24 @@ package Erroutc is
    --  the input value of E was either already No_Error_Msg, or was the
    --  last non-deleted message.
 
+   procedure Set_Specific_Warning_Off (Loc : Source_Ptr; Msg : String);
+   --  This is called in response to the two argument form of pragma Warnings
+   --  where the first argument is OFF, and the second argument is the prefix
+   --  of 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 set to No_Location for the configuration pragma case.
+
+   procedure Set_Specific_Warning_On
+     (Loc : Source_Ptr;
+      Msg : String;
+      Err : out Boolean);
+   --  This is called in response to the two argument form of pragma Warnings
+   --  where the first argument is ON, and the second argument is the prefix
+   --  of a specific warning to be suppressed. The first argument is the end
+   --  of the suppression range, and the second argument is the 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);
    --  Called in response to a pragma Warnings (Off) to record the source
    --  location from which warnings are to be turned off.
@@ -395,6 +466,20 @@ package Erroutc is
    function Warnings_Suppressed (Loc : Source_Ptr) return Boolean;
    --  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).
+   --  which generates a warning range for the whole source file). This routine
+   --  only deals with the general ON/OFF case, not specific warnings
+
+   function Warning_Specifically_Suppressed
+     (Loc : Source_Ptr;
+      Msg : String_Ptr) return Boolean;
+   --  Determines if given message to be posted at given location is suppressed
+   --  by specific ON/OFF Warnings pragmas specifying this particular message.
+
+   type Error_Msg_Proc is
+     access procedure (Msg : String; Flag_Location : Source_Ptr);
+   procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
+   --  Checks that specific warnings are consistent (for non-configuration
+   --  case, properly closed, and used). The argument is a pointer to the
+   --  Error_Msg procedure to be called if any inconsistencies are detected.
 
 end Erroutc;