From a4e6af224add2513f99641f56c5a0d41a4f75f48 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sat, 20 Jun 2015 14:08:26 +0200
Subject: [PATCH 1/3] Fix create-directory parent dir creation on Windows.

When passing #t as the second argument to make create-directory behave
like "mkdir -p", on Windows there was a small mistake in the logic so it
would never actually create the topmost parent directory, only those at
level 2 and below.  This was exposed by the find-files test which uses
this feature of create-directory.

Instead of having differing implementations, we move the UNIX
implementation into posix-common; it recursively decomposes pathnames
using standard procedures that already deal with the difference in path
separator.  Both use C_mkdir(), which is defined in a platform-specific
way (but using a common API) at the top of each corresponding platform's
posix file.
---
 NEWS             |  2 ++
 posix-common.scm | 19 ++++++++++++++++++-
 posixunix.scm    | 18 ------------------
 posixwin.scm     | 28 ----------------------------
 4 files changed, 20 insertions(+), 47 deletions(-)

diff --git a/NEWS b/NEWS
index b898bc0..0d72b4f 100644
--- a/NEWS
+++ b/NEWS
@@ -62,6 +62,8 @@
     to Seth Alves).
   - file-mkstemp now works correctly on Windows, it now returns valid
     file descriptors (#819, thanks to Michele La Monaca).
+  - create-directory on Windows now creates all intermediate
+    directories when passed #t as second parameter.
 
 - Runtime system:
   - Removed several deprecated, undocumented parts of the C interface:
diff --git a/posix-common.scm b/posix-common.scm
index 8b3e4e5..b0280ba 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -444,6 +444,24 @@ EOF
         (rmdir name))
       (rmdir name))))
 
+(define-inline (*create-directory loc name)
+  (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name loc)))
+    (posix-error #:file-error loc "cannot create directory" name)) )
+
+(define create-directory
+  (lambda (name #!optional parents?)
+    (##sys#check-string name 'create-directory)
+    (unless (or (fx= 0 (##sys#size name))
+                (file-exists? name))
+      (if parents?
+        (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
+                          (if file (make-pathname dir file ext) dir))))
+          (when (and dir (not (directory? dir)))
+            (loop (pathname-directory dir))
+            (*create-directory 'create-directory dir)) )
+        (*create-directory 'create-directory name) ) )
+    name))
+
 (define directory
   (lambda (#!optional (spec (current-directory)) show-dotfiles?)
     (##sys#check-string spec 'directory)
@@ -472,7 +490,6 @@ EOF
 		      (loop)
 		      (cons file (loop)) ) ) ) ) ) ) ) )
 
-
 ;;; Filename globbing:
 
 (define glob
diff --git a/posixunix.scm b/posixunix.scm
index 5e8d36f..6f7ec5b 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -611,24 +611,6 @@ EOF
 
 ;;; Directory stuff:
 
-(define-inline (*create-directory loc name)
-  (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name loc)))
-    (posix-error #:file-error loc "cannot create directory" name)) )
-
-(define create-directory
-  (lambda (name #!optional parents?)
-    (##sys#check-string name 'create-directory)
-    (unless (or (fx= 0 (##sys#size name))
-                (file-exists? name))
-      (if parents?
-        (let loop ((dir (let-values (((dir file ext) (decompose-pathname name)))
-                          (if file (make-pathname dir file ext) dir))))
-          (when (and dir (not (directory? dir)))
-            (loop (pathname-directory dir))
-            (*create-directory 'create-directory dir)) )
-        (*create-directory 'create-directory name) ) )
-    name))
-
 (define change-directory
   (lambda (name)
     (##sys#check-string name 'change-directory)
diff --git a/posixwin.scm b/posixwin.scm
index 83794aa..8ca0638 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -803,34 +803,6 @@ EOF
 
 ;;; Directory stuff:
 
-(define-inline (create-directory-helper name)
-  (unless (fx= 0 (##core#inline "C_mkdir" (##sys#make-c-string name 'create-directory)))
-    (##sys#update-errno)
-    (##sys#signal-hook #:file-error 'create-directory
-		       "cannot create directory" name)))
-
-(define-inline (create-directory-helper-silent name)
-  (unless (##sys#file-exists? name #f #t #f)
-    (create-directory-helper name)))
-
-(define-inline (create-directory-helper-parents name)
-  (let* ((l   (string-split name "/\\"))
-	 (c   (car l)))
-    (for-each
-     (lambda (x)
-       (set! c (string-append c "/" x))
-       (create-directory-helper-silent c))
-     (cdr l))))
-
-(define create-directory
-  (lambda (name #!optional parents?)
-    (##sys#check-string name 'create-directory)
-    (let ((name name))
-      (if parents?
-          (create-directory-helper-parents name)
-          (create-directory-helper name))
-      name)))
-
 (define change-directory
   (lambda (name)
     (##sys#check-string name 'change-directory)
-- 
2.1.4