From: William Harold Newman Date: Thu, 25 Jan 2001 18:31:50 +0000 (+0000) Subject: 0.6.10.7: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bbfeb9a341eb81fdd80146f38548437b211dc280;p=sbcl.git 0.6.10.7: merged MNA "minor patches" collection (sbcl-devel 2000-01-25): logical pathname support for LOAD-1-FOREIGN, and changes in regression tests (reflect 0.6.10.5 change, new tests for Gray streams, and fix reader test) fixed run-tests.sh to check all *.pure.lisp (not just one!) --- diff --git a/NEWS b/NEWS index 2cc4132..b6e2a51 100644 --- a/NEWS +++ b/NEWS @@ -654,6 +654,8 @@ changes in sbcl-0.6.11 relative to sbcl-0.6.10: an :ENVIRONMENT keyword option which doesn't smash case or do other bad things. The CMU-CL-style :ENV option is retained for porting convenience. +* LOAD-FOREIGN (and LOAD-1-FOREIGN) now support logical pathnames, + as per Daniel Barlow's suggestion and Martin Atzmueller's patch * DESCRIBE now works on structure objects again. * Fasl file format version numbers have increased again, because support for the Gray streams extension changes the format of the diff --git a/src/code/foreign.lisp b/src/code/foreign.lisp index d4e3e9e..8231b77 100644 --- a/src/code/foreign.lisp +++ b/src/code/foreign.lisp @@ -138,9 +138,10 @@ ;; Note: We use RTLD-GLOBAL so that it can find all the symbols ;; previously loaded. We use RTLD-NOW so that dlopen() will fail if ;; not all symbols are defined. - (let ((sap (dlopen file (logior rtld-now rtld-global)))) + (let* ((real-file (or (unix-namestring file) file)) + (sap (dlopen real-file (logior rtld-now rtld-global)))) (if (zerop (sap-int sap)) - (error "can't open object ~S: ~S" file (dlerror)) + (error "can't open object ~S: ~S" real-file (dlerror)) (pushnew sap *tables-from-dlopen* :test #'sap=))) (values)) diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 24c1dfb..012bdbf 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -21,9 +21,9 @@ :directory nil :name nil))) (assert (equal (file-namestring pathname0) "getty")) - (assert (null (directory-namestring pathname0))) - (assert (null (file-namestring pathname1))) - (assert (null (directory-namestring pathname1)))) + (assert (equal (directory-namestring pathname0) "")) + (assert (equal (file-namestring pathname1) "")) + (assert (equal (directory-namestring pathname1) ""))) ;;; In sbcl-0.6.9 DIRECTORY failed on paths with :WILD or ;;; :WILD-INFERIORS in their directory components. @@ -33,4 +33,4 @@ (assert (find-if (lambda (pathname) (search "tests/filesys.pure.lisp" (namestring pathname))) - dir2))) + dir))) diff --git a/tests/gray-streams.impure.lisp b/tests/gray-streams.impure.lisp index 61edffe..5f96206 100644 --- a/tests/gray-streams.impure.lisp +++ b/tests/gray-streams.impure.lisp @@ -167,6 +167,22 @@ (format our-char-output "~A~%" line)) (assert (null (peek-char nil our-char-input nil nil nil))))) test-string)))) + +(assert + (equal + (with-output-to-string (foo) + (let ((our-char-output (make-character-output-stream foo))) + (write-char #\a our-char-output) + (finish-output our-char-output) + (write-char #\ our-char-output) + (force-output our-char-output) + (fresh-line our-char-output) + (write-char #\b our-char-output) + (clear-output our-char-output) + (terpri our-char-output) + (assert (null (fresh-line our-char-output))) + (write-char #\c our-char-output))) + (format nil "a ~%b~%c"))) ;;;; example classes for binary output diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp index 23ccb4c..a518f25 100644 --- a/tests/reader.impure.lisp +++ b/tests/reader.impure.lisp @@ -18,9 +18,8 @@ ;;; Bug 30, involving mistakes in binding the read table, made this ;;; code fail. (defun read-vector (stream char) + (declare (ignorable char)) (coerce (read-delimited-list #\] stream t) 'vector)) -(set-syntax-from-char #\[ #\() ; do I really need this? -- MNA 2001-01-05 -(set-syntax-from-char #\] #\)) ; do I really need this? -- MNA 2001-01-05 (set-macro-character #\[ #'read-vector nil) (set-macro-character #\] (get-macro-character #\)) nil) (multiple-value-bind (res pos) diff --git a/tests/run-tests.sh b/tests/run-tests.sh index 310cac1..400a29e 100644 --- a/tests/run-tests.sh +++ b/tests/run-tests.sh @@ -17,7 +17,13 @@ sbcl=${1:-../src/runtime/sbcl --core ../output/sbcl.core --noinform --noprint --noprogrammer} # "Ten four" is the closest numerical slang I can find to "OK", so -# it's the return value that we expect from a successful test. +# it's the Unix status value that we expect from a successful test. +# (Of course, zero is the usual success value, but we don't want to +# use that because SBCL returns that by default, so we might think +# we passed a test when in fact some error caused us to exit SBCL +# in a weird unexpected way. In contrast, 104 is unlikely to be +# returned unless we exit through the intended explicit "test +# successful" path. tenfour () { if [ $? = 104 ]; then echo ok @@ -31,13 +37,15 @@ tenfour () { # and we can run them all in a single Lisp process. echo //running '*.pure.lisp' tests echo //i.e. *.pure.lisp -(for f in *.pure.lisp; do - echo "(progn" +( +echo "(progn" +for f in *.pure.lisp; do if [ -f $f ]; then echo " (progn (format t \"//running $f test~%\") (load \"$f\"))" fi - echo " (sb-ext:quit :unix-status 104))" -done) | $sbcl ; tenfour +done +echo " (sb-ext:quit :unix-status 104)) ; Return status=success." +) | $sbcl ; tenfour # *.impure.lisp files are Lisp code with side effects (e.g. doing DEFSTRUCT # or DEFTYPE or DEFVAR). Each one needs to be run as a separate diff --git a/version.lisp-expr b/version.lisp-expr index bd39bec..3d9d8a7 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -15,4 +15,4 @@ ;;; versions, and a string like "0.6.5.12" is used for versions which ;;; aren't released but correspond only to CVS tags or snapshots. -"0.6.10.6" +"0.6.10.7"