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
24483f02
Commit
24483f02
authored
Oct 01, 2013
by
Francois-Rene Rideau
Browse files
Fall back to %use-system where :error-output :output isn't supported (ABCL, CLISP).
Fix missing quote for stderr on allegro.
parent
02aaf3e8
Changes
3
Hide whitespace changes
Inline
Side-by-side
test/test-run-program.script
View file @
24483f02
...
...
@@ -37,7 +37,6 @@
(run-program "cat ; echo bar baz >&2 ; exit 42"
:input '("foo") :output :string :error-output '(:string :stripped t)
:ignore-error-status t)))
#-abcl
(assert-equal
'(("foo" "bar" "baz" "quux") nil 0)
(multiple-value-list
...
...
uiop/run-program.lisp
View file @
24483f02
...
...
@@ -363,7 +363,7 @@ for the implementation's underlying run-program function"
"Determines whether a run-program I/O specifier requires Lisp-side processing
via SLURP-INPUT-STREAM or VOMIT-OUTPUT-STREAM (return T),
or whether it's already taken care of by the implementation's underlying run-program."
(
not
(
typep
specifier
'
(
or
null
string
pathname
(
eql
:interactive
)
(
not
(
typep
specifier
'
(
or
null
string
pathname
(
member
:interactive
:output
)
#+
(
or
cmu
sbcl
scl
)
stream
#+
lispworks
file-stream
))))
;; not a type!? comm:socket-stream
...
...
@@ -442,7 +442,7 @@ It returns a process-info plist with possible keys:
(
multiple-value-list
(
apply
f
:input
%input
:output
%output
:allow-other-keys
t
`
(
,@
args
,@
keys
)))))
(
assert
(
eq
error-output
:
in
ter
active
))
(
assert
(
eq
%
error-output
:ter
minal
))
;;; since we now always return a code, we can't use this code path, anyway!
(
etypecase
%command
#+
os-windows
(
string
(
run
'ext:run-shell-command
%command
))
...
...
@@ -580,7 +580,7 @@ It returns a process-info plist with possible keys:
;; GF is the generic function to call to handle arbitrary values of SPEC
;; STREAM-EASY-P is T if we're going to use a RUN-PROGRAM that copies streams in the background
;; (it's only meaningful on CMUCL, SBCL, SCL that actually do it)
;; DIRECTION is :INPUT
or :
OUTPUT for the direction of this io argument
;; DIRECTION is :INPUT
, :OUTPUT or :ERROR-
OUTPUT for the direction of this io argument
;; FUN is a function of the new reduced spec and an activity function to call with a stream
;; when the subprocess is active and communicating through that stream.
;; ACTIVEP is a boolean true if we will get to run code while the process is running
...
...
@@ -588,36 +588,46 @@ It returns a process-info plist with possible keys:
;; RETURNER is a function called with the value of the activity.
;; --- TODO (fare@tunes.org): handle if-output-exists and such when doing it the hard way.
(
declare
(
ignorable
stream-easy-p
))
(
when
(
eq
spec
t
)
(
setf
spec
tval
))
(
labels
((
activity
(
stream
)
(
call-function
returner
(
call-stream-processor
gf
spec
stream
)))
(
easy-case
()
(
funcall
fun
spec
nil
))
(
hard-case
()
(
if
activep
(
funcall
fun
:stream
#'
activity
)
(
with-temporary-file
(
:pathname
tmp
:stream
s
:direction
(
ecase
direction
(
:input
:output
)
(
:output
:io
))
:element-type
element-type
:external-format
external-format
)
(
ecase
direction
(
:input
;; for input
(
unwind-protect
(
activity
s
)
(
ignore-errors
(
close
s
)))
(
funcall
fun
tmp
nil
))
(
:output
;; for output, error-output
(
unwind-protect
(
multiple-value-prog1
(
funcall
fun
tmp
nil
)
(
activity
s
))
(
ignore-errors
(
close
s
)))))))))
(
typecase
spec
((
or
null
string
pathname
(
eql
:interactive
))
(
easy-case
))
#+
(
or
cmu
sbcl
scl
)
;; streams are only easy on implementations that try very hard
(
stream
(
if
stream-easy-p
(
easy-case
)
(
hard-case
)))
(
t
(
hard-case
)))))
(
let*
((
actual-spec
(
if
(
eq
spec
t
)
tval
spec
))
(
activity-spec
(
if
(
eq
actual-spec
:output
)
(
ecase
direction
((
:input
:output
)
(
error
"~S not allowed as a ~S ~S spec"
:output
'run-program
direction
))
((
:error-output
)
nil
))
actual-spec
)))
(
labels
((
activity
(
stream
)
(
call-function
returner
(
call-stream-processor
gf
activity-spec
stream
)))
(
easy-case
()
(
funcall
fun
actual-spec
nil
))
(
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
)
(
ecase
direction
(
:input
(
unwind-protect
(
activity
s
)
(
ignore-errors
(
close
s
)))
(
funcall
fun
tmp
nil
))
((
:output
:error-output
)
(
unwind-protect
(
multiple-value-prog1
(
funcall
fun
tmp
nil
)
(
activity
s
))
(
ignore-errors
(
close
s
)))))))))
(
typecase
activity-spec
((
or
null
string
pathname
(
eql
:interactive
))
(
easy-case
))
#+
(
or
cmu
sbcl
scl
)
;; streams are only easy on implementations that try very hard
(
stream
(
if
stream-easy-p
(
easy-case
)
(
hard-case
)))
(
t
(
hard-case
))))))
(
defmacro
place-setter
(
place
)
(
when
place
...
...
@@ -650,7 +660,7 @@ It returns a process-info plist with possible keys:
#'
(
lambda
(
,
reduced-error-output-var
,
error-output-activity-var
)
,@
(
unless
eoavp
`
((
declare
(
ignore
,
error-output-activity-var
))))
,@
body
)
:output
,
error-output-form
,
active
(
place-setter
,
setf
)
,
keys
))
:
error-
output
,
error-output-form
,
active
(
place-setter
,
setf
)
,
keys
))
(
defun
%use-run-program
(
command
&rest
keys
&key
input
output
error-output
ignore-error-status
&allow-other-keys
)
...
...
@@ -659,8 +669,7 @@ It returns a process-info plist with possible keys:
(
assert
(
not
(
member
:stream
(
list
input
output
error-output
))))
(
let*
((
active-input-p
(
%active-io-specifier-p
input
))
(
active-output-p
(
%active-io-specifier-p
output
))
(
active-error-output-p
(
or
(
eq
error-output
:output
)
(
%active-io-specifier-p
error-output
)))
(
active-error-output-p
(
%active-io-specifier-p
error-output
))
(
activity
(
cond
(
active-output-p
:output
)
...
...
@@ -673,8 +682,7 @@ It returns a process-info plist with possible keys:
output
:keys
keys
:setf
output-result
:stream-easy-p
t
:active
(
eq
activity
:output
))
(
with-program-error-output
((
reduced-error-output
error-output-activity
)
(
unless
(
eq
error-output
:output
)
error-output
)
:keys
keys
:setf
error-output-result
error-output
:keys
keys
:setf
error-output-result
:stream-easy-p
t
:active
(
eq
activity
:error-output
))
(
with-program-input
((
reduced-input
input-activity
)
input
:keys
keys
...
...
@@ -839,6 +847,7 @@ or an indication of failure via the EXIT-CODE of the process"
(
apply
(
if
(
or
force-shell
#+
(
or
clisp
ecl
)
(
or
(
not
ignore-error-status
)
t
)
#+
clisp
(
eq
error-output
:interactive
)
#+
(
or
abcl
clisp
)
(
eq
:error-output
:output
)
#+
(
and
lispworks
os-unix
)
(
%interactivep
input
output
error-output
)
#+
(
or
abcl
cormanlisp
gcl
(
and
lispworks
os-windows
)
mcl
mkcl
xcl
)
t
)
'%use-system
'%use-run-program
)
...
...
uiop/stream.lisp
View file @
24483f02
...
...
@@ -63,7 +63,7 @@
(
defun
setup-stderr
()
(
setf
*stderr*
#.
(
or
#+
allegro
excl::*stderr*
#.
(
or
#+
allegro
'
excl::*stderr*
#+
clozure
'ccl::*stderr*
#+
(
or
cmu
scl
)
'system:*stderr*
#+
ecl
'ext::+process-error-output+
...
...
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