From 54c7597de21304b4cacbda21ca1e433697dc5736 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau Date: Tue, 11 Aug 2015 22:27:57 +0200 Subject: [PATCH] =?UTF-8?q?UIOP:=20Fix=20and=20use=20%run-program=20on=20E?= =?UTF-8?q?CL=20when=20applicable.=20Thanks=20to=20Daniel=20Kochma=C5=84sk?= =?UTF-8?q?i=20for=20his=20support.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- test/test-program.script | 2 -- test/test-run-program.script | 10 ---------- uiop/run-program.lisp | 11 +++++++---- 3 files changed, 7 insertions(+), 16 deletions(-) diff --git a/test/test-program.script b/test/test-program.script index 0867dc90..58d1429b 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -7,8 +7,6 @@ (assert (find-system :hello-world-example)) -(trace run-program #+(and sbcl os-windows) sb-ext:run-program) - ;; Try to load lisp-invocation from xcvb (initialize-source-registry `(:source-registry diff --git a/test/test-run-program.script b/test/test-run-program.script index f59137f6..1f68caab 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -1,13 +1,6 @@ ;; -*- Lisp -*- (declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0))) -#+(and clisp os-windows) -(ext:without-package-lock () - (trace uiop:run-program uiop/run-program::%run-program uiop/run-program::%system - ext:shell ext:run-shell-command ext:run-program)) - -#+(and sbcl os-windows) (trace sb-ext:run-program) - ;; On Windows, normalize away CRLF into jut the unixy LF. (defun dewindowize (x) (block () @@ -93,9 +86,6 @@ (with-output-to-string (*standard-output*) (run-program "echo ok" :output t :error-output :output))))) -;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess) -;;#+lispworks (trace system:run-shell-command system:pid-exit-status) - #| Testing run-program |# diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index ef7937de..9bd69146 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -426,10 +426,10 @@ It returns a process-info plist with possible keys: ;; NB: these implementations have unix vs windows set at compile-time. (declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists)) (assert (not (and wait (member :stream (list input output error-output))))) - #-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) + #-(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl) (progn command keys directory (error "run-program not available")) - #+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) + #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl) (let* ((%command (%normalize-command command)) (%input (%normalize-io-specifier input :input)) (%output (%normalize-io-specifier output :output)) @@ -585,7 +585,7 @@ It returns a process-info plist with possible keys: #+allegro (sys:reap-os-subprocess :pid process :wait t) #+clozure (nth-value 1 (ccl:external-process-status process)) #+(or cmu scl) (ext:process-exit-code process) - #+(or clasp ecl) (nth-value 1 (ext:external-process-status process)) + #+(or clasp ecl) (nth-value 1 (ext:external-process-wait process)) #+lispworks (if-let ((stream (or (getf process-info :input-stream) (getf process-info :output-stream) @@ -909,8 +909,11 @@ or an indication of failure via the EXIT-CODE of the process" (setf force-shell t))) (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (apply (if (or force-shell - #+(or clasp clisp ecl) (or (not ignore-error-status) t) + #+(or clasp clisp) (or (not ignore-error-status) t) #+clisp (member error-output '(:interactive :output)) + ;; old versions of ecl <= 15.3.7 don't support :error + #+ecl (and (nth-value 1 (ignore-errors (slot-value (ext:make-external-process) 'ext::error))) + (not (member error-output '(:interactive :output nil)))) #+(and lispworks os-unix) (%interactivep input output error-output) #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t) '%use-system '%use-run-program) -- GitLab