September 2005 - osicat-cvs@common-lisp.net

[osicat-cvs] CVS update: src/ffi.lisp src/osicat.lisp src/ports.lisp src/test-osicat.lisp
by jsquires＠common-lisp.net 26 Sep '05

26 Sep '05

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)

1 0

[osicat-cvs] CVS update: src/ports.lisp src/ffi.lisp src/osicat.asd src/osicat.lisp src/packages.lisp src/release.txt src/test-osicat.lisp src/version.txt
by jsquires＠common-lisp.net 25 Sep '05

25 Sep '05

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv17998 Modified Files: ffi.lisp osicat.asd osicat.lisp packages.lisp release.txt test-osicat.lisp version.txt Added Files: ports.lisp Log Message: Cleaned up OPEN-TEMPORARY-FILE and separated out MAKE-FD-STREAMS to make way for further fun in that direction. Fixed some tests. Prepared things for upcoming 0.5.0 release. Date: Sun Sep 25 20:24:35 2005 Author: jsquires Index: src/ffi.lisp diff -u src/ffi.lisp:1.6 src/ffi.lisp:1.7 --- src/ffi.lisp:1.6 Sat Sep 17 13:03:15 2005 +++ src/ffi.lisp Sun Sep 25 20:24:35 2005 @@ -104,7 +104,7 @@ :returning :int) (def-array-pointer cstring-array :cstring) -(def-foreign-var "environ" cstring-array "osicat") +(def-foreign-var "environ" 'cstring-array "osicat") (def-function "getpwnam" ((name :cstring)) :module "osicat" Index: src/osicat.asd diff -u src/osicat.asd:1.10 src/osicat.asd:1.11 --- src/osicat.asd:1.10 Mon Jul 26 15:25:30 2004 +++ src/osicat.asd Sun Sep 25 20:24:35 2005 @@ -69,7 +69,7 @@ ;;;; SYSTEM (defsystem :osicat - :version "0.4.1" + :version "0.5.0" :depends-on (:uffi) :components ((:c-source-file "osicat-glue") @@ -77,8 +77,9 @@ (:grovel-file "grovel-constants" :depends-on ("packages")) (:file "early-util" :depends-on ("packages")) (:file "ffi" :depends-on ("early-util")) + (:file "ports" :depends-on ("packages")) (:file "osicat" :depends-on - ("osicat-glue" "ffi" "grovel-constants")))) + ("osicat-glue" "ports" "ffi" "grovel-constants")))) ;;;; TESTING Index: src/osicat.lisp diff -u src/osicat.lisp:1.36 src/osicat.lisp:1.37 --- src/osicat.lisp:1.36 Sat Sep 17 13:10:48 2005 +++ src/osicat.lisp Sun Sep 25 20:24:35 2005 @@ -21,7 +21,7 @@ (in-package :osicat) -(defparameter *osicat-version* '(0 4 1) +(defparameter *osicat-version* '(0 5 0) "variable *OSICAT-VERSION* Osicat version number represented as a list of three integers. The @@ -131,45 +131,51 @@ ;;;; Temporary files -(defun make-temporary-file (&key (element-type 'character)) - "function MAKE-TEMPORARY-FILE (&key element-type) => stream - -Makes a temporary file setup for input and output, and returns a -stream connected to that file. ELEMENT-TYPE specifies the unit of -transaction of the stream. Consider using WITH-TEMPORARY-FILE instead -of this function. +(defun open-temporary-file (&key (element-type 'character) + (external-format :default)) + "function OPEN-TEMPORARY-FILE (&key element-type) => stream + +Creates a temporary file setup for input and output, and returns a +stream connected to that file. The file itself is unlinked once it +has been opened. ELEMENT-TYPE specifies the unit of transaction of +the stream. Consider using WITH-TEMPORARY-FILE instead of this +function. On failure, a FILE-ERROR may be signalled." - #+(or cmu sbcl) + #+osicat:fd-streams (let ((fd (osicat-tmpfile))) - (unless (>= fd 0) (signal 'file-error)) - #+cmu(sys:make-fd-stream fd :input t :output t - :element-type element-type) - #+sbcl(sb-sys:make-fd-stream fd :input t :output t - :element-type element-type)) - ;; XXX Warn about insecurity? Or is any platform too dumb to have - ;; fds, also relatively safe from race conditions through obscurity? - ;; XXX Will unlinking the file after opening the stream work the way - ;; we expect? (it seems to, from testing.) - #-(or cmu sbcl) - (let* ((name (tmpnam (make-null-pointer 'cstring))) - (stream (open (convert-from-cstring name) :direction :io - :element-type element-type))) - (unlink name) - stream)) + (unless (>= fd 0) (error 'file-error)) + (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)) + (let* ((name (tmpnam (make-null-pointer 'cstring))) + (stream (open (convert-from-cstring name) :direction :io + :element-type element-type + :external-format external-format + :if-exists nil))) + (when stream + (unlink name) + (return stream))))) (defmacro with-temporary-file ((stream &key element-type) &body body) "macro WITH-TEMPORARY-FILE (stream &key element-type) &body body => stream Within the lexical scope of the body, stream is connected to a -temporary file as created by MAKE-TEMPORARY-FILE. The file is closed +temporary file as created by OPEN-TEMPORARY-FILE. The file is closed automatically once BODY exits." - `(let ((,stream (make-temporary-file - ,@(when element-type `(:element-type ,element-type))))) + `(let ((,stream)) (unwind-protect - (progn ,@body) - (close ,stream :abort t)))) + (progn + (setf ,stream + (open-temporary-file + ,@(when element-type `(:element-type ,element-type)))) + ,@body) + (when ,stream + (close ,stream :abort t))))) ;;;; Directory access Index: src/packages.lisp diff -u src/packages.lisp:1.13 src/packages.lisp:1.14 --- src/packages.lisp:1.13 Tue Jul 5 18:55:46 2005 +++ src/packages.lisp Sun Sep 25 20:24:35 2005 @@ -58,7 +58,7 @@ ;; Permissions #:file-permissions ;; Temporary files - #:make-temporary-file + #:open-temporary-file #:with-temporary-file ;; Password entries #:user-info @@ -69,4 +69,6 @@ #:absolute-pathname-p #:relative-pathname-p #:unmerge-pathnames + ;; FD-streams symbol + #:fd-streams )) Index: src/release.txt diff -u src/release.txt:1.5 src/release.txt:1.6 --- src/release.txt:1.5 Mon Mar 1 00:52:23 2004 +++ src/release.txt Sun Sep 25 20:24:35 2005 @@ -1,4 +1,5 @@ osicat.asd +ports.lisp ffi.lisp early-util.lisp grovel-constants.lisp Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.11 src/test-osicat.lisp:1.12 --- src/test-osicat.lisp:1.11 Tue Jul 5 18:55:47 2005 +++ src/test-osicat.lisp Sun Sep 25 20:24:35 2005 @@ -49,8 +49,9 @@ (error () :error))))) t) -;;; XXX: (user-homedir-pathname) is "home:" under CMUCL, so this test -;;; will fail. +;;; FIXME: (user-homedir-pathname) is "home:" under CMUCL, so this +;;; test will fail. +#-cmu (deftest environment.1 (namestring (probe-file (cdr (assoc "HOME" (environment) :test #'equal)))) @@ -171,7 +172,7 @@ #.(namestring *test-dir*)) ;; Test the case of reading a link with a very long name. -(deftest read-link.1 +(deftest read-link.2 (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) (file (ensure-file "a-very-long-tmp-file-name-explicitly-for-the-purpose-of-testing-a-certain-condition-in-read-link-please-ignore-thanks"))) (unwind-protect Index: src/version.txt diff -u src/version.txt:1.11 src/version.txt:1.12 --- src/version.txt:1.11 Mon Jul 26 15:25:30 2004 +++ src/version.txt Sun Sep 25 20:24:35 2005 @@ -1 +1 @@ -0.4.1 +0.5.0

1 0

[osicat-cvs] CVS update: src/osicat.lisp
by jsquires＠common-lisp.net 17 Sep '05

17 Sep '05

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv21295 Modified Files: osicat.lisp Log Message: Some documentation updates. Date: Sat Sep 17 13:10:48 2005 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.35 src/osicat.lisp:1.36 --- src/osicat.lisp:1.35 Sat Sep 17 13:03:15 2005 +++ src/osicat.lisp Sat Sep 17 13:10:48 2005 @@ -86,8 +86,8 @@ (defun absolute-pathname (pathspec &optional (default *default-pathname-defaults*)) "function ABSOLUTE-PATHNAME pathspec &optional default => pathname -Returns an absolute pathname corresponding to pathspec by merging it with default, -and (current-directory) if necessary." +Returns an absolute pathname corresponding to pathspec by merging it +with default, and (current-directory) if necessary." (if (relative-pathname-p pathspec) (let ((tmp (merge-pathnames pathspec @@ -136,7 +136,8 @@ Makes a temporary file setup for input and output, and returns a stream connected to that file. ELEMENT-TYPE specifies the unit of -transaction of the stream. +transaction of the stream. Consider using WITH-TEMPORARY-FILE instead +of this function. On failure, a FILE-ERROR may be signalled." #+(or cmu sbcl) @@ -149,7 +150,7 @@ ;; XXX Warn about insecurity? Or is any platform too dumb to have ;; fds, also relatively safe from race conditions through obscurity? ;; XXX Will unlinking the file after opening the stream work the way - ;; we expect? + ;; we expect? (it seems to, from testing.) #-(or cmu sbcl) (let* ((name (tmpnam (make-null-pointer 'cstring))) (stream (open (convert-from-cstring name) :direction :io @@ -159,10 +160,13 @@ (defmacro with-temporary-file ((stream &key element-type) &body body) - "macro WITH-TEMPORARY-FILE (stream &key element-type) &body body => stream" + "macro WITH-TEMPORARY-FILE (stream &key element-type) &body body => stream + +Within the lexical scope of the body, stream is connected to a +temporary file as created by MAKE-TEMPORARY-FILE. The file is closed +automatically once BODY exits." `(let ((,stream (make-temporary-file - ,@(when element-type - `(:element-type ,element-type))))) + ,@(when element-type `(:element-type ,element-type))))) (unwind-protect (progn ,@body) (close ,stream :abort t))))

1 0

[osicat-cvs] CVS update: src/ffi.lisp src/osicat.lisp
by jsquires＠common-lisp.net 17 Sep '05

17 Sep '05

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv21168 Modified Files: ffi.lisp osicat.lisp Log Message: Applied patch from Luis Oliveira on comp.lang.lisp, just tweaking some quoting of FFI types. Date: Sat Sep 17 13:03:16 2005 Author: jsquires Index: src/ffi.lisp diff -u src/ffi.lisp:1.5 src/ffi.lisp:1.6 --- src/ffi.lisp:1.5 Fri Jul 8 16:18:19 2005 +++ src/ffi.lisp Sat Sep 17 13:03:15 2005 @@ -104,7 +104,7 @@ :returning :int) (def-array-pointer cstring-array :cstring) -(def-foreign-var "environ" 'cstring-array "osicat") +(def-foreign-var "environ" cstring-array "osicat") (def-function "getpwnam" ((name :cstring)) :module "osicat" Index: src/osicat.lisp diff -u src/osicat.lisp:1.34 src/osicat.lisp:1.35 --- src/osicat.lisp:1.34 Fri Jul 8 16:18:19 2005 +++ src/osicat.lisp Sat Sep 17 13:03:15 2005 @@ -312,7 +312,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-array i)) for split = (position #\= string) while string collecting (cons (subseq string 0 split)

1 0