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
15
Issues
15
List
Boards
Labels
Service Desk
Milestones
Merge Requests
9
Merge Requests
9
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
0a240312
Commit
0a240312
authored
Oct 10, 2016
by
Elias Pipping
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix :if-error-output-exists :append/:supersede/:error
Add a test, too.
parent
46d62aae
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
48 additions
and
5 deletions
+48
-5
test/cat-to-stderr.sh
test/cat-to-stderr.sh
+3
-0
test/test-run-program-unix.script
test/test-run-program-unix.script
+31
-0
uiop/run-program.lisp
uiop/run-program.lisp
+14
-5
No files found.
test/cat-to-stderr.sh
0 → 100755
View file @
0a240312
#!/bin/sh
cat
"
$@
"
>
&2
test/test-run-program-unix.script
View file @
0a240312
...
...
@@ -308,6 +308,37 @@
:output *output-file*)
(check-output in-string)))
(define-test
":input <file> :error-output <file> (files e.), :i-e-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-to-stderr.sh" :input *input-file*
:error-output *error-output-file*)
(create-file-from-string *input-file* in-string2)
(with-expected-failure (t)
(run-program "./cat-to-stderr.sh" :input *input-file*
:error-output *error-output-file*
:if-error-output-exists :error))
(check-error-output in-string1))))
(define-test
":input <file> :error-output <file> (files e.), :i-e-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-to-stderr.sh" :input *input-file*
:error-output *error-output-file*)
(create-file-from-string *input-file* in-string2)
(run-program "./cat-to-stderr.sh" :input *input-file*
:error-output *error-output-file*
:if-error-output-exists :append)
(check-error-output (concatenate 'string in-string1 in-string2)))))
(define-test
":output <fstream> :error-output <fstream>"
(progn
...
...
uiop/run-program.lisp
View file @
0a240312
...
...
@@ -478,6 +478,9 @@ ERROR-OUTPUT is similar to OUTPUT. T designates the *ERROR-OUTPUT*,
and :STREAM causes a stream to be made available via
PROCESS-INFO-ERROR-OUTPUT.
IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
affects ERROR-OUTPUT rather than OUTPUT.
INPUT is similar to OUTPUT, except that T designates the
*STANDARD-INPUT* and a stream requested through the :STREAM keyword
would be available through PROCESS-INFO-INPUT.
...
...
@@ -519,6 +522,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
'launch-program
))
(
%handle-if-does-not-exist
input
if-input-does-not-exist
)
(
%handle-if-exists
output
if-output-exists
)
(
%handle-if-exists
error-output
if-error-output-exists
)
#+
(
or
abcl
allegro
clozure
cmucl
ecl
(
and
lispworks
os-unix
)
mkcl
sbcl
scl
)
(
let*
((
%command
(
%normalize-command
command
))
(
%input
(
%normalize-io-specifier
input
:input
))
...
...
@@ -549,7 +553,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
:if-input-does-not-exist
:error
:if-output-exists
:append
#-
(
or
allegro
lispworks
)
:if-error-exists
#+
(
or
allegro
lispworks
)
:if-error-output-exists
,
if-error-output-exists
#+
(
or
allegro
lispworks
)
:if-error-output-exists
:append
:allow-other-keys
t
)
#+
allegro
`
(
:directory
,
directory
)
#+
(
and
allegro
os-windows
)
`
(
:show-window
,
(
if
interactive
nil
:hide
))
...
...
@@ -961,14 +965,14 @@ or :error-output."
(
string
(
parse-native-namestring
spec
))
(
pathname
spec
)
((
eql
:output
)
(
unless
(
equal
operator
" 2>"
)
(
unless
(
equal
operator
" 2>
>
"
)
(
parameter-error
"~S: only the ~S argument can be ~S"
'run-program
:error-output
:output
))
(
return-from
redirect
'
(
" 2>&1"
))))))
(
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
...
...
@@ -984,11 +988,13 @@ or :error-output."
(
defun
%system
(
command
&rest
keys
&key
directory
input
if-input-does-not-exist
output
if-output-exists
error-output
&allow-other-keys
)
error-output
if-error-output-exists
&allow-other-keys
)
"A portable abstraction of a low-level call to libc's system()."
(
declare
(
ignorable
error-output
directory
keys
))
(
declare
(
ignorable
directory
keys
))
(
%handle-if-does-not-exist
input
if-input-does-not-exist
)
(
%handle-if-exists
output
if-output-exists
)
(
%handle-if-exists
error-output
if-error-output-exists
)
#+
(
or
allegro
clozure
cmucl
(
and
lispworks
os-unix
)
sbcl
scl
)
(
wait-process
(
apply
'launch-program
(
%normalize-system-command
command
)
:wait
t
keys
))
...
...
@@ -1086,6 +1092,9 @@ as the second value of RUN-PROGRAM. T designates the *ERROR-OUTPUT*.
Also :OUTPUT means redirecting the error output to the output stream,
in which case NIL is returned.
IF-ERROR-OUTPUT-EXISTS is similar to IF-OUTPUT-EXIST, except that it
affects ERROR-OUTPUT rather than OUTPUT.
INPUT is similar to OUTPUT, except that VOMIT-OUTPUT-STREAM is used,
no value is returned, and T designates the *STANDARD-INPUT*.
...
...
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