From 5f1a09bea4ee8e116e4ecd91cc7044310c9d22d9 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 24 Jun 2009 15:14:44 +0000 Subject: [PATCH] 1.0.29.36: another regression from 1.0.29.27 * Need to be able to load zero-length .lisp files -- but still disallow loading of empty fasls. * Reported by Martin Cracauer. --- src/code/target-load.lisp | 5 ++++- tests/load.impure.lisp | 19 ++++++++++++++++++- version.lisp-expr | 2 +- 3 files changed, 23 insertions(+), 3 deletions(-) diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index d022e55..184a1ef 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -140,7 +140,10 @@ (let* ((real (probe-file stream)) (should-be-fasl-p (and real (string= (pathname-type real) *fasl-file-type*)))) - (when (fasl-header-p stream :errorp should-be-fasl-p) + ;; Don't allow empty .fasls, and assume other empty files + ;; are source files. + (when (and (or should-be-fasl-p (not (eql 0 (file-length stream)))) + (fasl-header-p stream :errorp should-be-fasl-p)) (return-from load (load-stream stream t))))) ;; Case 3: Open using the gived external format, process as source. (with-open-file (stream pathname :external-format external-format) diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp index 7466edb..a739006 100644 --- a/tests/load.impure.lisp +++ b/tests/load.impure.lisp @@ -287,4 +287,21 @@ (stimulate-sbcl) (stimulate-sbcl))) - +(defun load-empty-file (type) + (let ((pathname (make-pathname :name "load-impure-lisp-empty-temp" + :type type))) + (unwind-protect + (progn + (with-open-file (f pathname + :if-exists :supersede + :direction :output)) + (handler-case + (progn (load pathname) t) + (error () nil))) + (ignore-errors (delete-file pathname))))) + +(with-test (:name (load "empty.lisp")) + (assert (load-empty-file "lisp"))) + +(with-test (:name (load "empty.fasl")) + (assert (not (load-empty-file "fasl")))) diff --git a/version.lisp-expr b/version.lisp-expr index fedfda1..f580e61 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.29.35" +"1.0.29.36" -- 1.7.10.4