From: William Harold Newman <william.newman@airmail.net>
Date: Thu, 10 Jan 2002 00:20:58 +0000 (+0000)
Subject: 0.pre7.119:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=92018c1900a1c690f0235c7b752dbe4ce35af35c;p=sbcl.git

0.pre7.119:
	CR patch for bug 139 and other DIRECTORY badness (sbcl-devel
		2001-12-31)
	TMPDIR tweak suggested by CR sbcl-devel 2001-12-31
	enabled various test cases for DIRECTORY now that they work
	--
	Enable test cases.
	Remove or at least weaken BUGS entry.
---

diff --git a/BUGS b/BUGS
index 12abb16..86d149e 100644
--- a/BUGS
+++ b/BUGS
@@ -1282,30 +1282,6 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   still some functions named "hairy arg processor" and
   "SB-INT:&MORE processor".
 
-139:
-  In sbcl-0.pre7.107, (DIRECTORY "*.*") is broken, as reported by 
-  Nathan Froyd sbcl-devel 2001-12-28.
-
-  Christophe Rhodes suggested (sbcl-devel 2001-12-30) converting
-  the MERGED-PATHNAME expression in DEFUN DIRECTORY to
-        (merged-pathname (merge-pathnames pathname
-					  *default-pathname-defaults*))
-  This looks right, and fixes this bug, but it interacts with the NODES
-  logic in %ENUMERATE-PATHNAMES to create a new bug, so that
-  (DIRECTORY "../**/*.*") no longer shows files in the current working
-  directory. Probably %ENUMERATE-PATHNAMES (or related logic like
-  %ENUMERATE-MATCHES) needs to be patched as well.
-
-  Note: The MERGED-PATHNAME change changes behavior incompatibly,
-  making e.g. (DIRECTORY "*") no longer equivalent to (DIRECTORY "*.*"),
-  so deserves a NEWS entry. E.g.
-* minor incompatible change (part of a bug fix by Christophe Rhodes
-  to DIRECTORY behavior): DIRECTORY no longer implicitly promotes
-  NIL slots of its pathname argument to :WILD, and in particular
-  asking for the contents of a directory, which you used to be able
-  to do without explicit wildcards, e.g. (DIRECTORY "/tmp/"), 
-  now needs explicit wildcards, e.g. (DIRECTORY "/tmp/*.*").
-
 140:
   (reported by Alexey Dejneka sbcl-devel 2002-01-03)
 
diff --git a/NEWS b/NEWS
index 7fc8e2a..426f7a5 100644
--- a/NEWS
+++ b/NEWS
@@ -926,6 +926,12 @@ changes in sbcl-0.7.0 relative to sbcl-0.6.13:
   DEFINE-CONDITION, DEFINE-MODIFY-MACRO..). This mostly affects
   internal symbols, but a few supported extensions like
   SB-ALIEN:DEF-ALIEN-FUNCTION are also affected.
+* minor incompatible change (part of a bug fix by Christophe Rhodes
+  to DIRECTORY behavior): DIRECTORY no longer implicitly promotes
+  NIL slots of its pathname argument to :WILD, and in particular
+  asking for the contents of a directory, which you used to be able
+  to do without explicit wildcards, e.g. (DIRECTORY "/tmp/"), 
+  now needs explicit wildcards, e.g. (DIRECTORY "/tmp/*.*").
 * minor incompatible change: DEFINE-ALIEN-FUNCTION (also known by 
   the old deprecated name DEF-ALIEN-FUNCTION) now does DECLAIM FTYPE
   for the defined function, since declaiming return types involving
diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 1440777..ca9a19f 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -558,6 +558,13 @@
 		  (when (and res (eql (logand mode sb!unix:s-ifmt)
 				      sb!unix:s-ifdir))
 		    (let ((nodes (cons (cons dev ino) nodes)))
+		      ,@body))))
+	     (with-directory-node-removed ((head) &body body)
+	       `(multiple-value-bind (res dev ino mode)
+		    (unix-xstat ,head)
+		  (when (and res (eql (logand mode sb!unix:s-ifmt)
+				      sb!unix:s-ifdir))
+		    (let ((nodes (remove (cons dev ino) nodes :test #'equal)))
 		      ,@body)))))
     (if tail
 	(let ((piece (car tail)))
@@ -605,12 +612,13 @@
 						 verify-existence follow-links
 						 nodes function))))))))
 	  ((member :up)
+	     (with-directory-node-removed (head)
 	     (let ((head (concatenate 'string head "..")))
 	       (with-directory-node-noted (head)
 		 (%enumerate-directories (concatenate 'string head "/")
 					 (rest tail) pathname
 					 verify-existence follow-links
-					 nodes function))))))
+					 nodes function)))))))
 	(%enumerate-files head pathname verify-existence function))))
 
 ;;; Call FUNCTION on files.
@@ -905,15 +913,12 @@
    means this function can sometimes return files which don't have the same
    directory as PATHNAME."
   (let (;; We create one entry in this hash table for each truename,
-	;; as an asymptotically fast way of removing duplicates (which
-	;; can arise when e.g. multiple symlinks map to the same
-	;; truename).
+	;; as an asymptotically efficient way of removing duplicates
+	;; (which can arise when e.g. multiple symlinks map to the
+	;; same truename).
 	(truenames (make-hash-table :test #'equal))
-	;; FIXME: not really right, as per bug 139
         (merged-pathname (merge-pathnames pathname
-					  (make-pathname :name :wild
-							 :type :wild
-							 :version :wild))))
+					  *default-pathname-defaults*)))
     (!enumerate-matches (match merged-pathname)
       (let ((*ignore-wildcards* t)
             (truename (truename (if (eq (sb!unix:unix-file-kind match)
diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh
index 62f900a..7530090 100644
--- a/tests/filesys.test.sh
+++ b/tests/filesys.test.sh
@@ -143,10 +143,8 @@ Lisp filename syntax idiosyncrasies)."
   ;; "/usr/bin" instead of the CMU-CL-style "/usr/bin/". In that case,
   ;; s:/":": in most or all the NEED-MATCHes here.
   (need-match "./*.*" '("animal/" "dirt" "plant/" "water"))
-  ;; FIXME: (DIRECTORY "*.*") doesn't work (bug 139). And it looks as
-  ;; though the same problem affects (DIRECTORY "animal") too.
-  #+nil (need-match "*.*" '("animal/" "dirt" "plant/" "water"))
-  #+nil (need-match "animal" '("animal/"))
+  (need-match "*.*" '("animal/" "dirt" "plant/" "water"))
+  (need-match "animal" '("animal/"))
   (need-match "./animal" '("animal/"))
   (need-match "animal/*.*" '("animal/invertebrate/" "animal/vertebrate/"))
   (need-match "animal/*/*.*"
@@ -173,16 +171,10 @@ Lisp filename syntax idiosyncrasies)."
 			       "mammal/walrus"
 			       "snake/" "snake/python"))))
     (need-match "animal/vertebrate/**/*.*" vertebrates)
-    ;; FIXME: In sbcl-0.pre7.109, DIRECTORY got confused on (I think...)
-    ;; absolute pathnames containing "../*" stuff. If I understood
-    ;; and remember correctly, CR's patch will fix this.
-    #|
     (need-match "animal/vertebrate/mammal/../**/*.*" vertebrates)
     (need-match "animal/vertebrate/mammal/../**/**/*.*" vertebrates)
     (need-match "animal/vertebrate/mammal/mythical/../**/../**/*.*"
-		vertebrates)
-    |#
-    )
+		vertebrates))
   (need-match "animal/vertebrate/**/robot.*" nil)
   (need-match "animal/vertebrate/mammal/../**/*.robot" nil)
   (need-match "animal/vertebrate/mammal/../**/robot/*.*" nil)
diff --git a/tests/side-effectful-pathnames.test.sh b/tests/side-effectful-pathnames.test.sh
index 84ba3d7..32df3e7 100644
--- a/tests/side-effectful-pathnames.test.sh
+++ b/tests/side-effectful-pathnames.test.sh
@@ -58,7 +58,7 @@ rm -r $testdir
 # was removed from UNIX-STAT. Let's make sure that it works now.
 #
 # Set up an empty directory to work with.
-testdir=$TMPDIR/sbcl-mkdir-test-$$
+testdir=${TMPDIR:-/tmp}/sbcl-mkdir-test-$$
 if ! rm -rf $testdir ; then
   echo "$testdir already exists and could not be deleted"
   exit 1;
diff --git a/version.lisp-expr b/version.lisp-expr
index 0f665f6..1813232 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.118"
+"0.pre7.119"