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)