From c140c2d2ca44a54b36c8f2660616926531580a1e Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Wed, 2 Jun 2021 09:17:44 -0700 Subject: PROPUNAPPLY: fail when there is :APPLY but no :UNAPPLY Signed-off-by: Sean Whitton --- src/property.lisp | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/property.lisp b/src/property.lisp index 597d9bc..3242c9b 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -108,10 +108,22 @@ (defun propunapply (prop &rest args) (with-some-errors-are-failed-change - (let ((check (get prop 'check))) - (if (and check (not (apply check args))) - :no-change - (apply (get prop 'unapply (constantly :no-change)) args))))) + (let ((check (get prop 'check)) + (apply (get prop 'apply)) + (unapply (get prop 'unapply))) + ;; Only fail if there's no :UNAPPLY when there is an :APPLY, because + ;; that is the case in which we can't do what was requested. If there + ;; is no :APPLY then we can infer that there is nothing on the host to + ;; unapply (this will be the case for pure :HOSTATTRS properties). + (cond + ((or (and (not apply) (not unapply)) + (and check (not (apply check args)))) + :no-change) + (unapply + (apply unapply args)) + (apply + (failed-change +"Attempt to unapply property with :APPLY subroutine but no :UNAPPLY subroutine.")))))) (defun propappunapply (propapp) (if propapp -- cgit v1.2.3