diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-21 16:56:05 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-21 17:22:25 -0700 |
commit | 645e16867ed8caf4f6101ba08cfcef6828e22419 (patch) | |
tree | 140c4c475b7b8672f7ac2ccf77f7c12d18151ad0 /src/property.lisp | |
parent | 3822229ee9b5e9e4b582e7be43c37832bb0dbfa5 (diff) | |
download | consfigurator-645e16867ed8caf4f6101ba08cfcef6828e22419.tar.gz |
restore checking lambda list compat when setting property functions
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'src/property.lisp')
-rw-r--r-- | src/property.lisp | 38 |
1 files changed, 24 insertions, 14 deletions
diff --git a/src/property.lisp b/src/property.lisp index ccb1813..8fd8436 100644 --- a/src/property.lisp +++ b/src/property.lisp @@ -234,7 +234,13 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." (when (> (length ,declarations) 1) (error "Multiple DECLARE forms unsupported.")) ,@mforms - (let ((indent (cadr (assoc 'indent (cdar ,declarations))))) + (let ((indent (cadr (assoc 'indent (cdar ,declarations)))) + ;; Current implementation can DEFUN the property only when + ;; its :APPLY subroutine has the property's lambda list; + ;; this will fail to hold only for DEFPROPLIST/DEFPROPSPEC. + (can-defun + (and (getf ,slotsv :apply) + (equal (cadr (getf ,slotsv :apply)) ,lambdav)))) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (record-known-property ',,name)) @@ -246,19 +252,23 @@ parsing FORMSV and pushing SETPROP keyword argument pairs to plist SLOTSV." ;; routines of other properties. This can lead to clearer ;; code than going via DEFPROPSPEC/DEFPROPLIST for simple ;; things like installing packages. - (defun-which-calls ,,name (propapply ',,name) ,,lambdav - ;; Have to insert code to check connection type because - ;; %CONSFIGURE won't see a programmatic call and check - ;; this as is does for regular propapps. - ,@(and (eq ,typev :lisp) - '((assert-connection-supports :lisp))) - ;; Properties with :HOSTATTRS subroutines which set new - ;; hostattrs should not be used programmatically in this - ;; way, and using properties with :HOSTATTRS subroutines - ;; which only look at existing hostattrs has the potential - ;; for trouble too, so issue a warning. - ,@(and (getf ,slotsv :hostattrs) - '((warn-programmatic-apply-hostattrs)))))))))))) + ,@(and + can-defun + `((defun-which-calls ,,name (propapply ',,name) ,,lambdav + ;; Have to insert code to check connection type + ;; because %CONSFIGURE won't see a programmatic call + ;; and check this as is does for regular propapps. + ,@(and (eq ,typev :lisp) + '((assert-connection-supports :lisp))) + ;; Properties with :HOSTATTRS subroutines which set + ;; new hostattrs should not be used programmatically + ;; in this way, and using properties with :HOSTATTRS + ;; subroutines which only look at existing hostattrs + ;; has the potential for trouble too, so issue a + ;; warning. + ,@(and + (getf ,slotsv :hostattrs) + '((warn-programmatic-apply-hostattrs)))))))))))))) (defun warn-programmatic-apply-hostattrs () (warn "Calling property which has :HOSTATTRS subroutine programmatically. |