Commit 54c7597d authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

UIOP: Fix and use %run-program on ECL when applicable.

Thanks to Daniel Kochmański for his support.
parent 71f6e795
...@@ -7,8 +7,6 @@ ...@@ -7,8 +7,6 @@
(assert (find-system :hello-world-example)) (assert (find-system :hello-world-example))
(trace run-program #+(and sbcl os-windows) sb-ext:run-program)
;; Try to load lisp-invocation from xcvb ;; Try to load lisp-invocation from xcvb
(initialize-source-registry (initialize-source-registry
`(:source-registry `(:source-registry
......
;; -*- Lisp -*- ;; -*- Lisp -*-
(declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0))) (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. ;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x) (defun dewindowize (x)
(block () (block ()
...@@ -93,9 +86,6 @@ ...@@ -93,9 +86,6 @@
(with-output-to-string (*standard-output*) (with-output-to-string (*standard-output*)
(run-program "echo ok" :output t :error-output :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 Testing run-program
|# |#
......
...@@ -426,10 +426,10 @@ It returns a process-info plist with possible keys: ...@@ -426,10 +426,10 @@ It returns a process-info plist with possible keys:
;; NB: these implementations have unix vs windows set at compile-time. ;; 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)) (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))))) (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 (progn command keys directory
(error "run-program not available")) (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)) (let* ((%command (%normalize-command command))
(%input (%normalize-io-specifier input :input)) (%input (%normalize-io-specifier input :input))
(%output (%normalize-io-specifier output :output)) (%output (%normalize-io-specifier output :output))
...@@ -585,7 +585,7 @@ It returns a process-info plist with possible keys: ...@@ -585,7 +585,7 @@ It returns a process-info plist with possible keys:
#+allegro (sys:reap-os-subprocess :pid process :wait t) #+allegro (sys:reap-os-subprocess :pid process :wait t)
#+clozure (nth-value 1 (ccl:external-process-status process)) #+clozure (nth-value 1 (ccl:external-process-status process))
#+(or cmu scl) (ext:process-exit-code 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 #+lispworks
(if-let ((stream (or (getf process-info :input-stream) (if-let ((stream (or (getf process-info :input-stream)
(getf process-info :output-stream) (getf process-info :output-stream)
...@@ -909,8 +909,11 @@ or an indication of failure via the EXIT-CODE of the process" ...@@ -909,8 +909,11 @@ or an indication of failure via the EXIT-CODE of the process"
(setf force-shell t))) (setf force-shell t)))
(flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive))))
(apply (if (or force-shell (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)) #+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) #+(and lispworks os-unix) (%interactivep input output error-output)
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t) #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
'%use-system '%use-run-program) '%use-system '%use-run-program)
......
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