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

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
Loading
Loading
Loading
Loading
+17 −14
Original line number Diff line number Diff line
@@ -583,14 +583,17 @@ 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
            (let ((exit-code
                   #+allegro (multiple-value-bind (exit-code pid signal)
                                 (sys:reap-os-subprocess :pid process :wait t)
                        (declare (ignore pid))
                               (assert pid)
                               (or signal exit-code))
                   #+clozure (nth-value 1 (ccl:external-process-status process))
                   #+(or cmucl scl) (ext:process-exit-code process)
@@ -599,9 +602,9 @@ It returns a process-info object."
                                        #-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)))))
                   #+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