Signal clear arity errors for wrong-arity parameterized-layer calls
Multi-argument parameterized layers silently mis-handled every
wrong-arity call:
- Missing args: cl-progv (since its Emacs 27 rewrite) binds
parameters beyond the supplied values to nil, never leaving them
unbound, so (tp-set "s" '(two-arg-layer "red")) quietly produced
(:foreground "red" :background nil) - while the docstring of
tp-layer-props-with-args falsely promised an unbound-variable
error.
- Excess flat-form args fell into extra-props and were applied as
garbage text-property KEYS with value nil ("green" as a property
name).
- The stack path (tp-push-layer with one arg for a two-parameter
layer) fell through tp--normalize-layer-spec's named-inline branch,
building an odd-length plist and dying with the cryptic "Odd length
text property list".
Fixes, per site:
- tp-layer-props-with-args checks (length args) against the arglist
and signals "tp layer NAME takes N argument(s), got M"; its
docstring now documents the explicit error instead of the
impossible unbound-parameter story. Extra values remain ignored
in this direct call, per the documented contract.
- tp--resolve-props signals the same error after the arity split when
fewer values were available (covering parameterized groups too),
and rejects flat-form excess positional args whose first extra
element is not a symbol (i.e. can never be a property key).
- tp--normalize-layer-spec signals "tp layer NAME expects N args,
got M" for any parameterized-layer arity mismatch instead of
falling through to the named-inline branch.
Correct-arity flat, wrapped, extra-props and group behavior is
unchanged (covered by controls in the new tests, which port the
review's verify-arg1 probe).
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
parent
e15a18d718
commit
117c714b97
@ -573,5 +573,89 @@
|
||||
(should-error (tp-describe-layer 'tp-layer-test-missing)
|
||||
:type 'user-error)))
|
||||
|
||||
;;; ARG-1: wrong-arity parameterized-layer calls signal clear errors
|
||||
|
||||
(defmacro tp-layer-tests--with-colors (&rest body)
|
||||
"Run BODY with the two-parameter test layer tp-lt-colors defined."
|
||||
(declare (indent 0))
|
||||
`(tp-layer-tests--with-clean
|
||||
(define-tp tp-lt-colors (fg bg)
|
||||
`(face (:foreground ,fg :background ,bg)))
|
||||
,@body))
|
||||
|
||||
(ert-deftest tp-layer-test-props-with-args-missing-arg-errors ()
|
||||
"tp-layer-props-with-args signals on fewer args than parameters.
|
||||
Since Emacs 27 `cl-progv' silently binds missing parameters to nil,
|
||||
so the old docstring's promised unbound-variable error could never
|
||||
fire; the arity is now checked explicitly (ARG-1)."
|
||||
(tp-layer-tests--with-colors
|
||||
(let ((err (should-error
|
||||
(tp-layer-props-with-args 'tp-lt-colors '("red")))))
|
||||
;; Parens are literal in Emacs regexps.
|
||||
(should (string-match-p "takes 2 argument(s), got 1" (cadr err))))
|
||||
;; Correct arity still works.
|
||||
(should (equal (tp-layer-props-with-args 'tp-lt-colors
|
||||
'("red" "blue"))
|
||||
'(face (:foreground "red" :background "blue"))))
|
||||
;; Extra values are still ignored, per the documented contract.
|
||||
(should (equal (tp-layer-props-with-args 'tp-lt-colors
|
||||
'("red" "blue" "green"))
|
||||
'(face (:foreground "red" :background "blue"))))))
|
||||
|
||||
(ert-deftest tp-layer-test-tp-set-flat-missing-arg-errors ()
|
||||
"The flat tp-set form with too few layer args signals, not nil-binds.
|
||||
Before ARG-1, (tp-set \"s\" \\='(layer \"red\")) on a two-parameter
|
||||
layer silently produced (:foreground \"red\" :background nil)."
|
||||
(tp-layer-tests--with-colors
|
||||
(should-error (tp-set "s" '(tp-lt-colors "red")))))
|
||||
|
||||
(ert-deftest tp-layer-test-tp-set-flat-excess-arg-errors ()
|
||||
"Flat-form excess positional args signal instead of corrupting props.
|
||||
Before ARG-1, the excess string fell into extra-props and was applied
|
||||
as a text-property KEY with value nil."
|
||||
(tp-layer-tests--with-colors
|
||||
(let ((err (should-error
|
||||
(tp-set "gg" '(tp-lt-colors "red" "blue" "green")))))
|
||||
(should (string-match-p "excess argument" (cadr err))))
|
||||
;; Correct-arity flat form is unchanged.
|
||||
(should (equal (text-properties-at
|
||||
0 (tp-set "ok" '(tp-lt-colors "red" "blue")))
|
||||
'(face (:foreground "red" :background "blue"))))
|
||||
;; Legitimate extra PROPS after the args still work.
|
||||
(should (equal (plist-get
|
||||
(text-properties-at
|
||||
0 (tp-set "ok" '(tp-lt-colors "red" "blue"
|
||||
help-echo "tip")))
|
||||
'help-echo)
|
||||
"tip"))
|
||||
;; The wrapped-args form with extra props is untouched as well.
|
||||
(should (equal (plist-get
|
||||
(text-properties-at
|
||||
0 (tp-set "ok" '(tp-lt-colors ("red" "blue")
|
||||
help-echo "tip")))
|
||||
'help-echo)
|
||||
"tip"))))
|
||||
|
||||
(ert-deftest tp-layer-test-stack-path-wrong-arity-clear-error ()
|
||||
"The stack path signals a clear arity error, not \"Odd length ...\".
|
||||
Before ARG-1, (tp-push-layer s \\='(layer \"red\")) fell through
|
||||
tp--normalize-layer-spec's named-inline branch, producing the odd
|
||||
plist (\"red\" tp-name layer) and the cryptic error \"Odd length
|
||||
text property list\"."
|
||||
(tp-layer-tests--with-colors
|
||||
(let ((err (should-error
|
||||
(tp-push-layer (copy-sequence "st")
|
||||
'(tp-lt-colors "red")))))
|
||||
(should (string-match-p "expects 2 args, got 1" (cadr err))))
|
||||
(let ((err (should-error
|
||||
(tp--normalize-layer-spec '(tp-lt-colors "red")))))
|
||||
(should (string-match-p "expects 2 args, got 1" (cadr err))))
|
||||
;; Correct arity through the stack path is unchanged.
|
||||
(let ((s (copy-sequence "st")))
|
||||
(tp-push-layer s '(tp-lt-colors "red" "blue"))
|
||||
(should (equal (text-properties-at 0 s)
|
||||
'(face (:foreground "red" :background "blue")
|
||||
tp-name tp-lt-colors))))))
|
||||
|
||||
(provide 'tp-layer-tests)
|
||||
;;; tp-layer-tests.el ends here
|
||||
|
||||
32
tp-layer.el
32
tp-layer.el
@ -879,8 +879,10 @@ two-parameter layer."
|
||||
"Return properties for parameterized layer LAYER-NAME with ARGS.
|
||||
ARGS is a list of argument values bound positionally (via `cl-progv',
|
||||
so dynamically) to the layer's parameters while the stored body form
|
||||
is evaluated. Extra values are ignored; missing ones leave their
|
||||
parameter unbound, which signals an error if the body refers to it.
|
||||
is evaluated. Extra values are ignored; passing fewer values than
|
||||
the layer has parameters signals a wrong-arity error (since Emacs 27
|
||||
`cl-progv' silently binds missing parameters to nil, so the arity is
|
||||
checked explicitly here).
|
||||
If INCLUDE-TP-NAME is non-nil, appends `tp-name' property to identify
|
||||
the layer.
|
||||
Recursively expands any nested layer names in the returned plist.
|
||||
@ -895,6 +897,9 @@ Returns nil when LAYER-NAME is not a parameterized layer."
|
||||
(let* ((entry (cdr (assoc layer-name tp-layer-alist)))
|
||||
(arglist (car entry))
|
||||
(body (cadr entry)))
|
||||
(when (< (length args) (length arglist))
|
||||
(error "tp layer %s takes %d argument(s), got %d"
|
||||
layer-name (length arglist) (length args)))
|
||||
(tp--check-layer-cycle layer-name)
|
||||
(let* ((tp--layer-expansion-stack
|
||||
(cons layer-name tp--layer-expansion-stack))
|
||||
@ -1234,6 +1239,22 @@ For group names, includes `tp-layers' property with the full layer stack."
|
||||
(cddr props)
|
||||
(tp--strip-trailing-plist-nil
|
||||
(-drop arity (cdr props)))))
|
||||
;; ARG-1: wrong-arity parameterized calls must signal
|
||||
;; clearly instead of nil-binding missing parameters or
|
||||
;; applying excess positional args as garbage property
|
||||
;; keys.
|
||||
(kind (cond ((tp-layer-parameterized-p first-elem) "layer")
|
||||
((tp-group-parameterized-p first-elem) "group")))
|
||||
(_arity-check
|
||||
(when kind
|
||||
(when (< (length args) arity)
|
||||
(error "tp %s %s takes %d argument(s), got %d"
|
||||
kind first-elem arity (length args)))
|
||||
(when (and (not wrapped-args)
|
||||
extra-props
|
||||
(not (symbolp (car extra-props))))
|
||||
(error "tp %s %s takes %d argument(s); excess argument %S is not a property key"
|
||||
kind first-elem arity (car extra-props)))))
|
||||
(layer-props
|
||||
(cond
|
||||
;; Parameterized layer - evaluate with the argument(s)
|
||||
@ -1439,6 +1460,13 @@ LAYER-SPEC can be:
|
||||
(or (tp-layer-props-with-args name rest t) ; include tp-name
|
||||
(error "Failed to resolve parameterized layer %S with args %S"
|
||||
name rest)))
|
||||
;; ARG-1: a parameterized layer with the wrong number of
|
||||
;; arguments must not fall through to the named-inline branch,
|
||||
;; which would build an odd-length plist and die with the
|
||||
;; cryptic "Odd length text property list".
|
||||
((tp-layer-parameterized-p name)
|
||||
(error "tp layer %s expects %d args, got %d"
|
||||
name (length (tp-layer-arglist name)) (length rest)))
|
||||
;; Named inline layer: (NAME &rest PLIST)
|
||||
(rest
|
||||
(append rest (list 'tp-name name)))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user