From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sun, 21 Jun 2009 21:59:22 +0000 (+0000)
Subject: 1.0.29.29: (one more)^3 DIRECTORY regression
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1dc69aa156beb876b51c1ad23db73730723bce6d;p=sbcl.git

1.0.29.29: (one more)^3 DIRECTORY regression

* Fix /*/foo: refactoring left lambdas where none were needed, so the
  iteration code was never run at all for non-leaf cases.

* Test-cases...
---

diff --git a/NEWS b/NEWS
index f1845f7..4798045 100644
--- a/NEWS
+++ b/NEWS
@@ -27,7 +27,7 @@
     (reported by Tobias Rittweiler)
   * bug fix: regressions in DIRECTORY from 1.0.28.61: pattern matching of
     directory components now works as it used to. (various prolems reported by
-    Michael Becker, Gabriel Dos Reis, and Cyrus Harmon)
+    Michael Becker, Gabriel Dos Reis, Cyrus Harmon, and Harald Hanche-Olsen)
   * bug fix: :PTY option in RUN-PROGRAM was broken with stream arguments.
     (reported by Elliot Slaughter, thanks to Stas Boukarev)
   * bug fix: bogus undefined variable warnings from fopcompiled references to
diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index f7c95b0..482b34b 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -790,19 +790,15 @@ Experimental: interface subject to change."
                     ;; end of the line
                     (funcall function subdirectory))
                    ((or (eq :wild next) (typep next 'pattern))
-                    (lambda (pathname)
-                      (map-wild function more pathname)))
+                    (map-wild function more subdirectory))
                    ((eq :wild-inferiors next)
-                    (lambda (pathname)
-                      (map-wild-inferiors function more pathname)))
+                    (map-wild-inferiors function more subdirectory))
                    (t
-                    (lambda (pathname)
-                      (let ((this (pathname-directory pathname)))
-                        (when (equal next (car (last this)))
-                          (map-matching-directories
-                           function
-                           (make-pathname :directory (append this more)
-                                          :defaults pathname)))))))))
+                    (let ((this (pathname-directory subdirectory)))
+                      (map-matching-directories
+                       function
+                       (make-pathname :directory (append this more)
+                                      :defaults subdirectory)))))))
       (map-directory
        (if (eq :wild this)
            #'cont
diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh
index 4fd0179..0d69b36 100644
--- a/tests/filesys.test.sh
+++ b/tests/filesys.test.sh
@@ -205,9 +205,14 @@ use_test_subdirectory
 mkdir foo
 touch foo/aa.txt
 touch foo/aa.tmp
+mkdir foo/x
 mkdir far
 touch far/ab.txt
 touch far/ab.tmp
+mkdir far/x
+mkdir far/y
+mkdir far/y/x
+mkdir far/x/x
 mkdir qar
 touch qar/ac.txt
 touch qar/ac.tmp
@@ -232,6 +237,9 @@ run_sbcl <<EOF
 (test "f*.[mb]*" "foo.moose/" "foo.bar")
 (test "f*.m*.*")
 (test "f*.b*.*")
+(test "*/x" "foo/x/" "far/x/")
+(test "far/*/x" "far/y/x/" "far/x/x/")
+(test "**/x/" "foo/x/" "far/x/" "far/x/x" "far/y/x/")
 (quit :unix-status $EXIT_LISP_WIN)
 EOF
 check_status_maybe_lose "DIRECTORY/PATTERNS" $?
diff --git a/version.lisp-expr b/version.lisp-expr
index c27e3d6..1e89aa4 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.29.28"
+"1.0.29.29"