From 3826656eaff634b0349b610f274203b3026d3f87 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Thu, 21 May 2015 07:00:35 +0200
Subject: Rework exit handling to correctly report exit status.

Fix ticket 77.
---
 src/grt/ghdl_main.adb     |  3 ++-
 src/grt/grt-errors.adb    |  1 +
 src/grt/grt-errors.ads    |  1 +
 src/grt/grt-main.adb      |  4 ++++
 src/grt/grt-processes.adb | 11 +++++------
 src/grt/grt-processes.ads |  4 +++-
 6 files changed, 16 insertions(+), 8 deletions(-)

(limited to 'src/grt')

diff --git a/src/grt/ghdl_main.adb b/src/grt/ghdl_main.adb
index ce5b67d7e..2d1a00813 100644
--- a/src/grt/ghdl_main.adb
+++ b/src/grt/ghdl_main.adb
@@ -32,6 +32,7 @@ with Grt.Types; use Grt.Types;
 pragma Warnings (Off);
 with Grt.Rtis_Binding;
 with Grt.Std_Logic_1164;
+with Grt.Errors;
 pragma Warnings (On);
 
 
@@ -57,5 +58,5 @@ begin
 
    Grt_Init;
    Grt.Main.Run;
-   return 0;
+   return Grt.Errors.Exit_Status;
 end Ghdl_Main;
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index eddea38c1..ed936688b 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -48,6 +48,7 @@ package body Grt.Errors is
 
    procedure Exit_Simulation is
    begin
+      --  -2 is Grt.Errors.Run_Stop
       Maybe_Return_Via_Longjump (-2);
       Internal_Error ("exit_simulation");
    end Exit_Simulation;
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index c797a71bd..33c993226 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -67,6 +67,7 @@ package Grt.Errors is
    pragma No_Return (Fatal_Error);
    pragma Export (C, Fatal_Error, "__ghdl_fatal");
 
+   --  Stop or finish simulation (for VHPI or std.env).
    Exit_Status : Integer := 0;
    procedure Exit_Simulation;
 
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 6d595b4cc..4d4106bee 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -182,6 +182,10 @@ package body Grt.Main is
          Disp_Stats_Hook (0);
       end if;
 
+      if Status = -2 then
+         return;
+      end if;
+
       if Expect_Failure then
          if Status >= 0 then
             Expect_Failure := False;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 4a124e689..01e8394bc 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -707,6 +707,9 @@ package body Grt.Processes is
    Run_Finished : constant Integer := 3;
    --  Failure, simulation should stop.
    Run_Failure : constant Integer := -1;
+   --  Stop/finish request from user (via std.env).
+   Run_Stop : constant Integer := -2;
+   pragma Unreferenced (Run_Stop);
 
    Mt_Last : Natural;
    Mt_Table : Process_Acc_Array_Acc;
@@ -1015,7 +1018,7 @@ package body Grt.Processes is
 
       Status := Run_Through_Longjump (Initialization_Phase'Access);
       if Status /= Run_Resumed then
-         return -1;
+         return Status;
       end if;
 
       Nbr_Delta_Cycles := 0;
@@ -1074,11 +1077,7 @@ package body Grt.Processes is
 
       Grt.Hooks.Call_Finish_Hooks;
 
-      if Status = Run_Failure then
-         return -1;
-      else
-         return Exit_Status ;
-      end if;
+      return Status;
    end Simulation;
 
 end Grt.Processes;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 534a129ad..2d953ecf1 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -38,7 +38,9 @@ package Grt.Processes is
    procedure Init;
 
    --  Do the VHDL simulation.
-   --  Return 0 in case of success (end of time reached).
+   --  Return simulation status:
+   --  >= 0 in case of success (end of time reached).
+   --  < 0 in case of failure or stop request.
    function Simulation return Integer;
 
    --  Number of delta cycles.
-- 
cgit v1.2.3