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

improve the first-order checking for the current class/c implementation

Browse Source 
(not strictly necessary, but the new, still pending class/c first-order
checking checks the arities of the methods and those additional
tests got put into the test suite, so the easiest thing for now
is just to make the current class/c implementation do that check too)
This commit is contained in:
Robby Findler 2013-12-13 12:02:53 -06:00
parent 45b4bd5667
commit 52c74701ec
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
racket/collects/racket/private/class-internal.rkt
View File

@ -2810,11 +2810,17 @@ An example
(unless (-class? cls) ;; TODO: might be a wrapper class (unless (-class? cls) ;; TODO: might be a wrapper class
(fail '(expected: "a class" given: "~v") cls)) (fail '(expected: "a class" given: "~v") cls))
(let ([method-ht (class-method-ht cls)] (let ([method-ht (class-method-ht cls)]
[methods (class-methods cls)]
[beta-methods (class-beta-methods cls)] [beta-methods (class-beta-methods cls)]
[meth-flags (class-meth-flags cls)]) [meth-flags (class-meth-flags cls)])
(for ([m (class/c-methods ctc)]) (for ([m (in-list (class/c-methods ctc))]
(unless (hash-ref method-ht m #f) [c (in-list (class/c-method-contracts ctc))])
(fail "no public method ~a" m))) (define mth (hash-ref method-ht m #f))
(unless mth (fail "no public method ~a" m))
(unless (contract-first-order-passes?
c
(vector-ref methods mth))
(fail "public method ~a doesn't match contract" m)))
(unless (class/c-opaque? ctc) (unless (class/c-opaque? ctc)
(for ([m (class/c-absents ctc)]) (for ([m (class/c-absents ctc)])
(when (hash-ref method-ht m #f) (when (hash-ref method-ht m #f)