0.9.4.84:
[sbcl.git] / contrib / sb-posix / posix-tests.lisp
1 (defpackage "SB-POSIX-TESTS"
2   (:use "COMMON-LISP" "SB-RT"))
3
4 (in-package "SB-POSIX-TESTS")
5
6 (defvar *test-directory*
7   (ensure-directories-exist
8    (merge-pathnames (make-pathname :directory '(:relative "test-lab"))
9                     (make-pathname :directory
10                                    (pathname-directory *load-truename*)))))
11
12 (defvar *current-directory* *default-pathname-defaults*)
13
14 (defvar *this-file* *load-truename*)
15
16 (eval-when (:compile-toplevel :load-toplevel)
17   (defconstant +mode-rwx-all+ (logior sb-posix::s-irusr sb-posix::s-iwusr sb-posix::s-ixusr
18                                       sb-posix::s-irgrp sb-posix::s-iwgrp sb-posix::s-ixgrp
19                                       sb-posix::s-iroth sb-posix::s-iwoth sb-posix::s-ixoth)))
20
21 (defmacro define-eacces-test (name form &rest values)
22   `(deftest ,name
23     (block ,name
24       (when (= (sb-posix:geteuid) 0)
25         (return-from ,name (values ,@values)))
26       ,form)
27     ,@values))
28 \f
29 (deftest chdir.1
30   (sb-posix:chdir *test-directory*)
31   0)
32
33 (deftest chdir.2
34   (sb-posix:chdir (namestring *test-directory*))
35   0)
36
37 (deftest chdir.3
38   (sb-posix:chdir "/")
39   0)
40
41 (deftest chdir.4
42   (sb-posix:chdir #p"/")
43   0)
44
45 (deftest chdir.5
46   (sb-posix:chdir *current-directory*)
47   0)
48
49 (deftest chdir.6
50   (sb-posix:chdir "/../")
51   0)
52
53 (deftest chdir.7
54   (sb-posix:chdir #p"/../")
55   0)
56
57 (deftest chdir.8
58   (sb-posix:chdir (make-pathname :directory '(:absolute :up)))
59   0)
60
61 (deftest chdir.error.1
62   (let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist"))))
63     (handler-case
64         (sb-posix:chdir (merge-pathnames dne *test-directory*))
65       (sb-posix:syscall-error (c)
66         (sb-posix:syscall-errno c))))
67   #.sb-posix::enoent)
68
69 (deftest chdir.error.2
70   (handler-case
71       (sb-posix:chdir *this-file*)
72     (sb-posix:syscall-error (c)
73       (sb-posix:syscall-errno c)))
74   #.sb-posix::enotdir)
75 \f
76 (deftest mkdir.1
77   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.1"))))
78     (unwind-protect
79          (sb-posix:mkdir (merge-pathnames dne *test-directory*) 0)
80       ;; FIXME: no delete-directory in CL, but using our own operators
81       ;; is probably not ideal
82       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
83   0)
84
85 (deftest mkdir.2
86   (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.2"))))
87     (unwind-protect
88          (sb-posix:mkdir (namestring (merge-pathnames dne *test-directory*)) 0)
89       (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*)))))
90   0)
91
92 (deftest mkdir.error.1
93   (handler-case
94       (sb-posix:mkdir *test-directory* 0)
95     (sb-posix:syscall-error (c)
96       (sb-posix:syscall-errno c)))
97   #.sb-posix::eexist)
98
99 (deftest mkdir.error.2
100   (handler-case
101       (sb-posix:mkdir "/" 0)
102     (sb-posix:syscall-error (c)
103       (sb-posix:syscall-errno c)))
104   #.sb-posix::eexist)
105
106 (define-eacces-test mkdir.error.3
107   (let* ((dir (merge-pathnames
108                (make-pathname :directory '(:relative "mkdir.error.3"))
109                *test-directory*))
110          (dir2 (merge-pathnames
111                 (make-pathname :directory '(:relative "does-not-exist"))
112                 dir)))
113     (sb-posix:mkdir dir 0)
114     (handler-case
115         (sb-posix:mkdir dir2 0)
116       (sb-posix:syscall-error (c)
117         (sb-posix:rmdir dir)
118         (sb-posix:syscall-errno c))
119       (:no-error (result)
120         (sb-posix:rmdir dir2)
121         (sb-posix:rmdir dir)
122         result)))
123   #.sb-posix::eacces)
124 \f
125 (deftest rmdir.1
126   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.1"))))
127     (ensure-directories-exist (merge-pathnames dne *test-directory*))
128     (sb-posix:rmdir (merge-pathnames dne *test-directory*)))
129   0)
130
131 (deftest rmdir.2
132   (let ((dne (make-pathname :directory '(:relative "rmdir.does-not-exist.2"))))
133     (ensure-directories-exist (merge-pathnames dne *test-directory*))
134     (sb-posix:rmdir (namestring (merge-pathnames dne *test-directory*))))
135   0)
136
137 (deftest rmdir.error.1
138   (let ((dne (make-pathname :directory '(:relative "rmdir.dne.error.1"))))
139     (handler-case
140         (sb-posix:rmdir (merge-pathnames dne *test-directory*))
141       (sb-posix:syscall-error (c)
142         (sb-posix:syscall-errno c))))
143   #.sb-posix::enoent)
144
145 (deftest rmdir.error.2
146   (handler-case
147       (sb-posix:rmdir *this-file*)
148     (sb-posix:syscall-error (c)
149       (sb-posix:syscall-errno c)))
150   #.sb-posix::enotdir)
151
152 (deftest rmdir.error.3
153   (handler-case
154       (sb-posix:rmdir "/")
155     (sb-posix:syscall-error (c)
156       (sb-posix:syscall-errno c)))
157   #.sb-posix::ebusy)
158
159 (deftest rmdir.error.4
160   (let* ((dir (ensure-directories-exist
161                (merge-pathnames
162                 (make-pathname :directory '(:relative "rmdir.error.4"))
163                 *test-directory*)))
164          (file (make-pathname :name "foo" :defaults dir)))
165     (with-open-file (s file :direction :output)
166       (write "" :stream s))
167     (handler-case
168         (sb-posix:rmdir dir)
169       (sb-posix:syscall-error (c)
170         (delete-file file)
171         (sb-posix:rmdir dir)
172         (let ((errno (sb-posix:syscall-errno c)))
173           ;; documented by POSIX
174           (or (= errno sb-posix::eexist) (= errno sb-posix::enotempty))))))
175   t)
176
177 (define-eacces-test rmdir.error.5
178   (let* ((dir (merge-pathnames
179                (make-pathname :directory '(:relative "rmdir.error.5"))
180                *test-directory*))
181          (dir2 (merge-pathnames
182                 (make-pathname :directory '(:relative "unremovable"))
183                 dir)))
184     (sb-posix:mkdir dir +mode-rwx-all+)
185     (sb-posix:mkdir dir2 +mode-rwx-all+)
186     (sb-posix:chmod dir 0)
187     (handler-case
188         (sb-posix:rmdir dir2)
189       (sb-posix:syscall-error (c)
190         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
191         (sb-posix:rmdir dir2)
192         (sb-posix:rmdir dir)
193         (sb-posix:syscall-errno c))
194       (:no-error (result)
195         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
196         (sb-posix:rmdir dir)
197         result)))
198   #.sb-posix::eacces)
199 \f
200 (deftest stat.1
201   (let* ((stat (sb-posix:stat *test-directory*))
202          (mode (sb-posix::stat-mode stat)))
203     ;; FIXME: Ugly ::s everywhere
204     (logand mode (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)))
205   #.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
206
207 (deftest stat.2
208   (let* ((stat (sb-posix:stat "/"))
209          (mode (sb-posix::stat-mode stat)))
210     ;; it's logically possible for / to be writeable by others... but
211     ;; if it is, either someone is playing with strange security
212     ;; modules or they want to know about it anyway.
213     (logand mode sb-posix::s-iwoth))
214   0)
215
216 (deftest stat.3
217   (let* ((now (get-universal-time))
218          ;; FIXME: (encode-universal-time 00 00 00 01 01 1970)
219          (unix-now (- now 2208988800))
220          (stat (sb-posix:stat *test-directory*))
221          (atime (sb-posix::stat-atime stat)))
222     ;; FIXME: breaks if mounted noatime :-(
223     (< (- atime unix-now) 10))
224   t)
225
226 (deftest stat.4
227   (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up))))
228          (mode (sb-posix::stat-mode stat)))
229     ;; it's logically possible for / to be writeable by others... but
230     ;; if it is, either someone is playing with strange security
231     ;; modules or they want to know about it anyway.
232     (logand mode sb-posix::s-iwoth))
233   0)
234
235 ;;; FIXME: add tests for carrying a stat structure around in the
236 ;;; optional argument to SB-POSIX:STAT
237
238 (deftest stat.error.1
239   (handler-case (sb-posix:stat "")
240     (sb-posix:syscall-error (c)
241       (sb-posix:syscall-errno c)))
242   #.sb-posix::enoent)
243
244 (define-eacces-test stat.error.2
245   (let* ((dir (merge-pathnames
246                (make-pathname :directory '(:relative "stat.error.2"))
247                *test-directory*))
248          (file (merge-pathnames
249                 (make-pathname :name "unstatable")
250                 dir)))
251     (sb-posix:mkdir dir +mode-rwx-all+)
252     (with-open-file (s file :direction :output)
253       (write "" :stream s))
254     (sb-posix:chmod dir 0)
255     (handler-case
256         (sb-posix:stat file)
257       (sb-posix:syscall-error (c)
258         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
259         (sb-posix:unlink file)
260         (sb-posix:rmdir dir)
261         (sb-posix:syscall-errno c))
262       (:no-error (result)
263         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
264         (sb-posix:unlink file)
265         (sb-posix:rmdir dir)
266         result)))
267   #.sb-posix::eacces)
268 \f
269 ;;; stat-mode tests
270 (defmacro with-stat-mode ((mode pathname) &body body)
271   (let ((stat (gensym)))
272     `(let* ((,stat (sb-posix:stat ,pathname))
273             (,mode (sb-posix::stat-mode ,stat)))
274        ,@body)))
275
276 (defmacro with-lstat-mode ((mode pathname) &body body)
277   (let ((stat (gensym)))
278     `(let* ((,stat (sb-posix:lstat ,pathname))
279             (,mode (sb-posix::stat-mode ,stat)))
280        ,@body)))
281
282 (deftest stat-mode.1
283   (with-stat-mode (mode *test-directory*)
284     (sb-posix:s-isreg mode))
285   nil)
286
287 (deftest stat-mode.2
288   (with-stat-mode (mode *test-directory*)
289     (sb-posix:s-isdir mode))
290   t)
291
292 (deftest stat-mode.3
293   (with-stat-mode (mode *test-directory*)
294     (sb-posix:s-ischr mode))
295   nil)
296
297 (deftest stat-mode.4
298   (with-stat-mode (mode *test-directory*)
299     (sb-posix:s-isblk mode))
300   nil)
301
302 (deftest stat-mode.5
303   (with-stat-mode (mode *test-directory*)
304     (sb-posix:s-isfifo mode))
305   nil)
306
307 (deftest stat-mode.6
308   (with-stat-mode (mode *test-directory*)
309     (sb-posix:s-issock mode))
310   nil)
311
312 (deftest stat-mode.7
313   (let ((link-pathname (make-pathname :name "stat-mode.7"
314                                       :defaults *test-directory*)))
315     (unwind-protect
316          (progn
317            (sb-posix:symlink *test-directory* link-pathname)
318            (with-lstat-mode (mode link-pathname)
319              (sb-posix:s-islnk mode)))
320       (ignore-errors (sb-posix:unlink link-pathname))))
321   t)
322
323 (deftest stat-mode.8
324   (let ((pathname (make-pathname :name "stat-mode.8"
325                                  :defaults *test-directory*)))
326     (unwind-protect
327          (progn
328            (with-open-file (out pathname :direction :output)
329              (write-line "test" out))
330            (with-stat-mode (mode pathname)
331              (sb-posix:s-isreg mode)))
332       (ignore-errors (delete-file pathname))))
333   t)
334 \f
335 ;;; see comment in filename's designator definition, in macros.lisp
336 (deftest filename-designator.1
337   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
338     ;; creat() with a string as argument
339     (sb-posix:creat file 0)
340     ;; if this test fails, it will probably be with
341     ;; "System call error 2 (No such file or directory)"
342     (let ((*default-pathname-defaults* *test-directory*))
343       (sb-posix:unlink (car (directory "*.txt")))))
344   0)
345 \f
346 (deftest open.1
347   (let ((fd (sb-posix:open *test-directory* sb-posix::o-rdonly)))
348     (ignore-errors (sb-posix:close fd))
349     (< fd 0))
350   nil)
351
352 (deftest open.error.1
353   (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly)
354     (sb-posix:syscall-error (c)
355       (sb-posix:syscall-errno c)))
356   #.sb-posix::eisdir)
357
358 #-(and x86-64 linux)
359 (deftest fcntl.1
360   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
361     (= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))
362   t)
363 ;; On AMD64/Linux O_LARGEFILE is always set, even though the whole
364 ;; flag makes no sense.
365 #+(and x86-64 linux)
366 (deftest fcntl.1
367   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
368     (/= 0 (logand (sb-posix:fcntl fd sb-posix::f-getfl)
369                   sb-posix::o-nonblock)))
370   t)
371
372 (deftest opendir.1
373   (let ((dir (sb-posix:opendir "/")))
374     (unwind-protect (sb-alien:null-alien dir)
375       (unless (sb-alien:null-alien dir)
376         (sb-posix:closedir dir))))
377   nil)
378
379 (deftest readdir.1
380   (let ((dir (sb-posix:opendir "/")))
381     (unwind-protect
382        (block dir-loop
383          (loop for dirent = (sb-posix:readdir dir)
384                until (sb-alien:null-alien dirent)
385                when (not (stringp (sb-posix:dirent-name dirent)))
386                  do (return-from dir-loop nil)
387                finally (return t)))
388       (sb-posix:closedir dir)))
389   t)