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