[Cmucl-cvs] [git] CMU Common Lisp branch 20f-branch updated. snapshot-2014-09-13-g8329e1d

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, 20f-branch has been updated
       via  8329e1d53ee57bf375c63675642b21358790ea2b (commit)
      from  ab0a979db83310c64fcbbc13b178d5c31af9f5c9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 8329e1d53ee57bf375c63675642b21358790ea2b
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Oct 1 20:29:32 2014 -0700

    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.

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 9d224df..ee844e3 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)))
-		      , at 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)))
+		    , at 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 4fd57e3..2cdc460 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 0000000..a3d99e8
--- /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")))
+
+	 
+    
+  

-----------------------------------------------------------------------

Summary of changes:
 src/code/filesys.lisp            |   10 +++++--
 src/general-info/release-20f.txt |    2 ++
 tests/filesys.lisp               |   60 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 69 insertions(+), 3 deletions(-)
 create mode 100644 tests/filesys.lisp


hooks/post-receive
-- 
CMU Common Lisp