From 8d60dc276cfcdb896e36b82160ad8c2065736f90 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 30 Jan 2005 20:15:50 +0000 Subject: [PATCH] 0.8.19.4: COMPILE-FILE needs to deal with :EXTERNAL-FORMAT arguments. ... pass it through to OPEN. --- NEWS | 2 ++ src/compiler/debug-dump.lisp | 1 - src/compiler/main.lisp | 18 +++++++++++------- tests/load.impure.lisp | 21 ++++++++++++++++++++- version.lisp-expr | 2 +- 5 files changed, 34 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index 68ac90b..b7b3947 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.18: ** portions of multibyte characters at the end of buffers for character-based file input are correctly transferred to the start of the buffer at the next read. + ** COMPILE-FILE now respects any EXTERNAL-FORMAT argument given, + passing it through to OPEN. changes in sbcl-0.8.19 relative to sbcl-0.8.18: * new port: SBCL now works in native 64-bit mode on x86-64/Linux diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index 9e3630a..af7d67f 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -275,7 +275,6 @@ name)))))) (list res))) - ;;; Given an arbitrary sequence, coerce it to an unsigned vector if ;;; possible. Ordinarily we coerce it to the smallest specialized ;;; vector we can. However, we also have a special hack for diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index c9a936e..39e1d69 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -693,6 +693,8 @@ ;; If a file, the truename of the corresponding source file. If from ;; a Lisp form, :LISP. If from a stream, :STREAM. (name (missing-arg) :type (or pathname (member :lisp :stream))) + ;; the external format that we'll call OPEN with, if NAME is a file. + (external-format nil) ;; the defaulted, but not necessarily absolute file name (i.e. prior ;; to TRUENAME call.) Null if not a file. This is used to set ;; *COMPILE-FILE-PATHNAME*, and if absolute, is dumped in the @@ -726,9 +728,10 @@ (stream nil :type (or stream null))) ;;; Given a pathname, return a SOURCE-INFO structure. -(defun make-file-source-info (file) +(defun make-file-source-info (file external-format) (let ((file-info (make-file-info :name (truename file) :untruename file + :external-format external-format :write-date (file-write-date file)))) (make-source-info :file-info file-info))) @@ -785,10 +788,13 @@ (declare (type source-info info)) (or (source-info-stream info) (let* ((file-info (source-info-file-info info)) - (name (file-info-name file-info))) + (name (file-info-name file-info)) + (external-format (file-info-external-format file-info))) (setf sb!xc:*compile-file-truename* name sb!xc:*compile-file-pathname* (file-info-untruename file-info) - (source-info-stream info) (open name :direction :input))))) + (source-info-stream info) + (open name :direction :input + :external-format external-format))))) ;;; Close the stream in INFO if it is open. (defun close-source-info (info) @@ -1533,7 +1539,7 @@ #!+sb-doc "Compile INPUT-FILE, producing a corresponding fasl file and returning its filename. Besides the ANSI &KEY arguments :OUTPUT-FILE, :VERBOSE, - :PRINT, and :EXTERNAL-FORMAT,the following extensions are supported: + :PRINT, and :EXTERNAL-FORMAT, the following extensions are supported: :TRACE-FILE If given, internal data structures are dumped to the specified file, or if a value of T is given, to a file of *.trace type @@ -1552,15 +1558,13 @@ optimization values, and the :BLOCK-COMPILE argument will probably become deprecated." - (unless (eq external-format :default) - (error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported.")) (let* ((fasl-output nil) (output-file-name nil) (compile-won nil) (warnings-p nil) (failure-p t) ; T in case error keeps this from being set later (input-pathname (verify-source-file input-file)) - (source-info (make-file-source-info input-pathname)) + (source-info (make-file-source-info input-pathname external-format)) (*compiler-trace-output* nil)) ; might be modified below (unwind-protect diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp index c9eab11..f0d4524 100644 --- a/tests/load.impure.lisp +++ b/tests/load.impure.lisp @@ -11,10 +11,12 @@ ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. +(defvar *tmp-filename* "load-test.tmp") + ;;; Bug reported by Sean Ross: FASL loader set fill pointer to loaded ;;; simple arrays. + (defvar *array*) -(defvar *tmp-filename* "load-test.tmp") (progn (with-open-file (s *tmp-filename* @@ -34,4 +36,21 @@ (when tmp-fasl (delete-file tmp-fasl)) (delete-file *tmp-filename*)))) +;;; rudimentary external-format test +(dolist (ef '(:default :ascii :latin-1 :utf-8)) + (with-open-file (s *tmp-filename* + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (print '(defun foo (x) (1+ x)) s)) + (fmakunbound 'foo) + (let (tmp-fasl) + (unwind-protect + (progn + (setq tmp-fasl (compile-file *tmp-filename* :external-format ef)) + (load tmp-fasl) + (assert (= (foo 1) 2))) + (when tmp-fasl (delete-file tmp-fasl)) + (delete-file *tmp-filename*)))) + (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index c99b334..50e9458 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.19.3" +"0.8.19.4" -- 1.7.10.4