Commit 623bf535 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Tweak with-temporary-file and its tests. 

One WTF test fails on GCL, due to a compiler bug.
parent 3a5927e6

test/test-utilities.script

+14 −19
Original line number Diff line number Diff line
@@ -302,34 +302,29 @@ 
  (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")

(DBG "testing with-temporary-file")

(with-temporary-file (:stream s :direction :io :prefix "WTF0")

  (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")

(let ((pn1 (with-temporary-file (:pathname pn :direction :output :prefix "WTF1")

             (assert-equal (read-file-lines pn) ())

             pn)))

  (assert (not (probe-file pn))))

  (assert (not (probe-file pn1))))



(DBG :wtf-s-p)

(let ((pn

        (with-temporary-file (:stream s :pathname p :keep t :direction :io :prefix "LEP")

(let ((pn2 (with-temporary-file (:stream s :pathname p :keep t :direction :io :prefix "WTF2")

             (println "Hello, World" s)

          (DBG :wsp s p (probe-file p))

             p)))

  (assert-equal (read-file-lines pn) '("Hello, World"))

  (delete-file pn))

  (assert-equal (read-file-lines pn2) '("Hello, World"))

  (delete-file pn2))



#-gcl ;; BUG in GCL compiling the WTF internal loop. Works if loaded without compiling.

(assert

 (not (probe-file

       (let ((s 'outer-s))

         (with-temporary-file (:stream s :pathname p :direction :io :prefix "LEP")

         (with-temporary-file (:stream s :pathname p :direction :io :prefix "WTF3")

           (assert (open-stream-p s))

           (DBG :wsp s p (probe-file p))

           (println "Same thing with :close-stream" s)

           :close-stream

           (assert-equal s 'outer-s) ;; the stream s (1) has been closed and (2) is no longer in scope.

uiop/stream.lisp

+11 −11
Original line number Diff line number Diff line
@@ -601,17 +601,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e 
                 (when stream

                   (setf okp pathname)

                   (when want-stream-p

                     (setf results

                           (multiple-value-list

                     ;; Note: can't return directly from within with-open-file

                     ;; or the non-local return causes the file creation to be undone.

                     (setf results (multiple-value-list

                                    (if want-pathname-p

                                        (funcall thunk stream pathname)

                                        (funcall thunk stream)))))))

               (when okp

                 (unless want-stream-p

                   (setf results (multiple-value-list (call-function thunk pathname))))

                 (when after

                   (setf results (multiple-value-list (call-function after pathname))))

                 (return (apply 'values results))))

               (cond

                 ((not okp) nil)

                 (after (return (call-function after okp)))

                 ((and want-pathname-p (not want-stream-p)) (return (call-function thunk okp)))

                 (t (return (apply 'values results)))))

          (when (and okp (not (call-function keep)))

            (ignore-errors (delete-file-if-exists okp))))))