signal SKIPPED-PROPERTIES & factor out interpreting exit codes

Unconditionally signalling FAILED-CHANGE does not make sense because perhaps
the type of condition C is not a subtype of SIMPLE-CONDITION.  Moreover, when
we invoke the SKIP-PROPERTY restart we do not actually pass the condition.
For simplicity, and since all we need is notification that a SKIP-PROPERTY
restart was invoked, instead define and signal a special-purpose condition.

Additionally, use an exit code to pass the signal between Lisp images.

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

2 files changed, 15 insertions, 16 deletions

diff --git a/src/connection/fork.lisp b/src/connection/fork.lisp
index 169552d..1eb6568 100644
--- a/src/connection/fork.lisp
+++ b/src/connection/fork.lisp
@@ -66,7 +66,7 @@ for example, such that we don't see it."
         (-1
          (error "fork(2) failed"))
         (0
-         (with-backtrace-and-exit-code-two
+         (with-backtrace-and-exit-code
            ;; Capture child stdout in case *STANDARD-OUTPUT* has been rebound
            ;; to somewhere else in the parent, e.g. by APPLY-AND-PRINT.  The
            ;; parent can then send the contents of the file named by OUTPUT to
@@ -89,10 +89,7 @@ for example, such that we don't see it."
              ;; (establish-connection :local)) here, but we need to kill off
              ;; the child afterwards, rather than returning to the child's
              ;; REPL or whatever else.
-             (uiop:quit
-              (if (eql :no-change (continue-deploy* connection remaining))
-                  0
-                  1)))))
+             (continue-deploy* connection remaining))))
         (t
          (multiple-value-bind (pid status) (waitpid child 0)
            (declare (ignore pid))
@@ -104,7 +101,8 @@ for example, such that we don't see it."
                 "Fork connection child did not exit normally, status #x~(~4,'0X~)"
                 status))
              (let ((exit-status (wexitstatus status)))
-               (unless (< exit-status 2)
-                 (failed-change
-                  "Fork connection child failed, exit code ~D" exit-status))
-               (values nil (and (zerop status) :no-change))))))))))
+               (return-exit
+                exit-status
+                :on-failure
+                (failed-change "Fork connection child failed, exit code ~D"
+                               exit-status))))))))))
diff --git a/src/connection/sbcl.lisp b/src/connection/sbcl.lisp
index fb862aa..ed68243 100644
--- a/src/connection/sbcl.lisp
+++ b/src/connection/sbcl.lisp
@@ -56,13 +56,14 @@ recommended."))
     (multiple-value-bind (program forms)
         (continue-deploy*-program remaining requirements)
       (multiple-value-bind (out err exit) (run :may-fail :input program *sbcl*)
-        (inform t (if (< exit 2) "done." "failed.") :fresh-line nil)
+        (inform t (if (< exit 3) "done." "failed.") :fresh-line nil)
         (when-let ((lines (lines out)))
           (inform t "  Output was:" :fresh-line nil)
           (with-indented-inform (inform t lines)))
-        (unless (< exit 2)
-          ;; print FORMS not PROGRAM because latter might contain sudo passwords
-          (failed-change
-	   "~&Remote Lisp failed; stderr was:~%~%~A~&~%Program we sent:~%~%~S"
-           err forms))
-        (values nil (if (zerop exit) :no-change nil))))))
+        (return-exit
+         exit
+         ;; print FORMS not PROGRAM because latter might contain sudo passwords
+         :on-failure
+         (failed-change
+	  "~&Remote Lisp failed; stderr was:~%~%~A~&~%Program we sent:~%~%~S"
+          err forms))))))