From b76dac3d5f89700f3a076403157eae3c52e4c118 Mon Sep 17 00:00:00 2001
From: Richard M Kreuter <kreuter@users.sourceforge.net>
Date: Tue, 1 Jan 2008 15:07:53 +0000
Subject: [PATCH] 1.0.13.8: Fix bug in ENSURE-DIRECTORIES-EXIST

* ENSURE-DIRECTORIES-EXIST used NAMESTRING rather than
  NATIVE-NAMESTRING to construct filenames, and so failed when the
  pathname denoted a filename containing wildcard characters.

* Add tests for same.
---
 src/code/filesys.lisp | 24 ++++++++++++++++--------
 tests/filesys.test.sh | 13 +++++++++++++
 version.lisp-expr     |  2 +-
 3 files changed, 30 insertions(+), 9 deletions(-)

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 4e858abcc..fb62f4203 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -969,6 +969,8 @@ system."
 (/show0 "filesys.lisp 899")
 
 ;;; predicate to order pathnames by; goes by name
+;; FIXME: Does anything use this?  It's not exported, and I don't find
+;; the name anywhere else.
 (defun pathname-order (x y)
   (let ((xn (%pathname-name x))
         (yn (%pathname-name y)))
@@ -999,22 +1001,28 @@ system."
                                :device (pathname-device pathname)
                                :directory (subseq dir 0 i))))
                  (unless (probe-file newpath)
-                   (let ((namestring (coerce (namestring newpath) 'string)))
+                   (let ((namestring (coerce (native-namestring newpath)
+                                             'string)))
                      (when verbose
                        (format *standard-output*
                                "~&creating directory: ~A~%"
                                namestring))
                      (sb!unix:unix-mkdir namestring mode)
-                     (unless (probe-file namestring)
-                       (restart-case (error 'simple-file-error
-                                            :pathname pathspec
-                                            :format-control "can't create directory ~A"
-                                            :format-arguments (list namestring))
+                     (unless (probe-file newpath)
+                       (restart-case (error
+                                      'simple-file-error
+                                      :pathname pathspec
+                                      :format-control
+                                      "can't create directory ~A"
+                                      :format-arguments (list namestring))
                          (retry ()
                            :report "Retry directory creation."
-                           (ensure-directories-exist pathspec :verbose verbose :mode mode))
+                           (ensure-directories-exist
+                            pathspec
+                            :verbose verbose :mode mode))
                          (continue ()
-                           :report "Continue as if directory creation was successful."
+                           :report
+                           "Continue as if directory creation was successful."
                            nil)))
                      (setf created-p t)))))
       (values pathspec created-p))))
diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh
index 09f96c0e8..f20c4e459 100644
--- a/tests/filesys.test.sh
+++ b/tests/filesys.test.sh
@@ -198,5 +198,18 @@ Lisp filename syntax idiosyncrasies)."
 EOF
 check_status_maybe_lose "DIRECTORY/TRUENAME part 3" $?
 
+# Test whether ENSURE-DIRECTORIES-EXIST can create a directory whose
+# name contains a wildcard character (it used to get itself confused
+# internally).
+run_sbcl --eval '(ensure-directories-exist "foo\\*bar/baz.txt")'
+test -d foo*bar
+check_status_maybe_lose "ENSURE-DIRECTORIES-EXIST part 1" $? \
+    0 "(directory exists)"
+
+run_sbcl --eval '(ensure-directories-exist "foo\\?bar/baz.txt")'
+test -d foo?bar
+check_status_maybe_lose "ENSURE-DIRECTORIES-EXIST part 2" $? \
+    0 "(directory exists)"
+
 # success convention for script
 exit $EXIT_TEST_WIN
diff --git a/version.lisp-expr b/version.lisp-expr
index 9f414da30..1a7111365 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.13.7"
+"1.0.13.8"
-- 
2.11.4.GIT