X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=a82bd7e085dea0dcce9f2800af993afff2f960cd;hb=77d94d36bcfd3d5eea73ad51e6ee621a8938f995;hp=14f04b0ffaf7be28c207cac513a3a4695faa6030;hpb=bbfa2aeb01af0a2353539aa3132a4b2a383cbd32;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 14f04b0..a82bd7e 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -12,6 +12,19 @@ (defvar *current-directory* *default-pathname-defaults*) (defvar *this-file* *load-truename*) + +(eval-when (:compile-toplevel :load-toplevel) + (defconstant +mode-rwx-all+ (logior sb-posix::s-irusr sb-posix::s-iwusr sb-posix::s-ixusr + sb-posix::s-irgrp sb-posix::s-iwgrp sb-posix::s-ixgrp + sb-posix::s-iroth sb-posix::s-iwoth sb-posix::s-ixoth))) + +(defmacro define-eacces-test (name form &rest values) + `(deftest ,name + (block ,name + (when (= (sb-posix:geteuid) 0) + (return-from ,name (values ,@values))) + ,form) + ,@values)) (deftest chdir.1 (sb-posix:chdir *test-directory*) @@ -33,6 +46,18 @@ (sb-posix:chdir *current-directory*) 0) +(deftest chdir.6 + (sb-posix:chdir "/../") + 0) + +(deftest chdir.7 + (sb-posix:chdir #p"/../") + 0) + +(deftest chdir.8 + (sb-posix:chdir (make-pathname :directory '(:absolute :up))) + 0) + (deftest chdir.error.1 (let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist")))) (handler-case @@ -78,11 +103,23 @@ (sb-posix:syscall-errno c))) #.sb-posix::eexist) -(deftest mkdir.error.3 - (handler-case - (sb-posix:mkdir "/almost-certainly-does-not-exist" 0) - (sb-posix:syscall-error (c) - (sb-posix:syscall-errno c))) +(define-eacces-test mkdir.error.3 + (let* ((dir (merge-pathnames + (make-pathname :directory '(:relative "mkdir.error.3")) + *test-directory*)) + (dir2 (merge-pathnames + (make-pathname :directory '(:relative "does-not-exist")) + dir))) + (sb-posix:mkdir dir 0) + (handler-case + (sb-posix:mkdir dir2 0) + (sb-posix:syscall-error (c) + (sb-posix:rmdir dir) + (sb-posix:syscall-errno c)) + (:no-error (result) + (sb-posix:rmdir dir2) + (sb-posix:rmdir dir) + result))) #.sb-posix::eacces) (deftest rmdir.1 @@ -112,7 +149,6 @@ (sb-posix:syscall-errno c))) #.sb-posix::enotdir) -#-sunos ; Apparently gives EINVAL on SunOS 8, which doesn't make sense (deftest rmdir.error.3 (handler-case (sb-posix:rmdir "/") @@ -138,15 +174,15 @@ (or (= errno sb-posix::eexist) (= errno sb-posix::enotempty)))))) t) -(deftest rmdir.error.5 +(define-eacces-test rmdir.error.5 (let* ((dir (merge-pathnames (make-pathname :directory '(:relative "rmdir.error.5")) *test-directory*)) (dir2 (merge-pathnames (make-pathname :directory '(:relative "unremovable")) dir))) - (sb-posix:mkdir dir #xffffffff) - (sb-posix:mkdir dir2 #xffffffff) + (sb-posix:mkdir dir +mode-rwx-all+) + (sb-posix:mkdir dir2 +mode-rwx-all+) (sb-posix:chmod dir 0) (handler-case (sb-posix:rmdir dir2) @@ -154,7 +190,11 @@ (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) (sb-posix:rmdir dir2) (sb-posix:rmdir dir) - (sb-posix:syscall-errno c)))) + (sb-posix:syscall-errno c)) + (:no-error (result) + (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) + (sb-posix:rmdir dir) + result))) #.sb-posix::eacces) (deftest stat.1 @@ -165,8 +205,11 @@ #.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) (deftest stat.2 - (let* ((stat (sb-posix:stat "/root")) + (let* ((stat (sb-posix:stat "/")) (mode (sb-posix::stat-mode stat))) + ;; it's logically possible for / to be writeable by others... but + ;; if it is, either someone is playing with strange security + ;; modules or they want to know about it anyway. (logand mode sb-posix::s-iwoth)) 0) @@ -180,6 +223,15 @@ (< (- atime unix-now) 10)) t) +(deftest stat.4 + (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up)))) + (mode (sb-posix::stat-mode stat))) + ;; it's logically possible for / to be writeable by others... but + ;; if it is, either someone is playing with strange security + ;; modules or they want to know about it anyway. + (logand mode sb-posix::s-iwoth)) + 0) + ;;; FIXME: add tests for carrying a stat structure around in the ;;; optional argument to SB-POSIX:STAT @@ -189,14 +241,14 @@ (sb-posix:syscall-errno c))) #.sb-posix::enoent) -(deftest stat.error.2 +(define-eacces-test stat.error.2 (let* ((dir (merge-pathnames (make-pathname :directory '(:relative "stat.error.2")) *test-directory*)) (file (merge-pathnames (make-pathname :name "unstatable") dir))) - (sb-posix:mkdir dir #xffffffff) + (sb-posix:mkdir dir +mode-rwx-all+) (with-open-file (s file :direction :output) (write "" :stream s)) (sb-posix:chmod dir 0) @@ -206,7 +258,12 @@ (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) (sb-posix:unlink file) (sb-posix:rmdir dir) - (sb-posix:syscall-errno c)))) + (sb-posix:syscall-errno c)) + (:no-error (result) + (sb-posix:chmod dir (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) + (sb-posix:unlink file) + (sb-posix:rmdir dir) + result))) #.sb-posix::eacces) ;;; stat-mode tests @@ -225,32 +282,32 @@ (deftest stat-mode.1 (with-stat-mode (mode *test-directory*) (sb-posix:s-isreg mode)) - 0) + nil) (deftest stat-mode.2 (with-stat-mode (mode *test-directory*) - (zerop (sb-posix:s-isdir mode))) - nil) + (sb-posix:s-isdir mode)) + t) (deftest stat-mode.3 (with-stat-mode (mode *test-directory*) (sb-posix:s-ischr mode)) - 0) + nil) (deftest stat-mode.4 (with-stat-mode (mode *test-directory*) (sb-posix:s-isblk mode)) - 0) + nil) (deftest stat-mode.5 (with-stat-mode (mode *test-directory*) (sb-posix:s-isfifo mode)) - 0) + nil) (deftest stat-mode.6 (with-stat-mode (mode *test-directory*) (sb-posix:s-issock mode)) - 0) + nil) (deftest stat-mode.7 (let ((link-pathname (make-pathname :name "stat-mode.7" @@ -259,9 +316,9 @@ (progn (sb-posix:symlink *test-directory* link-pathname) (with-lstat-mode (mode link-pathname) - (zerop (sb-posix:s-islnk mode)))) + (sb-posix:s-islnk mode))) (ignore-errors (sb-posix:unlink link-pathname)))) - nil) + t) (deftest stat-mode.8 (let ((pathname (make-pathname :name "stat-mode.8" @@ -271,9 +328,9 @@ (with-open-file (out pathname :direction :output) (write-line "test" out)) (with-stat-mode (mode pathname) - (zerop (sb-posix:s-isreg mode)))) + (sb-posix:s-isreg mode))) (ignore-errors (delete-file pathname)))) - nil) + t) ;;; see comment in filename's designator definition, in macros.lisp (deftest filename-designator.1 @@ -285,4 +342,40 @@ (let ((*default-pathname-defaults* *test-directory*)) (sb-posix:unlink (car (directory "*.txt"))))) 0) - + +(deftest open.1 + (let ((fd (sb-posix:open *test-directory* sb-posix::o-rdonly))) + (ignore-errors (sb-posix:close fd)) + (< fd 0)) + nil) + +(deftest open.error.1 + (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly) + (sb-posix:syscall-error (c) + (sb-posix:syscall-errno c))) + #.sb-posix::eisdir) + +(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) + + +(deftest opendir.1 + (let ((dir (sb-posix:opendir "/"))) + (unwind-protect (sb-alien:null-alien dir) + (unless (sb-alien:null-alien dir) + (sb-posix:closedir dir)))) + nil) + +(deftest readdir.1 + (let ((dir (sb-posix:opendir "/"))) + (unwind-protect + (block dir-loop + (loop for dirent = (sb-posix:readdir dir) + until (sb-alien:null-alien dirent) + when (not (stringp (sb-posix:dirent-name dirent))) + do (return-from dir-loop nil) + finally (return t))) + (sb-posix:closedir dir))) + t)