diff --git a/pkgs/racket-test-core/tests/racket/procs.rktl b/pkgs/racket-test-core/tests/racket/procs.rktl index c241c24615..e28f31aea6 100644 --- a/pkgs/racket-test-core/tests/racket/procs.rktl +++ b/pkgs/racket-test-core/tests/racket/procs.rktl @@ -758,4 +758,21 @@ ;; ---------------------------------------- +(let () + (struct a () + #:property prop:procedure (lambda (a x) + (list a x))) + + (define the-a (a)) + + (struct b () + #:property prop:procedure the-a) + + (define the-b (b)) + + (test (list the-a the-b) the-b) + (test 0 procedure-arity the-b)) + +;; ---------------------------------------- + (report-errs) diff --git a/racket/src/cs/rumble/procedure.ss b/racket/src/cs/rumble/procedure.ss index f444ffbf27..15375db0ec 100644 --- a/racket/src/cs/rumble/procedure.ss +++ b/racket/src/cs/rumble/procedure.ss @@ -132,15 +132,15 @@ orig-f (and n-args (fx+ n-args 1)) (lambda (v) - (cond - [(not v) (case-lambda)] - [else - (case-lambda - [() (v f)] - [(a) (v f a)] - [(a b) (v f a b)] - [(a b c) (v f a b c)] - [args (chez:apply v f args)])])) + (let ([proc (case-lambda + [() (v f)] + [(a) (v f a)] + [(a b) (v f a b)] + [(a b c) (v f a b c)] + [args (chez:apply v f args)])]) + (if success-k + (success-k proc) + proc))) wrong-arity-wrapper)]))]))] [else (fail-k orig-f)]))