X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ffilesys.pure.lisp;h=3e7ab3dcf459615912716460cab9e79267807594;hb=a96369c72588c5457d71d6aaea35f2c450b19ef5;hp=0356cd55d8f1d284fecaecb961e55e1c315dd393;hpb=dccfa0f4e378a267744c03b1416accdf9d888987;p=sbcl.git diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp index 0356cd5..3e7ab3d 100644 --- a/tests/filesys.pure.lisp +++ b/tests/filesys.pure.lisp @@ -28,10 +28,50 @@ ;;; 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) (search "tests/filesys.pure.lisp" (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))) + +;;; OPEN, LOAD and friends should signal an error of type FILE-ERROR +;;; if they are fed wild pathname designators; firstly, with wild +;;; pathnames that don't correspond to any files: +(assert (typep (nth-value 1 (ignore-errors (open "non-existent*.lisp"))) + 'file-error)) +(assert (typep (nth-value 1 (ignore-errors (load "non-existent*.lisp"))) + 'file-error)) +;;; then for pathnames that correspond to precisely one: +(assert (typep (nth-value 1 (ignore-errors (open "filesys.pur*.lisp"))) + 'file-error)) +(assert (typep (nth-value 1 (ignore-errors (load "filesys.pur*.lisp"))) + 'file-error)) +;;; then for pathnames corresponding to many: +(assert (typep (nth-value 1 (ignore-errors (open "*.lisp"))) + 'file-error)) +(assert (typep (nth-value 1 (ignore-errors (load "*.lisp"))) + 'file-error)) + +;;; ANSI: FILE-LENGTH should signal an error of type TYPE-ERROR if +;;; 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 (typep (nth-value 1 (ignore-errors (file-length *terminal-io*))) + 'type-error))