ada: Fix detecting Compilation_Errors

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.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 5ed3aab2d9f34d2b4f80a4c58f74d4a171869b37..2554d5895b3a36057d81f1fa2f625f04df43096c 100644 (file)
--- 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 76113b9e05ace3d89b387b4ccdbc7542e5131ddb..707851ac6a7a3feda37aa69cfcc3e2757c9e4a7f 100644 (file)
--- 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 &