From 406c4143b9aa508c35c0004f57f587170dfda166 Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 12 May 2009 11:00:13 +0000
Subject: [PATCH] 1.0.28.43: QUIT related work

 * SAVE-LISP-AND-DIE :TOPLEVEL can return, just call QUIT if it does.

 * --script should not override QUIT called by user with its own exit status.
   (reported by Hubert Kauker)
---
 NEWS                   |    6 ++++++
 src/code/save.lisp     |    8 +++++---
 src/code/toplevel.lisp |   14 ++++++--------
 tests/core.test.sh     |    6 ++++++
 tests/script.test.sh   |   36 ++++++++++++++++++++++++++++++++++++
 version.lisp-expr      |    2 +-
 6 files changed, 60 insertions(+), 12 deletions(-)
 create mode 100644 tests/script.test.sh

diff --git a/NEWS b/NEWS
index 7ce94b9..3a93e5a 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+  * minor incompatible change: SAVE-LISP-AND-DIE :TOPLEVEL function is now
+    allowed to return, which causes SBCL to quit with exit status 0. Previously
+    if the function returned with a small integer return value, that value
+    was accidentally reused as the exit status.
   * new feature: SB-EXT:DEFGLOBAL macro allows defining global non-special
     variables.
   * new feature: SB-EXT:ALWAYS-BOUND proclamation inhibits MAKUNBOUND, and
@@ -19,6 +23,8 @@
   * improvement: pretty-printing loop has been implemented properly. (thanks
     to Tobias Rittweiler)
   * documentation: CLOS slot typechecing policy has been documented.
+  * bug fix: exit status from QUIT when called under --script was lost
+    (reported by Hubert Kauker)
   * bug fix: MAKE-ARRAY for non-zero :INITIAL-ELEMENT always used the
     same implementation of FILL to initialize the array, even if a more
     efficient one was available (reported by Stas Boukarev, thanks to
diff --git a/src/code/save.lisp b/src/code/save.lisp
index d4f183e..059f132 100644
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -49,8 +49,8 @@ The following &KEY arguments are defined:
   :TOPLEVEL
      The function to run when the created core file is resumed. The
      default function handles command line toplevel option processing
-     and runs the top level read-eval-print loop. This function should
-     not return.
+     and runs the top level read-eval-print loop. This function returning
+     is equivalent to (SB-EXT:QUIT :UNIX-STATUS 0) being called.
 
   :EXECUTABLE
      If true, arrange to combine the SBCL runtime and the core image
@@ -126,7 +126,9 @@ sufficiently motivated to do lengthy fixes."
              (handling-end-of-the-world
                (reinit)
                #!+hpux (sb!sys:%primitive sb!vm::setup-return-from-lisp-stub)
-               (funcall toplevel)))
+               (progn
+                 (funcall toplevel)
+                 (sb!ext:quit))))
            (foreign-bool (value)
              (if value 1 0))
            (save-core (gc)
diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp
index 6071131..87a4752 100644
--- a/src/code/toplevel.lisp
+++ b/src/code/toplevel.lisp
@@ -398,14 +398,12 @@ command-line.")
     t))
 
 (defun process-script (script)
-  (let ((pathname (native-pathname script))
-        (ok nil))
-    (unwind-protect
-         (with-open-file (f pathname :element-type :default)
-           (maybe-skip-shebang-line f)
-           (load f :verbose nil :print nil)
-           (setf ok t))
-      (quit :unix-status (if ok 0 1)))))
+  (let ((pathname (native-pathname script)))
+    (handling-end-of-the-world
+      (with-open-file (f pathname :element-type :default)
+        (maybe-skip-shebang-line f)
+        (load f :verbose nil :print nil)
+        (quit)))))
 
 ;; Errors while processing the command line cause the system to QUIT,
 ;; instead of trying to go into the Lisp debugger, because trying to
diff --git a/tests/core.test.sh b/tests/core.test.sh
index 4f80be8..7393645 100644
--- a/tests/core.test.sh
+++ b/tests/core.test.sh
@@ -20,6 +20,12 @@ use_test_subdirectory
 tmpcore=$TEST_FILESTEM.core
 tmpoutput=$TEST_FILESTEM.txt
 
+run_sbcl <<EOF
+  (save-lisp-and-die "$tmpcore" :toplevel (lambda () 42))
+EOF
+run_sbcl_with_core "$tmpcore" --no-userinit --no-sysinit
+check_status_maybe_lose "SAVE-LISP-AND-DIE :TOPLEVEL" $? 0 "(saved core ran)"
+
 # In sbcl-0.7.7 SAVE-LISP-AND-DIE didn't work at all because of
 # flakiness caused by consing/GC/purify twice-and-at-least-twice
 # mismatch grot.
diff --git a/tests/script.test.sh b/tests/script.test.sh
new file mode 100644
index 0000000..a9ce19a
--- /dev/null
+++ b/tests/script.test.sh
@@ -0,0 +1,36 @@
+#!/bin/sh
+
+# tests related to --script
+
+# This software is part of the SBCL system. See the README file for
+# more information.
+#
+# While most of SBCL is derived from the CMU CL system, the test
+# files (like this one) were written from scratch after the fork
+# from CMU CL.
+#
+# This software is in the public domain and is provided with
+# absolutely no warranty. See the COPYING and CREDITS files for
+# more information.
+
+. ./subr.sh
+
+use_test_subdirectory
+
+tmpscript=$TEST_FILESTEM.lisp-script
+
+echo '(quit :unix-status 7)' > $tmpscript
+run_sbcl --script $tmpscript
+check_status_maybe_lose "--script exit status from QUIT" $? 7 "(quit status good)"
+
+echo '(error "oops")' > $tmpscript
+run_sbcl --script $tmpscript
+check_status_maybe_lose "--script exit status from ERROR" $? 1 "(error implies 1)"
+
+echo 'nil'> $tmpscript
+run_sbcl --script $tmpscript
+check_status_maybe_lose "--script exit status from normal exit" $? 0 "(everything ok)"
+
+rm -f $tmpscript
+
+exit $EXIT_TEST_WIN
diff --git a/version.lisp-expr b/version.lisp-expr
index 401b27b..f181b56 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.42"
+"1.0.28.43"
-- 
1.7.10.4