From 69cd16d7335a7f66985752b84f78d18e45f9783e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Wed, 12 Jun 2002 11:51:55 +0000 Subject: [PATCH] 0.7.4.28: Fix BUG 179 ... one character fix, and two-line test. Some OpenMCL cross-compilation fixes ... prefer (declaim (ftype (*) ...)) to (declare (values ...)) ... remove arrays that are undumpable from cross-compiler's logic. --- BUGS | 10 +--------- NEWS | 2 ++ src/code/filesys.lisp | 10 +++++----- src/compiler/dump.lisp | 14 +++++++++++--- src/compiler/ir1tran.lisp | 5 ++--- tests/filesys.test.sh | 4 +++- version.lisp-expr | 2 +- 7 files changed, 25 insertions(+), 22 deletions(-) diff --git a/BUGS b/BUGS index 4573bce..cd8dc40 100644 --- a/BUGS +++ b/BUGS @@ -1288,9 +1288,6 @@ WORKAROUND: (defclass c0 (b) ()) (make-instance 'c19) -177: - (fixed in sbcl-0.7.4.24) - 178: "AVER failure compiling confused THEs in FUNCALL" In sbcl-0.7.4.24, compiling (defun bug178 (x) @@ -1303,12 +1300,7 @@ WORKAROUND: (funcall (the nil x))) 179: - Reported by Miles Egan on sbcl-devel 11 June 2002: - In sbcl-0.7.4.x, doing - $ touch /tmp/bad\* - $ sbcl - * (directory "/tmp/*") - yields an error: "bad place for a wild pathname" + (fixed in sbcl-0.7.4.28) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/NEWS b/NEWS index 418b9fb..d109ef7 100644 --- a/NEWS +++ b/NEWS @@ -1141,6 +1141,8 @@ changes in sbcl-0.7.5 relative to sbcl-0.7.4: to David Lichteblau) * bug 175 fixed: more-closely-ANSI CHANGE-CLASS function, now accepting initargs. (thanks to Espen Johnsen and Pierre Mai) + * bug 179 fixed: DIRECTORY can now deal with filenames with pattern + characters in them. * bug fix: Structure type predicate functions now check their argument count as they should. * bug fix: classes with :METACLASS STRUCTURE-CLASS now print diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index bde23dc..2841bf5 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -827,11 +827,11 @@ (merged-pathname (merge-pathnames pathname *default-pathname-defaults*))) (!enumerate-matches (match merged-pathname) - (let ((*ignore-wildcards* t) - (truename (truename (if (eq (sb!unix:unix-file-kind match) - :directory) - (concatenate 'string match "/") - match)))) + (let* ((*ignore-wildcards* t) + (truename (truename (if (eq (sb!unix:unix-file-kind match) + :directory) + (concatenate 'string match "/") + match)))) (setf (gethash (namestring truename) truenames) truename))) (mapcar #'cdr diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 094f646..398bfca 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -266,7 +266,7 @@ (declare (type pathname name)) (let* ((stream (open name :direction :output - :if-exists :new-version + :if-exists :supersede :element-type 'sb!assem:assembly-unit)) (res (make-fasl-output :stream stream))) @@ -576,9 +576,8 @@ ;;; this function is not parallel to other functions DUMP-FOO, e.g. ;;; DUMP-SYMBOL and DUMP-LIST. The mapping between names and behavior ;;; should be made more consistent. +(declaim (ftype (function (package fasl-output) index) dump-package)) (defun dump-package (pkg file) - (declare (type package pkg) (type fasl-output file)) - #+nil (declare (values index)) (declare (inline assoc)) (cond ((cdr (assoc pkg (fasl-output-packages file) :test #'eq))) (t @@ -821,8 +820,17 @@ ;; KLUDGE: What exactly does the (ASH .. -3) stuff do? -- WHN 19990902 (simple-bit-vector (dump-unsigned-vector 1 (ash (+ (the index len) 7) -3))) + ;; KLUDGE: This isn't the best way of expressing that the host + ;; may not have specializations for (unsigned-byte 2) and + ;; (unsigned-byte 4), which means that these types are + ;; type-equivalent to (simple-array (unsigned-byte 8) (*)); + ;; the workaround is to remove them from the etypecase, since + ;; they can't be dumped from the cross-compiler anyway. -- + ;; CSR, 2002-05-07 + #-sb-xc-host ((simple-array (unsigned-byte 2) (*)) (dump-unsigned-vector 2 (ash (+ (the index (ash len 1)) 7) -3))) + #-sb-xc-host ((simple-array (unsigned-byte 4) (*)) (dump-unsigned-vector 4 (ash (+ (the index (ash len 2)) 7) -3))) ((simple-array (unsigned-byte 8) (*)) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 19c2f89..a3dd4df 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -124,9 +124,8 @@ ;;; names a macro or special form, then we error out using the ;;; supplied context which indicates what we were trying to do that ;;; demanded a function. +(declaim (ftype (function (t string) global-var) find-free-fun)) (defun find-free-fun (name context) - (declare (string context)) - #+nil (declare (values global-var)) (or (let ((old-free-fun (gethash name *free-funs*))) (and (not (invalid-free-fun-p old-free-fun)) old-free-fun)) @@ -171,8 +170,8 @@ ;;; corresponding value. Otherwise, we make a new leaf using ;;; information from the global environment and enter it in ;;; *FREE-VARS*. If the variable is unknown, then we emit a warning. +(declaim (ftype (function (t) (or leaf cons heap-alien-info)) find-free-var)) (defun find-free-var (name) - #+nil (declare (values (or leaf cons heap-alien-info))) ; see FIXME comment (unless (symbolp name) (compiler-error "Variable name is not a symbol: ~S." name)) (or (gethash name *free-vars*) diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh index 28f3935..4f68bb2 100644 --- a/tests/filesys.test.sh +++ b/tests/filesys.test.sh @@ -16,6 +16,7 @@ testdir=`pwd`"/filesys-test-$$" mkdir $testdir echo this is a test > $testdir/test-1.tmp echo this is a test > $testdir/test-2.tmp +echo this is a test > $testdir/wild\?test.tmp cd $testdir ln -s test-1.tmp link-1 ln -s `pwd`/test-2.tmp link-2 @@ -29,7 +30,8 @@ expected_truenames=\ #p\"$testdir/link-5\"\ #p\"$testdir/link-6\"\ #p\"$testdir/test-1.tmp\"\ - #p\"$testdir/test-2.tmp\")" + #p\"$testdir/test-2.tmp\"\ + #p\"$testdir/wild\\\\?test.tmp\")" $SBCL <