X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=92fef5f6ef4fd24fdf4551058aa67b4a2c4ec6a0;hb=646a14a9099c3c6bbb60ff09f7fb6a781a030815;hp=02dee2be79648c8d17834b6ce820d258a0195780;hpb=0f234877047c56ca945fe54e9e77a9cc2c8141cb;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 02dee2b..92fef5f 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -235,8 +235,7 @@ ;; FIXME: (encode-universal-time 00 00 00 01 01 1970) (unix-now (- now 2208988800)) (stat (sb-posix:stat *test-directory*)) - #+darwin (atime (sb-alien:slot (sb-posix:stat-atime stat) 'sb-posix::tv-sec)) - #-darwin (atime (sb-posix::stat-atime stat))) + (atime (sb-posix::stat-atime stat))) ;; FIXME: breaks if mounted noatime :-( #+nil (< (- atime unix-now) 10) (< (- atime unix-now) 10)) @@ -252,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 @@ -402,6 +428,73 @@ sb-posix::o-nonblock))) t) +#-win32 +(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) @@ -454,6 +547,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 @@ -490,27 +611,7 @@ (plusp (sb-posix:time)) t) -;;; CLH: FIXME! For darwin atime and mtime return a timespec. This -;;; _should_ work, but it doesn't. For some reason mtime is always -;;; 0. Comment the mtime test out for the moment. -#+darwin -(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-alien:slot (sb-posix:stat-atime stat) 'sb-posix::tv-sec) atime) - #+nil (= (sb-alien:slot (sb-posix:stat-mtime stat) 'sb-posix::tv-sec) mtime)))) - (t #+nil t)) - -#-(or win32 darwin) +#-win32 (deftest utimes.1 (let ((file (merge-pathnames #p"utimes.1" *test-directory*)) (atime (random (1- (expt 2 31)))) @@ -645,3 +746,49 @@ (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)