From 09a0fe12216e440e46c3a96e7eb73426e2846ff4 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Sun, 20 Oct 2013 20:40:58 -0400 Subject: [PATCH] More tweaks (and tests) for with-temporary-file, and change run-program accordingly. --- test/test-utilities.script | 21 ++++++++++++++++- uiop/run-program.lisp | 22 ++++++++---------- uiop/stream.lisp | 47 ++++++++++++++++++++++++++------------ 3 files changed, 63 insertions(+), 27 deletions(-) diff --git a/test/test-utilities.script b/test/test-utilities.script index ad151a8d..2d0cbe30 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -245,5 +245,24 @@ (ts "c" +crlf+ (strcat ccr +lf+)) (ts (strcat acrlf "b") +lf+ (strcat acrlf blf))) +(DBG :wtf-s) (with-temporary-file (:stream s :direction :io :prefix "LEP") - (println "Hello, World" s)) + (println "Hello, World" s) + (file-position s 0) + (assert-equal (read-line s) "Hello, World")) + +(DBG :wtf-p) +(let ((pn + (with-temporary-file (:pathname pn :direction :output :prefix "LEP") + (assert-equal (read-file-lines pn) ()) + pn))) + (assert (not (probe-file pn)))) + +(DBG :wtf-s-p) +(let ((pn + (with-temporary-file (:stream s :pathname p :keep t :direction :io :prefix "LEP") + (println "Hello, World" s) + (DBG :wsp s p (probe-file p)) + p))) + (assert-equal (read-file-lines pn) '("Hello, World")) + (delete-file pn)) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 5f5280d3..0bff9588 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -611,22 +611,20 @@ It returns a process-info plist with possible keys: (hard-case () (if activep (funcall fun :stream #'activity) - (with-temporary-file (:pathname tmp :stream s - :direction (ecase direction - ((:input) :output) - ((:output :error-output) :io)) - :element-type element-type - :external-format external-format) + (with-temporary-file (:pathname tmp) (ecase direction (:input - (unwind-protect (activity s) - (ignore-errors (close s))) + (with-output-file (s tmp :if-exists :overwrite + :external-format external-format + :element-type element-type) + (activity s)) (funcall fun tmp nil)) ((:output :error-output) - (unwind-protect - (multiple-value-prog1 (funcall fun tmp nil) - (activity s)) - (ignore-errors (close s))))))))) + (multiple-value-prog1 (funcall fun tmp nil) + (with-input-file (s tmp + :external-format external-format + :element-type element-type) + (activity s))))))))) (typecase activity-spec ((or null string pathname (eql :interactive)) (easy-case)) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index dbc32b5f..be2b2d14 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -533,6 +533,7 @@ If a string, repeatedly read and evaluate from it, returning the last values." (defun call-with-temporary-file (thunk &key + (want-stream-p t) (want-pathname-p t) prefix keep (direction :io) (element-type *default-stream-element-type*) (external-format *utf-8-external-format*)) @@ -542,24 +543,37 @@ This utility will KEEP the file past its extent if and only if explicitly reques The file will be open with specified DIRECTION, ELEMENT-TYPE and EXTERNAL-FORMAT." #+gcl2.6 (declare (ignorable external-format)) (check-type direction (member :output :io)) + (assert (or want-stream-p want-pathname-p)) (loop :with prefix = (namestring (ensure-absolute-pathname (or prefix "tmp") #'temporary-directory)) + :with results = () :for counter :from (random (ash 1 32)) - :for pathname = (pathname (format nil "~A~36R" prefix counter)) :do + :for pathname = (pathname (format nil "~A~36R" prefix counter)) + :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL ;; TODO: on Unix, use CFFI and mkstemp -- but UIOP is precisely meant to not depend on CFFI or on anything! Grrrr. (unwind-protect - (with-open-file (stream pathname - :direction direction - :element-type element-type - #-gcl2.6 :external-format #-gcl2.6 external-format - :if-exists nil :if-does-not-exist :create) - (if stream - (return (funcall thunk stream pathname)) - (setf pathname nil))) - (when (and pathname (not keep)) - (ignore-errors (delete-file pathname)))))) + (progn + (with-open-file (stream pathname + :direction direction + :element-type element-type + #-gcl2.6 :external-format #-gcl2.6 external-format + :if-exists nil :if-does-not-exist :create) + (when stream + (setf okp pathname) + (when want-stream-p + (setf results + (multiple-value-list + (if want-pathname-p + (funcall thunk stream pathname) + (funcall thunk stream))))))) + (when okp + (if want-stream-p + (return (apply 'values results)) + (return (funcall thunk pathname))))) + (when (and okp (not keep)) + (ignore-errors (delete-file-if-exists okp)))))) (defmacro with-temporary-file ((&key (stream (gensym "STREAM") streamp) (pathname (gensym "PATHNAME") pathnamep) @@ -572,19 +586,24 @@ The STREAM will be closed if no binding is specified. Unless KEEP is specified, delete the file afterwards." (check-type stream symbol) (check-type pathname symbol) - `(flet ((think (,stream ,pathname) - ,@(unless pathnamep `((declare (ignore ,pathname)))) - ,@(unless streamp `((when ,stream (close ,stream)))) + (assert (or streamp pathnamep)) + `(flet ((think (,@(when streamp `(,stream)) ,@(when pathnamep `(,pathname))) ,@body)) #-gcl (declare (dynamic-extent #'think)) (call-with-temporary-file #'think + :want-stream-p ,streamp + :want-pathname-p ,pathnamep ,@(when direction `(:direction ,direction)) ,@(when prefix `(:prefix ,prefix)) ,@(when keep `(:keep ,keep)) ,@(when element-type `(:element-type ,element-type)) ,@(when external-format `(:external-format ,external-format))))) + (defun get-temporary-file (&key prefix) + (with-temporary-file (:pathname pn :keep t :prefix prefix) + pn)) + ;; Temporary pathnames in simple cases where no contention is assumed (defun add-pathname-suffix (pathname suffix) "Add a SUFFIX to the name of a PATHNAME, return a new pathname" -- GitLab