X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Fposix-tests.lisp;h=d25708653a81640cc47d54c02bc739315365a721;hb=82f9c527cb607ccd19e5b24261dfe9af7b1ba72e;hp=b3ce8a2352602108112190248bd69a914d92ed72;hpb=53ab0266f9a92943cc93f675cc727d01cfa55474;p=sbcl.git diff --git a/contrib/sb-posix/posix-tests.lisp b/contrib/sb-posix/posix-tests.lisp index b3ce8a2..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 @@ -496,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) @@ -515,6 +542,7 @@ (sb-posix:closedir dir))) t) +#-darwin (deftest readdir/dirent-name (let ((dir (sb-posix:opendir *current-directory*))) (unwind-protect @@ -536,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 @@ -769,7 +814,7 @@ ;#-(or win32 sunos hpux) ;;;; mkdtemp is unimplemented on at least Solaris 10 -#-(or win32 hpux) +#-(or win32 hpux sunos) ;;; But it is implemented on OpenSolaris 2008.11 (deftest mkdtemp.1 (let ((pathname @@ -814,8 +859,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")