X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=b3ce8a2352602108112190248bd69a914d92ed72;hb=007bcd5aac2f3a1e714563bd39f7a2db2d0bf7c2;hp=71f218c7461ea29666279828e7dfd5179068b3b6;hpb=30918f91c144b51c5c204427b2fd70d49b8d1407;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 71f218c..b3ce8a2 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -405,6 +405,7 @@ (ignore-errors (sb-posix:unlink name)))) nil) +#-hpux ; fix: cant handle c-vargs (deftest open.error.1 (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly) (sb-posix:syscall-error (c) @@ -414,20 +415,87 @@ #+win32 #.sb-posix:eacces) -#-(or (and x86-64 linux) win32) +#-(or (and x86-64 (or linux sunos)) win32) (deftest fcntl.1 (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock))) (= (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock)) t) ;; On AMD64/Linux O_LARGEFILE is always set, even though the whole ;; flag makes no sense. -#+(and x86-64 linux) +#+(and x86-64 (or linux sunos)) (deftest fcntl.1 (let ((fd (sb-posix:open "/dev/null" sb-posix::o-nonblock))) (/= 0 (logand (sb-posix:fcntl fd sb-posix::f-getfl) sb-posix::o-nonblock))) t) +#-(or hpux win32) ; fix: cant handle c-vargs +(deftest fcntl.flock.1 + (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) + (let ((flock (make-instance 'sb-posix:flock + :type sb-posix:f-wrlck + :whence sb-posix:seek-set + :start 0 :len 10)) + (pathname "fcntl.flock.1") + kid-status) + (catch 'test + (with-open-file (f pathname :direction :output) + (write-line "1234567890" f) + (assert (zerop (sb-posix:fcntl f sb-posix:f-setlk flock))) + (let ((pid (sb-posix:fork))) + (if (zerop pid) + (progn + (multiple-value-bind (nope error) + (ignore-errors (sb-posix:fcntl f sb-posix:f-setlk flock)) + (sb-ext:quit + :unix-status + (cond ((not (null nope)) 1) + ((= (sb-posix:syscall-errno error) sb-posix:eagain) + 42) + (t 86)) + :recklessly-p t #| don't delete the file |#))) + (progn + (setf kid-status + (sb-posix:wexitstatus + (nth-value + 1 (sb-posix:waitpid pid 0)))) + (throw 'test nil)))))) + kid-status)) + 42) + + +#-win32 +(deftest fcntl.flock.2 + (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) + (let ((flock (make-instance 'sb-posix:flock + :type sb-posix:f-wrlck + :whence sb-posix:seek-set + :start 0 :len 10)) + (pathname "fcntl.flock.2") + kid-status) + (catch 'test + (with-open-file (f pathname :direction :output) + (write-line "1234567890" f) + (assert (zerop (sb-posix:fcntl f sb-posix:f-setlk flock))) + (let ((ppid (sb-posix:getpid)) + (pid (sb-posix:fork))) + (if (zerop pid) + (let ((r (sb-posix:fcntl f sb-posix:f-getlk flock))) + (sb-ext:quit + :unix-status + (cond ((not (zerop r)) 1) + ((= (sb-posix:flock-pid flock) ppid) 42) + (t 86)) + :recklessly-p t #| don't delete the file |#)) + (progn + (setf kid-status + (sb-posix:wexitstatus + (nth-value + 1 (sb-posix:waitpid pid 0)))) + (throw 'test nil)))))) + kid-status)) + 42) + (deftest opendir.1 (let ((dir (sb-posix:opendir "/"))) (unwind-protect (sb-alien:null-alien dir) @@ -576,6 +644,7 @@ ;; Same thing, but with a very long link target (which doesn't have ;; to exist). This tests the array adjustment in the wrapper, ;; provided that the target's length is long enough. + #-hpux ; arg2 to readlink is 80, and arg0 is larger than that (deftest readlink.2 (let ((target-pathname (make-pathname :name (make-string 255 :initial-element #\a) @@ -690,7 +759,7 @@ (multiple-value-bind (fd temp) (sb-posix:mkstemp (make-pathname :name "mkstemp-1" - :type "XXX" + :type "XXXXXX" :defaults *test-directory*)) (let ((pathname (sb-ext:parse-native-namestring temp))) (unwind-protect @@ -698,13 +767,16 @@ (delete-file temp)))) t "mkstemp-1") -#-win32 +;#-(or win32 sunos hpux) +;;;; mkdtemp is unimplemented on at least Solaris 10 +#-(or win32 hpux) +;;; But it is implemented on OpenSolaris 2008.11 (deftest mkdtemp.1 (let ((pathname (sb-ext:parse-native-namestring (sb-posix:mkdtemp (make-pathname :name "mkdtemp-1" - :type "XXX" + :type "XXXXXX" :defaults *test-directory*)) nil *default-pathname-defaults* @@ -721,7 +793,29 @@ #-win32 (deftest mktemp.1 (let ((pathname (sb-ext:parse-native-namestring - (sb-posix:mktemp #p"mktemp.XXX")))) + (sb-posix:mktemp #p"mktemp.XXXXXX")))) (values (equal "mktemp" (pathname-name pathname)) - (not (equal "XXX" (pathname-type pathname))))) + (not (equal "XXXXXX" (pathname-type pathname))))) t t) + +#-win32 +(deftest mkstemp.null-terminate + (let* ((default (make-pathname :directory '(:absolute "tmp"))) + (filename (namestring (make-pathname :name "mkstemp-1" + :type "XXXXXX" + :defaults default))) + ;; The magic 64 is the filename length that happens to + ;; trigger the no null termination bug at least on my + ;; machine on a certain build. + (n (- 64 (length (sb-ext:string-to-octets filename))))) + (multiple-value-bind (fd temp) + (sb-posix:mkstemp (make-pathname + :name "mkstemp-1" + :type (format nil "~AXXXXXX" + (make-string n :initial-element #\x)) + :defaults default)) + (let ((pathname (sb-ext:parse-native-namestring temp))) + (unwind-protect + (values (integerp fd) (pathname-name pathname)) + (delete-file temp))))) + t "mkstemp-1")