1.0.15.2: Add binding to fcntl's struct flock in SB-POSIX.

[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 6d5caa1..5c4d01c 100644 (file)
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -252,6 +252,7 @@
   0)
 
 ;; Test that stat can take a second argument.
+#-win32
 (deftest stat.5
     (let* ((stat-1 (sb-posix:stat "/"))
            (inode-1 (sb-posix:stat-ino stat-1))
@@ -264,6 +265,19 @@
   t
   t)
 
+#+win32
+(deftest stat.5
+    (let* ((stat-1 (sb-posix:stat "/"))
+           (mode-1 (sb-posix:stat-mode stat-1))
+           (stat-2 (sb-posix:stat "C:\\CONFIG.SYS"
+                                   stat-1))
+           (mode-2 (sb-posix:stat-mode stat-2)))
+      (values
+       (eq stat-1 stat-2)
+       (/= mode-1 mode-2)))
+  t
+  t)
+
 ;;; FIXME: add tests for carrying a stat structure around in the
 ;;; optional argument to SB-POSIX:STAT
 
@@ -414,6 +428,71 @@
                   sb-posix::o-nonblock)))
   t)
 
+(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)
+
+
+(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)
@@ -670,3 +749,44 @@
     ;; FIXME: something saner, please
     (equal (sb-unix::posix-getcwd) (sb-posix:getcwd))
   t)
+
+#-win32
+(deftest mkstemp.1
+    (multiple-value-bind (fd temp)
+        (sb-posix:mkstemp (make-pathname
+                           :name "mkstemp-1"
+                           :type "XXXXXX"
+                           :defaults *test-directory*))
+      (let ((pathname (sb-ext:parse-native-namestring temp)))
+        (unwind-protect
+             (values (integerp fd) (pathname-name pathname))
+          (delete-file temp))))
+  t "mkstemp-1")
+
+#-win32
+(deftest mkdtemp.1
+    (let ((pathname
+           (sb-ext:parse-native-namestring
+            (sb-posix:mkdtemp (make-pathname
+                               :name "mkdtemp-1"
+                               :type "XXXXXX"
+                               :defaults *test-directory*))
+            nil
+            *default-pathname-defaults*
+            :as-directory t)))
+      (unwind-protect
+           (values (let* ((xxx (car (last (pathname-directory pathname))))
+                          (p (position #\. xxx)))
+                     (and p (subseq xxx 0 p)))
+                   (pathname-name pathname)
+                   (pathname-type pathname))
+        (sb-posix:rmdir pathname)))
+  "mkdtemp-1" nil nil)
+
+#-win32
+(deftest mktemp.1
+    (let ((pathname (sb-ext:parse-native-namestring
+                     (sb-posix:mktemp #p"mktemp.XXXXXX"))))
+      (values (equal "mktemp" (pathname-name pathname))
+              (not (equal "XXXXXX" (pathname-type pathname)))))
+  t t)