From: Viljar Indus <in...@adacore.com>
There are multiple scenarios where warnings can be turned into
errors. However internally they should always be handled the
same way and we should not rely on additional counters and variables
to handle the different behaviours.
These different types of converted warnings have however been
emitted differently historically. This information is stored in
the Warn_Err attribute which now stores the reason for the conversion
so that the printers know how to handle those scenarios.
Based on the reason these warnings are printed in different ways:
* If converted by pragma Warning_As_Error then it should print the
message with an error prefix and a [warning-as-error] tag.
* If it is a run time warning converted by -gnatwE then the message
should be printed with just an error prefix.
* if the warning was converted by -gnatwe then the message should be
printed with a warning prefix.
gcc/ada/ChangeLog:
* atree.ads (Compile_Time_Pragma_Warnings): Removed.
* errout.adb (Initialize): Remove initialization for
Compile_Time_Pragma_Warnings.
(Error_Msg_Internal): Use Warning_As_Error_Kind in the
Error_Msg_Object. Set its value based on the reason the
warning was changed to an error.
(Write_JSON_Span): Adjust the code for Warn_Err.
(Output_Messages): Update the calculation for actual warnings
and errors by just using Warnings_Treated_As_Errors.
(Set_Msg_Text): Simply mark that we are dealing with a
run time message here. Move the code for the Warning_Mode to
Error_Msg_Internal.
* erroutc-pretty_emitter.adb (Write_Error_Msg_Line): Adjust the code
for Warn_Err. Use the Warn_As_Err_Tag token.
* erroutc.adb (Compilation_Errors): Simplify the implementation so
that it only checks for errors and warnings treated as errors.
(Decrease_Error_Msg_Count): Remove the count for
Compile_Time_Pragma_Warnings.
(dmsg): Adjust the code for changes to Warn_Err.
(Increase_Error_Msg_Count): Likewise and remove the count for
Compile_Time_Pragma_Warnings.
(Output_Msg_Text): Warnings converted to error by the
Warning_As_Error pragma and -gnatwE now use the error prefix
in their messages but only warnings changed by the pragma get
the [warning-as-error] tag.
(Output_Text_Within): Adjust the variable name for
Is_Runtime_Raise_Msg.
(Write_Error_Summary): Adjust printing of warnings so that it
just uses the counts for Warnings_Detected and
Warnings_Treated_As_Errors.
* erroutc.ads (Is_Runtime_Raise): renamed to Is_Runtime_Raise_Msg.
(Warning_As_Error_Kind): New type for marking the warning message
is treated as an error which also captures the reason for the
change. Historically each of the reasons will have a different way
of displaying the warning message.
(Error_Msg_Object.Warn_Err): Change type to Warning_As_Error_Kind.
(Kind_To_String): Warnings treated as errors originating from
the pragma or -gnatwE will return error where as warnings
originating from -gnatwe will return warning.
(Compilation_Errors): Update the documentation.
(Warn_As_Err_Tag): Constant string to be used when printing warnings
as errors.
* errutil.adb (Error_Msg): Adjust the code for Warn_Err.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/atree.ads | 3 -
gcc/ada/errout.adb | 46 +++++-----
gcc/ada/erroutc-pretty_emitter.adb | 4 +-
gcc/ada/erroutc.adb | 135 ++++++++---------------------
gcc/ada/erroutc.ads | 40 ++++++---
gcc/ada/errutil.adb | 4 +-
6 files changed, 92 insertions(+), 140 deletions(-)
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index e17eecc04d0..802db870933 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -175,9 +175,6 @@ package Atree is
-- Number of warnings changed into errors as a result of matching a pattern
-- given in a Warning_As_Error configuration pragma.
- Compile_Time_Pragma_Warnings : Nat := 0;
- -- Number of warnings that come from a Compile_Time_Warning pragma
-
Configurable_Run_Time_Violations : Nat := 0;
-- Count of configurable run time violations so far. This is used to
-- suppress certain cascaded error messages when we know that we may not
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index ae7df04b91f..472fbbe6cb2 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1400,7 +1400,7 @@ package body Errout is
Line => Get_Physical_Line_Number (Sptr),
Col => Get_Column_Number (Sptr),
Compile_Time_Pragma => Is_Compile_Time_Msg,
- Warn_Err => False, -- reset below
+ Warn_Err => None, -- reset below
Warn_Chr => Warning_Msg_Char,
Uncond => Is_Unconditional_Msg,
Msg_Cont => Continuation,
@@ -1413,12 +1413,25 @@ package body Errout is
Fixes => First_Fix));
Cur_Msg := Errors.Last;
- -- Test if warning to be treated as error
+ -- Test if a warning is to be treated as error:
+ -- * It is marked by a pragma Warning_As_Error
+ -- * Warning_Mode is Treat_Run_Time_Warnings_As_Errors and we are
+ -- dealing with a runtime warning.
+ -- * Warning_Mode is Warnings_As_Errors and it is not a compile time
+ -- message.
- Errors.Table (Cur_Msg).Warn_Err :=
- Error_Msg_Kind in Warning | Style
- and then (Warning_Treated_As_Error (Errors.Table (Cur_Msg))
- or else Is_Runtime_Raise);
+ if Error_Msg_Kind in Warning | Style then
+ if Warning_Treated_As_Error (Errors.Table (Cur_Msg)) then
+ Errors.Table (Cur_Msg).Warn_Err := From_Pragma;
+ elsif Warning_Mode = Treat_Run_Time_Warnings_As_Errors
+ and then Is_Runtime_Raise_Msg
+ then
+ Errors.Table (Cur_Msg).Warn_Err := From_Run_Time_As_Err;
+ elsif Warning_Mode = Treat_As_Error and then not Is_Compile_Time_Msg
+ then
+ Errors.Table (Cur_Msg).Warn_Err := From_Warn_As_Err;
+ end if;
+ end if;
-- If immediate errors mode set, output error message now. Also output
-- now if the -d1 debug flag is set (so node number message comes out
@@ -2119,7 +2132,6 @@ package body Errout is
Warnings_Treated_As_Errors := 0;
Warnings_Detected := 0;
Warnings_As_Errors_Count := 0;
- Compile_Time_Pragma_Warnings := 0;
-- Initialize warnings tables
@@ -2627,7 +2639,8 @@ package body Errout is
Write_Str ("{""kind"":");
- if Errors.Table (E).Kind = Warning and then not Errors.Table (E).Warn_Err
+ if Errors.Table (E).Kind = Warning
+ and then Errors.Table (E).Warn_Err = None
then
Write_Str ("""warning""");
elsif Errors.Table (E).Kind in
@@ -3126,11 +3139,10 @@ package body Errout is
end if;
if Warning_Mode = Treat_As_Error then
+ pragma Assert (Warnings_Detected >= Warnings_Treated_As_Errors);
Total_Errors_Detected :=
- Total_Errors_Detected
- + Warnings_Detected
- - Compile_Time_Pragma_Warnings;
- Warnings_Detected := Compile_Time_Pragma_Warnings;
+ Total_Errors_Detected + Warnings_Treated_As_Errors;
+ Warnings_Detected := Warnings_Detected - Warnings_Treated_As_Errors;
end if;
end Output_Messages;
@@ -4075,15 +4087,7 @@ package body Errout is
Set_Msg_Insertion_Code;
else
- -- Switch the message from a warning to an error if the flag
- -- -gnatwE is specified to treat run-time exception warnings
- -- as non-serious errors.
-
- if Error_Msg_Kind = Warning
- and then Warning_Mode = Treat_Run_Time_Warnings_As_Errors
- then
- Is_Runtime_Raise := True;
- end if;
+ Is_Runtime_Raise_Msg := True;
if Error_Msg_Kind = Warning then
Set_Msg_Str ("will be raised at run time");
diff --git a/gcc/ada/erroutc-pretty_emitter.adb
b/gcc/ada/erroutc-pretty_emitter.adb
index 86e2e3ddec6..d9bf560dd8d 100644
--- a/gcc/ada/erroutc-pretty_emitter.adb
+++ b/gcc/ada/erroutc-pretty_emitter.adb
@@ -1120,8 +1120,8 @@ package body Erroutc.Pretty_Emitter is
Write_Str (" " & Switch_Str);
end if;
- if E_Msg.Warn_Err then
- Write_Str (" [warning-as-error]");
+ if E_Msg.Warn_Err = From_Pragma then
+ Write_Str (" " & Warn_As_Err_Tag);
end if;
Write_Eol;
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 26988dc8488..14a11ff925c 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -225,27 +225,9 @@ package body Erroutc is
------------------------
function Compilation_Errors return Boolean is
- Warnings_Count : constant Int := Warnings_Detected;
begin
- if Total_Errors_Detected /= 0 then
- return True;
-
- elsif Warnings_Treated_As_Errors /= 0 then
- return True;
-
- -- We should never treat warnings that originate from a
- -- Compile_Time_Warning pragma as an error. Warnings_Count is the sum
- -- of both "normal" and Compile_Time_Warning warnings. This means that
- -- there are only one or more non-Compile_Time_Warning warnings when
- -- Warnings_Count is greater than Compile_Time_Pragma_Warnings.
-
- elsif Warning_Mode = Treat_As_Error
- and then Warnings_Count > Compile_Time_Pragma_Warnings
- then
- return True;
- end if;
-
- return False;
+ return Total_Errors_Detected /= 0
+ or else Warnings_Treated_As_Errors /= 0;
end Compilation_Errors;
------------------------------
@@ -262,15 +244,10 @@ package body Erroutc is
when Warning | Style =>
Warnings_Detected := Warnings_Detected - 1;
- if E.Warn_Err then
+ if E.Warn_Err /= None then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if;
- if E.Compile_Time_Pragma then
- Compile_Time_Pragma_Warnings :=
- Compile_Time_Pragma_Warnings - 1;
- end if;
-
when High_Check | Medium_Check | Low_Check =>
Check_Messages := Check_Messages - 1;
@@ -329,7 +306,7 @@ package body Erroutc is
w (" Line = ", Int (E.Line));
w (" Col = ", Int (E.Col));
w (" Kind = ", E.Kind'Img);
- w (" Warn_Err = ", E.Warn_Err);
+ w (" Warn_Err = ", E.Warn_Err'Img);
w (" Warn_Chr = '" & E.Warn_Chr & ''');
w (" Uncond = ", E.Uncond);
w (" Msg_Cont = ", E.Msg_Cont);
@@ -428,14 +405,14 @@ package body Erroutc is
when Warning | Style =>
Warnings_Detected := Warnings_Detected + 1;
- if E.Warn_Err then
+ if E.Warn_Err /= None then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
-- Propagate Warn_Err to all of the preceeding continuation
-- messages and the main message.
for J in reverse 1 .. Errors.Last loop
- if not Errors.Table (J).Warn_Err then
+ if Errors.Table (J).Warn_Err = None then
Errors.Table (J).Warn_Err := E.Warn_Err;
Warnings_Treated_As_Errors :=
@@ -446,11 +423,6 @@ package body Erroutc is
end loop;
end if;
- if E.Compile_Time_Pragma then
- Compile_Time_Pragma_Warnings :=
- Compile_Time_Pragma_Warnings + 1;
- end if;
-
when High_Check | Medium_Check | Low_Check =>
Check_Messages := Check_Messages + 1;
@@ -1035,7 +1007,7 @@ package body Erroutc is
-- Prefix with "error:" rather than warning.
-- Additionally include the style suffix when needed.
- if E_Msg.Warn_Err then
+ if E_Msg.Warn_Err in From_Pragma | From_Run_Time_As_Err then
Append
(Buf,
SGR_Error & "error: " & SGR_Reset &
@@ -1067,8 +1039,8 @@ package body Erroutc is
-- Postfix [warning-as-error] at the end
- if E_Msg.Warn_Err then
- Append (Buf, " [warning-as-error]");
+ if E_Msg.Warn_Err = From_Pragma then
+ Append (Buf, " " & Warn_As_Err_Tag);
end if;
Output_Text_Within (To_String (Buf), Line_Length);
@@ -1162,7 +1134,7 @@ package body Erroutc is
Error_Msg_Kind := Error;
Is_Unconditional_Msg := False;
- Is_Runtime_Raise := False;
+ Is_Runtime_Raise_Msg := False;
Warning_Msg_Char := " ";
-- Check style message
@@ -2211,71 +2183,32 @@ package body Erroutc is
Write_Str (" errors");
end if;
- -- We now need to output warnings. When using -gnatwe, all warnings
- -- should be treated as errors, except for warnings originating from
- -- the use of the Compile_Time_Warning pragma. Another situation
- -- where a warning might be treated as an error is when the source
- -- code contains a Warning_As_Error pragma.
- -- When warnings are treated as errors, we still log them as
- -- warnings, but we add a message denoting how many of these warnings
- -- are also errors.
+ if Warnings_Detected > 0 then
+ Write_Str (", ");
+ Write_Int (Warnings_Detected);
+ Write_Str (" warning");
- declare
- Warnings_Count : constant Int := Warnings_Detected;
-
- Non_Compile_Time_Warnings : Int;
- -- Number of warnings that do not come from a Compile_Time_Warning
- -- pragmas.
-
- begin
- if Warnings_Count > 0 then
- Write_Str (", ");
- Write_Int (Warnings_Count);
- Write_Str (" warning");
-
- if Warnings_Count > 1 then
- Write_Char ('s');
- end if;
-
- Non_Compile_Time_Warnings :=
- Warnings_Count - Compile_Time_Pragma_Warnings;
-
- if Warning_Mode = Treat_As_Error
- and then Non_Compile_Time_Warnings > 0
- then
- Write_Str (" (");
-
- if Compile_Time_Pragma_Warnings > 0 then
- Write_Int (Non_Compile_Time_Warnings);
- Write_Str (" ");
- end if;
-
- Write_Str ("treated as error");
-
- if Non_Compile_Time_Warnings > 1 then
- Write_Char ('s');
- end if;
-
- Write_Char (')');
-
- elsif Warnings_Treated_As_Errors > 0 then
- Write_Str (" (");
-
- if Warnings_Treated_As_Errors /= Warnings_Count then
- Write_Int (Warnings_Treated_As_Errors);
- Write_Str (" ");
- end if;
-
- Write_Str ("treated as error");
-
- if Warnings_Treated_As_Errors > 1 then
- Write_Str ("s");
- end if;
-
- Write_Str (")");
- end if;
+ if Warnings_Detected > 1 then
+ Write_Char ('s');
end if;
- end;
+
+ if Warnings_Treated_As_Errors > 0 then
+ Write_Str (" (");
+
+ if Warnings_Treated_As_Errors /= Warnings_Detected then
+ Write_Int (Warnings_Treated_As_Errors);
+ Write_Str (" ");
+ end if;
+
+ Write_Str ("treated as error");
+
+ if Warnings_Treated_As_Errors > 1 then
+ Write_Str ("s");
+ end if;
+
+ Write_Str (")");
+ end if;
+ end if;
if Info_Messages /= 0 then
Write_Str (", ");
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 94fcddd84a4..2d8499a5bff 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -82,15 +82,14 @@ package Erroutc is
-- Set true to indicate that the current message originates from a
-- Compile_Time_Warning or Compile_Time_Error pragma.
+ Is_Runtime_Raise_Msg : Boolean := False;
+ -- Set to True to indicate that the current message is a constraint error
+ -- that will be raised at runtime (contains [).
+
Is_Unconditional_Msg : Boolean := False;
-- Set True to indicate that the current message contains the insertion
-- character ! and is thus to be treated as an unconditional message.
- Is_Runtime_Raise : Boolean := False;
- -- Set to True to indicate that the current message is a warning about a
- -- constraint error that will be raised at runtime (contains [ and switch
- -- -gnatwE was given)..
-
Error_Msg_Kind : Error_Msg_Type := Error;
Warning_Msg_Char : String (1 .. 2);
@@ -261,6 +260,17 @@ package Erroutc is
Table_Increment => 200,
Table_Name => "Fix");
+ type Warning_As_Error_Kind is
+ (None, From_Pragma, From_Warn_As_Err, From_Run_Time_As_Err);
+ -- The reason for a warning to be converted as an error:
+ -- * None - Regular warning. Default value for non-warning messages.
+ -- * From_Pragma - Warning converted to an error due to a pragma
+ -- Warning_As_Error.
+ -- * From_Warn_As_Err - Warning converted to an error because the
+ -- Warning_Mode was set to Treat_As_Errors by -gnatwe.
+ -- * From_Run_Time_As_Err - Warning converted to an error because the
+ -- Warning_Mode was set to Treat_Run_Time_Warnings_As_Errors by -gnatwE.
+
type Error_Msg_Object is record
Text : String_Ptr;
-- Text of error message, fully expanded with all insertions
@@ -308,9 +318,11 @@ package Erroutc is
-- True if the message originates from a Compile_Time_Warning or
-- Compile_Time_Error pragma
- 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.
+ Warn_Err : Warning_As_Error_Kind;
+ -- By default this is None. If the warning was converted by some reason
+ -- to an error then it has a different value. Depending on the value
+ -- the warning will be printed in a different way due to historical
+ -- reasons.
Warn_Chr : String (1 .. 2);
-- See Warning_Msg_Char
@@ -381,7 +393,7 @@ package Erroutc is
-- Update E to point to the next continuation message
function Kind_To_String (E : Error_Msg_Object) return String is
- (if E.Warn_Err then "error"
+ (if E.Warn_Err in From_Pragma | From_Run_Time_As_Err then "error"
else
(case E.Kind is
when Error | Non_Serious_Error => "error",
@@ -578,7 +590,7 @@ package Erroutc is
(SGR_Seq (Color_Bold));
function Get_SGR_Code (E_Msg : Error_Msg_Object) return String is
- (if E_Msg.Warn_Err then SGR_Error
+ (if E_Msg.Warn_Err /= None then SGR_Error
else
(case E_Msg.Kind is
when Warning | Style => SGR_Warning,
@@ -606,8 +618,8 @@ package Erroutc is
-- buffer, and preceded by a space.
function Compilation_Errors return Boolean;
- -- Returns true if errors have been detected, or warnings in -gnatwe
- -- (treat warnings as errors) mode.
+ -- Returns true if errors have been detected, or warnings that are treated
+ -- as errors.
procedure dmsg (Id : Error_Msg_Id);
-- Debugging routine to dump an error message
@@ -718,6 +730,10 @@ package Erroutc is
High_Prefix : constant String := "high: ";
Style_Prefix : constant String := "(style) ";
+ Warn_As_Err_Tag : constant String := "[warning-as-error]";
+ -- Tag used at the end of warning messages that were converted by
+ -- pragma Warning_As_Error.
+
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
-- All error messages whose location is in the range From .. To (not
-- including the end points) will be deleted from the error listing.
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index b5fd1a525db..b3674a1bcb5 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -208,7 +208,9 @@ package body Errutil is
Line => Get_Physical_Line_Number (Sptr),
Col => Get_Column_Number (Sptr),
Compile_Time_Pragma => Is_Compile_Time_Msg,
- Warn_Err => Warning_Mode = Treat_As_Error,
+ Warn_Err => (if Warning_Mode = Treat_As_Error
+ then From_Warn_As_Err
+ else None),
Warn_Chr => Warning_Msg_Char,
Uncond => Is_Unconditional_Msg,
Msg_Cont => Continuation,
--
2.43.0
