Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Merge Requests
8
Merge Requests
8
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
asdf
asdf
Commits
46d62aae
Commit
46d62aae
authored
Oct 10, 2016
by
Elias Pipping
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix :if-output-exists :append/:supersede/:error
Add a test, too.
parent
d836afba
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
58 additions
and
12 deletions
+58
-12
test/test-run-program-unix.script
test/test-run-program-unix.script
+32
-2
uiop/run-program.lisp
uiop/run-program.lisp
+26
-10
No files found.
test/test-run-program-unix.script
View file @
46d62aae
...
...
@@ -262,7 +262,7 @@
:if-input-does-not-exist :create)))
(define-test
":input <file> :output <file> (files e.)"
":input <file> :output <file> (files e.)
:i-o-e :supersede
"
(let ((in-string (format nil "A line.~%And another.~%")))
(create-file-from-string *input-file* in-string)
(create-file-from-string *output-file* "")
...
...
@@ -270,7 +270,37 @@
(check-output in-string)))
(define-test
":input <file> :output <file> (files e./m.)"
":input <file> :output <file> (files e.) :i-o-e :error"
(progn
(let ((in-string1 (format nil "A line.~%"))
(in-string2 (format nil "And another.~%")))
(delete-file-if-exists *output-file*)
(create-file-from-string *input-file* in-string1)
(run-program "cat" :input *input-file*
:output *output-file*)
(create-file-from-string *input-file* in-string2)
(with-expected-failure (t)
(run-program "cat" :input *input-file*
:output *output-file* :if-output-exists :error))
(check-output in-string1))))
(define-test
":input <file> :output <file> (files e.) :i-o-e :append"
(progn
(let ((in-string1 (format nil "A line.~%"))
(in-string2 (format nil "And another.~%")))
(delete-file-if-exists *output-file*)
(create-file-from-string *input-file* in-string1)
(run-program "cat" :input *input-file*
:output *output-file*)
(create-file-from-string *input-file* in-string2)
(run-program "cat" :input *input-file*
:output *output-file*
:if-output-exists :append)
(check-output (concatenate 'string in-string1 in-string2)))))
(define-test
":input <file> :output <file> (files e./m.) :i-o-e :supersede"
(let ((in-string (format nil "A line.~%And another.~%")))
(create-file-from-string *input-file* in-string)
(delete-file-if-exists *output-file*)
...
...
uiop/run-program.lisp
View file @
46d62aae
...
...
@@ -401,11 +401,6 @@ argument to pass to the internal RUN-PROGRAM"
:output
(
error
"Wrong specifier ~S for role ~S"
specifier
role
)))))
(
defun
%normalize-if-exists
(
action
)
(
ecase
action
(
:supersede
#+
clisp
:overwrite
#-
clisp
action
)
((
:append
:error
)
action
)))
(
defun
%interactivep
(
input
output
error-output
)
(
member
:interactive
(
list
input
output
error-output
)))
...
...
@@ -431,6 +426,13 @@ argument to pass to the internal RUN-PROGRAM"
;; >128 from exiting in response to a signal by setting this code
(
signal-code
:initform
nil
)))
(
defun
%handle-if-exists
(
file
if-exists
)
(
when
(
or
(
stringp
file
)
(
pathnamep
file
))
(
ecase
if-exists
((
:append
:supersede
:error
)
(
with-open-file
(
dummy
file
:direction
:output
:if-exists
if-exists
)
(
declare
(
ignorable
dummy
)))))))
(
defun
%handle-if-does-not-exist
(
file
if-does-not-exist
)
(
when
(
or
(
stringp
file
)
(
pathnamep
file
))
(
ecase
if-does-not-exist
...
...
@@ -465,6 +467,12 @@ stream will be made available that can be accessed via
PROCESS-INFO-OUTPUT and read from. Otherwise, OUTPUT should be a value
that the underlying lisp implementation knows how to handle.
IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
default). The meaning of these values and their effect on the case
where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
to OPEN with :DIRECTION :OUTPUT.
ERROR-OUTPUT is similar to OUTPUT. T designates the *ERROR-OUTPUT*,
:OUTPUT means redirecting the error output to the output stream,
and :STREAM causes a stream to be made available via
...
...
@@ -510,9 +518,9 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(
parameter-error
"~S: Streams passed as I/O parameters need to be (synonymous with) file streams on this lisp"
'launch-program
))
(
%handle-if-does-not-exist
input
if-input-does-not-exist
)
(
%handle-if-exists
output
if-output-exists
)
#+
(
or
abcl
allegro
clozure
cmucl
ecl
(
and
lispworks
os-unix
)
mkcl
sbcl
scl
)
(
let*
((
%command
(
%normalize-command
command
))
(
%if-output-exists
(
%normalize-if-exists
if-output-exists
))
(
%input
(
%normalize-io-specifier
input
:input
))
(
%output
(
%normalize-io-specifier
output
:output
))
(
%error-output
(
%normalize-io-specifier
error-output
:error-output
))
...
...
@@ -539,7 +547,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
#.
(
or
#+
(
or
allegro
lispworks
)
:error-output
:error
)
,
%error-output
:wait
nil
:element-type
,
element-type
:external-format
,
external-format
:if-input-does-not-exist
:error
:if-output-exists
,
%if-output-exists
:if-output-exists
:append
#-
(
or
allegro
lispworks
)
:if-error-exists
#+
(
or
allegro
lispworks
)
:if-error-output-exists
,
if-error-output-exists
:allow-other-keys
t
)
...
...
@@ -960,7 +968,7 @@ or :error-output."
(
when
pathname
(
list
operator
" "
(
escape-shell-token
(
native-namestring
pathname
)))))))
(
let*
((
redirections
(
append
(
redirect
in
" <"
)
(
redirect
out
" >"
)
(
redirect
err
" 2>"
)))
(
let*
((
redirections
(
append
(
redirect
in
" <"
)
(
redirect
out
" >
>
"
)
(
redirect
err
" 2>"
)))
(
normalized
(
%normalize-system-command
command
))
(
directory
(
or
directory
#+
(
or
abcl
xcl
)
(
getcwd
)))
(
chdir
(
when
directory
...
...
@@ -975,10 +983,12 @@ or :error-output."
(
defun
%system
(
command
&rest
keys
&key
directory
input
if-input-does-not-exist
output
error-output
&allow-other-keys
)
output
if-output-exists
error-output
&allow-other-keys
)
"A portable abstraction of a low-level call to libc's system()."
(
declare
(
ignorable
output
error-output
directory
keys
))
(
declare
(
ignorable
error-output
directory
keys
))
(
%handle-if-does-not-exist
input
if-input-does-not-exist
)
(
%handle-if-exists
output
if-output-exists
)
#+
(
or
allegro
clozure
cmucl
(
and
lispworks
os-unix
)
sbcl
scl
)
(
wait-process
(
apply
'launch-program
(
%normalize-system-command
command
)
:wait
t
keys
))
...
...
@@ -1065,6 +1075,12 @@ E.g., using :OUTPUT :STRING will have it return the entire output stream as a st
And using :OUTPUT '(:STRING :STRIPPED T) will have it return the same string
stripped of any ending newline.
IF-OUTPUT-EXISTS, which is only meaningful if OUTPUT is a string or a
pathname, can take the values :ERROR, :APPEND, and :SUPERSEDE (the
default). The meaning of these values and their effect on the case
where OUTPUT does not exist, is analogous to the IF-EXISTS parameter
to OPEN with :DIRECTION :OUTPUT.
ERROR-OUTPUT is similar to OUTPUT, except that the resulting value is returned
as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
Also :OUTPUT means redirecting the error output to the output stream,
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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