* enhancement: SB-POSIX improvements:
** WNOHANG and WUNTRACED are exported.
** SYSCALL-ERROR now also provides the name of the failing system call.
+ * enhancement: --script improvements:
+ ** errors on standard input, output, and error streams are handled and
+ cause scripts to exit silently, making them easier to use in shell
+ pipelines.
+ ** backtraces from scripts now go to standard error instead of the
+ terminal even if one is available.
+ ** --script can be an argument, causing the script to be loaded from
+ standard input.
* optimization: using a &REST argument only in APPLY or VALUES-LIST calls
allows the compiler to automatically elide rest-list allocation so long as
the call sites are in functions that the compiler knows cannot escape.
As a runtime option this is equivalent to @code{--noinform}
@code{--disable-ldb} @code{--lose-on-corruption}
@code{--end-runtime-options} @code{--script} @var{filename}. See the
-description of @code{--script} as a toplevel option below.
+description of @code{--script} as a toplevel option below. If there
+are no other commandline arguments following @code{--script}, the
+filename argument can be omitted.
@item --help
Print some basic information about SBCL, then exit.
read-eval-print-loop, and exit afterwards. If the file begins with a
shebang line, it is ignored.
+If there are no other command line arguments following, the filename
+can be omitted: this causes the script to be loaded from standard
+input instead. Shebang lines in standard input script are currently
+@emph{not} ignored.
+
+In either case, if there is an unhandled error (eg. end of file, or a
+broken pipe) on either standard input, standard output, or standard
+error, the script silently exits with code 0. This allows eg. safely
+piping output from SBCL to @code{head -n1} or similar.
+
@end table
@node Initialization Files
;;; slightly differently) elsewhere.
(declaim (special *posix-argv*
*core-string*
+ *stdin*
+ *stdout*
+ *stderr*
+ *tty*
*read-only-space-free-pointer*
sb!vm:*static-space-free-pointer*
sb!vm::*current-catch-block*
;;; Returns T if the stream is a binary input stream with a FASL header.
(defun fasl-header-p (stream &key errorp)
- (let ((p (file-position stream)))
- (unwind-protect
- (let* ((header *fasl-header-string-start-string*)
- (buffer (make-array (length header) :element-type '(unsigned-byte 8)))
- (n 0))
- (flet ((scan ()
- (maybe-skip-shebang-line stream)
- (setf n (read-sequence buffer stream))))
- (if errorp
- (scan)
- (or (ignore-errors (scan))
- ;; no a binary input stream
- (return-from fasl-header-p nil))))
- (if (mismatch buffer header
- :test #'(lambda (code char) (= code (char-code char))))
- ;; Immediate EOF is valid -- we want to match what
- ;; CHECK-FASL-HEADER does...
- (or (zerop n)
- (when errorp
- (error 'fasl-header-missing
- :stream stream
- :fhsss buffer
- :expected header)))
- t))
- (file-position stream p))))
+ (unless (member (stream-element-type stream) '(character base-char))
+ (let ((p (file-position stream)))
+ (unwind-protect
+ (let* ((header *fasl-header-string-start-string*)
+ (buffer (make-array (length header) :element-type '(unsigned-byte 8)))
+ (n 0))
+ (flet ((scan ()
+ (maybe-skip-shebang-line stream)
+ (setf n (read-sequence buffer stream))))
+ (if errorp
+ (scan)
+ (or (ignore-errors (scan))
+ ;; no a binary input stream
+ (return-from fasl-header-p nil))))
+ (if (mismatch buffer header
+ :test #'(lambda (code char) (= code (char-code char))))
+ ;; Immediate EOF is valid -- we want to match what
+ ;; CHECK-FASL-HEADER does...
+ (or (zerop n)
+ (when errorp
+ (error 'fasl-header-missing
+ :stream stream
+ :fhsss buffer
+ :expected header)))
+ t))
+ (file-position stream p)))))
+
;;;; LOAD-AS-FASL
;;;;
(process-1 option)))))
(defun process-script (script)
- (let ((pathname (native-pathname script)))
+ (flet ((load-script (stream)
+ ;; Scripts don't need to be stylish or fast, but silence is usually a
+ ;; desirable quality...
+ (handler-bind (((or style-warning compiler-note) #'muffle-warning)
+ (stream-error (lambda (e)
+ ;; Shell-style.
+ (when (member (stream-error-stream e)
+ (list *stdout* *stdin* *stderr*))
+ (quit)))))
+ ;; Let's not use the *TTY* for scripts, ok? Also, normally we use
+ ;; synonym streams, but in order to have the broken pipe/eof error
+ ;; handling right we want to bind them for scripts.
+ (let ((*terminal-io* (make-two-way-stream *stdin* *stdout*))
+ (*debug-io* (make-two-way-stream *stdin* *stderr*))
+ (*standard-input* *stdin*)
+ (*standard-output* *stdout*)
+ (*error-output* *stderr*))
+ (load stream :verbose nil :print nil)))))
(handling-end-of-the-world
- (with-open-file (f pathname :element-type :default)
- (sb!fasl::maybe-skip-shebang-line f)
- ;; Scripts don't need to be stylish or fast, but silence is usually a
- ;; desirable quality...
- (handler-bind (((or style-warning compiler-note) #'muffle-warning))
- (load f :verbose nil :print nil))))))
+ (if (eq t script)
+ (load-script *stdin*)
+ (with-open-file (f (native-pathname script) :element-type :default)
+ (sb!fasl::maybe-skip-shebang-line f)
+ (load-script f))))))
;; Errors while processing the command line cause the system to QUIT,
;; instead of trying to go into the Lisp debugger, because trying to
(setf disable-debugger t
no-userinit t
no-sysinit t
- script (pop-option))
+ script (if options (pop-option) t))
(return))
((string= option "--sysinit")
(pop-option)
use_test_subdirectory
tmpscript=$TEST_FILESTEM.lisp-script
+tmpout=$TEST_FILESTEM.lisp-out
+tmperr=$TEST_FILESTEM.lisp-err
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 2> /dev/null
+run_sbcl --script $tmpscript 1> $tmpout 2> $tmperr
check_status_maybe_lose "--script exit status from ERROR" $? 1 "(error implies 1)"
+grep BACKTRACE $tmpout > /dev/null
+check_status_maybe_lose "--script backtrace not to stdout" $? 1 "(ok)"
+grep BACKTRACE $tmperr > /dev/null
+check_status_maybe_lose "--script backtrace to stderr" $? 0 "(ok)"
echo 'nil'> $tmpscript
run_sbcl --script $tmpscript
(close *standard-output*)
(sb-ext:quit :unix-status 3)
EOF
-cat $tmpscript
run_sbcl --script $tmpscript
check_status_maybe_lose "--script exit status from QUIT when stdout closed" $? 3 "(as given)"
run_sbcl --load $tmpscript
check_status_maybe_lose "--load exit status from QUIT when stdout closed" $? 3 "(as given)"
-rm -f $tmpscript
+cat > $tmpscript <<EOF
+(loop (write-line (read-line)))
+EOF
+echo ONE | run_sbcl --script $tmpscript 1> $tmpout 2> $tmperr
+check_status_maybe_lose "--script exit status when stdin closed" $? 0 "(as given)"
+if [ -s $tmperr ] || [ "ONE" != `cat $tmpout` ]
+then
+ echo "--script outputs wrong"
+ exit $EXIT_LOSE
+fi
+
+cat > $tmpscript <<EOF
+(loop (write-line "foo"))
+EOF
+run_sbcl --script $tmpscript 2> $tmperr | head -n1 > $tmpout
+check_status_maybe_lose "--script exit status when stdout closed" $? 0 "(as given)"
+if [ -s $tmperr ] || [ "foo" != `cat $tmpout` ]
+then
+ echo "--script unexpected error output"
+ 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)"
+if [ -s $tmperr ] || [ "Ok!" != `cat $tmpout` ]
+then
+ echo "--script unexpected error output"
+ exit $EXIT_LOSE
+fi
+
+rm -f $tmpscript $tmpout $tmperr
exit $EXIT_TEST_WIN
;;; 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.48.32"
+"1.0.48.33"
projects / sbcl.git / commitdiff