racket/file: add make-parent-directory*

Also, clarify behavior of `make-directory*` in the case of a relative
path when the current directory does not exist.

pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl

@@ -1058,7 +1058,27 @@ paths disappear during the scan, then an exception is raised.}
 
 Creates directory specified by @racket[path], creating intermediate
 directories as necessary, and never failing if @racket[path] exists
-already.}
+already.
+
+If @racket[path] is a relative path and the current directory does not
+exist, then @racket[make-directory*] will not create the current
+directory, because it considers only explicit elements of
+@racket[path].}
+
+
+@defproc[(make-parent-directory* [path path-string?]) void?]{
+
+Creates the parent directory of the path specified by @racket[path],
+creating intermediate directories as necessary, and never failing if
+an ancestor of @racket[path] exists already.
+
+If @racket[path] is a filesystem root or a relative path with a single
+path element, then no directory is created. Like
+@racket[make-directory*], if @racket[path] is a relative path and the
+current directory does not exist, then @racket[make-parent-directory*]
+will not create it.
+
+@history[#:added "6.1.1.3"]}
 
 
 @defproc[(make-temporary-file [template string? "rkttmp~a"]

pkgs/racket-pkgs/racket-test/tests/racket/file.rktl

@@ -1710,6 +1710,42 @@
               (values f #t)))))
   (delete-directory/files tmp-dir))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test `make[-parent]-directory`
+
+(let ()
+  (define tmp (find-system-path 'temp-dir))
+  (define (check build-z-dir-path pick-directory)
+    (define made (make-temporary-file "check-make-~a" 'directory))
+    (define z-dir (build-z-dir-path made "x" "y"))
+    (define z (build-path z-dir "z"))
+    (parameterize ([current-directory (pick-directory made)])
+      (test #f directory-exists? z-dir)
+      (test #f file-exists? z)
+      (make-parent-directory* z)
+      (test #t directory-exists? z-dir)
+      (make-parent-directory* z)
+      (delete-directory/files z-dir)
+      (test #f directory-exists? z-dir)
+      (make-directory* z)
+      (test #t directory-exists? z-dir)
+      (test #t directory-exists? z)
+      (make-directory* z)
+      (make-parent-directory* z))
+    (delete-directory/files made))
+  (check build-path (lambda (made) (current-directory)))
+  (check (lambda args (apply build-path (cdr args))) values)
+  (check (lambda args (apply build-path 'same (cdr args))) values))
+
+;; Check on a current directory that does not exist:
+(let ()  
+  (define made (make-temporary-file "check-make-~a" 'directory))
+  (parameterize ([current-directory (build-path made "nonesuch")])
+    (make-parent-directory* "z")
+    (test #f directory-exists? (current-directory))
+    (err/rt-test (make-directory* "z") exn:fail:filesystem?))
+  (delete-directory/files made))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check that `in-directory' fails properly on filesystem errors
 

racket/collects/pkg/private/path.rkt

@@ -6,10 +6,6 @@
 
 (provide (all-defined-out))
 
-(define (make-parent-directory* p)
-  (define parent (path-only p))
-  (make-directory* parent))
-
 (define (path->bytes* pkg)
   (cond
     [(path? pkg)

racket/collects/racket/file.rkt

@@ -7,6 +7,7 @@
 (provide delete-directory/files
          copy-directory/files
          make-directory*
+         make-parent-directory*
          make-temporary-file
 
          get-preference
@@ -94,6 +95,8 @@
           [else (raise-not-a-file-or-directory 'copy-directory/files src)])))
 
 (define (make-directory* dir)
+  (unless (path-string? dir)
+    (raise-argument-error 'make-directory* "path-string?" dir))
   (let-values ([(base name dir?) (split-path dir)])
     (when (and (path? base)
                (not (directory-exists? base)))
@@ -102,6 +105,16 @@
       (with-handlers ([exn:fail:filesystem:exists? void])
         (make-directory dir)))))
 
+(define (make-parent-directory* p)
+  (unless (path-string? p)
+    (raise-argument-error 'make-parent-directory* "path-string?" p))
+  (define-values (base name dir?) (split-path p))
+  (cond
+   [(path? base) (make-directory* base)]
+   [else
+    ;; Do nothing with an immediately relative path or a root directory
+    (void)]))
+
 (define-syntax (make-temporary-file stx)
   (with-syntax ([app (datum->syntax stx #'#%app stx)])
     (syntax-case stx ()

racket/src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "6.1.1.2"
+#define MZSCHEME_VERSION "6.1.1.3"
 
 #define MZSCHEME_VERSION_X 6
 #define MZSCHEME_VERSION_Y 1
 #define MZSCHEME_VERSION_Z 1
-#define MZSCHEME_VERSION_W 2
+#define MZSCHEME_VERSION_W 3
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)