source: trunk/source/tests/ansi-tests/rename-file.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 6.6 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Jan  8 06:22:53 2004
4;;;; Contains: Tests for RENAME-FILE
5
6(in-package :cl-test)
7
8(deftest rename-file.1
9  (let ((pn1 #p"file-to-be-renamed.txt")
10        (pn2 #p"file-that-was-renamed.txt"))
11    (delete-all-versions pn1)
12    (delete-all-versions pn2)
13    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
14    (let ((results (multiple-value-list (rename-file pn1 pn2))))
15      (destructuring-bind (defaulted-new-name old-truename new-truename)
16          results
17          (values
18           (=t (length results) 3)
19           (probe-file pn1)
20           (notnot (probe-file pn2))
21           (list (notnot (pathnamep defaulted-new-name))
22                 (notnot (pathnamep old-truename))
23                 (notnot (pathnamep new-truename))
24                 (typep old-truename 'logical-pathname)
25                 (typep new-truename 'logical-pathname))
26           (notnot (probe-file defaulted-new-name))
27           (probe-file old-truename)
28           (notnot (probe-file new-truename))))))
29  t nil t (t t t nil nil) t nil t)
30
31(deftest rename-file.2
32  (let ((pn1 "file-to-be-renamed.txt")
33        (pn2 "file-that-was-renamed.txt"))
34    (delete-all-versions pn1)
35    (delete-all-versions pn2)
36    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
37    (let ((results (multiple-value-list (rename-file pn1 pn2))))
38      (destructuring-bind (defaulted-new-name old-truename new-truename)
39          results
40          (values
41           (=t (length results) 3)
42           (probe-file pn1)
43           (notnot (probe-file pn2))
44           (list (notnot (pathnamep defaulted-new-name))
45                 (notnot (pathnamep old-truename))
46                 (notnot (pathnamep new-truename))
47                 (typep old-truename 'logical-pathname)
48                 (typep new-truename 'logical-pathname))
49           (notnot (probe-file defaulted-new-name))
50           (probe-file old-truename)
51           (notnot (probe-file new-truename))))))
52  t nil t (t t t nil nil) t nil t)
53
54 (deftest rename-file.3
55  (let* ((pn1 (make-pathname :name "file-to-be-renamed"
56                             :type "txt"
57                             :version :newest
58                             :defaults *default-pathname-defaults*))
59         (pn2 (make-pathname :name "file-that-was-renamed"))
60         (pn3 (make-pathname :name "file-that-was-renamed"
61                             :defaults pn1)))
62    (delete-all-versions pn1)
63    (delete-all-versions pn3)
64    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
65    (let ((results (multiple-value-list (rename-file pn1 pn2))))
66      (destructuring-bind (defaulted-new-name old-truename new-truename)
67          results
68          (values
69           (equalpt (pathname-type pn1)
70                    (pathname-type defaulted-new-name))
71           (=t (length results) 3)
72           (probe-file pn1)
73           (notnot (probe-file pn3))
74           (list (notnot (pathnamep defaulted-new-name))
75                 (notnot (pathnamep old-truename))
76                 (notnot (pathnamep new-truename))
77                 (typep old-truename 'logical-pathname)
78                 (typep new-truename 'logical-pathname))
79           (notnot (probe-file defaulted-new-name))
80           (probe-file old-truename)
81           (notnot (probe-file new-truename))))))
82  t t nil t (t t t nil nil) t nil t)
83
84(deftest rename-file.4
85  (let ((pn1 "file-to-be-renamed.txt")
86        (pn2 "file-that-was-renamed.txt"))
87    (delete-all-versions pn1)
88    (delete-all-versions pn2)
89    (let ((s (open pn1 :direction :output)))
90      (format s "Whatever~%")
91      (close s)
92      (let ((results (multiple-value-list (rename-file s pn2))))
93        (destructuring-bind (defaulted-new-name old-truename new-truename)
94            results
95          (values
96           (=t (length results) 3)
97           (probe-file pn1)
98           (notnot (probe-file pn2))
99           (list (notnot (pathnamep defaulted-new-name))
100                 (notnot (pathnamep old-truename))
101                 (notnot (pathnamep new-truename))
102                 (typep old-truename 'logical-pathname)
103                 (typep new-truename 'logical-pathname))
104           (notnot (probe-file defaulted-new-name))
105           (probe-file old-truename)
106           (notnot (probe-file new-truename)))))))
107  t nil t (t t t nil nil) t nil t)
108
109(deftest rename-file.5
110  (let ((pn1 "CLTEST:file-to-be-renamed.txt")
111        (pn2 "CLTEST:file-that-was-renamed.txt"))
112    (delete-all-versions pn1)
113    (delete-all-versions pn2)
114    (assert (typep (pathname pn1) 'logical-pathname))
115    (assert (typep (pathname pn2) 'logical-pathname))
116    (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
117    (let ((results (multiple-value-list (rename-file pn1 pn2))))
118      (destructuring-bind (defaulted-new-name old-truename new-truename)
119          results
120          (values
121           (=t (length results) 3)
122           (probe-file pn1)
123           (notnot (probe-file pn2))
124           (list (notnot (pathnamep defaulted-new-name))
125                 (notnot (pathnamep old-truename))
126                 (notnot (pathnamep new-truename))
127                 (typep old-truename 'logical-pathname)
128                 (typep new-truename 'logical-pathname))
129           (notnot (probe-file defaulted-new-name))
130           (probe-file old-truename)
131           (notnot (probe-file new-truename))
132           (notnot (typep defaulted-new-name 'logical-pathname))
133           ))))
134  t nil t (t t t nil nil) t nil t t)
135
136;;; Specialized string tests
137
138(deftest rename-file.6
139  (do-special-strings
140   (s "file-to-be-renamed.txt" nil)
141   (let ((pn1 s)
142         (pn2 "file-that-was-renamed.txt"))
143     (delete-all-versions pn1)
144     (delete-all-versions pn2)
145     (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
146     (let ((results (multiple-value-list (rename-file pn1 pn2))))
147       (destructuring-bind (defaulted-new-name old-truename new-truename)
148           results
149         (assert
150          (equal
151           (list
152            (=t (length results) 3)
153            (probe-file pn1)
154            (notnot (probe-file pn2))
155            (list (notnot (pathnamep defaulted-new-name))
156                  (notnot (pathnamep old-truename))
157                  (notnot (pathnamep new-truename))
158                  (typep old-truename 'logical-pathname)
159                  (typep new-truename 'logical-pathname))
160            (notnot (probe-file defaulted-new-name))
161            (probe-file old-truename)
162            (notnot (probe-file new-truename)))
163           '(t nil t (t t t nil nil) t nil t)))))))
164  nil)
165
166(deftest rename-file.7
167  (do-special-strings
168   (s "file-that-was-renamed.txt" nil)
169   (let ((pn1 "file-to-be-renamed.txt")
170         (pn2 s))
171     (delete-all-versions pn1)
172     (delete-all-versions pn2)
173     (with-open-file (s pn1 :direction :output) (format s "Whatever~%"))
174     (let ((results (multiple-value-list (rename-file pn1 pn2))))
175       (destructuring-bind (defaulted-new-name old-truename new-truename)
176           results
177         (assert
178          (equal
179           (list
180            (=t (length results) 3)
181            (probe-file pn1)
182            (notnot (probe-file pn2))
183            (list (notnot (pathnamep defaulted-new-name))
184                  (notnot (pathnamep old-truename))
185                  (notnot (pathnamep new-truename))
186                  (typep old-truename 'logical-pathname)
187                  (typep new-truename 'logical-pathname))
188            (notnot (probe-file defaulted-new-name))
189            (probe-file old-truename)
190            (notnot (probe-file new-truename)))
191           '(t nil t (t t t nil nil) t nil t)))))))
192  nil)
193
194;;; Error tests
195
196(deftest rename-file.error.1
197  (signals-error (rename-file) program-error)
198  t)
199
Note: See TracBrowser for help on using the repository browser.