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:
Kinneyzhang 2026-07-27 01:49:47 +08:00
parent e15a18d718
commit 117c714b97
2 changed files with 114 additions and 2 deletions

View File

@ -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

View File

@ -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)))