Skip to content
Snippets Groups Projects
Commit 2f316750 authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix regression in %ENUMERATE-DIRECTORIES.

Previously (18a at least), %ENUMERATE-DIRECTORIES would return a path
even if a directory element did not exist.  This behavior is restored.

See email from cmucl-help, Sep 26, 2014.

 * src/code/filesys.lisp:
   * Fix regression.in %ENUMERATE-DIRECTORIES.  Even if the directory
     does not exist, we continue recursing instead of stopping.
 * src/general-info/release-20f.txt:
   * Update
 * tests/filesys.lisp:
   * New file adding tests for UNIX-NAMESTRING.
parent 19ac8cdc
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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.
......
;;; 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")))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment