From: Viljar Indus <in...@adacore.com>
Store the Exit_Code value and use that to generate
the Exceution_Successful value in the SARIF report.
gcc/ada/ChangeLog:
* comperr.adb (Compiler_Abort): Pass the exit code in calls to
Output_Messages.
* errout.adb (Output_Messages): Add new parameter for the
Exit_Code and store its value.
* errout.ads (Output_Messages): Likewise.
* erroutc-sarif_emitter.adb (Print_Invocations): Set
Execution_Successful based on the exit code.
* erroutc.ads (Exit_Code): Store the exit code value.
* gnat1drv.adb (Gnat1drv): Pass the exit code in calls to
Output_Messages.
* prepcomp.adb (Parse_Preprocessing_Data_File, Prpare_To_Preprocess):
Likewise.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/comperr.adb | 2 +-
gcc/ada/errout.adb | 5 +++--
gcc/ada/errout.ads | 5 +++--
gcc/ada/erroutc-sarif_emitter.adb | 3 +--
gcc/ada/erroutc.ads | 4 ++++
gcc/ada/gnat1drv.adb | 26 +++++++++++++++-----------
gcc/ada/prepcomp.adb | 4 ++--
7 files changed, 29 insertions(+), 20 deletions(-)
diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb
index 602b13dd59b..c6285e98620 100644
--- a/gcc/ada/comperr.adb
+++ b/gcc/ada/comperr.adb
@@ -146,7 +146,7 @@ package body Comperr is
if Serious_Errors_Detected /= 0 and then not Debug_Flag_K then
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (E_Errors);
Set_Standard_Error;
Write_Str ("compilation abandoned due to previous error");
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 25d1d52e34b..5ed3aab2d9f 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -44,7 +44,6 @@ with Gnatvsn; use Gnatvsn;
with Lib; use Lib;
with Opt; use Opt;
with Nlists; use Nlists;
-with Osint; use Osint;
with Output; use Output;
with Scans; use Scans;
with Sem_Aux; use Sem_Aux;
@@ -2710,7 +2709,7 @@ package body Errout is
-- Output_Messages --
---------------------
- procedure Output_Messages is
+ procedure Output_Messages (Exit_Code : Exit_Code_Type) is
-- Local subprograms
@@ -2819,6 +2818,8 @@ package body Errout is
raise Program_Error;
end if;
+ Erroutc.Exit_Code := Exit_Code;
+
-- Reset current error source file if the main unit has a pragma
-- Source_Reference. This ensures outputting the proper name of
-- the source file in this situation.
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 98aa4b4c120..40b5155f3f7 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -32,6 +32,7 @@ with Err_Vars;
with Erroutc;
with Errid; use Errid;
with Namet; use Namet;
+with Osint; use Osint;
with Table;
with Types; use Types;
with Uintp; use Uintp;
@@ -716,9 +717,9 @@ package Errout is
-- and must be set True on the last call (a value of True activates some
-- processing that must only be done after all messages are posted).
- procedure Output_Messages;
+ procedure Output_Messages (Exit_Code : Exit_Code_Type);
-- Output list of messages, including messages giving number of detected
- -- errors and warnings.
+ -- errors and warnings and store the exit code used.
procedure Error_Msg
(Msg : String; Flag_Location : Source_Ptr);
diff --git a/gcc/ada/erroutc-sarif_emitter.adb
b/gcc/ada/erroutc-sarif_emitter.adb
index 791becb3965..90f7a7c73a9 100644
--- a/gcc/ada/erroutc-sarif_emitter.adb
+++ b/gcc/ada/erroutc-sarif_emitter.adb
@@ -28,7 +28,6 @@ with GNAT.Lists; use GNAT.Lists;
with Gnatvsn; use Gnatvsn;
with Lib; use Lib;
with Namet; use Namet;
-with Osint; use Osint;
with Output; use Output;
with Sinput; use Sinput;
with System.OS_Lib;
@@ -759,7 +758,7 @@ package body Erroutc.SARIF_Emitter is
-- Print executionSuccessful
- Write_Boolean_Attribute (N_EXECUTION_SUCCESSFUL, not Compilation_Errors);
+ Write_Boolean_Attribute (N_EXECUTION_SUCCESSFUL, Exit_Code = E_Success);
End_Block;
NL_And_Indent;
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 5ee26797c72..2c44b5b1487 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -29,10 +29,14 @@
with Table;
with Errsw; use Errsw;
with Errid; use Errid;
+with Osint; use Osint;
with Types; use Types;
package Erroutc is
+ Exit_Code : Exit_Code_Type := E_Success;
+ -- Exit_Code used at the end of the compilation
+
type Error_Msg_Type is
(Error, -- Default value
Non_Serious_Error,
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 46f04e484b7..ec57cd23731 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -982,7 +982,7 @@ procedure Gnat1drv is
-- Local variables
Back_End_Mode : Back_End.Back_End_Mode_Type;
- Ecode : Exit_Code_Type;
+ Ecode : Exit_Code_Type := E_Success;
Main_Unit_Kind : Node_Kind;
-- Kind of main compilation unit node
@@ -1169,9 +1169,10 @@ begin
-- Exit with errors if the main source could not be parsed
if Sinput.Main_Source_File <= No_Source_File then
+ Ecode := E_Errors;
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
- Exit_Program (E_Errors);
+ Errout.Output_Messages (Ecode);
+ Exit_Program (Ecode);
end if;
Main_Unit_Node := Cunit (Main_Unit);
@@ -1198,9 +1199,10 @@ begin
Errout.Finalize (Last_Call => False);
if Compilation_Errors then
+ Ecode := E_Errors;
Treepr.Tree_Dump;
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (Ecode);
Namet.Finalize;
-- Generate ALI file if specially requested
@@ -1209,7 +1211,7 @@ begin
Write_ALI (Object => False);
end if;
- Exit_Program (E_Errors);
+ Exit_Program (Ecode);
end if;
-- Case of no code required to be generated, exit indicating no error
@@ -1217,7 +1219,7 @@ begin
if Original_Operating_Mode = Check_Syntax then
Treepr.Tree_Dump;
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (Ecode);
Namet.Finalize;
Check_Rep_Info;
@@ -1407,7 +1409,7 @@ begin
Post_Compilation_Validation_Checks;
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (Ecode);
Treepr.Tree_Dump;
-- Generate ALI file if specially requested, or for missing subunits,
@@ -1461,7 +1463,7 @@ begin
then
Post_Compilation_Validation_Checks;
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (Ecode);
Write_ALI (Object => False);
Tree_Dump;
Namet.Finalize;
@@ -1541,7 +1543,8 @@ begin
-- representation information for List_Rep_Info).
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages
+ ((if Compilation_Errors then E_Errors else E_Success));
-- Back annotation of representation info is not done in CodePeer and
-- SPARK modes.
@@ -1557,8 +1560,9 @@ begin
-- there will be no attempt to generate an object file.
if Compilation_Errors then
+ Ecode := E_Errors;
Treepr.Tree_Dump;
- Exit_Program (E_Errors);
+ Exit_Program (Ecode);
end if;
if not GNATprove_Mode then
@@ -1632,7 +1636,7 @@ begin
exception
when Unrecoverable_Error =>
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (E_Errors);
Set_Standard_Error;
Write_Str ("compilation abandoned");
diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb
index ea7760a713b..35dd4cbf53a 100644
--- a/gcc/ada/prepcomp.adb
+++ b/gcc/ada/prepcomp.adb
@@ -545,7 +545,7 @@ package body Prepcomp is
if Total_Errors_Detected > T then
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (E_Fatal);
Fail ("errors found in preprocessing data file """
& Get_Name_String (N) & """");
end if;
@@ -668,7 +668,7 @@ package body Prepcomp is
if T /= Total_Errors_Detected then
Errout.Finalize (Last_Call => True);
- Errout.Output_Messages;
+ Errout.Output_Messages (E_Fatal);
Fail ("errors found in definition file """
& Get_Name_String (N)
& """");
--
2.43.0
