Commit 1fa1f7a6 authored by Robert Goldman's avatar Robert Goldman

Merge branch 'bug/ecl-system-output' into 'master'

Bug fix: Avoid ext:system on ECL

ext:system is a wrapper around ext:run-program that forces :output  nil, which is not something we want. See also https://bugs.launchpad.net/asdf/+bug/1638870

See merge request !48
parents 077a4616 772330cd
...@@ -24,13 +24,6 @@ ...@@ -24,13 +24,6 @@
(leave-test (leave-test
"This test is not meant to be run on versions of CMU CL that predate 21B" 0)))) "This test is not meant to be run on versions of CMU CL that predate 21B" 0))))
#+ecl
(unless (version-satisfies
(lisp-implementation-version)
"16.1.2")
(leave-test
"This test is not meant to be run on versions of ECL that predate 16.1.2" 0))
#+mkcl #+mkcl
(unless (version-satisfies (lisp-implementation-version) "1.1.10") (unless (version-satisfies (lisp-implementation-version) "1.1.10")
(leave-test (leave-test
......
...@@ -965,17 +965,17 @@ or :error-output." ...@@ -965,17 +965,17 @@ or :error-output."
(string (string
(os-cond (os-cond
((os-windows-p) ((os-windows-p)
#+(or allegro clisp) #+(or allegro clisp ecl)
(strcat (%cmd-shell-pathname) " /c " command) (strcat (%cmd-shell-pathname) " /c " command)
#-(or allegro clisp) command) #-(or allegro clisp ecl) command)
(t command))) (t command)))
(list (escape-shell-command (list (escape-shell-command
(os-cond (os-cond
((os-unix-p) (cons "exec" command)) ((os-unix-p) (cons "exec" command))
((os-windows-p) ((os-windows-p)
#+(or allegro sbcl clisp) #+(or allegro clisp ecl sbcl)
(cons (%cmd-shell-pathname) (cons "/c" command)) (cons (%cmd-shell-pathname) (cons "/c" command))
#-(or allegro sbcl clisp) command) #-(or allegro clisp ecl sbcl) command)
(t command)))))) (t command))))))
(defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM (defun %redirected-system-command (command in out err directory) ;; helper for %USE-SYSTEM
...@@ -1012,18 +1012,28 @@ or :error-output." ...@@ -1012,18 +1012,28 @@ or :error-output."
error-output if-error-output-exists error-output if-error-output-exists
&allow-other-keys) &allow-other-keys)
"A portable abstraction of a low-level call to libc's system()." "A portable abstraction of a low-level call to libc's system()."
(declare (ignorable directory keys)) (declare (ignorable keys directory input if-input-does-not-exist output
;; see comments for these functions if-output-exists error-output if-error-output-exists))
(%handle-if-does-not-exist input if-input-does-not-exist) #+(or abcl allegro clozure cmucl ecl (and lispworks os-unix) mkcl sbcl scl)
(%handle-if-exists output if-output-exists) (let (#+(or abcl ecl mkcl) (version (parse-version (lisp-implementation-version))))
(%handle-if-exists error-output if-error-output-exists) (nest
#+(or allegro clozure cmucl (and lispworks os-unix) sbcl scl) #+abcl (unless (lexicographic< '< version '(1 4 0)))
(wait-process #+ecl (unless (lexicographic<= '< version '(16 0 0)))
(apply 'launch-program (%normalize-system-command command) :wait t keys)) #+mkcl (unless (lexicographic<= '< version '(1 1 9)))
(return-from %system
(wait-process
(apply 'launch-program (%normalize-system-command command) keys)))))
#+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl) #+(or abcl clasp clisp cormanlisp ecl gcl genera (and lispworks os-windows) mkcl xcl)
(let ((%command (%redirected-system-command command input output error-output directory))) (let ((%command (%redirected-system-command command input output error-output directory)))
#+(and lispworks os-windows) ;; see comments for these functions
(system:call-system %command :current-directory directory :wait t) (%handle-if-does-not-exist input if-input-does-not-exist)
(%handle-if-exists output if-output-exists)
(%handle-if-exists error-output if-error-output-exists)
#+abcl (ext:run-shell-command %command)
#+(or clasp ecl) (let ((*standard-input* *stdin*)
(*standard-output* *stdout*)
(*error-output* *stderr*))
(ext:system %command))
#+clisp #+clisp
(let ((raw-exit-code (let ((raw-exit-code
(or (or
...@@ -1034,19 +1044,14 @@ or :error-output." ...@@ -1034,19 +1044,14 @@ or :error-output."
(if (minusp raw-exit-code) (if (minusp raw-exit-code)
(- 128 raw-exit-code) (- 128 raw-exit-code)
raw-exit-code)) raw-exit-code))
#-(or clisp (and lispworks os-windows)) #+cormanlisp (win32:system %command)
(with-current-directory ((os-cond ((not (os-unix-p)) directory))) #+gcl (system:system %command)
#+abcl (ext:run-shell-command %command) ;; FIXME: deprecated #+genera (not-implemented-error '%system)
#+cormanlisp (win32:system %command) #+(and lispworks os-windows)
#+(or clasp ecl) (let ((*standard-input* *stdin*) (system:call-system %command :current-directory directory :wait t)
(*standard-output* *stdout*) #+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
(*error-output* *stderr*)) #+mkcl (mkcl:system %command)
(ext:system %command)) #+xcl (system:%run-shell-command %command)))
#+gcl (system:system %command)
#+genera (not-implemented-error '%system)
#+mcl (ccl::with-cstrs ((%%command %command)) (_system %%command))
#+mkcl (mkcl:system %command)
#+xcl (system:%run-shell-command %command))))
(defun %use-system (command &rest keys (defun %use-system (command &rest keys
&key input output error-output ignore-error-status &allow-other-keys) &key input output error-output ignore-error-status &allow-other-keys)
...@@ -1153,7 +1158,7 @@ or an indication of failure via the EXIT-CODE of the process" ...@@ -1153,7 +1158,7 @@ or an indication of failure via the EXIT-CODE of the process"
#+(or clasp clisp) t #+(or clasp clisp) t
;; A race condition in ECL <= 16.0.0 prevents using ext:run-program ;; A race condition in ECL <= 16.0.0 prevents using ext:run-program
#+ecl #.(if-let (ver (parse-version (lisp-implementation-version))) #+ecl #.(if-let (ver (parse-version (lisp-implementation-version)))
(lexicographic<= '< ver '(16 0 1))) (lexicographic<= '< ver '(16 0 0)))
#+(and lispworks os-unix) (%interactivep input output error-output) #+(and lispworks os-unix) (%interactivep input output error-output)
#+(or cormanlisp gcl (and lispworks os-windows) mcl xcl) t) #+(or cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
'%use-system '%use-launch-program) '%use-system '%use-launch-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