1.0.45.30: wrap --script loading in a WITH-COMPILATION-UNIT
authorNikodemus Siivola <nikodemus@random-state.net>
Sun, 13 Feb 2011 20:22:08 +0000 (20:22 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Sun, 13 Feb 2011 20:22:08 +0000 (20:22 +0000)
  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
src/code/toplevel.lisp
tests/script.test.sh
version.lisp-expr

index 5d2d598..21df767 100644 (file)
@@ -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))))
index 0868844..2749322 100644 (file)
@@ -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)
index a9ce19a..87061f6 100644 (file)
@@ -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
index 9ef40cb..34f1332 100644 (file)
@@ -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"