From: Viljar Indus <in...@adacore.com>
Subprogram Compilation_Errors is used to check whether any
errors have been detected during the compilation process. It
relies on Total_Errors_Detected and Warnings_Treated_As_Errors
counts. Total_Erros_Detected are updated immidiatelly after
the error objects have been created. Warnings_Treated_As_Errors
were updated only when the messages are being printed.
This leads to a situation where we do not have the correct count
of Warnings_Treated_As_Errors unless the errors have been printed.
gcc/ada/ChangeLog:
* errout.adb (Error_Msg_Internal): Relocate Warn_As_Err propagation
to Increase_Error_Msg_Counti.
(Delete_Warning_And_Continuations): Update
Warnings_Treated_As_Errors count.
(Delete_Warning): Likewise.
(To_Be_Removed): Likewise.
* erroutc.adb (Increase_Error_Msg_Count): Count warnings treated
as errors here and perform the propagation of this property to
the parent message.
(Output_Msg_Text): Remove counting of warnings as errors from
here.
(Decrease_Error_Msg_Count): Update Warnings_Treated_As_Errors
count.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/errout.adb | 21 +++++++++------------
gcc/ada/erroutc.adb | 25 ++++++++++++++++++++++---
2 files changed, 31 insertions(+), 15 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 5ed3aab2d9f..2554d5895b3 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1060,9 +1060,6 @@ package body Errout is
Temp_Msg : Error_Msg_Id;
- Warn_Err : Boolean;
- -- Set if warning to be treated as error
-
First_Fix : Fix_Id := No_Fix;
Last_Fix : Fix_Id := No_Fix;
@@ -1422,20 +1419,12 @@ package body Errout is
-- Test if warning to be treated as error
- Warn_Err :=
+ Errors.Table (Cur_Msg).Warn_Err :=
Error_Msg_Kind in Warning | Style
and then (Warning_Treated_As_Error (Msg_Buffer (1 .. Msglen))
or else Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg))
or else Is_Runtime_Raise);
- -- Propagate Warn_Err to this message and preceding continuations.
-
- for J in reverse 1 .. Errors.Last loop
- Errors.Table (J).Warn_Err := Warn_Err;
-
- exit when not Errors.Table (J).Msg_Cont;
- end loop;
-
-- 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
-- just before actual error message)
@@ -1815,6 +1804,10 @@ package body Errout is
if not Errors.Table (E).Deleted then
Errors.Table (E).Deleted := True;
Warnings_Detected := Warnings_Detected - 1;
+
+ if Errors.Table (E).Warn_Err then
+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
+ end if;
end if;
end Delete_Warning;
@@ -3344,6 +3337,10 @@ package body Errout is
then
Warnings_Detected := Warnings_Detected - 1;
+ if Errors.Table (E).Warn_Err then
+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
+ end if;
+
return True;
-- No removal required
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 76113b9e05a..707851ac6a7 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -282,6 +282,10 @@ package body Erroutc is
when Warning | Style =>
Warnings_Detected := Warnings_Detected - 1;
+ if E.Warn_Err then
+ Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
+ end if;
+
when High_Check | Medium_Check | Low_Check =>
Check_Messages := Check_Messages - 1;
@@ -429,6 +433,24 @@ package body Erroutc is
when Warning | Style =>
Warnings_Detected := Warnings_Detected + 1;
+ if E.Warn_Err 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
+ Errors.Table (J).Warn_Err := E.Warn_Err;
+
+ Warnings_Treated_As_Errors :=
+ Warnings_Treated_As_Errors + 1;
+ end if;
+
+ exit when not Errors.Table (J).Msg_Cont;
+ end loop;
+ end if;
+
when High_Check | Medium_Check | Low_Check =>
Check_Messages := Check_Messages + 1;
@@ -1014,9 +1036,6 @@ package body Erroutc is
-- Additionally include the style suffix when needed.
if E_Msg.Warn_Err then
-
- Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
-
Append
(Buf,
SGR_Error & "error: " & SGR_Reset &
--
2.43.0
