From: Viljar Indus <in...@adacore.com>
There was a general concept of info messages being a subset of
warnings. However that is no longer the case. Messages with an
info insertion character should be treated just as info messages.
gcc/ada/
* atree.ads: Remove Warning_Info_Messages.
* errout.adb: Remove various places where Warning_Info_Messages
was used.
* erroutc.adb: Remove various places where Warning_Info_Messages
was used. Create Error_Msg_Object objects with only an info
attribute if the message contained both info and warning insertion
characters. New method Has_Switch_Tag for detecting if a message
should have an error tag.
* errutil.adb: Create Error_Msg_Object objects with only an info
attribute if the message contained both info and warning insertion
characters.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/atree.ads | 10 ++----
gcc/ada/errout.adb | 80 +++++++++++++++++++++++++--------------------
gcc/ada/erroutc.adb | 51 ++++++++++++++++++++---------
gcc/ada/errutil.adb | 31 ++++++++----------
4 files changed, 96 insertions(+), 76 deletions(-)
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 2ecb386c23b..834cc3150f5 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -161,15 +161,11 @@ package Atree is
-- Number of warnings detected. Initialized to zero at the start of
-- compilation. This count includes the count of style and info messages.
- Warning_Info_Messages : Nat := 0;
- -- Number of info messages generated as warnings. Info messages are never
- -- treated as errors (whether from use of the pragma, or the compiler
- -- switch -gnatwe).
-
- Report_Info_Messages : Nat := 0;
+ Info_Messages : Nat := 0;
-- Number of info messages generated as reports. Info messages are never
-- treated as errors (whether from use of the pragma, or the compiler
- -- switch -gnatwe). Used under Spark_Mode to report proved checks.
+ -- switch -gnatwe). Used by GNATprove under SPARK_Mode to report proved
+ -- checks.
Check_Messages : Nat := 0;
-- Number of check messages generated. Check messages are neither warnings
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 76c461a2fd7..1e6b0fe4369 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -283,10 +283,6 @@ package body Errout is
M.Deleted := True;
Warnings_Detected := Warnings_Detected - 1;
- if M.Info then
- Warning_Info_Messages := Warning_Info_Messages - 1;
- end if;
-
if M.Warn_Err then
Warnings_Treated_As_Errors := Warnings_Treated_As_Errors - 1;
end if;
@@ -428,7 +424,8 @@ package body Errout is
-- that style checks are not considered warning messages for this
-- purpose.
- if Is_Warning_Msg and then Warnings_Suppressed (Orig_Loc) /= No_String
+ if Is_Warning_Msg
+ and then Warnings_Suppressed (Orig_Loc) /= No_String
then
return;
@@ -1049,6 +1046,33 @@ package body Errout is
return;
end if;
+ if Is_Info_Msg then
+
+ -- If the flag location is in the main extended source unit then for
+ -- sure we want the message since it definitely belongs.
+
+ if In_Extended_Main_Source_Unit (Sptr) then
+ null;
+
+ -- Keep info message if message text contains !!
+
+ elsif Has_Double_Exclam then
+ null;
+
+ -- Here is where we delete a message from a with'ed unit
+
+ else
+ Cur_Msg := No_Error_Msg;
+
+ if not Continuation then
+ Last_Killed := True;
+ end if;
+
+ return;
+ end if;
+
+ end if;
+
-- Special check for warning message to see if it should be output
if Is_Warning_Msg then
@@ -1064,7 +1088,7 @@ package body Errout is
end if;
-- If the flag location is in the main extended source unit then for
- -- sure we want the warning since it definitely belongs
+ -- sure we want the warning since it definitely belongs.
if In_Extended_Main_Source_Unit (Sptr) then
null;
@@ -1210,6 +1234,11 @@ package body Errout is
return;
end if;
+ -- Warning, Style and Info attributes are mutually exclusive
+
+ pragma Assert (Boolean'Pos (Is_Warning_Msg) + Boolean'Pos (Is_Info_Msg) +
+ Boolean'Pos (Is_Style_Msg) <= 1);
+
-- Here we build a new error object
Errors.Append
@@ -1384,15 +1413,7 @@ package body Errout is
-- Bump appropriate statistics counts
if Errors.Table (Cur_Msg).Info then
-
- -- Could be (usually is) both "info" and "warning"
-
- if Errors.Table (Cur_Msg).Warn then
- Warning_Info_Messages := Warning_Info_Messages + 1;
- Warnings_Detected := Warnings_Detected + 1;
- else
- Report_Info_Messages := Report_Info_Messages + 1;
- end if;
+ Info_Messages := Info_Messages + 1;
elsif Errors.Table (Cur_Msg).Warn
or else Errors.Table (Cur_Msg).Style
@@ -1648,10 +1669,6 @@ 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).Info then
- Warning_Info_Messages := Warning_Info_Messages - 1;
- end if;
end if;
end Delete_Warning;
@@ -1695,7 +1712,8 @@ package body Errout is
Tag : constant String := Get_Warning_Tag (Cur);
begin
- if (CE.Warn and not CE.Deleted)
+ if CE.Warn
+ and then not CE.Deleted
and then
(Warning_Specifically_Suppressed (CE.Sptr.Ptr, CE.Text, Tag)
/= No_String
@@ -1968,7 +1986,6 @@ package body Errout is
Warnings_Treated_As_Errors := 0;
Warnings_Detected := 0;
- Warning_Info_Messages := 0;
Warnings_As_Errors_Count := 0;
-- Initialize warnings tables
@@ -2640,8 +2657,7 @@ package body Errout is
-- are also errors.
declare
- Warnings_Count : constant Int :=
- Warnings_Detected - Warning_Info_Messages;
+ Warnings_Count : constant Int := Warnings_Detected;
Compile_Time_Warnings : Int;
-- Number of warnings that come from a Compile_Time_Warning
@@ -2702,12 +2718,12 @@ package body Errout is
end if;
end;
- if Warning_Info_Messages + Report_Info_Messages /= 0 then
+ if Info_Messages /= 0 then
Write_Str (", ");
- Write_Int (Warning_Info_Messages + Report_Info_Messages);
+ Write_Int (Info_Messages);
Write_Str (" info message");
- if Warning_Info_Messages + Report_Info_Messages > 1 then
+ if Info_Messages > 1 then
Write_Char ('s');
end if;
end if;
@@ -3419,23 +3435,19 @@ package body Errout is
Write_Max_Errors;
end if;
- -- Even though Warning_Info_Messages are a subclass of warnings, they
- -- must not be treated as errors when -gnatwe is in effect.
-
if Warning_Mode = Treat_As_Error then
declare
Compile_Time_Pragma_Warnings : constant Nat :=
Count_Compile_Time_Pragma_Warnings;
Total : constant Int := Total_Errors_Detected + Warnings_Detected
- - Warning_Info_Messages - Compile_Time_Pragma_Warnings;
+ - Compile_Time_Pragma_Warnings;
-- We need to protect against a negative Total here, because
-- if a pragma Compile_Time_Warning occurs in dead code, it
-- gets counted in Compile_Time_Pragma_Warnings but not in
-- Warnings_Detected.
begin
Total_Errors_Detected := Int'Max (Total, 0);
- Warnings_Detected :=
- Warning_Info_Messages + Compile_Time_Pragma_Warnings;
+ Warnings_Detected := Compile_Time_Pragma_Warnings;
end;
end if;
end Output_Messages;
@@ -3630,10 +3642,6 @@ package body Errout is
Warnings_Detected := Warnings_Detected - 1;
end if;
- if Errors.Table (E).Info then
- Warning_Info_Messages := Warning_Info_Messages - 1;
- end if;
-
-- When warning about a runtime exception has been escalated
-- into error, the starting message has increased the total
-- errors counter, so here we decrease this counter.
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index f404018c44d..aa9aac4774f 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -59,6 +59,11 @@ package body Erroutc is
-- from generic instantiations by using pragma Warnings around generic
-- instances, as needed in GNATprove.
+ function Has_Switch_Tag (Id : Error_Msg_Id) return Boolean;
+ function Has_Switch_Tag (E_Msg : Error_Msg_Object) return Boolean;
+ -- Returns True if the E_Msg is Warning, Style or Info and has a non-empty
+ -- Warn_Char.
+
---------------
-- Add_Class --
---------------
@@ -144,12 +149,7 @@ package body Erroutc is
if Errors.Table (D).Info then
- if Errors.Table (D).Warn then
- Warning_Info_Messages := Warning_Info_Messages - 1;
- Warnings_Detected := Warnings_Detected - 1;
- else
- Report_Info_Messages := Report_Info_Messages - 1;
- end if;
+ Info_Messages := Info_Messages - 1;
elsif Errors.Table (D).Warn or else Errors.Table (D).Style then
Warnings_Detected := Warnings_Detected - 1;
@@ -246,8 +246,7 @@ package body Erroutc is
------------------------
function Compilation_Errors return Boolean is
- Warnings_Count : constant Int
- := Warnings_Detected - Warning_Info_Messages;
+ Warnings_Count : constant Int := Warnings_Detected;
begin
if Total_Errors_Detected /= 0 then
return True;
@@ -330,6 +329,7 @@ package body Erroutc is
w (" Line = ", Int (E.Line));
w (" Col = ", Int (E.Col));
+ w (" Info = ", E.Info);
w (" Warn = ", E.Warn);
w (" Warn_Err = ", E.Warn_Err);
w (" Warn_Runtime_Raise = ", E.Warn_Runtime_Raise);
@@ -366,13 +366,11 @@ package body Erroutc is
------------------------
function Get_Warning_Option (Id : Error_Msg_Id) return String is
- Warn : constant Boolean := Errors.Table (Id).Warn;
Style : constant Boolean := Errors.Table (Id).Style;
Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
begin
- if (Warn or Style)
- and then Warn_Chr /= " "
+ if Has_Switch_Tag (Errors.Table (Id))
and then Warn_Chr (1) /= '?'
then
if Warn_Chr = "$ " then
@@ -394,13 +392,11 @@ package body Erroutc is
---------------------
function Get_Warning_Tag (Id : Error_Msg_Id) return String is
- Warn : constant Boolean := Errors.Table (Id).Warn;
- Style : constant Boolean := Errors.Table (Id).Style;
Warn_Chr : constant String (1 .. 2) := Errors.Table (Id).Warn_Chr;
Option : constant String := Get_Warning_Option (Id);
begin
- if Warn or Style then
+ if Has_Switch_Tag (Id) then
if Warn_Chr = "? " then
return "[enabled by default]";
elsif Warn_Chr = "* " then
@@ -413,6 +409,23 @@ package body Erroutc is
return "";
end Get_Warning_Tag;
+ --------------------
+ -- Has_Switch_Tag --
+ --------------------
+
+ function Has_Switch_Tag (Id : Error_Msg_Id) return Boolean
+ is (Has_Switch_Tag (Errors.Table (Id)));
+
+ function Has_Switch_Tag (E_Msg : Error_Msg_Object) return Boolean
+ is
+ Warn : constant Boolean := E_Msg.Warn;
+ Style : constant Boolean := E_Msg.Style;
+ Info : constant Boolean := E_Msg.Info;
+ Warn_Chr : constant String (1 .. 2) := E_Msg.Warn_Chr;
+ begin
+ return (Warn or Style or Info) and then Warn_Chr /= " ";
+ end Has_Switch_Tag;
+
-------------
-- Matches --
-------------
@@ -918,6 +931,7 @@ package body Erroutc is
Is_Unconditional_Msg := False;
Is_Warning_Msg := False;
Is_Runtime_Raise := False;
+ Warning_Msg_Char := " ";
-- Check style message
@@ -962,7 +976,14 @@ package body Erroutc is
elsif Msg (J) = '?' or else Msg (J) = '<' then
if Msg (J) = '?' or else Error_Msg_Warn then
- Is_Warning_Msg := not Is_Style_Msg;
+
+ -- Consider Info and Style messages as unique message types.
+ -- Those messages can have warning insertion characters within
+ -- them. However they should only be switch specific insertion
+ -- characters and not the generic ? or ?? warning insertion
+ -- characters.
+
+ Is_Warning_Msg := not (Is_Style_Msg or else Is_Info_Msg);
J := J + 1;
Warning_Msg_Char := Parse_Message_Class;
diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index 4f5aa216461..6747fe59d24 100644
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -199,6 +199,11 @@ package body Errutil is
return;
end if;
+ -- Warning, Style and Info attributes are mutually exclusive
+
+ pragma Assert (Boolean'Pos (Is_Warning_Msg) + Boolean'Pos (Is_Info_Msg) +
+ Boolean'Pos (Is_Style_Msg) <= 1);
+
-- Otherwise build error message object for new message
Errors.Append
@@ -308,15 +313,7 @@ package body Errutil is
-- Bump appropriate statistics counts
if Errors.Table (Cur_Msg).Info then
-
- -- Could be (usually is) both "info" and "warning"
-
- if Errors.Table (Cur_Msg).Warn then
- Warning_Info_Messages := Warning_Info_Messages + 1;
- Warnings_Detected := Warnings_Detected + 1;
- else
- Report_Info_Messages := Report_Info_Messages + 1;
- end if;
+ Info_Messages := Info_Messages + 1;
elsif Errors.Table (Cur_Msg).Warn
or else Errors.Table (Cur_Msg).Style
@@ -553,19 +550,19 @@ package body Errutil is
Write_Str (" errors");
end if;
- if Warnings_Detected - Warning_Info_Messages /= 0 then
+ if Warnings_Detected /= 0 then
Write_Str (", ");
- Write_Int (Warnings_Detected - Warning_Info_Messages);
+ Write_Int (Warnings_Detected);
Write_Str (" warning");
- if Warnings_Detected - Warning_Info_Messages /= 1 then
+ if Warnings_Detected /= 1 then
Write_Char ('s');
end if;
if Warning_Mode = Treat_As_Error then
Write_Str (" (treated as error");
- if Warnings_Detected - Warning_Info_Messages /= 1 then
+ if Warnings_Detected /= 1 then
Write_Char ('s');
end if;
@@ -595,9 +592,8 @@ package body Errutil is
-- must not be treated as errors when -gnatwe is in effect.
if Warning_Mode = Treat_As_Error then
- Total_Errors_Detected :=
- Total_Errors_Detected + Warnings_Detected - Warning_Info_Messages;
- Warnings_Detected := Warning_Info_Messages;
+ Total_Errors_Detected := Total_Errors_Detected + Warnings_Detected;
+ Warnings_Detected := 0;
end if;
-- Prevent displaying the same messages again in the future
@@ -617,8 +613,7 @@ package body Errutil is
Serious_Errors_Detected := 0;
Total_Errors_Detected := 0;
Warnings_Detected := 0;
- Warning_Info_Messages := 0;
- Report_Info_Messages := 0;
+ Info_Messages := 0;
Cur_Msg := No_Error_Msg;
-- Initialize warnings table, if all warnings are suppressed, supply
--
2.45.1
