From b92e0bedf7e29a43fe4fd9141b5d658751e3bef0 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 13 Feb 2011 20:22:08 +0000 Subject: [PATCH] 1.0.45.30: wrap --script loading in a WITH-COMPILATION-UNIT Avoid UNDEFINED-FUNCTION warnings for code like (defun foo () (bar)) (defun bar () 42) by wrapping the LOAD done by --script in a WITH-COMPILATION-UNIT. Fixes lp#677779. --- src/code/late-extensions.lisp | 13 +++++++++++++ src/code/toplevel.lisp | 10 +--------- tests/script.test.sh | 6 ++++++ version.lisp-expr | 2 +- 4 files changed, 21 insertions(+), 10 deletions(-) diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp index 5d2d598..21df767 100644 --- a/src/code/late-extensions.lisp +++ b/src/code/late-extensions.lisp @@ -344,3 +344,16 @@ See also the declarations SB-EXT:GLOBAL and SB-EXT:ALWAYS-BOUND." (sb!c:with-source-location (source-location) (setf (info :source-location :variable name) source-location)) name) + +;;; Needs WITH-COMPILATION-UNIT, hence not in toplevel.lisp. +(defun load-script (pathname) + ;; WITH-COMPILATION-UNIT to avoid style-warnings for + ;; forward-referenced functions in scripts. Needs to be around + ;; HANDLING-END-OF-THE-WORLD so that we don't unwind from it, which + ;; would cause a bogus complaint about a fatal error... + (sb!xc:with-compilation-unit () + (handling-end-of-the-world + (with-open-file (f pathname :element-type :default) + (sb!fasl::maybe-skip-shebang-line f) + (load f :verbose nil :print nil)) + (quit)))) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 0868844..2749322 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -292,14 +292,6 @@ any non-negative real number." (dolist (option options) (process-1 option))))) -(defun process-script (script) - (let ((pathname (native-pathname script))) - (handling-end-of-the-world - (with-open-file (f pathname :element-type :default) - (sb!fasl::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 ;; go into the Lisp debugger would get into various annoying issues of @@ -446,7 +438,7 @@ any non-negative real number." (process-init-file userinit :user)) (process-eval/load-options (nreverse reversed-options)) (when script - (process-script script) + (load-script (native-pathname script)) (bug "PROCESS-SCRIPT returned"))) (abort () :report (lambda (s) diff --git a/tests/script.test.sh b/tests/script.test.sh index a9ce19a..87061f6 100644 --- a/tests/script.test.sh +++ b/tests/script.test.sh @@ -31,6 +31,12 @@ echo 'nil'> $tmpscript run_sbcl --script $tmpscript check_status_maybe_lose "--script exit status from normal exit" $? 0 "(everything ok)" +echo '(setf *error-output* *standard-output*) (defun foo () (bar)) (defun bar () 11) (quit :unix-status (foo))'> $tmpscript +out=`run_sbcl --script $tmpscript` +check_status_maybe_lose "--script exit status from normal exit" $? 11 "(everything ok)" +test -z "$out" +check_status_maybe_lose "--script forward-referenced functions" $? 0 "(everything ok)" + rm -f $tmpscript exit $EXIT_TEST_WIN diff --git a/version.lisp-expr b/version.lisp-expr index 9ef40cb..34f1332 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -20,4 +20,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.45.29" +"1.0.45.30" -- 1.7.10.4