diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp index 9d224df5e82f399fe76311e284ddaae56aba37b0..ee844e3f76cbd716f352901c2df118ffdba5bc44 100644 --- a/src/code/filesys.lisp +++ b/src/code/filesys.lisp @@ -710,9 +710,13 @@ (with-directory-node-noted ((head) &body body) `(multiple-value-bind (res dev ino mode) (unix-xstat ,head) - (when (and res (eql (logand mode unix:s-ifmt) unix:s-ifdir)) - (let ((nodes (cons (cons dev ino) nodes))) - ,@body)))) + ;; Even if the directory does not exist, we want to + ;; continue recursing. + (let ((nodes (if (and res (eql (logand mode unix:s-ifmt) + unix:s-ifdir)) + (cons (cons dev ino) nodes) + nodes))) + ,@body))) (do-directory-entries ((name directory) &body body) `(let ((dir (unix:open-dir ,directory))) (when dir diff --git a/src/general-info/release-20f.txt b/src/general-info/release-20f.txt index 4fd57e3aa023887ac72d92eaf0a8dba176a63b37..2cdc46084dabd86fb3096a4902cb3c5c263deaab 100644 --- a/src/general-info/release-20f.txt +++ b/src/general-info/release-20f.txt @@ -127,6 +127,8 @@ New in this release: doubles. As a side-effect of this fix, DECODE-FLOAT returns the correct values for denormals, and SCALE-FLOAT scales denormals correctly. + * EXT:UNIX-NAMESTRING no longer returns NIL if a directory does + not exist. This was a regression from at least 18a. * Trac Tickets: * Ticket #90 fixed. diff --git a/tests/filesys.lisp b/tests/filesys.lisp new file mode 100644 index 0000000000000000000000000000000000000000..a3d99e80747095523e13ae053697f1e0f5539351 --- /dev/null +++ b/tests/filesys.lisp @@ -0,0 +1,60 @@ +;;; Tests for the functions in filesys.lisp. + +(defpackage :filesys-tests + (:use :cl :lisp-unit)) + +(in-package "FILESYS-TESTS") + +;; These tests for unix-namestring come from the cmucl-help mailing +;; list, Sep 26, 2014 by Jared C. Davis + +(define-test unix-namestring.1.exists + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + (dolist (path '("/tmp/hello.txt" + "/tmp/foo/" + "/tmp/foo/hello.txt" + "/tmp/foo/bar/hello.txt" + "/tmp/foo/bar/bye.txt" + "/tmp/foo/bar/" + "/tmp/foo/bar/baz" + "/tmp/foo/bye.txt" + "/tmp/bye.txt")) + (assert-equal path + (ext:unix-namestring path nil) + path))) + +(define-test unix-namestring.1.non-existent + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + ;; These paths contain directories that don't exist. + (dolist (path '("/tmp/oops/" + "/tmp/oops/hello.txt" + "/tmp/foo/oops/hello.txt" + "/tmp/foo/bar/oops/hello.txt" + "/tmp/foo/oops/" + )) + (assert-equal path + (ext:unix-namestring path nil) + path))) + +(define-test unix-namestring.2 + ;; Make sure the desired directories exist. + (assert-equal #P"/tmp/foo/bar/hello.txt" + (ensure-directories-exist "/tmp/foo/bar/hello.txt")) + (unwind-protect + (progn + ;; Create a symlink loop + ;; ln -s /tmp/foo/bar/symlink /tmp/foo/ + (unix:unix-unlink "/tmp/foo/bar/symlink") + (assert-equal t + (unix:unix-symlink "/tmp/foo/" "/tmp/foo/bar/symlink")) + (assert-equal "/tmp/foo/bar/symlink" + (ext:unix-namestring "/tmp/foo/bar/symlink" nil))) + (unix:unix-unlink "/tmp/foo/bar/symlink"))) + + + +