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

fix (-> any/c boolean?) for the case of an impersonated struct predicate

Browse Source 
closes #1129
This commit is contained in:
Robby Findler 2015-11-10 08:56:45 -06:00
parent 54be64ad31
commit 3d31d86bf5
2 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test/tests/racket/contract/arrow.rkt
View File

@ -386,6 +386,13 @@
(test/pos-blame (test/pos-blame
'predicate/c13 'predicate/c13
'(contract (-> any/c boolean?) (λ (x #:y y) #t) 'pos 'neg)) '(contract (-> any/c boolean?) (λ (x #:y y) #t) 'pos 'neg))
(test/pos-blame
'predicate/c14
'(contract (-> any/c boolean?)
(let ()
(struct s ())
((impersonate-procedure s? (λ (x) (values (λ (r) "") x))) 11))
'pos 'neg))
;; this test ensures that no contract wrappers ;; this test ensures that no contract wrappers
;; are created for struct predicates ;; are created for struct predicates

4
racket/collects/racket/contract/private/arrow-val-first.rkt
View File

@ -1289,7 +1289,9 @@
given: "~e") given: "~e")
f)) f))
(cond (cond
[(struct-predicate-procedure? f) #f] [(and (struct-predicate-procedure? f)
(not (impersonator? f)))
#f]
[(and (equal? (procedure-arity f) 1) [(and (equal? (procedure-arity f) 1)
(let-values ([(required mandatory) (procedure-keywords f)]) (let-values ([(required mandatory) (procedure-keywords f)])
(and (null? required) (and (null? required)