X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=9b2ce3acf481a15ddd18819e4dab229a6eabd353;hb=3eb0a28fe6a7912d6ff2b97221325c0e3bfc5703;hp=41d9b2fdf86b483f16897694cf0b95257bdb92b1;hpb=808502965803b3772ea40dab28ec85dc131e676a;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 41d9b2f..9b2ce3a 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -6,36 +6,48 @@ (defvar *test-directory* (ensure-directories-exist (merge-pathnames (make-pathname :directory '(:relative "test-lab")) - (make-pathname :directory - (pathname-directory *load-truename*))))) + (make-pathname :directory + (pathname-directory *load-truename*))))) (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))) + (defconstant +mode-rwx-all+ + (logior sb-posix::s-irusr sb-posix::s-iwusr sb-posix::s-ixusr + #-win32 + (logior + 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) + #-win32 + `(deftest ,name + (block ,name + (when (= (sb-posix:geteuid) 0) + (return-from ,name (values ,@values))) + ,form) + ,@values)) (deftest chdir.1 (sb-posix:chdir *test-directory*) 0) (deftest chdir.2 - (sb-posix:chdir (namestring *test-directory*)) + (sb-posix:chdir (namestring *test-directory*)) 0) (deftest chdir.3 - (sb-posix:chdir "/") + (sb-posix:chdir "/") 0) (deftest chdir.4 - (sb-posix:chdir #p"/") + (sb-posix:chdir #p"/") 0) (deftest chdir.5 - (sb-posix:chdir *current-directory*) + (sb-posix:chdir *current-directory*) 0) (deftest chdir.6 @@ -53,9 +65,9 @@ (deftest chdir.error.1 (let ((dne (make-pathname :directory '(:relative "chdir.does-not-exist")))) (handler-case - (sb-posix:chdir (merge-pathnames dne *test-directory*)) + (sb-posix:chdir (merge-pathnames dne *test-directory*)) (sb-posix:syscall-error (c) - (sb-posix:syscall-errno c)))) + (sb-posix:syscall-errno c)))) #.sb-posix::enoent) (deftest chdir.error.2 @@ -63,12 +75,15 @@ (sb-posix:chdir *this-file*) (sb-posix:syscall-error (c) (sb-posix:syscall-errno c))) - #.sb-posix::enotdir) + #-win32 + #.sb-posix:enotdir + #+win32 + #.sb-posix:einval) (deftest mkdir.1 (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.1")))) (unwind-protect - (sb-posix:mkdir (merge-pathnames dne *test-directory*) 0) + (sb-posix:mkdir (merge-pathnames dne *test-directory*) 0) ;; FIXME: no delete-directory in CL, but using our own operators ;; is probably not ideal (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*))))) @@ -77,7 +92,7 @@ (deftest mkdir.2 (let ((dne (make-pathname :directory '(:relative "mkdir.does-not-exist.2")))) (unwind-protect - (sb-posix:mkdir (namestring (merge-pathnames dne *test-directory*)) 0) + (sb-posix:mkdir (namestring (merge-pathnames dne *test-directory*)) 0) (ignore-errors (sb-posix:rmdir (merge-pathnames dne *test-directory*))))) 0) @@ -90,16 +105,31 @@ (deftest mkdir.error.2 (handler-case - (sb-posix:mkdir "/" 0) + (sb-posix:mkdir #-win32 "/" #+win32 "C:/" 0) (sb-posix:syscall-error (c) (sb-posix:syscall-errno c))) - #.sb-posix::eexist) + #-win32 + #.sb-posix::eexist + #+win32 + #.sb-posix:eacces) -(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 @@ -116,10 +146,10 @@ (deftest rmdir.error.1 (let ((dne (make-pathname :directory '(:relative "rmdir.dne.error.1")))) - (handler-case - (sb-posix:rmdir (merge-pathnames dne *test-directory*)) + (handler-case + (sb-posix:rmdir (merge-pathnames dne *test-directory*)) (sb-posix:syscall-error (c) - (sb-posix:syscall-errno c)))) + (sb-posix:syscall-errno c)))) #.sb-posix::enoent) (deftest rmdir.error.2 @@ -127,82 +157,93 @@ (sb-posix:rmdir *this-file*) (sb-posix:syscall-error (c) (sb-posix:syscall-errno c))) - #.sb-posix::enotdir) + #-win32 + #.sb-posix::enotdir + #+win32 + #.sb-posix::einval) -#-sunos ; Apparently gives EINVAL on SunOS 8, which doesn't make sense (deftest rmdir.error.3 (handler-case - (sb-posix:rmdir "/") + (sb-posix:rmdir #-win32 "/" #+win32 "C:/") (sb-posix:syscall-error (c) (sb-posix:syscall-errno c))) - #.sb-posix::ebusy) + #-win32 + #.sb-posix::ebusy + #+win32 + #.sb-posix::eacces) (deftest rmdir.error.4 (let* ((dir (ensure-directories-exist - (merge-pathnames - (make-pathname :directory '(:relative "rmdir.error.4")) - *test-directory*))) - (file (make-pathname :name "foo" :defaults dir))) - (with-open-file (s file :direction :output) + (merge-pathnames + (make-pathname :directory '(:relative "rmdir.error.4")) + *test-directory*))) + (file (make-pathname :name "foo" :defaults dir))) + (with-open-file (s file :direction :output :if-exists nil) (write "" :stream s)) (handler-case - (sb-posix:rmdir dir) + (sb-posix:rmdir dir) (sb-posix:syscall-error (c) - (delete-file file) - (sb-posix:rmdir dir) - (let ((errno (sb-posix:syscall-errno c))) - ;; documented by POSIX - (or (= errno sb-posix::eexist) (= errno sb-posix::enotempty)))))) + (delete-file file) + (sb-posix:rmdir dir) + (let ((errno (sb-posix:syscall-errno c))) + ;; documented by POSIX + (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))) + (make-pathname :directory '(:relative "rmdir.error.5")) + *test-directory*)) + (dir2 (merge-pathnames + (make-pathname :directory '(:relative "unremovable")) + dir))) (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) + (sb-posix:rmdir dir2) (sb-posix:syscall-error (c) - (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: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)) + (: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 (let* ((stat (sb-posix:stat *test-directory*)) - (mode (sb-posix::stat-mode stat))) + (mode (sb-posix::stat-mode stat))) ;; FIXME: Ugly ::s everywhere (logand mode (logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec))) #.(logior sb-posix::s-iread sb-posix::s-iwrite sb-posix::s-iexec)) +#-win32 (deftest stat.2 (let* ((stat (sb-posix:stat "/")) - (mode (sb-posix::stat-mode 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) - + (deftest stat.3 (let* ((now (get-universal-time)) - ;; FIXME: (encode-universal-time 00 00 00 01 01 1970) - (unix-now (- now 2208988800)) - (stat (sb-posix:stat *test-directory*)) - (atime (sb-posix::stat-atime stat))) + ;; FIXME: (encode-universal-time 00 00 00 01 01 1970) + (unix-now (- now 2208988800)) + (stat (sb-posix:stat *test-directory*)) + (atime (sb-posix::stat-atime stat))) ;; FIXME: breaks if mounted noatime :-( (< (- atime unix-now) 10)) t) -(deftest stat.2 +#-win32 +(deftest stat.4 (let* ((stat (sb-posix:stat (make-pathname :directory '(:absolute :up)))) - (mode (sb-posix::stat-mode 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. @@ -218,24 +259,29 @@ (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))) + (make-pathname :directory '(:relative "stat.error.2")) + *test-directory*)) + (file (merge-pathnames + (make-pathname :name "unstatable") + dir))) (sb-posix:mkdir dir +mode-rwx-all+) (with-open-file (s file :direction :output) (write "" :stream s)) (sb-posix:chmod dir 0) (handler-case - (sb-posix:stat file) + (sb-posix:stat file) (sb-posix:syscall-error (c) - (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: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)) + (: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 @@ -276,11 +322,13 @@ (sb-posix:s-isfifo mode)) nil) +#-win32 (deftest stat-mode.6 (with-stat-mode (mode *test-directory*) (sb-posix:s-issock mode)) nil) +#-win32 (deftest stat-mode.7 (let ((link-pathname (make-pathname :name "stat-mode.7" :defaults *test-directory*))) @@ -304,11 +352,14 @@ (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*)))) ;; creat() with a string as argument - (sb-posix:creat file 0) + (let ((fd (sb-posix:creat file sb-posix:s-iwrite))) + #+win32 + (sb-posix:close fd)) ;; if this test fails, it will probably be with ;; "System call error 2 (No such file or directory)" (let ((*default-pathname-defaults* *test-directory*)) @@ -316,13 +367,66 @@ 0) (deftest open.1 - (let ((fd (sb-posix:open *test-directory* sb-posix::o-rdonly))) - (ignore-errors (sb-posix:close fd)) - (< fd 0)) + (let ((name (merge-pathnames "open-test.txt" *test-directory*))) + (unwind-protect + (progn + (sb-posix:close (sb-posix:creat name sb-posix:s-iwrite)) + (let ((fd (sb-posix:open name sb-posix::o-rdonly))) + (ignore-errors (sb-posix:close fd)) + (< fd 0))) + (ignore-errors (sb-posix:unlink name)))) 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) + #-win32 + #.sb-posix::eisdir + #+win32 + #.sb-posix:eacces) + +#-(or (and x86-64 linux) 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) +(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) + +(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) + +#-win32 +(deftest pwent.1 + ;; make sure that we found something + (not (sb-posix:getpwuid 0)) + nil) + +#-win32 +(deftest pwent.2 + ;; make sure that we found something + (not (sb-posix:getpwnam "root")) + nil)