From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 15 Jun 2009 22:13:08 +0000 (+0000)
Subject: 1.0.29.10: one more DIRECTORY regression
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a7e9dfe7d823254a495eba012dd22fc83340129a;p=sbcl.git

1.0.29.10: one more DIRECTORY regression

 * (DIRECTORY "X*.*") should match directories in addition to files.
---

diff --git a/NEWS b/NEWS
index 529fca2..3873323 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,8 @@
   * bug fix: regression in DIRECTORY from 1.0.28.61, pattern matching of
     directory components now works again. (reported by Michael Becker and
     Gabriel Dos Reis)
+  * bug fix: regression in DIRECTORY from 1.0.28.61, (DIRECTORY "X*.*") now
+    matches directories beginning with X in addition to files.
   * bug fix: :PTY option in RUN-PROGRAM was broken with stream arguments.
     (reported by Elliot Slaughter, thanks to Stas Boukarev)
 
diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index db7bf8a..436accf 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -560,15 +560,17 @@ matching filenames."
                       (pathname (canonicalize-pathname pathname))
                       (name (pathname-name pathname))
                       (type (pathname-type pathname))
-                      ;; KLUDGE: We want #p"/foo" to match #p"/foo/,
-                      ;; so cobble up a directory name component from
-                      ;; name and type -- just take care with "*.*"!
+                      ;; KLUDGE: We want #p"/foo" to match #p"/foo/, so cobble
+                      ;; up a directory name component from name and type --
+                      ;; and we need to take care with * as type: we want
+                      ;; "*.*", "x*.*", and "x.*" to match directories without
+                      ;; dots in their names...
                       (dirname (if (and (eq :wild name) (eq :wild type))
                                    "*"
                                    (with-output-to-string (s)
                                      (when name
                                        (write-string (unparse-physical-piece name) s))
-                                     (when type
+                                     (when (and type (not (and name (eq type :wild))))
                                        (write-string "." s)
                                        (write-string (unparse-physical-piece type) s)))))
                       (dir (maybe-make-pattern dirname 0 (length dirname)))
diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh
index b636184..07298a0 100644
--- a/tests/filesys.test.sh
+++ b/tests/filesys.test.sh
@@ -223,6 +223,10 @@ run_sbcl <<EOF
 (test "*/*b.*" "far/ab.txt" "far/ab.tmp")
 (test "*a*/*.txt" "far/ab.txt" "qar/ac.txt")
 (test "*ar/*.txt" "far/ab.txt" "qar/ac.txt")
+(test "f*.*" "far/" "foo/")
+(test "f*" "far/" "foo/")
+(test "*r" "far/" "qar/")
+(test "*r.*" "far/" "qar/")
 (quit :unix-status $EXIT_LISP_WIN)
 EOF
 check_status_maybe_lose "DIRECTORY/PATTERNS" $?
diff --git a/version.lisp-expr b/version.lisp-expr
index 5c9f43c..0e4fb57 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.9"
+"1.0.29.10"