From 45e4225c7ceae7328b6951770f654932438ed266 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 14 Sep 2003 07:44:45 +0000 Subject: [PATCH] 0.8.3.60: * Fix bug reported by Doug McNaught: COMPILE-FILE should bind *READTABLE* (we bind it in SUB-COMPILE-FILE). --- NEWS | 2 ++ src/compiler/main.lisp | 56 +++++++++++++++++---------------- tests/bug-doug-mcnaught-20030914.lisp | 16 ++++++++++ tests/compiler.impure.lisp | 21 +++++++++++++ version.lisp-expr | 2 +- 5 files changed, 69 insertions(+), 28 deletions(-) create mode 100644 tests/bug-doug-mcnaught-20030914.lisp diff --git a/NEWS b/NEWS index 3611354..21ca817 100644 --- a/NEWS +++ b/NEWS @@ -2045,6 +2045,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: generic arithmetic in (SPEED 3) policy. * bug 145b fix: compiler used wrong type specifier while converting MEMBER-types to numeric. + * bug fix: COMPILE-FILE must bind *READTABLE*. (reported by Doug + McNaught) * fixed some bugs revealed by Paul Dietz' test suite: ** the RETURN clause in LOOP is now equivalent to DO (RETURN ...). ** ROUND and FROUND now give the right answer when given very diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 9c8597a..6a2d2bf 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1342,33 +1342,35 @@ ;;; Return (VALUES NIL WARNINGS-P FAILURE-P). (defun sub-compile-file (info) (declare (type source-info info)) - (let* ((*block-compile* *block-compile-arg*) - (*package* (sane-package)) - (*policy* *policy*) - (*lexenv* (make-null-lexenv)) - (*source-info* info) - (sb!xc:*compile-file-pathname* nil) - (sb!xc:*compile-file-truename* nil) - (*toplevel-lambdas* ()) - (*fun-names-in-this-file* ()) - (*compiler-error-bailout* - (lambda () - (compiler-mumble "~2&; fatal error, aborting compilation~%") - (return-from sub-compile-file (values nil t t)))) - (*current-path* nil) - (*last-source-context* nil) - (*last-original-source* nil) - (*last-source-form* nil) - (*last-format-string* nil) - (*last-format-args* nil) - (*last-message-count* 0) - ;; FIXME: Do we need this rebinding here? It's a literal - ;; translation of the old CMU CL rebinding to - ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*), - ;; and it's not obvious whether the rebinding to itself is - ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*. - (*info-environment* *info-environment*) - (*gensym-counter* 0)) + (let ((*package* (sane-package)) + (*readtable* *readtable*) + (sb!xc:*compile-file-pathname* nil) ; really bound in + (sb!xc:*compile-file-truename* nil) ; SUB-SUB-COMPILE-FILE + + (*policy* *policy*) + (*lexenv* (make-null-lexenv)) + (*block-compile* *block-compile-arg*) + (*source-info* info) + (*toplevel-lambdas* ()) + (*fun-names-in-this-file* ()) + (*compiler-error-bailout* + (lambda () + (compiler-mumble "~2&; fatal error, aborting compilation~%") + (return-from sub-compile-file (values nil t t)))) + (*current-path* nil) + (*last-source-context* nil) + (*last-original-source* nil) + (*last-source-form* nil) + (*last-format-string* nil) + (*last-format-args* nil) + (*last-message-count* 0) + ;; FIXME: Do we need this rebinding here? It's a literal + ;; translation of the old CMU CL rebinding to + ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*), + ;; and it's not obvious whether the rebinding to itself is + ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*. + (*info-environment* *info-environment*) + (*gensym-counter* 0)) (handler-case (with-compilation-values (sb!xc:with-compilation-unit () diff --git a/tests/bug-doug-mcnaught-20030914.lisp b/tests/bug-doug-mcnaught-20030914.lisp new file mode 100644 index 0000000..6c4a8e2 --- /dev/null +++ b/tests/bug-doug-mcnaught-20030914.lisp @@ -0,0 +1,16 @@ +(eval-when (:compile-toplevel :load-toplevel :execute) + (setq *readtable* (copy-readtable nil)) ; LOAD binds *readtable*... + + (set-macro-character #\] (get-macro-character #\))) + + (set-dispatch-macro-character #\# #\[ + #'(lambda (s c n) (declare (ignore c)) + (let* ((type (if n `(unsigned-byte ,n) + '(unsigned-byte 8))) + (list (read-delimited-list #\] s nil)) + (len (length list))) + (make-array (list len) + :element-type type + :initial-contents list))))) + +(defvar *bug-doug-mcnaught-20030914* '#4[1 2 3]) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index a1166ab..aa5ee2e 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -845,6 +845,27 @@ (declare (optimize (speed 0) (safety 3) (space 0) (debug 1) (compilation-speed 0))) (adjoin a b)) + +;;; bug reported by Doug McNaught on sbcl-devel 2003-09-14: +;;; COMPILE-FILE did not bind *READTABLE* +(let* ((source "bug-doug-mcnaught-20030914.lisp") + (fasl (compile-file-pathname source))) + (labels ((check () + (assert (null (get-macro-character #\])))) + (full-check () + (check) + (assert (typep *bug-doug-mcnaught-20030914* + '(simple-array (unsigned-byte 4) (*)))) + (assert (equalp *bug-doug-mcnaught-20030914* #(1 2 3))) + (makunbound '*bug-doug-mcnaught-20030914*))) + (compile-file source) + (check) + (load fasl) + (full-check) + (load source) + (full-check) + (delete-file fasl))) + ;;;; tests not in the problem domain, but of the consistency of the ;;;; compiler machinery itself diff --git a/version.lisp-expr b/version.lisp-expr index 5ce9d88..3fa0939 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".) -"0.8.3.59" +"0.8.3.60" -- 1.7.10.4