Changeset 15719 in project


Ignore:
Timestamp:
09/03/09 02:25:29 (10 years ago)
Author:
Kon Lovett
Message:

Fix for 'create-directory' when parents wanted; was always trying an absolute-pathname!

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/posixunix.scm

    r15543 r15719  
    861861
    862862(define-inline (create-directory-helper name)
    863     (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string name)))
    864             (posix-error #:file-error 'create-directory
    865                          "cannot create directory" name)))
     863  (unless (zero? (##core#inline "C_mkdir" (##sys#make-c-string name)))
     864    (posix-error #:file-error 'create-directory "cannot create directory" name)) )
    866865
    867866(define-inline (create-directory-check name)
    868     (if (file-exists? name)
    869         (if (fx< (##core#inline "C_stat" (##sys#make-c-string name)) 0)
    870             (posix-error #:file-error 'create-directory
    871                          "cannot stat file" name)
    872             (or (foreign-value "C_isdir" bool)
    873                 (posix-error #:file-error 'create-directory
    874                              "path segment is a file" name)))
    875         #f))
     867  (and (file-exists? name)
     868       (if (fx< (##core#inline "C_stat" (##sys#make-c-string name)) 0)
     869           (posix-error #:file-error 'create-directory "cannot stat file" name)
     870           (or (foreign-value "C_isdir" bool)
     871               (posix-error #:file-error 'create-directory "path segment is a file" name)) ) ) )
    876872
    877873(define-inline (create-directory-helper-silent name)
    878     (unless (create-directory-check name)
    879             (create-directory-helper name)))
    880 
    881 (define-inline (create-directory-helper-parents name)
    882     (let ((c   ""))
     874  (unless (create-directory-check name)
     875    (create-directory-helper name)))
     876
     877(define create-directory-helper-parents
     878  (let ((string-append string-append)
     879        (char=? char=?)
     880        (string-ref string-ref)
     881        (string-split string-split) )
     882    (lambda (name)
     883      (let ((c #f)
     884            (dirs (string-split name "/")) )
    883885        (for-each
    884              (lambda (x)
    885                  (set! c (string-append c "/" x))
    886                  (create-directory-helper-silent c))
    887              (string-split name "/"))))
     886         (lambda (x)
     887           ; take the 1st dir component as-is so as not to create an
     888           ; absoulte pathname
     889           (set! c (if c (string-append c "/" x) x))
     890           (create-directory-helper-silent c) )
     891         ; handle case of an absolute pathanme
     892         (if (char=? #\/ (string-ref name 0)) (cons "/" dirs) dirs)) ) ) ) )
    888893
    889894(define create-directory
    890   (lambda (name #!optional parents?)
    891     (##sys#check-string name 'create-directory)
    892     (if parents?
    893         (create-directory-helper-parents name)
    894         (create-directory-helper name))))
     895  (let ((string=? string=?))
     896    (lambda (name #!optional parents?)
     897      (##sys#check-string name 'create-directory)
     898      ; do not pass an empty string to helper-parents
     899      (if (and parents? (not (string=? "" name)))
     900          (create-directory-helper-parents name)
     901          (create-directory-helper name) ) ) ) )
    895902
    896903(define change-directory
Note: See TracChangeset for help on using the changeset viewer.