From ab2e5206be8337a4ea9ff185c766739e90318c64 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lu=C3=ADs=20Borges=20de=20Oliveira?= Date: Wed, 3 Jun 2020 13:06:20 +0100 Subject: [PATCH 1/3] LAUNCH-PROGRAM: fix ERROR-OUTPUT-STREAM slot name PROCESS-INFO contains an ERROR-OUTPUT-STREAM rather than an ERROR-STREAM slot. --- uiop/launch-program.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/uiop/launch-program.lisp b/uiop/launch-program.lisp index dbe8c66b..c03e1f2e 100644 --- a/uiop/launch-program.lisp +++ b/uiop/launch-program.lisp @@ -621,7 +621,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 +630,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) @@ -674,7 +674,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))))) -- GitLab From 210b0601efc38d07b7c97b13ae556003e2b8ed5f Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Wed, 18 Nov 2020 12:47:36 -0600 Subject: [PATCH 2/3] Test error output to stream. --- test/test-run-program-unix.script | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/test/test-run-program-unix.script b/test/test-run-program-unix.script index b261b453..a157e48c 100644 --- a/test/test-run-program-unix.script +++ b/test/test-run-program-unix.script @@ -205,6 +205,8 @@ (run-program (format nil "./exiter.sh 0 ~a" output-string) :error-output :output)) + + (define-test ":output (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 -- GitLab From a6472e1e56680850412b953fa0bccd1467709efb Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Thu, 19 Nov 2020 14:46:29 -0600 Subject: [PATCH 3/3] ECL patch from Eric Timmons. Eric writes: "Looks like uiop:launch-program never snagged the error output stream so the test was just running `(read-line nil)`." --- uiop/launch-program.lisp | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/uiop/launch-program.lisp b/uiop/launch-program.lisp index c03e1f2e..1a107666 100644 --- a/uiop/launch-program.lisp +++ b/uiop/launch-program.lisp @@ -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 @@ -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 -- GitLab