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

fix problem with procedure-chaperone, keywords, and proxy properties

Browse Source
This commit is contained in:
Matthew Flatt 2010-09-17 16:29:15 -06:00
parent 3866c3e450
commit f663307252
2 changed files with 26 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/racket/private/kw.rkt
View File

@ -1187,7 +1187,16 @@
(define (do-chaperone-procedure is-proxy? chaperone-procedure name proc wrap-proc props)
(if (or (not (keyword-procedure? proc))
(not (procedure? wrap-proc)))
(not (procedure? wrap-proc))
;; if any bad prop, let `chaperone-procedure' complain
(let loop ([props props])
(cond
[(null? props) #f]
[(proxy-property? (car props))
(let ([props (cdr props)])
(or (null? props)
(loop (cdr props))))]
[else #t])))
(apply chaperone-procedure proc wrap-proc props)
(let-values ([(a) (procedure-arity proc)]
[(b) (procedure-arity wrap-proc)]
@ -1317,5 +1326,5 @@
new-proc
(apply chaperone-struct new-proc
;; chaperone-struct insists on having at least one selector:
keyword-procedure-allowed values
keyword-procedure-allowed (lambda (s v) v)
props)))))))

15
collects/tests/racket/chaperone.rktl
View File

@ -1131,6 +1131,21 @@
(test #f equal? h2 f1)
(test #f equal? h3 f1))
;; ----------------------------------------
;; A regression test mixing `procedure-rename',
;; chaperones, and proxy properties:
(let ()
(define (f #:key k) k)
(define null-checker
(make-keyword-procedure
(λ (kwds kwd-vals . args) (apply values kwd-vals args))
(λ args (apply values args))))
(define-values (proxy-prop:p p? p-ref) (make-proxy-property 'p))
(define new-f
(chaperone-procedure f null-checker proxy-prop:p #t))
(test #t procedure? (procedure-rename new-f 'g)))
;; ----------------------------------------