suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: fix keyword-procedure chaperone with properties

Browse Source 
Closes #2569
This commit is contained in:
Matthew Flatt 2019-03-29 10:46:29 -06:00
parent 793d655770
commit fdad73df32
2 changed files with 27 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -3400,6 +3400,26 @@
(test gen current-pseudo-random-generator) (test gen current-pseudo-random-generator)
(test gen impersonated-current-pseudo-random-generator))) (test gen impersonated-current-pseudo-random-generator)))
;; ----------------------------------------
;; Test keyword-argument procedures and impersonator properties
(let ()
(define (group-rows #:group x) 1)
(define-values (impersonator-prop:contracted
has-impersonator-prop:contracted?
get-impersonator-prop:contracted)
(make-impersonator-property 'impersonator-prop:contracted))
(define group-rows*
(chaperone-procedure group-rows
(λ (#:group x) (list x))
impersonator-prop:contracted 2))
(test #t procedure? group-rows*)
(test #t has-impersonator-prop:contracted? group-rows*)
(test 1 'apply (group-rows* #:group 10)))
;; ---------------------------------------- ;; ----------------------------------------
(report-errs) (report-errs)

19
racket/src/cs/rumble/impersonator.ss
View File

@ -610,18 +610,13 @@
;; ---------------------------------------- ;; ----------------------------------------
(define (set-impersonator-applicables!) (define (set-impersonator-applicables!)
(struct-property-set! prop:procedure (let ([add (lambda (rtd)
(record-type-descriptor props-procedure-impersonator) (struct-property-set! prop:procedure rtd impersonate-apply)
impersonate-apply) (struct-property-set! prop:procedure-arity rtd 3))])
(struct-property-set! prop:procedure (add (record-type-descriptor props-procedure-impersonator))
(record-type-descriptor props-procedure-chaperone) (add (record-type-descriptor props-procedure-chaperone))
impersonate-apply) (add (record-type-descriptor props-procedure~-impersonator))
(struct-property-set! prop:procedure-arity (add (record-type-descriptor props-procedure~-chaperone)))
(record-type-descriptor props-procedure-impersonator)
3)
(struct-property-set! prop:procedure-arity
(record-type-descriptor props-procedure-chaperone)
3)
(struct-property-set! prop:procedure (struct-property-set! prop:procedure
(record-type-descriptor impersonator-property-accessor-procedure) (record-type-descriptor impersonator-property-accessor-procedure)