1.0.23.50: Less magic constants in the MIPS backend.
[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     #+nil (< (- atime unix-now) 10)
241     (< (- atime unix-now) 10))
242   t)
243
244 #-win32
245 (deftest stat.4
246   (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up))))
247          (mode (sb-posix::stat-mode stat)))
248     ;; it's logically possible for / to be writeable by others... but
249     ;; if it is, either someone is playing with strange security
250     ;; modules or they want to know about it anyway.
251     (logand mode sb-posix::s-iwoth))
252   0)
253
254 ;; Test that stat can take a second argument.
255 #-win32
256 (deftest stat.5
257     (let* ((stat-1 (sb-posix:stat "/"))
258            (inode-1 (sb-posix:stat-ino stat-1))
259            (stat-2 (sb-posix:stat "/bin/sh"
260                                    stat-1))
261            (inode-2 (sb-posix:stat-ino stat-2)))
262       (values
263        (eq stat-1 stat-2)
264        (/= inode-1 inode-2)))
265   t
266   t)
267
268 #+win32
269 (deftest stat.5
270     (let* ((stat-1 (sb-posix:stat "/"))
271            (mode-1 (sb-posix:stat-mode stat-1))
272            (stat-2 (sb-posix:stat "C:\\CONFIG.SYS"
273                                    stat-1))
274            (mode-2 (sb-posix:stat-mode stat-2)))
275       (values
276        (eq stat-1 stat-2)
277        (/= mode-1 mode-2)))
278   t
279   t)
280
281 ;;; FIXME: add tests for carrying a stat structure around in the
282 ;;; optional argument to SB-POSIX:STAT
283
284 (deftest stat.error.1
285   (handler-case (sb-posix:stat "")
286     (sb-posix:syscall-error (c)
287       (sb-posix:syscall-errno c)))
288   #.sb-posix::enoent)
289
290 (define-eacces-test stat.error.2
291   (let* ((dir (merge-pathnames
292                (make-pathname :directory '(:relative "stat.error.2"))
293                *test-directory*))
294          (file (merge-pathnames
295                 (make-pathname :name "unstatable")
296                 dir)))
297     (sb-posix:mkdir dir +mode-rwx-all+)
298     (with-open-file (s file :direction :output)
299       (write "" :stream s))
300     (sb-posix:chmod dir 0)
301     (handler-case
302         (sb-posix:stat file)
303       (sb-posix:syscall-error (c)
304         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
305         (sb-posix:unlink file)
306         (sb-posix:rmdir dir)
307         (sb-posix:syscall-errno c))
308       (:no-error (result)
309         (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))
310         (sb-posix:unlink file)
311         (sb-posix:rmdir dir)
312         result)))
313   #.sb-posix::eacces)
314 \f
315 ;;; stat-mode tests
316 (defmacro with-stat-mode ((mode pathname) &body body)
317   (let ((stat (gensym)))
318     `(let* ((,stat (sb-posix:stat ,pathname))
319             (,mode (sb-posix::stat-mode ,stat)))
320        ,@body)))
321
322 (defmacro with-lstat-mode ((mode pathname) &body body)
323   (let ((stat (gensym)))
324     `(let* ((,stat (sb-posix:lstat ,pathname))
325             (,mode (sb-posix::stat-mode ,stat)))
326        ,@body)))
327
328 (deftest stat-mode.1
329   (with-stat-mode (mode *test-directory*)
330     (sb-posix:s-isreg mode))
331   nil)
332
333 (deftest stat-mode.2
334   (with-stat-mode (mode *test-directory*)
335     (sb-posix:s-isdir mode))
336   t)
337
338 (deftest stat-mode.3
339   (with-stat-mode (mode *test-directory*)
340     (sb-posix:s-ischr mode))
341   nil)
342
343 (deftest stat-mode.4
344   (with-stat-mode (mode *test-directory*)
345     (sb-posix:s-isblk mode))
346   nil)
347
348 (deftest stat-mode.5
349   (with-stat-mode (mode *test-directory*)
350     (sb-posix:s-isfifo mode))
351   nil)
352
353 #-win32
354 (deftest stat-mode.6
355   (with-stat-mode (mode *test-directory*)
356     (sb-posix:s-issock mode))
357   nil)
358
359 #-win32
360 (deftest stat-mode.7
361   (let ((link-pathname (make-pathname :name "stat-mode.7"
362                                       :defaults *test-directory*)))
363     (unwind-protect
364          (progn
365            (sb-posix:symlink *test-directory* link-pathname)
366            (with-lstat-mode (mode link-pathname)
367              (sb-posix:s-islnk mode)))
368       (ignore-errors (sb-posix:unlink link-pathname))))
369   t)
370
371 (deftest stat-mode.8
372   (let ((pathname (make-pathname :name "stat-mode.8"
373                                  :defaults *test-directory*)))
374     (unwind-protect
375          (progn
376            (with-open-file (out pathname :direction :output)
377              (write-line "test" out))
378            (with-stat-mode (mode pathname)
379              (sb-posix:s-isreg mode)))
380       (ignore-errors (delete-file pathname))))
381   t)
382 \f
383 ;;; see comment in filename's designator definition, in macros.lisp
384 (deftest filename-designator.1
385   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
386     ;; creat() with a string as argument
387     (let ((fd (sb-posix:creat file sb-posix:s-iwrite)))
388       #+win32
389       (sb-posix:close fd))
390     ;; if this test fails, it will probably be with
391     ;; "System call error 2 (No such file or directory)"
392     (let ((*default-pathname-defaults* *test-directory*))
393       (sb-posix:unlink (car (directory "*.txt")))))
394   0)
395 \f
396 (deftest open.1
397     (let ((name (merge-pathnames "open-test.txt" *test-directory*)))
398       (unwind-protect
399            (progn
400              (sb-posix:close
401               (sb-posix:creat name (logior sb-posix:s-iwrite sb-posix:s-iread)))
402              (let ((fd (sb-posix:open name sb-posix::o-rdonly)))
403                (ignore-errors (sb-posix:close fd))
404                (< fd 0)))
405         (ignore-errors (sb-posix:unlink name))))
406   nil)
407
408 (deftest open.error.1
409   (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly)
410     (sb-posix:syscall-error (c)
411       (sb-posix:syscall-errno c)))
412   #-win32
413   #.sb-posix::eisdir
414   #+win32
415   #.sb-posix:eacces)
416
417 #-(or (and x86-64 linux) win32)
418 (deftest fcntl.1
419   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
420     (= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))
421   t)
422 ;; On AMD64/Linux O_LARGEFILE is always set, even though the whole
423 ;; flag makes no sense.
424 #+(and x86-64 linux)
425 (deftest fcntl.1
426   (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock)))
427     (/= 0 (logand (sb-posix:fcntl fd sb-posix::f-getfl)
428                   sb-posix::o-nonblock)))
429   t)
430
431 #-win32
432 (deftest fcntl.flock.1
433     (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
434       (let ((flock (make-instance 'sb-posix:flock
435                       :type sb-posix:f-wrlck
436                       :whence sb-posix:seek-set
437                       :start 0 :len 10))
438             (pathname "fcntl.flock.1")
439             kid-status)
440         (catch 'test
441           (with-open-file (f pathname :direction :output)
442             (write-line "1234567890" f)
443             (assert (zerop (sb-posix:fcntl f sb-posix:f-setlk flock)))
444             (let ((pid (sb-posix:fork)))
445               (if (zerop pid)
446                   (progn
447                     (multiple-value-bind (nope error)
448                         (ignore-errors (sb-posix:fcntl f sb-posix:f-setlk flock))
449                       (sb-ext:quit
450                        :unix-status
451                        (cond ((not (null nope)) 1)
452                              ((= (sb-posix:syscall-errno error) sb-posix:eagain)
453                               42)
454                              (t 86))
455                        :recklessly-p t #| don't delete the file |#)))
456                   (progn
457                     (setf kid-status
458                           (sb-posix:wexitstatus
459                            (nth-value
460                             1 (sb-posix:waitpid pid 0))))
461                     (throw 'test nil))))))
462         kid-status))
463   42)
464
465
466 #-win32
467 (deftest fcntl.flock.2
468     (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note))
469       (let ((flock (make-instance 'sb-posix:flock
470                       :type sb-posix:f-wrlck
471                       :whence sb-posix:seek-set
472                       :start 0 :len 10))
473             (pathname "fcntl.flock.2")
474             kid-status)
475         (catch 'test
476           (with-open-file (f pathname :direction :output)
477             (write-line "1234567890" f)
478             (assert (zerop (sb-posix:fcntl f sb-posix:f-setlk flock)))
479             (let ((ppid (sb-posix:getpid))
480                   (pid (sb-posix:fork)))
481               (if (zerop pid)
482                   (let ((r (sb-posix:fcntl f sb-posix:f-getlk flock)))
483                     (sb-ext:quit
484                      :unix-status
485                      (cond ((not (zerop r)) 1)
486                            ((= (sb-posix:flock-pid flock) ppid) 42)
487                            (t 86))
488                      :recklessly-p t #| don't delete the file |#))
489                   (progn
490                     (setf kid-status
491                           (sb-posix:wexitstatus
492                            (nth-value
493                             1 (sb-posix:waitpid pid 0))))
494                     (throw 'test nil))))))
495         kid-status))
496   42)
497
498 (deftest opendir.1
499   (let ((dir (sb-posix:opendir "/")))
500     (unwind-protect (sb-alien:null-alien dir)
501       (unless (sb-alien:null-alien dir)
502         (sb-posix:closedir dir))))
503   nil)
504
505 (deftest readdir.1
506   (let ((dir (sb-posix:opendir "/")))
507     (unwind-protect
508        (block dir-loop
509          (loop for dirent = (sb-posix:readdir dir)
510                until (sb-alien:null-alien dirent)
511                when (not (stringp (sb-posix:dirent-name dirent)))
512                  do (return-from dir-loop nil)
513                finally (return t)))
514       (sb-posix:closedir dir)))
515   t)
516
517 (deftest readdir/dirent-name
518     (let ((dir (sb-posix:opendir *current-directory*)))
519       (unwind-protect
520            (equal (sort (loop for entry = (sb-posix:readdir dir)
521                            until (sb-alien:null-alien entry)
522                            collect (sb-posix:dirent-name entry))
523                         #'string<)
524                   (sort (append '("." "..")
525                                 (mapcar (lambda (p)
526                                           (let ((string (enough-namestring p *current-directory*)))
527                                             (if (pathname-name p)
528                                                 string
529                                                 (subseq string 0 (1- (length string))))))
530                                         (directory (make-pathname
531                                                     :name :wild
532                                                     :type :wild
533                                                     :defaults *current-directory*))))
534                         #'string<))
535         (sb-posix:closedir dir)))
536   t)
537
538 #-win32
539 (deftest pwent.1
540   ;; make sure that we found something
541   (not (sb-posix:getpwuid 0))
542   nil)
543
544 #-win32
545 (deftest pwent.2
546   ;; make sure that we found something
547   (not (sb-posix:getpwnam "root"))
548   nil)
549
550 #-win32
551 (deftest pwent.non-existing
552     ;; make sure that we get something sensible, not an error
553     (handler-case (progn (sb-posix:getpwnam "almost-certainly-does-not-exist")
554                          nil)
555       (t (cond) t))
556   nil)
557
558 #-win32
559 (deftest grent.1
560   ;; make sure that we found something
561   (not (sb-posix:getgrgid 0))
562   nil)
563
564 #-win32
565 (deftest grent.2
566   ;; make sure that we found something
567   (not (sb-posix:getgrnam "sys"))
568   nil)
569
570 #-win32
571 (deftest grent.non-existing
572     ;; make sure that we get something sensible, not an error
573     (handler-case (progn (sb-posix:getgrnam "almost-certainly-does-not-exist")
574                          nil)
575       (t (cond) t))
576   nil)
577
578 #+nil
579 ;; Requires root or special group + plus a sensible thing on the port
580 (deftest cfget/setispeed.1
581     (with-open-file (s "/dev/ttyS0")
582       (let* ((termios (sb-posix:tcgetattr s))
583              (old (sb-posix:cfgetispeed termios))
584              (new (if (= old sb-posix:b2400)
585                       sb-posix:b9600
586                       sb-posix:b2400)))
587         (sb-posix:cfsetispeed new termios)
588         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
589         (setf termios (sb-posix:tcgetattr s))
590         (= new (sb-posix:cfgetispeed termios))))
591   t)
592
593 #+nil
594 ;; Requires root or special group + a sensible thing on the port
595 (deftest cfget/setospeed.1
596     (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append)
597       (let* ((termios (sb-posix:tcgetattr s))
598              (old (sb-posix:cfgetospeed termios))
599              (new (if (= old sb-posix:b2400)
600                       sb-posix:b9600
601                       sb-posix:b2400)))
602         (sb-posix:cfsetospeed new termios)
603         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
604         (setf termios (sb-posix:tcgetattr 0))
605         (= new (sb-posix:cfgetospeed termios))))
606   t)
607
608
609 #-win32
610 (deftest time.1
611     (plusp (sb-posix:time))
612   t)
613
614 #-win32
615 (deftest utimes.1
616     (let ((file (merge-pathnames #p"utimes.1" *test-directory*))
617           (atime (random (1- (expt 2 31))))
618           (mtime (random (1- (expt 2 31)))))
619       (with-open-file (stream file
620                        :direction :output
621                        :if-exists :supersede
622                        :if-does-not-exist :create)
623         (princ "Hello, utimes" stream))
624       (sb-posix:utime file atime mtime)
625       (let* ((stat (sb-posix:stat file)))
626         (delete-file file)
627         (list (= (sb-posix:stat-atime stat) atime)
628               (= (sb-posix:stat-mtime stat) mtime))))
629   (t t))
630 \f
631 ;; readlink tests.
632 #-win32
633 (progn
634   (deftest readlink.1
635       (let ((link-pathname (make-pathname :name "readlink.1"
636                                           :defaults *test-directory*)))
637         (sb-posix:symlink "/" link-pathname)
638         (unwind-protect
639              (sb-posix:readlink link-pathname)
640           (ignore-errors (sb-posix:unlink link-pathname))))
641     "/")
642
643   ;; Same thing, but with a very long link target (which doesn't have
644   ;; to exist).  This tests the array adjustment in the wrapper,
645   ;; provided that the target's length is long enough.
646   (deftest readlink.2
647       (let ((target-pathname (make-pathname
648                               :name (make-string 255 :initial-element #\a)
649                               :directory '(:absolute)))
650             (link-pathname (make-pathname :name "readlink.2"
651                                           :defaults *test-directory*)))
652         (sb-posix:symlink target-pathname link-pathname)
653         (unwind-protect
654              (sb-posix:readlink link-pathname)
655           (ignore-errors (sb-posix:unlink link-pathname))))
656     #.(concatenate 'string "/" (make-string 255 :initial-element #\a)))
657
658   ;; The error tests are in the order of exposition from SUSv3.
659   (deftest readlink.error.1
660       (let* ((subdir-pathname (merge-pathnames
661                                (make-pathname
662                                 :directory '(:relative "readlink.error.1"))
663                                *test-directory*))
664              (link-pathname (make-pathname :name "readlink.error.1"
665                                            :defaults subdir-pathname)))
666         (sb-posix:mkdir subdir-pathname #o777)
667         (sb-posix:symlink "/" link-pathname)
668         (sb-posix:chmod subdir-pathname 0)
669         (unwind-protect
670              (handler-case (sb-posix:readlink link-pathname)
671                (sb-posix:syscall-error (c)
672                  (sb-posix:syscall-errno c)))
673           (ignore-errors
674             (sb-posix:chmod subdir-pathname #o777)
675             (sb-posix:unlink link-pathname)
676             (sb-posix:rmdir subdir-pathname))))
677     #.sb-posix:eacces)
678   (deftest readlink.error.2
679       (let* ((non-link-pathname (make-pathname :name "readlink.error.2"
680                                                :defaults *test-directory*))
681              (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
682         (unwind-protect
683              (handler-case (sb-posix:readlink non-link-pathname)
684                (sb-posix:syscall-error (c)
685                  (sb-posix:syscall-errno c)))
686           (ignore-errors
687             (sb-posix:close fd)
688             (sb-posix:unlink non-link-pathname))))
689     #.sb-posix:einval)
690   ;; Skipping EIO, ELOOP
691   (deftest readlink.error.3
692       (let* ((link-pathname (make-pathname :name "readlink.error.3"
693                                            :defaults *test-directory*))
694              (bogus-pathname (merge-pathnames
695                               (make-pathname
696                                :name "bogus"
697                                :directory '(:relative "readlink.error.3"))
698                                *test-directory*)))
699         (sb-posix:symlink link-pathname link-pathname)
700         (unwind-protect
701              (handler-case (sb-posix:readlink bogus-pathname)
702                (sb-posix:syscall-error (c)
703                  (sb-posix:syscall-errno c)))
704           (ignore-errors (sb-posix:unlink link-pathname))))
705     #.sb-posix:eloop)
706   ;; Note: PATH_MAX and NAME_MAX need not be defined, and may vary, so
707   ;; failure of this test is not too meaningful.
708   (deftest readlink.error.4
709       (let ((pathname
710              (make-pathname :name (make-string 257 ;NAME_MAX plus some, maybe
711                                                :initial-element #\a))))
712         (handler-case (sb-posix:readlink pathname)
713           (sb-posix:syscall-error (c)
714             (sb-posix:syscall-errno c))))
715     #.sb-posix:enametoolong)
716   (deftest readlink.error.5
717       (let ((string (format nil "~v{/A~}" 2049 ;PATH_MAX/2 plus some, maybe
718                                           '(x))))
719         (handler-case (sb-posix:readlink string)
720           (sb-posix:syscall-error (c)
721             (sb-posix:syscall-errno c))))
722     #.sb-posix:enametoolong)
723     (deftest readlink.error.6
724       (let ((no-such-pathname (make-pathname :name "readlink.error.6"
725                                              :defaults *test-directory*)))
726         (handler-case (sb-posix:readlink no-such-pathname)
727           (sb-posix:syscall-error (c)
728             (sb-posix:syscall-errno c))))
729     #.sb-posix:enoent)
730   (deftest readlink.error.7
731       (let* ((non-link-pathname (make-pathname :name "readlink.error.7"
732                                                :defaults *test-directory*))
733              (impossible-pathname (merge-pathnames
734                                    (make-pathname
735                                     :directory
736                                     '(:relative "readlink.error.7")
737                                     :name "readlink.error.7")
738                                    *test-directory*))
739              (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
740         (unwind-protect
741              (handler-case (sb-posix:readlink impossible-pathname)
742                (sb-posix:syscall-error (c)
743                  (sb-posix:syscall-errno c)))
744           (ignore-errors
745             (sb-posix:close fd)
746             (sb-posix:unlink non-link-pathname))))
747     #.sb-posix:enotdir)
748   )
749
750 (deftest getcwd.1
751     ;; FIXME: something saner, please
752     (equal (sb-unix::posix-getcwd) (sb-posix:getcwd))
753   t)
754
755 #-win32
756 (deftest mkstemp.1
757     (multiple-value-bind (fd temp)
758         (sb-posix:mkstemp (make-pathname
759                            :name "mkstemp-1"
760                            :type "XXXXXX"
761                            :defaults *test-directory*))
762       (let ((pathname (sb-ext:parse-native-namestring temp)))
763         (unwind-protect
764              (values (integerp fd) (pathname-name pathname))
765           (delete-file temp))))
766   t "mkstemp-1")
767
768 #-(or win32 sunos)
769 ;;; mkdtemp is unimplemented on at least Solaris 10
770 (deftest mkdtemp.1
771     (let ((pathname
772            (sb-ext:parse-native-namestring
773             (sb-posix:mkdtemp (make-pathname
774                                :name "mkdtemp-1"
775                                :type "XXXXXX"
776                                :defaults *test-directory*))
777             nil
778             *default-pathname-defaults*
779             :as-directory t)))
780       (unwind-protect
781            (values (let* ((xxx (car (last (pathname-directory pathname))))
782                           (p (position #\. xxx)))
783                      (and p (subseq xxx 0 p)))
784                    (pathname-name pathname)
785                    (pathname-type pathname))
786         (sb-posix:rmdir pathname)))
787   "mkdtemp-1" nil nil)
788
789 #-win32
790 (deftest mktemp.1
791     (let ((pathname (sb-ext:parse-native-namestring
792                      (sb-posix:mktemp #p"mktemp.XXXXXX"))))
793       (values (equal "mktemp" (pathname-name pathname))
794               (not (equal "XXXXXX" (pathname-type pathname)))))
795   t t)
796
797 #-win32
798 (deftest mkstemp.null-terminate
799     (let* ((default (make-pathname :directory '(:absolute "tmp")))
800            (filename (namestring (make-pathname :name "mkstemp-1"
801                                                 :type "XXXXXX"
802                                                 :defaults default)))
803            ;; The magic 64 is the filename length that happens to
804            ;; trigger the no null termination bug at least on my
805            ;; machine on a certain build.
806            (n (- 64 (length (sb-ext:string-to-octets filename)))))
807       (multiple-value-bind (fd temp)
808           (sb-posix:mkstemp (make-pathname
809                              :name "mkstemp-1"
810                              :type (format nil "~AXXXXXX"
811                                            (make-string n :initial-element #\x))
812                              :defaults default))
813         (let ((pathname (sb-ext:parse-native-namestring temp)))
814           (unwind-protect
815                (values (integerp fd) (pathname-name pathname))
816             (delete-file temp)))))
817   t "mkstemp-1")