From 92e56247394f44b9fe889bc137fe80802f855699 Mon Sep 17 00:00:00 2001
From: Elias Pipping <elias.pipping@fu-berlin.de>
Date: Thu, 11 Aug 2016 18:26:46 +0200
Subject: [PATCH] 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.
---
 uiop/run-program.lisp | 31 +++++++++++++++++--------------
 1 file changed, 17 insertions(+), 14 deletions(-)

diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp
index 61ab0a72..04dd0de9 100644
--- a/uiop/run-program.lisp
+++ b/uiop/run-program.lisp
@@ -583,25 +583,28 @@ It returns a process-info object."
     (or (slot-value process-info 'exit-code)
         (let ((process (slot-value process-info 'process)))
           (when process
+            #-(or allegro clasp clozure cmucl ecl lispworks mkcl sbcl scl)
+            (error "~S not implemented" '%wait-process)
             ;; 1- wait
             #+clozure (ccl::external-process-wait process)
             #+(or cmucl scl) (ext:process-wait process)
             #+sbcl (sb-ext:process-wait process)
             ;; 2- extract result
-            #+allegro (multiple-value-bind (exit-code pid signal)
-                          (sys:reap-os-subprocess :pid process :wait t)
-                        (declare (ignore pid))
-                        (or signal exit-code))
-            #+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)
-            #+mkcl (mkcl:join-process process)
-            #+sbcl (sb-ext:process-exit-code process)
-            #-(or allegro clasp clozure cmucl ecl lispworks mkcl sbcl scl)
-            (error "~S not implemented" '%wait-process-result)))))
+            (let ((exit-code
+                   #+allegro (multiple-value-bind (exit-code pid signal)
+                                 (sys:reap-os-subprocess :pid process :wait t)
+                               (assert pid)
+                               (or signal exit-code))
+                   #+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)
+                   #+mkcl (mkcl:join-process process)
+                   #+sbcl (sb-ext:process-exit-code process)))
+              (setf (slot-value process-info 'exit-code) exit-code)
+              exit-code)))))
 
   (defun %check-result (exit-code &key command process ignore-error-status)
     (unless ignore-error-status
-- 
GitLab