X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=13bb23d96fde4ba5c0b455f221d486009de2f953;hb=6548750bc1ca4d832afed1744cdc7133b232c6f2;hp=272209f150907ae73ef115377407d5620ace6c0c;hpb=93c21baaf6766c84806d1b4a558d5abfd0f5ec51;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 272209f..13bb23d 100644 --- a/contrib/sb-posix/posix-tests.lisp +++ b/contrib/sb-posix/posix-tests.lisp @@ -5,7 +5,7 @@ (defvar *test-directory* (ensure-directories-exist - (merge-pathnames (make-pathname :directory '(:relative "test-lab")) + (merge-pathnames (make-pathname :directory '(:relative "test-output")) (make-pathname :directory (pathname-directory *load-truename*))))) @@ -107,11 +107,16 @@ (handler-case (sb-posix:mkdir #-win32 "/" #+win32 "C:/" 0) (sb-posix:syscall-error (c) - (sb-posix:syscall-errno c))) - #-win32 - #.sb-posix::eexist - #+win32 - #.sb-posix:eacces) + ;; The results aren't the most consistent ones across platforms. Darwin + ;; likes EISDIR, Windows either EACCESS or EEXIST, others EEXIST. + ;; ...let's just accept them all. + (when (member (sb-posix:syscall-errno c) + (list #.sb-posix:eisdir + #.sb-posix:eacces + #.sb-posix::eexist) + :test #'eql) + :ok))) + :ok) (define-eacces-test mkdir.error.3 (let* ((dir (merge-pathnames @@ -164,13 +169,21 @@ (deftest rmdir.error.3 (handler-case - (sb-posix:rmdir #-win32 "/" #+win32 "C:/") + (sb-posix:rmdir #-win32 "/" #+win32 (sb-ext:posix-getenv "windir")) (sb-posix:syscall-error (c) - (sb-posix:syscall-errno c))) - #-win32 - #.sb-posix::ebusy - #+win32 - #.sb-posix::eacces) + (typep + (sb-posix:syscall-errno c) + '(member + #+(or darwin openbsd) + #.sb-posix:eisdir + #+win32 + #.sb-posix::eacces + #+win32 + #.sb-posix::enotempty + #+sunos + #.sb-posix::einval + #-(or darwin openbsd win32 sunos) + #.sb-posix::ebusy)))) t) (deftest rmdir.error.4 (let* ((dir (ensure-directories-exist @@ -267,14 +280,15 @@ #+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))) + (let ((f (namestring (merge-pathnames "some.file" *test-directory*)))) + (close (open f :if-exists :append :if-does-not-exist :create)) + (let* ((stat-1 (sb-posix:stat "/")) + (mode-1 (sb-posix:stat-mode stat-1)) + (stat-2 (sb-posix:stat f stat-1)) + (mode-2 (sb-posix:stat-mode stat-2))) + (values + (eq stat-1 stat-2) + (/= mode-1 mode-2)))) t t) @@ -405,6 +419,7 @@ (ignore-errors (sb-posix:unlink name)))) nil) +#-hpux ; fix: cant handle c-vargs (deftest open.error.1 (handler-case (sb-posix:open *test-directory* sb-posix::o-wronly) (sb-posix:syscall-error (c) @@ -414,21 +429,21 @@ #+win32 #.sb-posix:eacces) -#-(or (and x86-64 linux) win32) +#-(or (and x86-64 (or linux sunos)) 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) +#+(and x86-64 (or linux sunos)) (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) -#-win32 +#-(or hpux win32) ; fix: cant handle c-vargs (deftest fcntl.flock.1 (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) (let ((flock (make-instance 'sb-posix:flock @@ -463,7 +478,7 @@ 42) -#-win32 +#-(or win32 netbsd) (deftest fcntl.flock.2 (locally (declare (sb-ext:muffle-conditions sb-ext:compiler-note)) (let ((flock (make-instance 'sb-posix:flock @@ -495,6 +510,24 @@ kid-status)) 42) +(deftest read.1 + (progn + (with-open-file (ouf (merge-pathnames "read-test.txt" *test-directory*) + :direction :output + :if-exists :supersede + :if-does-not-exist :create) + (write-string "foo" ouf)) + (let ((fd (sb-posix:open (merge-pathnames "read-test.txt" *test-directory*) sb-posix:o-rdonly))) + (unwind-protect + (let ((buf (make-array 10 :element-type '(unsigned-byte 8)))) + (values + (sb-posix:read fd (sb-sys:vector-sap buf) 10) + (code-char (aref buf 0)) + (code-char (aref buf 1)) + (code-char (aref buf 2)))) + (sb-posix:close fd)))) + 3 #\f #\o #\o) + (deftest opendir.1 (let ((dir (sb-posix:opendir "/"))) (unwind-protect (sb-alien:null-alien dir) @@ -514,6 +547,7 @@ (sb-posix:closedir dir))) t) +#-darwin (deftest readdir/dirent-name (let ((dir (sb-posix:opendir *current-directory*))) (unwind-protect @@ -535,6 +569,23 @@ (sb-posix:closedir dir))) t) + +(deftest write.1 + (progn + (let ((fd (sb-posix:open (merge-pathnames "write-test.txt" *test-directory*) + (logior sb-posix:o-creat sb-posix:o-wronly) + (logior sb-posix:s-irusr sb-posix:s-iwusr))) + (retval nil)) + (unwind-protect + (let ((buf (coerce "foo" 'simple-base-string))) + (setf retval (sb-posix:write fd (sb-sys:vector-sap buf) 3))) + (sb-posix:close fd)) + + (with-open-file (inf (merge-pathnames "write-test.txt" *test-directory*) + :direction :input) + (values retval (read-line inf))))) + 3 "foo") + #-win32 (deftest pwent.1 ;; make sure that we found something @@ -643,6 +694,7 @@ ;; 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. + #-hpux ; arg2 to readlink is 80, and arg0 is larger than that (deftest readlink.2 (let ((target-pathname (make-pathname :name (make-string 255 :initial-element #\a) @@ -765,8 +817,10 @@ (delete-file temp)))) t "mkstemp-1") -#-(or win32 sunos) -;;; mkdtemp is unimplemented on at least Solaris 10 +;#-(or win32 sunos hpux) +;;;; mkdtemp is unimplemented on at least Solaris 10 +#-(or win32 hpux sunos) +;;; But it is implemented on OpenSolaris 2008.11 (deftest mkdtemp.1 (let ((pathname (sb-ext:parse-native-namestring @@ -810,8 +864,35 @@ :type (format nil "~AXXXXXX" (make-string n :initial-element #\x)) :defaults default)) - (let ((pathname (sb-ext:parse-native-namestring temp))) (unwind-protect - (values (integerp fd) (pathname-name pathname)) - (delete-file temp))))) - t "mkstemp-1") + (values (integerp fd) (subseq temp 0 (position #\. temp))) + (delete-file temp)))) + t "/tmp/mkstemp-1") + +(deftest envstuff + (let ((name1 "ASLIFJLSDKFJKAHGSDKLJH") + (name2 "KJHFKLJDSHIUYHBSDNFCBH")) + (values (sb-posix:getenv name1) + (sb-posix:getenv name1) + (progn + (sb-posix:putenv (concatenate 'string name1 "=name1,test1")) + (sb-ext:gc :full t) + (sb-posix:getenv name1)) + (progn + (sb-posix:setenv name1 "name1,test2" 0) + (sb-ext:gc :full t) + (sb-posix:getenv name1)) + (progn + (sb-posix:setenv name2 "name2,test1" 0) + (sb-ext:gc :full t) + (sb-posix:getenv name2)) + (progn + (sb-posix:setenv name2 "name2,test2" 1) + (sb-ext:gc :full t) + (sb-posix:getenv name2)))) + nil + nil + "name1,test1" + "name1,test1" + "name2,test1" + "name2,test2")