From: Alexey Dejneka <adejneka@comail.ru>
Date: Sun, 14 Sep 2003 07:44:45 +0000 (+0000)
Subject: 0.8.3.60:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=45e4225c7ceae7328b6951770f654932438ed266;p=sbcl.git

0.8.3.60:
        * Fix bug reported by Doug McNaught: COMPILE-FILE should bind
          *READTABLE* (we bind it in SUB-COMPILE-FILE).
---

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"