Commit 92e56247 authored by Elias Pipping's avatar Elias Pipping

Bug fix: Store exit code with Allegro CL

Have wait-process-result save the exit-code in process-info since we
cannot retrieve it again later.
parent 8dd8b1ea
...@@ -583,25 +583,28 @@ It returns a process-info object." ...@@ -583,25 +583,28 @@ It returns a process-info object."
(or (slot-value process-info 'exit-code) (or (slot-value process-info 'exit-code)
(let ((process (slot-value process-info 'process))) (let ((process (slot-value process-info 'process)))
(when process (when process
#-(or allegro clasp clozure cmucl ecl lispworks mkcl sbcl scl)
(error "~S not implemented" '%wait-process)
;; 1- wait ;; 1- wait
#+clozure (ccl::external-process-wait process) #+clozure (ccl::external-process-wait process)
#+(or cmucl scl) (ext:process-wait process) #+(or cmucl scl) (ext:process-wait process)
#+sbcl (sb-ext:process-wait process) #+sbcl (sb-ext:process-wait process)
;; 2- extract result ;; 2- extract result
#+allegro (multiple-value-bind (exit-code pid signal) (let ((exit-code
(sys:reap-os-subprocess :pid process :wait t) #+allegro (multiple-value-bind (exit-code pid signal)
(declare (ignore pid)) (sys:reap-os-subprocess :pid process :wait t)
(or signal exit-code)) (assert pid)
#+clozure (nth-value 1 (ccl:external-process-status process)) (or signal exit-code))
#+(or cmucl scl) (ext:process-exit-code process) #+clozure (nth-value 1 (ccl:external-process-status process))
#+(or clasp ecl) (nth-value 1 (ext:external-process-wait process t)) #+(or cmucl scl) (ext:process-exit-code process)
#+lispworks (funcall #+lispworks7+ #'sys:pipe-exit-status #+(or clasp ecl) (nth-value 1 (ext:external-process-wait process t))
#-lispworks7+ #'sys:pid-exit-status #+lispworks (funcall #+lispworks7+ #'sys:pipe-exit-status
process :wait t) #-lispworks7+ #'sys:pid-exit-status
#+mkcl (mkcl:join-process process) process :wait t)
#+sbcl (sb-ext:process-exit-code process) #+mkcl (mkcl:join-process process)
#-(or allegro clasp clozure cmucl ecl lispworks mkcl sbcl scl) #+sbcl (sb-ext:process-exit-code process)))
(error "~S not implemented" '%wait-process-result))))) (setf (slot-value process-info 'exit-code) exit-code)
exit-code)))))
(defun %check-result (exit-code &key command process ignore-error-status) (defun %check-result (exit-code &key command process ignore-error-status)
(unless ignore-error-status (unless ignore-error-status
......
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