patch ensure-directories-exist

[Devon7]

ensure-directories-exist silently fails.

[Devon7]

;; 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]

$ 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
?