ada: Fix Execution_Successful value with exceptions

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.

diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb
index 602b13dd59bba4fcbd1760e28e27cd945bab105a..c6285e98620811c69671cef7f20793fc95f6a095 100644 (file)
--- 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 25d1d52e34b495331ef1a87622b7e326dcb6c337..5ed3aab2d9f34d2b4f80a4c58f74d4a171869b37 100644 (file)
--- 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 98aa4b4c12096fce257ff324950ee2eeddc47f61..40b5155f3f7f32cc7f6571821e95c647e4b39ff9 100644 (file)
--- 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 791becb39657d1e9b159b808230fe2dc096de869..90f7a7c73a90ac5b58b66702f30a0cf81611190e 100644 (file)
--- 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 5ee26797c72b63b8bb9e6fdedf53fb20183083a5..2c44b5b14877b83d4b84e4622073c310c5e7bcd7 100644 (file)
--- 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 46f04e484b79f118b52222a5ebb6be1bcb7f4220..ec57cd23731ee8de4c290e955af92fe63068ebef 100644 (file)
--- 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 ea7760a713b7ca4a3a742dff7f28792ddfaf1001..35dd4cbf53ae9be30db2a70baf5ff9c3b5980c27 100644 (file)
--- 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)
                      & """");