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

fix class/c contract-name implementation

Browse Source 
specifically, fix the case where a field doesn't have
a contract, but just has to exist
This commit is contained in:
Robby Findler 2014-02-12 10:15:49 -06:00
parent 83eab4158a
commit 53d30648f9
2 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt
View File

@ -352,6 +352,7 @@
(override [o (->m (<=/c 2) integer?)])
(augment [p (->m (<=/c 3) integer?)])
(augride [q (->m (<=/c 4) integer?)])))
(test-name '(class/c (field n)) (class/c (field n)))
(test-name '(struct/dc s
[a integer?]

7
racket/collects/racket/private/class-c-new.rkt
View File

@ -448,7 +448,9 @@
[else
(define field-names
(for/list ([(fld ctc) (in-hash (ext-class/c-contract-table-of-flds-to-ctcs c))])
`(,fld ,(contract-name ctc))))
(if (just-check-existence? ctc)
fld
`(,fld ,(contract-name ctc)))))
(define init-fields '())
(define init-names
(filter
@ -468,7 +470,8 @@
(set! init-fields (cons clause init-fields))
#f]
[else clause])]))))
(set! field-names (filter (λ (x) (not (member (car x) (map car init-fields))))
(set! field-names (filter (λ (x) (or (not (pair? x))
(not (member (car x) (map car init-fields)))))
field-names))
(define meth-names