Rework exit handling to correctly report exit status.

Fix ticket 77.

3 files changed, 35 insertions, 15 deletions

diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index 492e47d..28613c7 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -95,10 +95,9 @@ package body Ghdldrv is
    Linker_Args : Argument_Table_Pkg.Instance;
 
    --  Display the program spawned in Flag_Disp_Commands is TRUE.
-   --  Raise COMPILE_ERROR in case of failure.
-   procedure My_Spawn (Program_Name : String; Args : Argument_List)
-   is
-      Status : Integer;
+   --  Return the exit status.
+   function My_Spawn_Status (Program_Name : String; Args : Argument_List)
+                            return Integer is
    begin
       if Flag_Disp_Commands then
          Put (Program_Name);
@@ -108,7 +107,16 @@ package body Ghdldrv is
          end loop;
          New_Line;
       end if;
-      Status := Spawn (Program_Name, Args);
+      return Spawn (Program_Name, Args);
+   end My_Spawn_Status;
+
+   --  Display the program spawned in Flag_Disp_Commands is TRUE.
+   --  Raise COMPILE_ERROR in case of failure.
+   procedure My_Spawn (Program_Name : String; Args : Argument_List)
+   is
+      Status : Integer;
+   begin
+      Status := My_Spawn_Status (Program_Name, Args);
       if Status = 0 then
          return;
       elsif Status = 1 then
@@ -953,6 +961,19 @@ package body Ghdldrv is
       return "-r UNIT [ARCH] [OPTS]      Run UNIT";
    end Get_Short_Help;
 
+   procedure Run_Design (Exec : String_Access; Args : Argument_List)
+   is
+      Status : Integer;
+   begin
+      if Is_Absolute_Path (Exec.all) then
+         Status := My_Spawn_Status (Exec.all, Args);
+      else
+         Status := My_Spawn_Status
+           ('.' & Directory_Separator & Exec.all, Args);
+      end if;
+      Set_Exit_Status (Exit_Status (Status));
+   end Run_Design;
+
    procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List)
    is
       pragma Unreferenced (Cmd);
@@ -969,8 +990,7 @@ package body Ghdldrv is
          Error ("Please elaborate your design.");
          raise Exec_Error;
       end if;
-      My_Spawn ('.' & Directory_Separator & Base_Name.all,
-                Args (Opt_Arg .. Args'Last));
+      Run_Design (Base_Name, Args (Opt_Arg .. Args'Last));
    end Perform_Action;
 
    --  Command Elab_Run.
@@ -1012,12 +1032,7 @@ package body Ghdldrv is
       else
          Link (Add_Std => True, Disp_Only => False);
          Delete_File (Filelist_Name.all, Success);
-         if Is_Absolute_Path (Output_File.all) then
-            My_Spawn (Output_File.all, Args (Run_Arg .. Args'Last));
-         else
-            My_Spawn ('.' & Directory_Separator & Output_File.all,
-                      Args (Run_Arg .. Args'Last));
-         end if;
+         Run_Design (Output_File, Args (Run_Arg .. Args'Last));
       end if;
    end Perform_Action;
 
diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb
index 45d9615..606119e 100644
--- a/src/ghdldrv/ghdlmain.adb
+++ b/src/ghdldrv/ghdlmain.adb
@@ -321,6 +321,9 @@ package body Ghdlmain is
          First_Arg := Argument_Count + 1;
       end if;
 
+      --  Set before running the action, so that it can be changed.
+      Set_Exit_Status (Success);
+
       declare
          Args : Argument_List (1 .. Argument_Count - First_Arg + 1);
       begin
@@ -336,7 +339,6 @@ package body Ghdlmain is
       --   Name_Table.Disp_Stats;
       --   Iirs.Disp_Stats;
       --end if;
-      Set_Exit_Status (Success);
    exception
       when Option_Error
         | Compile_Error
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index cc93bd8..13bb6f8 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -58,6 +58,7 @@ with Grt.Images;
 with Grt.Values;
 with Grt.Names;
 with Grt.Std_Logic_1164;
+with Grt.Errors;
 
 with Ghdlcomp;
 with Foreigns;
@@ -605,7 +606,9 @@ package body Ghdlrun is
       end if;
 
       Grt.Main.Run;
-      --V := Ghdl_Main (1, Gnat_Argv);
+
+      Ada.Command_Line.Set_Exit_Status
+        (Ada.Command_Line.Exit_Status (Grt.Errors.Exit_Status));
    end Run;