X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=02dee2be79648c8d17834b6ce820d258a0195780;hb=0f234877047c56ca945fe54e9e77a9cc2c8141cb;hp=9b2ce3acf481a15ddd18819e4dab229a6eabd353;hpb=3eb0a28fe6a7912d6ff2b97221325c0e3bfc5703;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 9b2ce3a..02dee2b 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -18,7 +18,7 @@ (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-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) @@ -235,8 +235,10 @@ ;; 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))) + #+darwin (atime (sb-alien:slot (sb-posix:stat-atime stat) 'sb-posix::tv-sec)) + #-darwin (atime (sb-posix::stat-atime stat))) ;; FIXME: breaks if mounted noatime :-( + #+nil (< (- atime unix-now) 10) (< (- atime unix-now) 10)) t) @@ -352,7 +354,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*)))) @@ -370,7 +371,8 @@ (let ((name (merge-pathnames "open-test.txt" *test-directory*))) (unwind-protect (progn - (sb-posix:close (sb-posix:creat name sb-posix:s-iwrite)) + (sb-posix:close + (sb-posix:creat name (logior sb-posix:s-iwrite sb-posix:s-iread))) (let ((fd (sb-posix:open name sb-posix::o-rdonly))) (ignore-errors (sb-posix:close fd)) (< fd 0))) @@ -419,6 +421,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 @@ -430,3 +453,195 @@ ;; make sure that we found something (not (sb-posix:getpwnam "root")) nil) + +#+nil +;; Requires root or special group + plus a sensible thing on the port +(deftest cfget/setispeed.1 + (with-open-file (s "/dev/ttyS0") + (let* ((termios (sb-posix:tcgetattr s)) + (old (sb-posix:cfgetispeed termios)) + (new (if (= old sb-posix:b2400) + sb-posix:b9600 + sb-posix:b2400))) + (sb-posix:cfsetispeed new termios) + (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios) + (setf termios (sb-posix:tcgetattr s)) + (= new (sb-posix:cfgetispeed termios)))) + t) + +#+nil +;; Requires root or special group + a sensible thing on the port +(deftest cfget/setospeed.1 + (with-open-file (s "/dev/ttyS0" :direction :output :if-exists :append) + (let* ((termios (sb-posix:tcgetattr s)) + (old (sb-posix:cfgetospeed termios)) + (new (if (= old sb-posix:b2400) + sb-posix:b9600 + sb-posix:b2400))) + (sb-posix:cfsetospeed new termios) + (sb-posix:tcsetattr 0 sb-posix:tcsadrain termios) + (setf termios (sb-posix:tcgetattr 0)) + (= new (sb-posix:cfgetospeed termios)))) + t) + + +#-win32 +(deftest time.1 + (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) +(deftest utimes.1 + (let ((file (merge-pathnames #p"utimes.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, utimes" 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)) + +;; 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) + )