71f218c7461ea29666279828e7dfd5179068b3b6
[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 (deftest opendir.1
432   (let ((dir (sb-posix:opendir "/")))
433     (unwind-protect (sb-alien:null-alien dir)
434       (unless (sb-alien:null-alien dir)
435         (sb-posix:closedir dir))))
436   nil)
437
438 (deftest readdir.1
439   (let ((dir (sb-posix:opendir "/")))
440     (unwind-protect
441        (block dir-loop
442          (loop for dirent = (sb-posix:readdir dir)
443                until (sb-alien:null-alien dirent)
444                when (not (stringp (sb-posix:dirent-name dirent)))
445                  do (return-from dir-loop nil)
446                finally (return t)))
447       (sb-posix:closedir dir)))
448   t)
449
450 (deftest readdir/dirent-name
451     (let ((dir (sb-posix:opendir *current-directory*)))
452       (unwind-protect
453            (equal (sort (loop for entry = (sb-posix:readdir dir)
454                            until (sb-alien:null-alien entry)
455                            collect (sb-posix:dirent-name entry))
456                         #'string<)
457                   (sort (append '("." "..")
458                                 (mapcar (lambda (p)
459                                           (let ((string (enough-namestring p *current-directory*)))
460                                             (if (pathname-name p)
461                                                 string
462                                                 (subseq string 0 (1- (length string))))))
463                                         (directory (make-pathname
464                                                     :name :wild
465                                                     :type :wild
466                                                     :defaults *current-directory*))))
467                         #'string<))
468         (sb-posix:closedir dir)))
469   t)
470
471 #-win32
472 (deftest pwent.1
473   ;; make sure that we found something
474   (not (sb-posix:getpwuid 0))
475   nil)
476
477 #-win32
478 (deftest pwent.2
479   ;; make sure that we found something
480   (not (sb-posix:getpwnam "root"))
481   nil)
482
483 #-win32
484 (deftest pwent.non-existing
485     ;; make sure that we get something sensible, not an error
486     (handler-case (progn (sb-posix:getpwnam "almost-certainly-does-not-exist")
487                          nil)
488       (t (cond) t))
489   nil)
490
491 #-win32
492 (deftest grent.1
493   ;; make sure that we found something
494   (not (sb-posix:getgrgid 0))
495   nil)
496
497 #-win32
498 (deftest grent.2
499   ;; make sure that we found something
500   (not (sb-posix:getgrnam "sys"))
501   nil)
502
503 #-win32
504 (deftest grent.non-existing
505     ;; make sure that we get something sensible, not an error
506     (handler-case (progn (sb-posix:getgrnam "almost-certainly-does-not-exist")
507                          nil)
508       (t (cond) t))
509   nil)
510
511 #+nil
512 ;; Requires root or special group + plus a sensible thing on the port
513 (deftest cfget/setispeed.1
514     (with-open-file (s "/dev/ttyS0")
515       (let* ((termios (sb-posix:tcgetattr s))
516              (old (sb-posix:cfgetispeed termios))
517              (new (if (= old sb-posix:b2400)
518                       sb-posix:b9600
519                       sb-posix:b2400)))
520         (sb-posix:cfsetispeed new termios)
521         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
522         (setf termios (sb-posix:tcgetattr s))
523         (= new (sb-posix:cfgetispeed termios))))
524   t)
525
526 #+nil
527 ;; Requires root or special group + a sensible thing on the port
528 (deftest cfget/setospeed.1
529     (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append)
530       (let* ((termios (sb-posix:tcgetattr s))
531              (old (sb-posix:cfgetospeed termios))
532              (new (if (= old sb-posix:b2400)
533                       sb-posix:b9600
534                       sb-posix:b2400)))
535         (sb-posix:cfsetospeed new termios)
536         (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios)
537         (setf termios (sb-posix:tcgetattr 0))
538         (= new (sb-posix:cfgetospeed termios))))
539   t)
540
541
542 #-win32
543 (deftest time.1
544     (plusp (sb-posix:time))
545   t)
546
547 #-win32
548 (deftest utimes.1
549     (let ((file (merge-pathnames #p"utimes.1" *test-directory*))
550           (atime (random (1- (expt 2 31))))
551           (mtime (random (1- (expt 2 31)))))
552       (with-open-file (stream file
553                        :direction :output
554                        :if-exists :supersede
555                        :if-does-not-exist :create)
556         (princ "Hello, utimes" stream))
557       (sb-posix:utime file atime mtime)
558       (let* ((stat (sb-posix:stat file)))
559         (delete-file file)
560         (list (= (sb-posix:stat-atime stat) atime)
561               (= (sb-posix:stat-mtime stat) mtime))))
562   (t t))
563 \f
564 ;; readlink tests.
565 #-win32
566 (progn
567   (deftest readlink.1
568       (let ((link-pathname (make-pathname :name "readlink.1"
569                                           :defaults *test-directory*)))
570         (sb-posix:symlink "/" link-pathname)
571         (unwind-protect
572              (sb-posix:readlink link-pathname)
573           (ignore-errors (sb-posix:unlink link-pathname))))
574     "/")
575
576   ;; Same thing, but with a very long link target (which doesn't have
577   ;; to exist).  This tests the array adjustment in the wrapper,
578   ;; provided that the target's length is long enough.
579   (deftest readlink.2
580       (let ((target-pathname (make-pathname
581                               :name (make-string 255 :initial-element #\a)
582                               :directory '(:absolute)))
583             (link-pathname (make-pathname :name "readlink.2"
584                                           :defaults *test-directory*)))
585         (sb-posix:symlink target-pathname link-pathname)
586         (unwind-protect
587              (sb-posix:readlink link-pathname)
588           (ignore-errors (sb-posix:unlink link-pathname))))
589     #.(concatenate 'string "/" (make-string 255 :initial-element #\a)))
590
591   ;; The error tests are in the order of exposition from SUSv3.
592   (deftest readlink.error.1
593       (let* ((subdir-pathname (merge-pathnames
594                                (make-pathname
595                                 :directory '(:relative "readlink.error.1"))
596                                *test-directory*))
597              (link-pathname (make-pathname :name "readlink.error.1"
598                                            :defaults subdir-pathname)))
599         (sb-posix:mkdir subdir-pathname #o777)
600         (sb-posix:symlink "/" link-pathname)
601         (sb-posix:chmod subdir-pathname 0)
602         (unwind-protect
603              (handler-case (sb-posix:readlink link-pathname)
604                (sb-posix:syscall-error (c)
605                  (sb-posix:syscall-errno c)))
606           (ignore-errors
607             (sb-posix:chmod subdir-pathname #o777)
608             (sb-posix:unlink link-pathname)
609             (sb-posix:rmdir subdir-pathname))))
610     #.sb-posix:eacces)
611   (deftest readlink.error.2
612       (let* ((non-link-pathname (make-pathname :name "readlink.error.2"
613                                                :defaults *test-directory*))
614              (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
615         (unwind-protect
616              (handler-case (sb-posix:readlink non-link-pathname)
617                (sb-posix:syscall-error (c)
618                  (sb-posix:syscall-errno c)))
619           (ignore-errors
620             (sb-posix:close fd)
621             (sb-posix:unlink non-link-pathname))))
622     #.sb-posix:einval)
623   ;; Skipping EIO, ELOOP
624   (deftest readlink.error.3
625       (let* ((link-pathname (make-pathname :name "readlink.error.3"
626                                            :defaults *test-directory*))
627              (bogus-pathname (merge-pathnames
628                               (make-pathname
629                                :name "bogus"
630                                :directory '(:relative "readlink.error.3"))
631                                *test-directory*)))
632         (sb-posix:symlink link-pathname link-pathname)
633         (unwind-protect
634              (handler-case (sb-posix:readlink bogus-pathname)
635                (sb-posix:syscall-error (c)
636                  (sb-posix:syscall-errno c)))
637           (ignore-errors (sb-posix:unlink link-pathname))))
638     #.sb-posix:eloop)
639   ;; Note: PATH_MAX and NAME_MAX need not be defined, and may vary, so
640   ;; failure of this test is not too meaningful.
641   (deftest readlink.error.4
642       (let ((pathname
643              (make-pathname :name (make-string 257 ;NAME_MAX plus some, maybe
644                                                :initial-element #\a))))
645         (handler-case (sb-posix:readlink pathname)
646           (sb-posix:syscall-error (c)
647             (sb-posix:syscall-errno c))))
648     #.sb-posix:enametoolong)
649   (deftest readlink.error.5
650       (let ((string (format nil "~v{/A~}" 2049 ;PATH_MAX/2 plus some, maybe
651                                           '(x))))
652         (handler-case (sb-posix:readlink string)
653           (sb-posix:syscall-error (c)
654             (sb-posix:syscall-errno c))))
655     #.sb-posix:enametoolong)
656     (deftest readlink.error.6
657       (let ((no-such-pathname (make-pathname :name "readlink.error.6"
658                                              :defaults *test-directory*)))
659         (handler-case (sb-posix:readlink no-such-pathname)
660           (sb-posix:syscall-error (c)
661             (sb-posix:syscall-errno c))))
662     #.sb-posix:enoent)
663   (deftest readlink.error.7
664       (let* ((non-link-pathname (make-pathname :name "readlink.error.7"
665                                                :defaults *test-directory*))
666              (impossible-pathname (merge-pathnames
667                                    (make-pathname
668                                     :directory
669                                     '(:relative "readlink.error.7")
670                                     :name "readlink.error.7")
671                                    *test-directory*))
672              (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
673         (unwind-protect
674              (handler-case (sb-posix:readlink impossible-pathname)
675                (sb-posix:syscall-error (c)
676                  (sb-posix:syscall-errno c)))
677           (ignore-errors
678             (sb-posix:close fd)
679             (sb-posix:unlink non-link-pathname))))
680     #.sb-posix:enotdir)
681   )
682
683 (deftest getcwd.1
684     ;; FIXME: something saner, please
685     (equal (sb-unix::posix-getcwd) (sb-posix:getcwd))
686   t)
687
688 #-win32
689 (deftest mkstemp.1
690     (multiple-value-bind (fd temp)
691         (sb-posix:mkstemp (make-pathname
692                            :name "mkstemp-1"
693                            :type "XXX"
694                            :defaults *test-directory*))
695       (let ((pathname (sb-ext:parse-native-namestring temp)))
696         (unwind-protect
697              (values (integerp fd) (pathname-name pathname))
698           (delete-file temp))))
699   t "mkstemp-1")
700
701 #-win32
702 (deftest mkdtemp.1
703     (let ((pathname
704            (sb-ext:parse-native-namestring
705             (sb-posix:mkdtemp (make-pathname
706                                :name "mkdtemp-1"
707                                :type "XXX"
708                                :defaults *test-directory*))
709             nil
710             *default-pathname-defaults*
711             :as-directory t)))
712       (unwind-protect
713            (values (let* ((xxx (car (last (pathname-directory pathname))))
714                           (p (position #\. xxx)))
715                      (and p (subseq xxx 0 p)))
716                    (pathname-name pathname)
717                    (pathname-type pathname))
718         (sb-posix:rmdir pathname)))
719   "mkdtemp-1" nil nil)
720
721 #-win32
722 (deftest mktemp.1
723     (let ((pathname (sb-ext:parse-native-namestring
724                      (sb-posix:mktemp #p"mktemp.XXX"))))
725       (values (equal "mktemp" (pathname-name pathname))
726               (not (equal "XXX" (pathname-type pathname)))))
727   t t)