From: Christophe Rhodes <csr21@cantab.net>
Date: Tue, 4 Dec 2012 20:19:23 +0000 (+0000)
Subject: fix direct execution of (shebanged) fasls
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=0338d1fc97a74b8ff332821ea275120b9de951c1;p=sbcl.git

fix direct execution of (shebanged) fasls

Broken since 4993cd5, when fasl-header-p stopped working on bivalent
streams.  Make it work on bivalent streams, as long as they're
seekable (i.e. don't sniff stdin for a fasl header; bad things happen).
---

diff --git a/NEWS b/NEWS
index 632124d..b7953e8 100644
--- a/NEWS
+++ b/NEWS
@@ -1,4 +1,8 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
+changes relative to sbcl-1.1.2:
+  * bug fix: fasls are now once again directly executable (on platforms
+    supporting shebang lines, with a suitably-installed sbcl).
+
 changes in sbcl-1.1.2 relative to sbcl-1.1.1:
   * notice: System requirements for SBCL on Microsoft Windows: Windows NT 5.1
     or newer (Windows XP, Server 2003) is required.  Support for Windows 2000
diff --git a/src/code/load.lisp b/src/code/load.lisp
index 941891b..ede4e2d 100644
--- a/src/code/load.lisp
+++ b/src/code/load.lisp
@@ -315,7 +315,14 @@
 
 ;;; Returns T if the stream is a binary input stream with a FASL header.
 (defun fasl-header-p (stream &key errorp)
-  (unless (member (stream-element-type stream) '(character base-char))
+  (unless (and (member (stream-element-type stream) '(character base-char))
+               ;; give up if it's not a file stream, or it's an
+               ;; fd-stream but it's either not bivalent or not
+               ;; seekable (doesn't really have a file)
+               (or (not (typep stream 'file-stream))
+                   (and (typep stream 'fd-stream)
+                        (or (not (sb!impl::fd-stream-bivalent-p stream))
+                            (not (sb!impl::fd-stream-file stream))))))
     (let ((p (file-position stream)))
       (unwind-protect
            (let* ((header *fasl-header-string-start-string*)
diff --git a/tests/script.test.sh b/tests/script.test.sh
index 33483ba..48da103 100644
--- a/tests/script.test.sh
+++ b/tests/script.test.sh
@@ -18,6 +18,7 @@
 use_test_subdirectory
 
 tmpscript=$TEST_FILESTEM.lisp-script
+tmpfasl=$TEST_FILESTEM.lisp-fasl
 tmpout=$TEST_FILESTEM.lisp-out
 tmperr=$TEST_FILESTEM.lisp-err
 
@@ -87,7 +88,7 @@ then
     exit $EXIT_LOSE
 fi
 echo '(write-line "Ok!")' | run_sbcl --script 1>$tmpout 2>$tmperr
-check_status_maybe_lose "--script exit status script from stdin" $? 0 "(ok)"
+check_status_maybe_lose "--script exit status from stdin" $? 0 "(ok)"
 if [ -s $tmperr ] || [ "Ok!" != `cat $tmpout` ]
 then
     echo "--script unexpected error output"
@@ -105,6 +106,22 @@ if [ "`grep -c :SCRIPT-OK $tmpout`" != 1 ] ; then
    exit $EXIT_LOSE
 fi
 
-rm -f $tmpscript $tmpout $tmperr
+# automatically executing fasls
+#
+# this test is fragile, with its SBCL_HOME hack to get the shebang
+# line in the fasl to find the right core, and also is unlikely to
+# work with that mechanism on Windows.
+echo '(format t "Hello, Fasl~%")' > $tmpscript
+run_sbcl --eval "(compile-file \"$tmpscript\" :output-file \"$tmpfasl\")"  </dev/null >/dev/null
+chmod +x $tmpfasl
+SBCL_HOME=$(dirname $SBCL_CORE) ./$tmpfasl >$tmpout 2>$tmperr
+check_status_maybe_lose "--script exit status from fasl" $? 0 "(ok)"
+if [ -s $tmperr ] || [ "Hello, Fasl" != "`cat $tmpout`" ]
+then
+    echo "--script from fasl unexpected output"
+    exit $EXIT_LOSE
+fi
+
+rm -f $tmpscript $tmpout $tmperr $tmpfasl
 
 exit $EXIT_TEST_WIN