Clozure / ccl

Clozure Common Lisp
http://ccl.clozure.com
Apache License 2.0
840 stars 105 forks source link

patch ensure-directories-exist #475

Closed Devon7 closed 2 months ago

Devon7 commented 5 months ago

ensure-directories-exist silently fails.

Devon7 commented 5 months ago

;; Test 2 fails. With the patch, all tests pass.

(in-package :ccl)
(require :cl-fad)

(defun test ()
  (dolist (fn '(ensure-directories-exist ensure-directories-exist*))
    (dotimes (test 3)
      (let* ((file1 (translate-logical-pathname
             (cl-fad::generate-random-pathname
              "/tmp/Z/%" #'cl-fad::generate-random-string)))
         (dir1 (ccl::filepath-to-dirpath file1))
         (file2 (merge-pathnames "dir2" dir1))
         (dir2 (ccl::filepath-to-dirpath file2))
         (file (merge-pathnames "file" dir2))
         (result (destructuring-bind (create-this-file expect-file-error)
             (cdr (assoc test `((0 nil nil)
                        (1 ,file1 t)
                        (2 ,file2 t))))
               (when create-this-file
             (with-open-file (out create-this-file
                          :direction :output)
               (declare (ignore out))))
               (handler-case (funcall fn file :verbose t)
             (file-error (e) (describe e) (if expect-file-error :pass :fail))
             (error (e) (print e) :fail)
             (:no-error (path created-p) (declare (ignore path created-p)) (if expect-file-error :fail :pass))))))
    (format t "                Test ~D ~S ~S~%" test fn result)))))
Devon7 commented 5 months ago
$ ccl --batch --load ensure-directories-exist.lisp < /dev/null
Creating directory: /tmp/Z/
Creating directory: /tmp/Z/ACEW99W1/
Creating directory: /tmp/Z/ACEW99W1/dir2/
                Test 0 ENSURE-DIRECTORIES-EXIST :PASS
#<SIMPLE-FILE-ERROR #x302000B70AED>
Class: #<STANDARD-CLASS SIMPLE-FILE-ERROR>
Wrapper: #<CLASS-WRAPPER SIMPLE-FILE-ERROR #x3020000FA2FD>
Instance slots
PATHNAME: "/tmp/Z/FECAU6L3/dir2/"
ERROR-TYPE: "Not a directory : ~s"
FORMAT-CONTROL: #<Unbound>
FORMAT-ARGUMENTS: (NIL)
                Test 1 ENSURE-DIRECTORIES-EXIST :PASS
                Test 2 ENSURE-DIRECTORIES-EXIST :FAIL
Creating directory: /tmp/Z/KSOP7NWX/
Creating directory: /tmp/Z/KSOP7NWX/dir2/
                Test 0 ENSURE-DIRECTORIES-EXIST* :PASS
Creating directory: /tmp/Z/3CNAUYWQ/
#<FILE-ERROR #x302000B65A4D>
Class: #<STANDARD-CLASS FILE-ERROR>
Wrapper: #<CLASS-WRAPPER FILE-ERROR #x3020000FA9BD>
Instance slots
PATHNAME: "/tmp/Z/3CNAUYWQ/"
ERROR-TYPE: "Can't create directory ~S, since a file exists by that name and is not a directory"
                Test 1 ENSURE-DIRECTORIES-EXIST* :PASS
Creating directory: /tmp/Z/JBWJB9IS/dir2/
#<FILE-ERROR #x302000B6178D>
Class: #<STANDARD-CLASS FILE-ERROR>
Wrapper: #<CLASS-WRAPPER FILE-ERROR #x3020000FA9BD>
Instance slots
PATHNAME: "/tmp/Z/JBWJB9IS/dir2/"
ERROR-TYPE: "Can't create directory ~S, since a file exists by that name and is not a directory"
                Test 2 ENSURE-DIRECTORIES-EXIST* :PASS
Clozure Common Lisp Version 1.12.2 (v1.12.2-12-g3ff2cd13) DarwinX8664
?