[Cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2014-09-28-g2f31675

[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, master has been updated
       via  2f316750cc7f9ed3b49349c2ca858a8d31e1ceb9 (commit)
      from  19ac8cdc20d4124a6ef32578007e1183dc741305 (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 2f316750cc7f9ed3b49349c2ca858a8d31e1ceb9
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