1.0.0.25: fix win32 build
[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 ;;; see comment in filename's designator definition, in macros.lisp
356 (deftest filename-designator.1
357   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
358     ;; creat() with a string as argument
359     (let ((fd (sb-posix:creat file sb-posix:s-iwrite)))
360       #+win32
361       (sb-posix:close fd))
362     ;; if this test fails, it will probably be with
363     ;; "System call error 2 (No such file or directory)"
364     (let ((*default-pathname-defaults* *test-directory*))
365       (sb-posix:unlink (car (directory "*.txt")))))
366   0)
367 \f
368 (deftest open.1
369     (let ((name (merge-pathnames "open-test.txt" *test-directory*)))
370       (unwind-protect
371            (progn
372              (sb-posix:close
373               (sb-posix:creat name (logior sb-posix:s-iwrite sb-posix:s-iread)))
374              (let ((fd (sb-posix:open name sb-posix::o-rdonly)))
375                (ignore-errors (sb-posix:close fd))
376                (< fd 0)))
377         (ignore-errors (sb-posix:unlink name))))
378   nil)
379
380 (deftest open.error.1
381   (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly)
382     (sb-posix:syscall-error (c)
383       (sb-posix:syscall-errno c)))
384   #-win32
385   #.sb-posix::eisdir
386   #+win32
387   #.sb-posix:eacces)
388
389 #-(or (and x86-64 linux) win32)
390 (deftest fcntl.1
391   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
392     (= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))
393   t)
394 ;; On AMD64/Linux O_LARGEFILE is always set, even though the whole
395 ;; flag makes no sense.
396 #+(and x86-64 linux)
397 (deftest fcntl.1
398   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
399     (/= 0 (logand (sb-posix:fcntl fd sb-posix::f-getfl)
400                   sb-posix::o-nonblock)))
401   t)
402
403 (deftest opendir.1
404   (let ((dir (sb-posix:opendir "/")))
405     (unwind-protect (sb-alien:null-alien dir)
406       (unless (sb-alien:null-alien dir)
407         (sb-posix:closedir dir))))
408   nil)
409
410 (deftest readdir.1
411   (let ((dir (sb-posix:opendir "/")))
412     (unwind-protect
413        (block dir-loop
414          (loop for dirent = (sb-posix:readdir dir)
415                until (sb-alien:null-alien dirent)
416                when (not (stringp (sb-posix:dirent-name dirent)))
417                  do (return-from dir-loop nil)
418                finally (return t)))
419       (sb-posix:closedir dir)))
420   t)
421
422 (deftest readdir/dirent-name
423     (let ((dir (sb-posix:opendir *current-directory*)))
424       (unwind-protect
425            (equal (sort (loop for entry = (sb-posix:readdir dir)
426                            until (sb-alien:null-alien entry)
427                            collect (sb-posix:dirent-name entry))
428                         #'string<)
429                   (sort (append '("." "..")
430                                 (mapcar (lambda (p)
431                                           (let ((string (enough-namestring p *current-directory*)))
432                                             (if (pathname-name p)
433                                                 string
434                                                 (subseq string 0 (1- (length string))))))
435                                         (directory (make-pathname
436                                                     :name :wild
437                                                     :type :wild
438                                                     :defaults *current-directory*))))
439                         #'string<))
440         (sb-posix:closedir dir)))
441   t)
442
443 #-win32
444 (deftest pwent.1
445   ;; make sure that we found something
446   (not (sb-posix:getpwuid 0))
447   nil)
448
449 #-win32
450 (deftest pwent.2
451   ;; make sure that we found something
452   (not (sb-posix:getpwnam "root"))
453   nil)
454
455 #+nil
456 ;; Requires root or special group + plus a sensible thing on the port
457 (deftest cfget/setispeed.1
458     (with-open-file (s "/dev/ttyS0")
459       (let* ((termios (sb-posix:tcgetattr s))
460              (old (sb-posix:cfgetispeed termios))
461              (new (if (= old sb-posix:b2400)
462                       sb-posix:b9600
463                       sb-posix:b2400)))
464         (sb-posix:cfsetispeed new termios)
465         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
466         (setf termios (sb-posix:tcgetattr s))
467         (= new (sb-posix:cfgetispeed termios))))
468   t)
469
470 #+nil
471 ;; Requires root or special group + a sensible thing on the port
472 (deftest cfget/setospeed.1
473     (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append)
474       (let* ((termios (sb-posix:tcgetattr s))
475              (old (sb-posix:cfgetospeed termios))
476              (new (if (= old sb-posix:b2400)
477                       sb-posix:b9600
478                       sb-posix:b2400)))
479         (sb-posix:cfsetospeed new termios)
480         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
481         (setf termios (sb-posix:tcgetattr 0))
482         (= new (sb-posix:cfgetospeed termios))))
483   t)
484
485
486 #-win32
487 (deftest time.1
488     (plusp (sb-posix:time))
489   t)
490
491 #-win32
492 (deftest utime.1
493     (let ((file (merge-pathnames #p"utime.1" *test-directory*))
494           (atime (random (1- (expt 2 31))))
495           (mtime (random (1- (expt 2 31)))))
496       (with-open-file (stream file
497                        :direction :output
498                        :if-exists :supersede
499                        :if-does-not-exist :create)
500         (princ "Hello, utime" stream))
501       (sb-posix:utime file atime mtime)
502       (let* ((stat (sb-posix:stat file)))
503         (delete-file file)
504         (list (= (sb-posix:stat-atime stat) atime)
505               (= (sb-posix:stat-mtime stat) mtime))))
506   (t t))
507
508 #-win32
509 (deftest utimes.1
510     (let ((file (merge-pathnames #p"utimes.1" *test-directory*))
511           (atime (random (1- (expt 2 31))))
512           (mtime (random (1- (expt 2 31)))))
513       (with-open-file (stream file
514                        :direction :output
515                        :if-exists :supersede
516                        :if-does-not-exist :create)
517         (princ "Hello, utimes" stream))
518       (sb-posix:utime file atime mtime)
519       (let* ((stat (sb-posix:stat file)))
520         (delete-file file)
521         (list (= (sb-posix:stat-atime stat) atime)
522               (= (sb-posix:stat-mtime stat) mtime))))
523   (t t))
524
525
526