X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=a1800e23b49c5309fa0b7cac23000280ce66a321;hb=ffe8d65266ed7c2c67a0a6ce7ff0de633000037e;hp=2ff7dbb6cce421ff5ed6aefc5f73097589dd0281;hpb=e37366e7bb72bc80c6c9908efe09f94ce26add16;p=sbcl.git diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 2ff7dbb..a1800e2 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -28,7 +28,7 @@ ;;; In sbcl-0.6.9 DIRECTORY failed on paths with :WILD or ;;; :WILD-INFERIORS in their directory components. -(let ((dir (directory "../**/*"))) +(let ((dir (directory "../**/*.*"))) ;; We know a little bit about the structure of this result; ;; let's test to make sure that this test file is in it. (assert (find-if (lambda (pathname) @@ -36,10 +36,26 @@ (namestring pathname))) dir))) +;;; Set *default-pathname-defaults* to something other than the unix +;;; cwd, to catch functions which access the filesystem without +;;; merging properly. We should test more functions than just OPEN +;;; here, of course + +(let ((*default-pathname-defaults* + (make-pathname :directory + (butlast + (pathname-directory *default-pathname-defaults*)) + :defaults *default-pathname-defaults*))) + ;; SBCL 0.7.1.2 failed to merge on OPEN + (with-open-file (i "tests/filesys.pure.lisp") + (assert i))) + + + ;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if -;;; stream is not a stream associated with a file. +;;; STREAM is not a stream associated with a file. ;;; ;;; (Peter Van Eynde's ansi-test suite caught this, and Eric Marsden ;;; reported a fix for CMU CL, which was ported to sbcl-0.6.12.35.) -(assert (subtypep (nth-value 1 (ignore-errors (file-length *terminal-io*))) - 'type-error)) +(assert (typep (nth-value 1 (ignore-errors (file-length *terminal-io*))) + 'type-error))