diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-07-08 10:59:41 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-07-10 20:58:49 -0700 |
commit | c59383aa6732d42ee51a01fabca39a91d275db46 (patch) | |
tree | 7691ffecb5c8f3e6ea21b4ecf7b659df6d04876c /src/combinator.lisp | |
parent | 47aa18cea2c8e81dd9b8baca8ca049d3b8c14a86 (diff) | |
download | consfigurator-c59383aa6732d42ee51a01fabca39a91d275db46.tar.gz |
APPLY-AND-PRINT: ensure print "failed" if there is a non-local exit
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/combinator.lisp')
-rw-r--r-- | src/combinator.lisp | 22 |
1 files changed, 13 insertions, 9 deletions
diff --git a/src/combinator.lisp b/src/combinator.lisp index 9e5ee8f..3598e9b 100644 --- a/src/combinator.lisp +++ b/src/combinator.lisp @@ -139,7 +139,11 @@ apply the elements of REQUIREMENTS in reverse order." (not (and (< *consfigurator-debug-level* 3) (char= #\% (char (symbol-name (car propapp)) 0)) (not (get (car propapp) 'desc)))))) - result) + ;; Initialise to FAILED-CHANGE here so that if there is a + ;; non-local exit from us we print "failed". For example, if + ;; the user or a combinator invokes a SKIP-PROPERTY restart + ;; established further down the property call stack. + (result 'failed-change)) (unwind-protect-in-parent (setq result (restart-case (if announce @@ -156,15 +160,15 @@ apply the elements of REQUIREMENTS in reverse order." (or (> *consfigurator-debug-level* 1) (not (eql result :no-change)))) (fresh-line) - (princ buffer))) + (princ buffer)) + (when announce + (informat t "~&~@[~A :: ~]~@[~A ... ~]~A~%" + (get-hostname) (propappdesc propapp) + (case result + (:no-change "ok") + ('failed-change "failed") + (t "done"))))) (setf (fill-pointer buffer) 0) - (when announce - (informat t "~&~@[~A :: ~]~@[~A ... ~]~A~%" - (get-hostname) (propappdesc propapp) - (case result - (:no-change "ok") - ('failed-change "failed") - (t "done")))) (unless (eql result :no-change) (setq return-value result))))))) |