dont use unsafe-{chaperone,impersonator}-procedure when {chaperone,impersonator}-procedure* might be involved
This commit is contained in:
parent
39a1b81b6a
commit
6723c64487
|
@ -379,6 +379,27 @@
|
||||||
'something-else 'yet-another-thing)
|
'something-else 'yet-another-thing)
|
||||||
1)))
|
1)))
|
||||||
|
|
||||||
|
(test/spec-passed/result
|
||||||
|
'chaperone-procedure*-and-contract-interaction
|
||||||
|
'(let ()
|
||||||
|
(define (f1 x) x)
|
||||||
|
|
||||||
|
(define-values (prop:p prop:p? prop:get-p)
|
||||||
|
(make-impersonator-property 'p))
|
||||||
|
|
||||||
|
(define the-answer 'dont-know)
|
||||||
|
|
||||||
|
(define f2 (chaperone-procedure*
|
||||||
|
f1
|
||||||
|
(λ (f x)
|
||||||
|
(set! the-answer (and (prop:p? f) (prop:get-p f)))
|
||||||
|
x)))
|
||||||
|
(define f3 (contract (-> integer? integer?) f2 'pos 'neg))
|
||||||
|
(define f4 (chaperone-procedure f3 #f prop:p 1234))
|
||||||
|
(f4 1)
|
||||||
|
the-answer)
|
||||||
|
1234)
|
||||||
|
|
||||||
(test/pos-blame
|
(test/pos-blame
|
||||||
'predicate/c1
|
'predicate/c1
|
||||||
'(contract predicate/c 1 'pos 'neg))
|
'(contract predicate/c 1 'pos 'neg))
|
||||||
|
|
|
@ -460,6 +460,10 @@
|
||||||
[(matches-arity-exactly? val min-arity max-arity req-kwd opt-kwd)
|
[(matches-arity-exactly? val min-arity max-arity req-kwd opt-kwd)
|
||||||
(if (and (null? req-kwd) (null? opt-kwd))
|
(if (and (null? req-kwd) (null? opt-kwd))
|
||||||
(cond
|
(cond
|
||||||
|
[(impersonator? val)
|
||||||
|
(if basic-unsafe-lambda
|
||||||
|
(values basic-lambda #f)
|
||||||
|
basic-lambda)]
|
||||||
[(and basic-unsafe-lambda
|
[(and basic-unsafe-lambda
|
||||||
basic-unsafe-lambda/result-values-assumed
|
basic-unsafe-lambda/result-values-assumed
|
||||||
(equal? contract-result-val-count
|
(equal? contract-result-val-count
|
||||||
|
|
Loading…
Reference in New Issue
Block a user