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 <ka...@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.
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.
