[osicat-cvs] CVS update: src/ffi.lisp src/osicat.lisp src/ports.lisp src/test-osicat.lisp

[Julian E. C. Squires]

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)