X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=d25708653a81640cc47d54c02bc739315365a721;hb=82f9c527cb607ccd19e5b24261dfe9af7b1ba72e;hp=92fef5f6ef4fd24fdf4551058aa67b4a2c4ec6a0;hpb=e4d73846ea60ae6cba79c32dde6d9f88b7540146;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index 92fef5f..d257086 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 @@ -167,10 +172,14 @@ (sb-posix:rmdir #-win32 "/" #+win32 "C:/") (sb-posix:syscall-error (c) (sb-posix:syscall-errno c))) - #-win32 - #.sb-posix::ebusy + #+darwin + #.sb-posix:eisdir #+win32 - #.sb-posix::eacces) + #.sb-posix::eacces + #+sunos + #.sb-posix::einval + #-(or darwin win32 sunos) + #.sb-posix::ebusy) (deftest rmdir.error.4 (let* ((dir (ensure-directories-exist @@ -269,7 +278,7 @@ (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-2 (sb-posix:stat "C:\\pagefile.sys" stat-1)) (mode-2 (sb-posix:stat-mode stat-2))) (values @@ -405,6 +414,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 +424,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 @@ -495,6 +505,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 +542,7 @@ (sb-posix:closedir dir))) t) +#-darwin (deftest readdir/dirent-name (let ((dir (sb-posix:opendir *current-directory*))) (unwind-protect @@ -535,6 +564,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 +689,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,7 +812,10 @@ (delete-file temp)))) t "mkstemp-1") -#-win32 +;#-(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 @@ -792,3 +842,52 @@ (values (equal "mktemp" (pathname-name pathname)) (not (equal "XXXXXX" (pathname-type pathname))))) t t) + +#-win32 +(deftest mkstemp.null-terminate + (let* ((default (make-pathname :directory '(:absolute "tmp"))) + (filename (namestring (make-pathname :name "mkstemp-1" + :type "XXXXXX" + :defaults default))) + ;; The magic 64 is the filename length that happens to + ;; trigger the no null termination bug at least on my + ;; machine on a certain build. + (n (- 64 (length (sb-ext:string-to-octets filename))))) + (multiple-value-bind (fd temp) + (sb-posix:mkstemp (make-pathname + :name "mkstemp-1" + :type (format nil "~AXXXXXX" + (make-string n :initial-element #\x)) + :defaults default)) + (unwind-protect + (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")