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 @@ ...@@ -205,6 +205,8 @@
(run-program (format nil "./exiter.sh 0 ~a" output-string) (run-program (format nil "./exiter.sh 0 ~a" output-string)
:error-output :output)) :error-output :output))
(define-test (define-test
":output <file> (file e.)" ":output <file> (file e.)"
(progn (progn
...@@ -380,6 +382,19 @@ ...@@ -380,6 +382,19 @@
(check-strings in-string out-string) (check-strings in-string out-string)
(close-streams process)))) (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*) (defvar *dynamic-input*)
(define-test (define-test
......
...@@ -3,7 +3,8 @@ ...@@ -3,7 +3,8 @@
(uiop/package:define-package :uiop/launch-program (uiop/package:define-package :uiop/launch-program
(:use :uiop/common-lisp :uiop/package :uiop/utility (: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 (:export
;;; Escaping the command invocation madness ;;; Escaping the command invocation madness
#:easy-sh-character-p #:escape-sh-token #:escape-sh-command #:easy-sh-character-p #:escape-sh-token #:escape-sh-command
...@@ -621,7 +622,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -621,7 +622,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(prop 'process pid-or-nil) (prop 'process pid-or-nil)
(when (eq input :stream) (prop 'input-stream in-or-io)) (when (eq input :stream) (prop 'input-stream in-or-io))
(when (eq output :stream) (prop 'output-stream out-or-err)) (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 (t
(prop 'process err-or-pid) (prop 'process err-or-pid)
(ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0)) (ecase (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0))
...@@ -630,7 +631,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -630,7 +631,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(2 (prop 'output-stream in-or-io)) (2 (prop 'output-stream in-or-io))
(3 (prop 'bidir-stream in-or-io))) (3 (prop 'bidir-stream in-or-io)))
(when (eq error-output :stream) (when (eq error-output :stream)
(prop 'error-stream out-or-err)))) (prop 'error-output-stream out-or-err))))
#+(or abcl clozure cmucl sbcl scl) #+(or abcl clozure cmucl sbcl scl)
(progn (progn
(prop 'process process) (prop 'process process)
...@@ -663,6 +664,11 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -663,6 +664,11 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
code ;; ignore code ;; ignore
(unless (zerop mode) (unless (zerop mode)
(prop (case mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) stream)) (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)) (prop 'process process))
#+lispworks #+lispworks
;; See also the comments on the process-info class ;; See also the comments on the process-info class
...@@ -674,7 +680,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object." ...@@ -674,7 +680,7 @@ LAUNCH-PROGRAM returns a PROCESS-INFO object."
(prop (ecase mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream)) (prop (ecase mode (1 'input-stream) (2 'output-stream) (3 'bidir-stream))
io-or-pid)) io-or-pid))
(when (eq error-output :stream) (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 ;; Prior to Lispworks 7, this returned (pid); now it
;; returns (io err pid) of which we keep io. ;; returns (io err pid) of which we keep io.
(t (prop 'process io-or-pid))))) (t (prop 'process io-or-pid)))))
......
Supports Markdown
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