From 242b5506ee4f567513eff93ac163d6938c77edc3 Mon Sep 17 00:00:00 2001 From: Elias Pipping <elias.pipping@fu-berlin.de> Date: Sat, 27 Aug 2016 21:07:13 +0000 Subject: [PATCH] Bug fix: Return non-zero after signal on LispWorks --- uiop/run-program.lisp | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index 04dd0de9..4cbf606a 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -547,7 +547,7 @@ It returns a process-info object." (when process (prop 'process process))) #+lispworks (if wait - (prop 'exit-code (first process*)) + (prop 'exit-code (or (second process*) (first process*))) (let ((mode (+ (if (eq input :stream) 1 0) (if (eq output :stream) 2 0)))) (if (or (plusp mode) (eq error-output :stream)) (destructuring-bind (io err pid) process* @@ -598,9 +598,13 @@ It returns a process-info object." #+clozure (nth-value 1 (ccl:external-process-status process)) #+(or cmucl scl) (ext:process-exit-code process) #+(or clasp ecl) (nth-value 1 (ext:external-process-wait process t)) - #+lispworks (funcall #+lispworks7+ #'sys:pipe-exit-status - #-lispworks7+ #'sys:pid-exit-status - process :wait t) + #+lispworks + ;; a signal is only returned on LispWorks 7+ + (multiple-value-bind (exit-code signal) + (funcall #+lispworks7+ #'sys:pipe-exit-status + #-lispworks7+ #'sys:pid-exit-status + process :wait t) + (or signal exit-code)) #+mkcl (mkcl:join-process process) #+sbcl (sb-ext:process-exit-code process))) (setf (slot-value process-info 'exit-code) exit-code) -- GitLab