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

Merge branch 'loliveira/asdf-fix-launch-program' into 'master'

Loliveira/asdf fix launch program

See merge request asdf/asdf!151
parents 7ca91d7a a6472e1e
......@@ -205,6 +205,8 @@
(run-program (format nil "./exiter.sh 0 ~a" output-string)
:error-output :output))
(define-test
":output <file> (file e.)"
(progn
......@@ -380,6 +382,19 @@
(check-strings in-string out-string)
(close-streams process))))
(define-test
":error-output :stream"
(let* ((error-output-string "Output to stream.")
(process
(launch-program (format nil "./exiter.sh 0 \"~a\" \"~a\"" output-string error-output-string)
:error-output :stream))
(error-output-stream (process-info-error-output process))
error-output-line)
(wait-process process)
(setf error-output-line (read-line error-output-stream))
(handle-result "Expected error output to with error output stream?"
(equal error-output-string error-output-line))))
(defvar *dynamic-input*)
(define-test
......
......@@ -3,7 +3,8 @@
(uiop/package:define-package :uiop/launch-program
(:use :uiop/common-lisp :uiop/package :uiop/utility
:uiop/pathname :uiop/os :uiop/filesystem :uiop/stream)
:uiop/pathname :uiop/os :uiop/filesystem :uiop/stream
:uiop/version)
(:export
;;; Escaping the command invocation madness
#:easy-sh-character-p #:escape-sh-token #:escape-sh-command
......@@ -621,7 +622,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(prop 'process pid-or-nil)
(when (eq input :stream) (prop 'input-stream in-or-io))
(when (eq output :stream) (prop 'output-stream out-or-err))
(when (eq error-output :stream) (prop 'error-stream err-or-pid)))
(when (eq error-output :stream) (prop 'error-output-stream err-or-pid)))
(t
(prop 'process err-or-pid)
(ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
......@@ -630,7 +631,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(2 (prop 'output-stream in-or-io))
(3 (prop 'bidir-stream in-or-io)))
(when (eq error-output :stream)
(prop 'error-stream out-or-err))))
(prop 'error-output-stream out-or-err))))
#+(or abcl clozure cmucl sbcl scl)
(progn
(prop 'process process)
......@@ -663,6 +664,11 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
code ;; ignore
(unless (zerop mode)
(prop (case mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) stream))
(when (eq error-output :stream)
(prop 'error-output-stream
(if (version< (lisp-implementation-version) "16.0.0")
(symbol-call :ext :external-process-error process)
(symbol-call :ext :external-process-error-stream process))))
(prop 'process process))
#+lispworks
;; See also the comments on the process-info class
......@@ -674,7 +680,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(prop (ecase mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream))
io-or-pid))
(when (eq error-output :stream)
(prop 'error-stream err-or-nil)))
(prop 'error-output-stream err-or-nil)))
;; Prior to Lispworks 7, this returned (pid); now it
;; returns (io err pid) of which we keep io.
(t (prop 'process io-or-pid)))))
......
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