X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=5c4d01ca24b32a8702bc620733234d0013263470;hb=9fb8bf2eb2c91cbda313edaa3362ff8b221ab81d;hp=c228642047347bf0d47e1cab00e0970ad439d784;hpb=893a993c727cd08afcdb7f87b1344d8e85042841;p=sbcl.git

diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp
index c228642..5c4d01c 100644
--- a/contrib/sb-posix/posix-tests.lisp
+++ b/contrib/sb-posix/posix-tests.lisp
@@ -237,6 +237,7 @@
          (stat (sb-posix:stat *test-directory*))
          (atime (sb-posix::stat-atime stat)))
     ;; FIXME: breaks if mounted noatime :-(
+    #+nil (< (- atime unix-now) 10)
     (< (- atime unix-now) 10))
   t)
 
@@ -250,6 +251,33 @@
     (logand mode sb-posix::s-iwoth))
   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))
+           (stat-2 (sb-posix:stat "/bin/sh"
+                                   stat-1))
+           (inode-2 (sb-posix:stat-ino stat-2)))
+      (values
+       (eq stat-1 stat-2)
+       (/= inode-1 inode-2)))
+  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
 
@@ -352,7 +380,6 @@
       (ignore-errors (delete-file pathname))))
   t)
 
-(defvar *test-directory* (merge-pathnames "test-lab/"))
 ;;; see comment in filename's designator definition, in macros.lisp
 (deftest filename-designator.1
   (let ((file (format nil "~A/[foo].txt" (namestring *test-directory*))))
@@ -401,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)
@@ -420,6 +512,27 @@
       (sb-posix:closedir dir)))
   t)
 
+(deftest readdir/dirent-name
+    (let ((dir (sb-posix:opendir *current-directory*)))
+      (unwind-protect
+           (equal (sort (loop for entry = (sb-posix:readdir dir)
+                           until (sb-alien:null-alien entry)
+                           collect (sb-posix:dirent-name entry))
+                        #'string<)
+                  (sort (append '("." "..")
+                                (mapcar (lambda (p)
+                                          (let ((string (enough-namestring p *current-directory*)))
+                                            (if (pathname-name p)
+                                                string
+                                                (subseq string 0 (1- (length string))))))
+                                        (directory (make-pathname
+                                                    :name :wild
+                                                    :type :wild
+                                                    :defaults *current-directory*))))
+                        #'string<))
+        (sb-posix:closedir dir)))
+  t)
+
 #-win32
 (deftest pwent.1
   ;; make sure that we found something
@@ -432,6 +545,34 @@
   (not (sb-posix:getpwnam "root"))
   nil)
 
+#-win32
+(deftest pwent.non-existing
+    ;; make sure that we get something sensible, not an error
+    (handler-case (progn (sb-posix:getpwnam "almost-certainly-does-not-exist")
+                         nil)
+      (t (cond) t))
+  nil)
+
+#-win32
+(deftest grent.1
+  ;; make sure that we found something
+  (not (sb-posix:getgrgid 0))
+  nil)
+
+#-win32
+(deftest grent.2
+  ;; make sure that we found something
+  (not (sb-posix:getgrnam "sys"))
+  nil)
+
+#-win32
+(deftest grent.non-existing
+    ;; make sure that we get something sensible, not an error
+    (handler-case (progn (sb-posix:getgrnam "almost-certainly-does-not-exist")
+                         nil)
+      (t (cond) t))
+  nil)
+
 #+nil
 ;; Requires root or special group + plus a sensible thing on the port
 (deftest cfget/setispeed.1
@@ -469,23 +610,6 @@
   t)
 
 #-win32
-(deftest utime.1
-    (let ((file (merge-pathnames #p"utime.1" *test-directory*))
-          (atime (random (1- (expt 2 31))))
-          (mtime (random (1- (expt 2 31)))))
-      (with-open-file (stream file
-                       :direction :output
-                       :if-exists :supersede
-                       :if-does-not-exist :create)
-        (princ "Hello, utime" stream))
-      (sb-posix:utime file atime mtime)
-      (let* ((stat (sb-posix:stat file)))
-        (delete-file file)
-        (list (= (sb-posix:stat-atime stat) atime)
-              (= (sb-posix:stat-mtime stat) mtime))))
-  (t t))
-
-#-win32
 (deftest utimes.1
     (let ((file (merge-pathnames #p"utimes.1" *test-directory*))
           (atime (random (1- (expt 2 31))))
@@ -501,6 +625,168 @@
         (list (= (sb-posix:stat-atime stat) atime)
               (= (sb-posix:stat-mtime stat) mtime))))
   (t t))
+
+;; readlink tests.
+#-win32
+(progn
+  (deftest readlink.1
+      (let ((link-pathname (make-pathname :name "readlink.1"
+                                          :defaults *test-directory*)))
+        (sb-posix:symlink "/" link-pathname)
+        (unwind-protect
+             (sb-posix:readlink link-pathname)
+          (ignore-errors (sb-posix:unlink link-pathname))))
+    "/")
+
+  ;; 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.
+  (deftest readlink.2
+      (let ((target-pathname (make-pathname
+                              :name (make-string 255 :initial-element #\a)
+                              :directory '(:absolute)))
+            (link-pathname (make-pathname :name "readlink.2"
+                                          :defaults *test-directory*)))
+        (sb-posix:symlink target-pathname link-pathname)
+        (unwind-protect
+             (sb-posix:readlink link-pathname)
+          (ignore-errors (sb-posix:unlink link-pathname))))
+    #.(concatenate 'string "/" (make-string 255 :initial-element #\a)))
+
+  ;; The error tests are in the order of exposition from SUSv3.
+  (deftest readlink.error.1
+      (let* ((subdir-pathname (merge-pathnames
+                               (make-pathname
+                                :directory '(:relative "readlink.error.1"))
+                               *test-directory*))
+             (link-pathname (make-pathname :name "readlink.error.1"
+                                           :defaults subdir-pathname)))
+        (sb-posix:mkdir subdir-pathname #o777)
+        (sb-posix:symlink "/" link-pathname)
+        (sb-posix:chmod subdir-pathname 0)
+        (unwind-protect
+             (handler-case (sb-posix:readlink link-pathname)
+               (sb-posix:syscall-error (c)
+                 (sb-posix:syscall-errno c)))
+          (ignore-errors
+            (sb-posix:chmod subdir-pathname #o777)
+            (sb-posix:unlink link-pathname)
+            (sb-posix:rmdir subdir-pathname))))
+    #.sb-posix:eacces)
+  (deftest readlink.error.2
+      (let* ((non-link-pathname (make-pathname :name "readlink.error.2"
+                                               :defaults *test-directory*))
+             (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
+        (unwind-protect
+             (handler-case (sb-posix:readlink non-link-pathname)
+               (sb-posix:syscall-error (c)
+                 (sb-posix:syscall-errno c)))
+          (ignore-errors
+            (sb-posix:close fd)
+            (sb-posix:unlink non-link-pathname))))
+    #.sb-posix:einval)
+  ;; Skipping EIO, ELOOP
+  (deftest readlink.error.3
+      (let* ((link-pathname (make-pathname :name "readlink.error.3"
+                                           :defaults *test-directory*))
+             (bogus-pathname (merge-pathnames
+                              (make-pathname
+                               :name "bogus"
+                               :directory '(:relative "readlink.error.3"))
+                               *test-directory*)))
+        (sb-posix:symlink link-pathname link-pathname)
+        (unwind-protect
+             (handler-case (sb-posix:readlink bogus-pathname)
+               (sb-posix:syscall-error (c)
+                 (sb-posix:syscall-errno c)))
+          (ignore-errors (sb-posix:unlink link-pathname))))
+    #.sb-posix:eloop)
+  ;; Note: PATH_MAX and NAME_MAX need not be defined, and may vary, so
+  ;; failure of this test is not too meaningful.
+  (deftest readlink.error.4
+      (let ((pathname
+             (make-pathname :name (make-string 257 ;NAME_MAX plus some, maybe
+                                               :initial-element #\a))))
+        (handler-case (sb-posix:readlink pathname)
+          (sb-posix:syscall-error (c)
+            (sb-posix:syscall-errno c))))
+    #.sb-posix:enametoolong)
+  (deftest readlink.error.5
+      (let ((string (format nil "~v{/A~}" 2049 ;PATH_MAX/2 plus some, maybe
+                                          '(x))))
+        (handler-case (sb-posix:readlink string)
+          (sb-posix:syscall-error (c)
+            (sb-posix:syscall-errno c))))
+    #.sb-posix:enametoolong)
+    (deftest readlink.error.6
+      (let ((no-such-pathname (make-pathname :name "readlink.error.6"
+                                             :defaults *test-directory*)))
+        (handler-case (sb-posix:readlink no-such-pathname)
+          (sb-posix:syscall-error (c)
+            (sb-posix:syscall-errno c))))
+    #.sb-posix:enoent)
+  (deftest readlink.error.7
+      (let* ((non-link-pathname (make-pathname :name "readlink.error.7"
+                                               :defaults *test-directory*))
+             (impossible-pathname (merge-pathnames
+                                   (make-pathname
+                                    :directory
+                                    '(:relative "readlink.error.7")
+                                    :name "readlink.error.7")
+                                   *test-directory*))
+             (fd (sb-posix:open non-link-pathname sb-posix::o-creat)))
+        (unwind-protect
+             (handler-case (sb-posix:readlink impossible-pathname)
+               (sb-posix:syscall-error (c)
+                 (sb-posix:syscall-errno c)))
+          (ignore-errors
+            (sb-posix:close fd)
+            (sb-posix:unlink non-link-pathname))))
+    #.sb-posix:enotdir)
+  )
+
+(deftest getcwd.1
+    ;; 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)