rename-file.lsp 7.64 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
8
9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Thu Jan  8 06:22:53 2004
;;;; Contains: Tests for RENAME-FILE

(in-package :cl-test)

(deftest rename-file.1
  (let ((pn1 #p"file-to-be-renamed.txt")
sds's avatar
sds committed
10
        (pn2 #p"file-that-was-renamed.txt"))
pfdietz's avatar
pfdietz committed
11
12
    (delete-all-versions pn1)
    (delete-all-versions pn2)
pfdietz's avatar
pfdietz committed
13
14
15
    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
    (let ((results (multiple-value-list (rename-file pn1 pn2))))
      (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
16
17
18
19
20
21
22
23
24
25
26
27
28
          results
          (values
           (=t (length results) 3)
           (probe-file pn1)
           (notnot (probe-file pn2))
           (list (notnot (pathnamep defaulted-new-name))
                 (notnot (pathnamep old-truename))
                 (notnot (pathnamep new-truename))
                 (typep old-truename 'logical-pathname)
                 (typep new-truename 'logical-pathname))
           (notnot (probe-file defaulted-new-name))
           (probe-file old-truename)
           (notnot (probe-file new-truename))))))
29
  t nil t (t t t nil nil) t nil t)
pfdietz's avatar
pfdietz committed
30
31
32

(deftest rename-file.2
  (let ((pn1 "file-to-be-renamed.txt")
sds's avatar
sds committed
33
        (pn2 "file-that-was-renamed.txt"))
pfdietz's avatar
pfdietz committed
34
35
    (delete-all-versions pn1)
    (delete-all-versions pn2)
pfdietz's avatar
pfdietz committed
36
37
38
    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
    (let ((results (multiple-value-list (rename-file pn1 pn2))))
      (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
39
40
41
42
43
44
45
46
47
48
49
50
51
          results
          (values
           (=t (length results) 3)
           (probe-file pn1)
           (notnot (probe-file pn2))
           (list (notnot (pathnamep defaulted-new-name))
                 (notnot (pathnamep old-truename))
                 (notnot (pathnamep new-truename))
                 (typep old-truename 'logical-pathname)
                 (typep new-truename 'logical-pathname))
           (notnot (probe-file defaulted-new-name))
           (probe-file old-truename)
           (notnot (probe-file new-truename))))))
52
  t nil t (t t t nil nil) t nil t)
pfdietz's avatar
pfdietz committed
53
54
55

 (deftest rename-file.3
  (let* ((pn1 (make-pathname :name "file-to-be-renamed"
sds's avatar
sds committed
56
57
58
59
60
61
                             :type "txt"
                             :version :newest
                             :defaults *default-pathname-defaults*))
         (pn2 (make-pathname :name "file-that-was-renamed"))
         (pn3 (make-pathname :name "file-that-was-renamed"
                             :defaults pn1)))
pfdietz's avatar
pfdietz committed
62
63
    (delete-all-versions pn1)
    (delete-all-versions pn3)
pfdietz's avatar
pfdietz committed
64
65
66
    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
    (let ((results (multiple-value-list (rename-file pn1 pn2))))
      (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
          results
          (values
           (equalpt (pathname-type pn1)
                    (pathname-type defaulted-new-name))
           (=t (length results) 3)
           (probe-file pn1)
           (notnot (probe-file pn3))
           (list (notnot (pathnamep defaulted-new-name))
                 (notnot (pathnamep old-truename))
                 (notnot (pathnamep new-truename))
                 (typep old-truename 'logical-pathname)
                 (typep new-truename 'logical-pathname))
           (notnot (probe-file defaulted-new-name))
           (probe-file old-truename)
           (notnot (probe-file new-truename))))))
82
  t t nil t (t t t nil nil) t nil t)
pfdietz's avatar
pfdietz committed
83
84
85

(deftest rename-file.4
  (let ((pn1 "file-to-be-renamed.txt")
sds's avatar
sds committed
86
        (pn2 "file-that-was-renamed.txt"))
pfdietz's avatar
pfdietz committed
87
88
    (delete-all-versions pn1)
    (delete-all-versions pn2)
pfdietz's avatar
pfdietz committed
89
90
91
92
    (let ((s (open pn1 :direction :output)))
      (format s "Whatever~%")
      (close s)
      (let ((results (multiple-value-list (rename-file s pn2))))
sds's avatar
sds committed
93
94
95
96
97
98
99
100
101
102
103
104
105
106
        (destructuring-bind (defaulted-new-name old-truename new-truename)
            results
          (values
           (=t (length results) 3)
           (probe-file pn1)
           (notnot (probe-file pn2))
           (list (notnot (pathnamep defaulted-new-name))
                 (notnot (pathnamep old-truename))
                 (notnot (pathnamep new-truename))
                 (typep old-truename 'logical-pathname)
                 (typep new-truename 'logical-pathname))
           (notnot (probe-file defaulted-new-name))
           (probe-file old-truename)
           (notnot (probe-file new-truename)))))))
107
  t nil t (t t t nil nil) t nil t)
pfdietz's avatar
pfdietz committed
108
109
110

(deftest rename-file.5
  (let ((pn1 "CLTEST:file-to-be-renamed.txt")
sds's avatar
sds committed
111
        (pn2 "CLTEST:file-that-was-renamed.txt"))
pfdietz's avatar
pfdietz committed
112
113
    (delete-all-versions pn1)
    (delete-all-versions pn2)
114
115
    (assert (typep (pathname pn1) 'logical-pathname))
    (assert (typep (pathname pn2) 'logical-pathname))
pfdietz's avatar
pfdietz committed
116
117
118
    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
    (let ((results (multiple-value-list (rename-file pn1 pn2))))
      (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
          results
          (values
           (=t (length results) 3)
           (probe-file pn1)
           (notnot (probe-file pn2))
           (list (notnot (pathnamep defaulted-new-name))
                 (notnot (pathnamep old-truename))
                 (notnot (pathnamep new-truename))
                 (typep old-truename 'logical-pathname)
                 (typep new-truename 'logical-pathname))
           (notnot (probe-file defaulted-new-name))
           (probe-file old-truename)
           (notnot (probe-file new-truename))
           (notnot (typep defaulted-new-name 'logical-pathname))
           ))))
134
  t nil t (t t t nil nil) t nil t t)
pfdietz's avatar
pfdietz committed
135

136
137
138
139
140
141
;;; Specialized string tests

(deftest rename-file.6
  (do-special-strings
   (s "file-to-be-renamed.txt" nil)
   (let ((pn1 s)
sds's avatar
sds committed
142
         (pn2 "file-that-was-renamed.txt"))
143
144
145
146
147
     (delete-all-versions pn1)
     (delete-all-versions pn2)
     (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
     (let ((results (multiple-value-list (rename-file pn1 pn2))))
       (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
           results
         (assert
          (equal
           (list
            (=t (length results) 3)
            (probe-file pn1)
            (notnot (probe-file pn2))
            (list (notnot (pathnamep defaulted-new-name))
                  (notnot (pathnamep old-truename))
                  (notnot (pathnamep new-truename))
                  (typep old-truename 'logical-pathname)
                  (typep new-truename 'logical-pathname))
            (notnot (probe-file defaulted-new-name))
            (probe-file old-truename)
            (notnot (probe-file new-truename)))
           '(t nil t (t t t nil nil) t nil t)))))))
164
165
166
167
168
169
  nil)

(deftest rename-file.7
  (do-special-strings
   (s "file-that-was-renamed.txt" nil)
   (let ((pn1 "file-to-be-renamed.txt")
sds's avatar
sds committed
170
         (pn2 s))
171
172
173
174
175
     (delete-all-versions pn1)
     (delete-all-versions pn2)
     (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
     (let ((results (multiple-value-list (rename-file pn1 pn2))))
       (destructuring-bind (defaulted-new-name old-truename new-truename)
sds's avatar
sds committed
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
           results
         (assert
          (equal
           (list
            (=t (length results) 3)
            (probe-file pn1)
            (notnot (probe-file pn2))
            (list (notnot (pathnamep defaulted-new-name))
                  (notnot (pathnamep old-truename))
                  (notnot (pathnamep new-truename))
                  (typep old-truename 'logical-pathname)
                  (typep new-truename 'logical-pathname))
            (notnot (probe-file defaulted-new-name))
            (probe-file old-truename)
            (notnot (probe-file new-truename)))
           '(t nil t (t t t nil nil) t nil t)))))))
192
193
194
  nil)

;;; Error tests
pfdietz's avatar
pfdietz committed
195
196

(deftest rename-file.error.1
197
198
  (signals-error (rename-file) program-error)
  t)
pfdietz's avatar
pfdietz committed
199