ensure-directories-exist.lsp 5.32 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Jan  5 20:53:03 2004
;;;; Contains: Tests of ENSURE-DIRECTORIES-EXIST

(in-package :cl-test)

(deftest ensure-directories-exist.1
  (let* ((pn (make-pathname :name "ensure-directories-exist.lsp"
sds's avatar
sds committed
10 11 12 13 14 15
                            :defaults *default-pathname-defaults*))
         (results nil)
         (verbosity
          (with-output-to-string
            (*standard-output*)
            (setq results (multiple-value-list (ensure-directories-exist pn))))))
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
    (values
     (length results)
     (equalt (truename pn) (truename (first results)))
     (second results)
     verbosity))
  2 t nil "")

(deftest ensure-directories-exist.2
  (with-open-file
   (s "ensure-directories-exist.lsp" :direction :input)
   (let* ((results (multiple-value-list (ensure-directories-exist s))))
     (values
      (length results)
      (equalt (truename (first results)) (truename s))
      (second results))))
   2 t nil)

(deftest ensure-directories-exist.3
  (let ((s (open "ensure-directories-exist.lsp" :direction :input)))
    (close s)
    (let* ((results (multiple-value-list (ensure-directories-exist s))))
      (values
       (length results)
       (equalt (truename (first results)) (truename s))
       (second results))))
   2 t nil)

(deftest ensure-directories-exist.4
  (let* ((pn (make-pathname :name "ensure-directories-exist.lsp"
sds's avatar
sds committed
45 46 47 48 49 50 51
                            :defaults *default-pathname-defaults*))
         (results nil)
         (verbosity
          (with-output-to-string
            (*standard-output*)
            (setq results (multiple-value-list
                           (ensure-directories-exist pn :verbose nil))))))
52 53 54 55 56 57 58 59 60
    (values
     (length results)
     (equalt (truename pn) (truename (first results)))
     (second results)
     verbosity))
  2 t nil "")

(deftest ensure-directories-exist.5
  (let* ((pn (make-pathname :name "ensure-directories-exist.lsp"
sds's avatar
sds committed
61 62 63 64 65 66 67
                            :defaults *default-pathname-defaults*))
         (results nil)
         (verbosity
          (with-output-to-string
            (*standard-output*)
            (setq results (multiple-value-list
                           (ensure-directories-exist pn :verbose t))))))
68 69 70 71 72 73 74 75 76
    (values
     (length results)
     (equalt (truename pn) (truename (first results)))
     (second results)
     verbosity))
  2 t nil "")

(deftest ensure-directories-exist.6
  (let* ((pn (make-pathname :name "ensure-directories-exist.lsp"
sds's avatar
sds committed
77 78 79 80 81 82 83 84
                            :defaults *default-pathname-defaults*))
         (results nil)
         (verbosity
          (with-output-to-string
            (*standard-output*)
            (setq results (multiple-value-list
                           (ensure-directories-exist
                            pn :allow-other-keys nil))))))
85 86 87 88 89 90 91 92 93
    (values
     (length results)
     (equalt (truename pn) (truename (first results)))
     (second results)
     verbosity))
  2 t nil "")

(deftest ensure-directories-exist.7
  (let* ((pn (make-pathname :name "ensure-directories-exist.lsp"
sds's avatar
sds committed
94 95 96 97 98 99 100 101
                            :defaults *default-pathname-defaults*))
         (results nil)
         (verbosity
          (with-output-to-string
            (*standard-output*)
            (setq results (multiple-value-list
                           (ensure-directories-exist
                            pn :allow-other-keys t :nonsense t))))))
102 103 104 105 106 107 108 109 110 111 112 113 114
    (values
     (length results)
     (equalt (truename pn) (truename (first results)))
     (second results)
     verbosity))
  2 t nil "")

;;; Case where directory shouldn't exist

;; The directort ansi-tests/scratch must not exist before this
;; test is run
(deftest ensure-directories-exist.8
  (let* ((subdir (make-pathname :directory '(:relative "scratch")
sds's avatar
sds committed
115 116 117
                                :defaults *default-pathname-defaults*))
         (pn (make-pathname :name "foo" :type "txt"
                            :defaults subdir)))
pfdietz's avatar
pfdietz committed
118
    (assert (not (probe-file pn)) ()
sds's avatar
sds committed
119
            "Delete subdirectory scratch and its contents!")
pfdietz's avatar
pfdietz committed
120
    (let* ((results nil)
sds's avatar
sds committed
121 122 123 124 125 126
           (verbosity
            (with-output-to-string
              (*standard-output*)
              (setq results (multiple-value-list (ensure-directories-exist pn)))))
           (result-pn (first results))
           (created (second results)))
pfdietz's avatar
pfdietz committed
127 128
      ;; Create the file and write to it
      (with-open-file (*standard-output*
sds's avatar
sds committed
129 130 131
                       pn :direction :output :if-exists :error
                       :if-does-not-exist :create)
                      (print nil))
132 133 134 135
      (values
       (length results)
       (notnot created)
       (equalt pn result-pn)
pfdietz's avatar
pfdietz committed
136
       (notnot (probe-file pn))
137 138 139 140
       verbosity
       )))
  2 t t t "")

141 142 143 144 145 146 147 148 149 150 151
;;; Specialized string tests

(deftest ensure-directories-exist.9
  (do-special-strings
   (str "ensure-directories-exist.lsp" nil)
   (let* ((results (multiple-value-list (ensure-directories-exist str))))
     (assert (eql (length results) 2))
     (assert (equalt (truename (first results)) (truename str)))
     (assert (null (second results)))))
  nil)

152 153
;; FIXME
;; Need to add a LPN test
154 155

(deftest ensure-directories-exist.error.1
156
  (signals-error-always
157 158
   (ensure-directories-exist
    (make-pathname :directory '(:relative :wild)
sds's avatar
sds committed
159
                   :defaults *default-pathname-defaults*))
160
   file-error)
161
  t t)
162 163

(deftest ensure-directories-exist.error.2
164 165
  (signals-error (ensure-directories-exist) program-error)
  t)