Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22441
Modified Files: ffi.lisp osicat.lisp ports.lisp test-osicat.lisp Log Message: Fixed environment under openmcl (and lispworks?). Enabled make-fd-streams for openmcl (although investigation of the test failure is still required). Improved temporary-files tests.
Date: Mon Sep 26 12:58:02 2005 Author: jsquires
Index: src/ffi.lisp diff -u src/ffi.lisp:1.7 src/ffi.lisp:1.8 --- src/ffi.lisp:1.7 Sun Sep 25 20:24:35 2005 +++ src/ffi.lisp Mon Sep 26 12:58:02 2005 @@ -103,8 +103,8 @@ :module "osicat" :returning :int)
-(def-array-pointer cstring-array :cstring) -(def-foreign-var "environ" 'cstring-array "osicat") +(def-foreign-type cstring-ptr (* :cstring)) +(def-foreign-var "environ" 'cstring-ptr "osicat")
(def-function "getpwnam" ((name :cstring)) :module "osicat"
Index: src/osicat.lisp diff -u src/osicat.lisp:1.37 src/osicat.lisp:1.38 --- src/osicat.lisp:1.37 Sun Sep 25 20:24:35 2005 +++ src/osicat.lisp Mon Sep 26 12:58:02 2005 @@ -144,13 +144,15 @@ On failure, a FILE-ERROR may be signalled." #+osicat:fd-streams (let ((fd (osicat-tmpfile))) - (unless (>= fd 0) (error 'file-error)) + (unless (>= fd 0) + (error 'file-error :pathname nil)) (make-fd-stream fd :direction :io :element-type element-type :external-format external-format)) #-osicat:fd-streams ;; 100 is an arbitrary number of iterations to try before failing. (do ((counter 100 (1- counter))) - ((zerop counter) (error 'file-error)) + ((zerop counter) + (error 'file-error :pathname nil)) (let* ((name (tmpnam (make-null-pointer 'cstring))) (stream (open (convert-from-cstring name) :direction :io :element-type element-type @@ -322,7 +324,7 @@ (handler-case (loop for i from 0 by 1 for string = (convert-from-cstring - (deref-array environ 'cstring-array i)) + (deref-array environ 'cstring-ptr i)) for split = (position #= string) while string collecting (cons (subseq string 0 split)
Index: src/ports.lisp diff -u src/ports.lisp:1.1 src/ports.lisp:1.2 --- src/ports.lisp:1.1 Sun Sep 25 20:24:35 2005 +++ src/ports.lisp Mon Sep 26 12:58:02 2005 @@ -41,17 +41,14 @@ :external-format external-format))) (pushnew 'fd-streams *features*))
-;; FIXME: This code would work for OpenMCL, except that the FD-STREAM -;; returned by ccl::make-fd-stream is apparently not a stream (as per -;; STREAMP etc). I'm sure there's something we can do to correct -;; this, but until then, I'm leaving it out. -#+nil ;; openmcl +#+openmcl (progn ;; KLUDGE: This is kind of evil, because MAKE-FD-STREAM isn't ;; exported from CCL in OpenMCL. However, it seems to have been - ;; around for a while, and I'm going to ask the OpenMCL developers - ;; if they'll add it to the exported interface. + ;; around for a while, and the developers have said that they don't + ;; have any plans to change it any time soon. (defun make-fd-stream (fd &key direction element-type external-format) (declare (ignore external-format)) - (ccl::make-fd-stream fd :direction direction :element-type element-type)) + (ccl::make-fd-stream fd :direction direction :element-type element-type + :class 'file-stream)) (pushnew 'fd-streams *features*))
Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.12 src/test-osicat.lisp:1.13 --- src/test-osicat.lisp:1.12 Sun Sep 25 20:24:35 2005 +++ src/test-osicat.lisp Mon Sep 26 12:58:02 2005 @@ -342,8 +342,23 @@
(deftest temporary-file.1 (with-temporary-file (stream) + (print 'foo stream) (let ((pos (file-position stream))) - (print 'foo stream) + (print 'bar stream) + (print 'baz stream) (file-position stream pos) - (eql (read stream) 'foo))) + (eql (read stream) 'bar))) + t) + +;; Test failure condition of OPEN-TEMPORARY-FILE. So far, opening too +;; many fds is all I can determine as a way to do this. +(deftest temporary-file.2 + (let ((fds)) + (handler-case + (unwind-protect + (do ((ctr 1024 (1- ctr))) ; 1024 fds is usually too many. + ((zerop ctr)) + (push (open-temporary-file) fds)) + (mapcar #'close fds)) + (file-error () t))) t)