From: Viljar Indus <in...@adacore.com>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/errout.adb | 33 +++++----------------------------
gcc/ada/erroutc.adb | 37 +++++++++++++++++++++++++++++++++++++
gcc/ada/erroutc.ads | 5 +++++
gcc/ada/errutil.adb | 32 ++++----------------------------
4 files changed, 51 insertions(+), 56 deletions(-)
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 7991f781e42..644fd1fad37 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -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
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index 32197ad7884..c57205418de 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -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 --
--------------------
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index dac47725aae..9a70cfa6244 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -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.
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index ab320be3390..62cd8679cf1 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -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
--
2.43.0
