aboutsummaryrefslogtreecommitdiff
path: root/src/combinator.lisp
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2021-07-08 10:59:41 -0700
committerSean Whitton <spwhitton@spwhitton.name>2021-07-10 20:58:49 -0700
commitc59383aa6732d42ee51a01fabca39a91d275db46 (patch)
tree7691ffecb5c8f3e6ea21b4ecf7b659df6d04876c /src/combinator.lisp
parent47aa18cea2c8e81dd9b8baca8ca049d3b8c14a86 (diff)
downloadconsfigurator-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.lisp22
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)))))))