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