1.0.28.38: undefined warning and compilation unit summary tweaking

[sbcl.git] / contrib / sb-posix / posix-tests.lisp

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index 3b9b171..b3ce8a2 100644 (file)
--- 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)
@@ -698,7 +767,10 @@
           (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
@@ -725,3 +797,25 @@
       (values (equal "mktemp" (pathname-name 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")