]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Refactor checking redundant messages
authorViljar Indus <indus@adacore.com>
Mon, 11 Nov 2024 08:19:21 +0000 (10:19 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 26 Nov 2024 09:49:35 +0000 (10:49 +0100)
Move common code between errout and errutil into a single function.

gcc/ada/ChangeLog:

* errout.adb: Use Is_Redundant_Error_Message.
* erroutc.adb: Move the common code for checking if a message
can be removed to Is_Redundant_Error_Message.
* erroutc.ads: Add definition of Is_Redundant_Error_Message.
* errutil.adb: Use Is_Redundant_Error_Message.

gcc/ada/errout.adb
gcc/ada/erroutc.adb
gcc/ada/erroutc.ads
gcc/ada/errutil.adb

index 7991f781e42399fc591c37f1371e31a102ca4f9e..644fd1fad37d5c7297ae7473a3201257c71ea702 100644 (file)
@@ -1340,37 +1340,14 @@ package body Errout is
          --  from the parser recovering. In full errors mode, we don't do this
          --  deletion, but otherwise such messages are discarded at this stage.
 
-         if Prev_Msg /= No_Error_Msg
-           and then Errors.Table (Prev_Msg).Line = Errors.Table (Cur_Msg).Line
-           and then Errors.Table (Prev_Msg).Sfile
-                    = Errors.Table (Cur_Msg).Sfile
-           and then Compiler_State = Parsing
+         if Compiler_State = Parsing
            and then not All_Errors_Mode
+           and then Is_Redundant_Error_Message (Prev_Msg, Cur_Msg)
          then
-            --  Don't delete unconditional messages and at this stage, don't
-            --  delete continuation lines; we attempted to delete those earlier
-            --  if the parent message was deleted.
-
-            if not Errors.Table (Cur_Msg).Uncond and then not Continuation then
-               --  Don't delete if prev msg is warning and new msg is an error.
-               --  This is because we don't want a real error masked by a
-               --  warning. In all other cases (that is parse errors for the
-               --  same line that are not unconditional) we do delete the
-               --  message. This helps to avoid junk extra messages from
-               --  cascaded parsing errors
-
-               if Errors.Table (Prev_Msg).Kind not in Warning | Style
-                 or else Errors.Table (Cur_Msg).Kind in Warning | Style
-               then
-                  --  All tests passed, delete the message by simply returning
-                  --  without any further processing.
-
-                  pragma Assert (not Continuation);
+            pragma Assert (not Continuation);
 
-                  Last_Killed := True;
-                  return;
-               end if;
-            end if;
+            Last_Killed := True;
+            return;
          end if;
 
          --  Come here if message is to be inserted in the error chain
index 32197ad788434eb613e599e7a7127a369f07ca2f..c57205418de768c29d04ab285853e4bc3db01d72 100644 (file)
@@ -441,6 +441,43 @@ package body Erroutc is
       end case;
    end Increase_Error_Msg_Count;
 
+   --------------------------------
+   -- Is_Redundant_Error_Message --
+   --------------------------------
+
+   function Is_Redundant_Error_Message
+     (Prev_Msg : Error_Msg_Id; Cur_Msg : Error_Msg_Id) return Boolean is
+
+   begin
+      return
+        Prev_Msg /= No_Error_Msg
+
+        --  Error messages are posted on the same line
+
+        and then Errors.Table (Prev_Msg).Line = Errors.Table (Cur_Msg).Line
+        and then Errors.Table (Prev_Msg).Sfile = Errors.Table (Cur_Msg).Sfile
+
+        --  Do not consider unconditional messages to be redundant right now
+        --  They may be removed later.
+
+        and then not Errors.Table (Cur_Msg).Uncond
+
+        --  Do not consider continuation messages as they are removed with
+        --  their parent later on.
+
+        and then not Errors.Table (Cur_Msg).Msg_Cont
+
+        --  Don't delete if prev msg is warning and new msg is an error.
+        --  This is because we don't want a real error masked by a
+        --  warning. In all other cases (that is parse errors for the
+        --  same line that are not unconditional) we do delete the
+        --  message. This helps to avoid junk extra messages from
+        --  cascaded parsing errors
+
+        and then (Errors.Table (Prev_Msg).Kind not in Warning | Style
+                  or else Errors.Table (Cur_Msg).Kind in Warning | Style);
+   end Is_Redundant_Error_Message;
+
    --------------------
    -- Has_Switch_Tag --
    --------------------
index dac47725aaefbb9a480dce6490160787723a0732..9a70cfa6244411251204d373428376b50b7736de 100644 (file)
@@ -481,6 +481,11 @@ package Erroutc is
    procedure Increase_Error_Msg_Count (E : Error_Msg_Object);
    --  Increase the error count for the given kind of error message
 
+   function Is_Redundant_Error_Message
+     (Prev_Msg : Error_Msg_Id; Cur_Msg : Error_Msg_Id) return Boolean;
+   --  Check if the Cur_Msg can be removed if it was issued at the same line as
+   --  the Prev_Msg.
+
    function Matches (S : String; P : String) return Boolean;
    --  Returns true if the String S matches the pattern P, which can contain
    --  wildcard chars (*). The entire pattern must match the entire string.
index ab320be33904f14ba6e16edcdad33b9be0784e6f..62cd8679cf1fe11971b1e39d148ee2aa05d9a862 100644 (file)
@@ -244,35 +244,11 @@ package body Errutil is
       --  from the parser recovering. In full errors mode, we don't do this
       --  deletion, but otherwise such messages are discarded at this stage.
 
-      if Prev_Msg /= No_Error_Msg
-        and then Errors.Table (Prev_Msg).Line = Errors.Table (Cur_Msg).Line
-        and then Errors.Table (Prev_Msg).Sfile = Errors.Table (Cur_Msg).Sfile
-      then
-         --  Don't delete unconditional messages and at this stage, don't
-         --  delete continuation lines (we attempted to delete those earlier
-         --  if the parent message was deleted.
-
-         if not Errors.Table (Cur_Msg).Uncond and then not Continuation then
-
-            --  Don't delete if prev msg is warning and new msg is an error.
-            --  This is because we don't want a real error masked by a warning.
-            --  In all other cases (that is parse errors for the same line that
-            --  are not unconditional) we do delete the message. This helps to
-            --  avoid junk extra messages from cascaded parsing errors
-
-            if Errors.Table (Prev_Msg).Kind not in Warning | Erroutc.Style
-              or else Errors.Table (Cur_Msg).Kind in Warning | Erroutc.Style
-            then
-               --  All tests passed, delete the message by simply returning
-               --  without any further processing.
-
-               if not Continuation then
-                  Last_Killed := True;
-               end if;
+      if Is_Redundant_Error_Message (Prev_Msg, Cur_Msg) then
+         pragma Assert (not Continuation);
 
-               return;
-            end if;
-         end if;
+         Last_Killed := True;
+         return;
       end if;
 
       --  Come here if message is to be inserted in the error chain