diff mbox

[Ada] Introduce new message kind "Check"

Message ID 20141023104003.GA22964@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 23, 2014, 10:40 a.m. UTC
This patch introduces a kind of message which is not an error (i.e. is
non-fatal), but is not a warning either (cannot be suppressed with pragma
Warnings). This new kind is called a check, and is recognized by a severity
prefix "low: ", "medium: " or "high: ". This new message kind is to be used by
the gnat2why backend for detected runtime-checks and other issues.

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-10-23  Johannes Kanig  <kanig@adacore.com>

	* errout.adb (Error_Msg_Internal): Copy check flag, increment
	check msg count.
	* erroutc.adb (Delete_Msg) adjust check msg count.
	(Output_Msg_Text) handle check msg case (do nothing).
	(Prescan_Message) recognize check messages with severity prefixes.
	* errutil.adb (Error_Msg) handle check flag, adjust counter.
diff mbox

Patch

Index: errout.adb
===================================================================
--- errout.adb	(revision 216574)
+++ errout.adb	(working copy)
@@ -982,6 +982,7 @@ 
           Col      => Get_Column_Number (Sptr),
           Warn     => Is_Warning_Msg,
           Info     => Is_Info_Msg,
+          Check    => Is_Check_Msg,
           Warn_Err => False, -- reset below
           Warn_Chr => Warning_Msg_Char,
           Style    => Is_Style_Msg,
@@ -1140,6 +1141,9 @@ 
             Info_Messages := Info_Messages + 1;
          end if;
 
+      elsif Errors.Table (Cur_Msg).Check then
+         Check_Messages := Check_Messages + 1;
+
       else
          Total_Errors_Detected := Total_Errors_Detected + 1;
 
Index: errout.ads
===================================================================
--- errout.ads	(revision 216574)
+++ errout.ads	(working copy)
@@ -413,6 +413,13 @@ 
    --      are continuations that are not printed using the -gnatj switch they
    --      will also have this prefix.
 
+   --    Insertion sequence "low: " or "medium: " or "high: " (check message)
+   --      This appears only at the start of the message (and not any of its
+   --      continuations, if any), and indicates that the message is a check
+   --      message. The message will be output with this prefix. Check
+   --      messages are not fatal (so are like info messages in that respect)
+   --      and are not controlled by pragma Warnings.
+
    -----------------------------------------------------
    -- Global Values Used for Error Message Insertions --
    -----------------------------------------------------
Index: atree.ads
===================================================================
--- atree.ads	(revision 216574)
+++ atree.ads	(working copy)
@@ -320,6 +320,10 @@ 
    --  Number of info messages generated. Info messages are neved treated as
    --  errors (whether from use of the pragma, or the compiler switch -gnatwe).
 
+   Check_Messages : Nat := 0;
+   --  Number of check messages generated. Check messages are neither warnings
+   --  nor errors.
+
    Warnings_Treated_As_Errors : Nat := 0;
    --  Number of warnings changed into errors as a result of matching a pattern
    --  given in a Warning_As_Error configuration pragma.
Index: errutil.adb
===================================================================
--- errutil.adb	(revision 216574)
+++ errutil.adb	(working copy)
@@ -213,6 +213,7 @@ 
             Col      => Get_Column_Number (Sptr),
             Warn     => Is_Warning_Msg,
             Info     => Is_Info_Msg,
+            Check    => Is_Check_Msg,
             Warn_Err => Warning_Mode = Treat_As_Error,
             Warn_Chr => Warning_Msg_Char,
             Style    => Is_Style_Msg,
@@ -313,6 +314,9 @@ 
             Info_Messages := Info_Messages + 1;
          end if;
 
+      elsif Errors.Table (Cur_Msg).Check then
+         Check_Messages := Check_Messages + 1;
+
       else
          Total_Errors_Detected := Total_Errors_Detected + 1;
 
Index: erroutc.adb
===================================================================
--- erroutc.adb	(revision 216582)
+++ erroutc.adb	(working copy)
@@ -145,6 +145,9 @@ 
                --  because this only gets incremented if we actually output the
                --  message, which we won't do if we are deleting it here!
 
+            elsif Errors.Table (D).Check then
+               Check_Messages := Check_Messages - 1;
+
             else
                Total_Errors_Detected := Total_Errors_Detected - 1;
 
@@ -653,6 +656,11 @@ 
          elsif Errors.Table (E).Style then
             null;
 
+            --  No prefix needed for check message, severity is there already
+
+         elsif Errors.Table (E).Check then
+            null;
+
             --  All other cases, add "error: " if unique error tag set
 
          elsif Opt.Unique_Error_Tag then
@@ -765,6 +773,15 @@ 
       Is_Info_Msg :=
         Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "info: ";
 
+      --  Check check message
+
+      Is_Check_Msg :=
+        (Msg'Length > 8 and then Msg (Msg'First .. Msg'First + 7) = "medium: ")
+        or else
+          (Msg'Length > 6 and then Msg (Msg'First .. Msg'First + 5) = "high: ")
+        or else
+          (Msg'Length > 5 and then Msg (Msg'First .. Msg'First + 4) = "low: ");
+
       --  Loop through message looking for relevant insertion sequences
 
       J := Msg'First;
@@ -833,7 +850,7 @@ 
          end if;
       end loop;
 
-      if Is_Warning_Msg or Is_Style_Msg then
+      if Is_Warning_Msg or Is_Style_Msg or Is_Check_Msg then
          Is_Serious_Error := False;
       end if;
    end Prescan_Message;
Index: erroutc.ads
===================================================================
--- erroutc.ads	(revision 216574)
+++ erroutc.ads	(working copy)
@@ -68,6 +68,10 @@ 
    --  "info: " and is to be treated as an information message. This string
    --  will be prepended to the message and all its continuations.
 
+   Is_Check_Msg : Boolean := False;
+   --  Set True to indicate that the current message starts with one of
+   --  "high: ", "medium: ", "low: " and is to be treated as a check message.
+
    Warning_Msg_Char : Character;
    --  Warning character, valid only if Is_Warning_Msg is True
    --    ' '      -- ?   or <   appeared on its own in message
@@ -208,6 +212,9 @@ 
       Info : Boolean;
       --  True if info message
 
+      Check : Boolean;
+      --  True if check message
+
       Warn_Err : Boolean;
       --  True if this is a warning message which is to be treated as an error
       --  as a result of a match with a Warning_As_Error pragma.