Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
09a0fe12
Commit
09a0fe12
authored
Oct 20, 2013
by
Francois-Rene Rideau
Browse files
More tweaks (and tests) for with-temporary-file, and change run-program accordingly.
parent
89860149
Changes
3
Hide whitespace changes
Inline
Side-by-side
test/test-utilities.script
View file @
09a0fe12
...
...
@@ -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))
uiop/run-program.lisp
View file @
09a0fe12
...
...
@@ -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
))
...
...
uiop/stream.lisp
View file @
09a0fe12
...
...
@@ -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"
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment