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