Commit e36c0653 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'with-temp-file-bug' into 'master'

Add test for UIOP:CALL-WITH-TEMPORARY-FILE.

See merge request asdf/asdf!153
parents 0fd4c2e6 80482de9
......@@ -214,7 +214,7 @@ test-all-clean-load:
@for lisp in ${lisps} ; do ${MAKE} test-clean-load l=$$lisp || exit 1 ; done
test-all-lisp:
@for lisp in ${lisps} ; do ${MAKE} test-lisp l=$$lisp || exit 1 ; done
@for lisp in ${lisps} ; do ${MAKE} test-lisp l=$$lisp t=${t}|| exit 1 ; done
test-all-upgrade:
@for lisp in ${ulisps} ; do ${MAKE} test-upgrade l=$$lisp || exit 1 ; done
......
......@@ -528,3 +528,96 @@
(unwind-protect
(uiop:compile-file* "sb-grovel-fail.lisp")
(uiop:delete-file-if-exists "sb-grovel-fail.fasl")))
;;; Call with temporary file had an ill-formed COND, causing malfunction.
(DBG "Testing UIOP:CALL-WITH-TEMPORARY-FILE")
(DBG "WANT-PATHNAME T WANT-STREAM NIL")
(call-with-temporary-file
#'(lambda (pathname)
(DBG :call-with-temporary-file-thunk
(format nil "Pathname is ~a" pathname))
(assert (probe-file pathname))
(with-open-file (str pathname :direction :output
:if-exists :append
:if-does-not-exist :error)
(assert (probe-file pathname))
(format str "Have successfully written in thunk."))
(DBG :call-with-temporary-file-thunk
"Thunk ran successfully."))
:want-pathname-p t :want-stream-p nil
:after #'(lambda (pathname)
(let ((line-read
(with-open-file (str pathname :direction :input)
(read-line str))))
(assert-equal line-read "Have successfully written in thunk."))))
(let ((pathname
(call-with-temporary-file
#'(lambda (pathname)
(DBG :call-with-temporary-file-thunk
(format nil "Pathname is ~a" pathname))
(assert (probe-file pathname))
(with-open-file (str pathname :direction :output
:if-exists :append
:if-does-not-exist :error)
(assert (probe-file pathname))
(format str "Have successfully written in thunk."))
(DBG :call-with-temporary-file-thunk
"Thunk ran successfully.")
pathname)
:want-pathname-p t :want-stream-p nil
:keep t)))
(unwind-protect
(let ((line-read
(with-open-file (str pathname :direction :input)
(read-line str))))
(assert-equal line-read "Have successfully written in thunk."))
(ignore-errors (uiop:delete-file-if-exists pathname))))
(DBG "WANT-PATHNAME NIL WANT-STREAM T")
(call-with-temporary-file
#'(lambda (str)
(format str "Have successfully written in thunk.")
(DBG :call-with-temporary-file-thunk
"Thunk ran successfully."))
:want-pathname-p nil :want-stream-p t
:keep t
:after #'(lambda (pathname)
(let ((line-read
(with-open-file (str pathname :direction :input)
(read-line str))))
(assert-equal line-read "Have successfully written in thunk."))))
(DBG "WANT-PATHNAME t WANT-STREAM T")
(call-with-temporary-file
#'(lambda (str pathname)
(format str "Have successfully written in thunk.")
(assert (pathnamep (parse-namestring pathname)))
(DBG :call-with-temporary-file-thunk
"Thunk ran successfully."))
:want-pathname-p t :want-stream-p t
:keep t
:after #'(lambda (pathname)
(let ((line-read
(with-open-file (str pathname :direction :input)
(read-line str))))
(assert-equal line-read "Have successfully written in thunk."))))
(let ((pathname (call-with-temporary-file
#'(lambda (str pathname)
(format str "Have successfully written in thunk.")
(assert (pathnamep (parse-namestring pathname)))
(DBG :call-with-temporary-file-thunk
"Thunk ran successfully.")
pathname)
:want-pathname-p t :want-stream-p t
:keep t)))
(unwind-protect
(let ((line-read
(with-open-file (str pathname :direction :input)
(read-line str))))
(assert-equal line-read "Have successfully written in thunk."))
(ignore-errors (uiop:delete-file-if-exists pathname))))
......@@ -629,11 +629,16 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
(if want-pathname-p
(funcall thunk stream pathname)
(funcall thunk stream)))))))
(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 (values-list results)))))
;; if we don't want a stream, then we must call the thunk *after*
;; the stream is closed, but only if it was successfully opened.
(when okp
(when (and want-pathname-p (not want-stream-p))
(setf results (multiple-value-list (funcall thunk okp))))
;; if the stream was successfully opened, then return a value,
;; either one computed already, or one from AFTER, if that exists.
(if after
(return (call-function after pathname))
(return (values-list results)))))
(when (and okp (not (call-function keep)))
(ignore-errors (delete-file-if-exists okp))))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment