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

Filter out overrideable checks for both super and override contracts, add

Browse Source 
check against final methods (and change check for augmentable ones).

svn: r18161
This commit is contained in:
Stevie Strickland 2010-02-18 22:06:41 +00:00
parent 7abafad8b1
commit 87c5e94fc3
1 changed files with 33 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
collects/scheme/private/class-internal.ss
View File

@ -2399,42 +2399,41 @@
(if blame
(apply raise-blame-error blame cls str args)
(return #f)))
(define method-ht (class-method-ht cls))
(define beta-methods (class-beta-methods cls))
(define meth-flags (class-meth-flags cls))
(define (check-overrideable m)
(let ([index (hash-ref method-ht m #f)])
(unless index
(failed "no public method ~a" m))
(let ([flag (vector-ref meth-flags index)])
(when (eq? flag 'final)
(failed "method ~a is final, not overrideable" m))
(when (eq? flag 'augmentable)
(failed "method ~a is augmentable, not overrideable" m)))))
(unless (class? cls)
(failed "not a class"))
(let ([method-ht (class-method-ht cls)])
(for ([m (class/c-methods ctc)])
(unless (hash-ref method-ht m #f)
(failed "no public method ~a" m)))
(for ([m (class/c-overrides ctc)])
(let ([index (hash-ref method-ht m #f)])
(unless index
(failed "no public method ~a" m))
(let ([vec (vector-ref (class-beta-methods cls) index)])
(when (and (positive? (vector-length vec))
(not (vector-ref vec (sub1 (vector-length vec)))))
(failed "method ~a is not overrideable" m)))))
(for ([m (class/c-augments ctc)])
(let ([index (hash-ref method-ht m #f)])
(unless index
(failed "no public method ~a" m))
(let ([vec (vector-ref (class-beta-methods cls) index)])
(when (zero? (vector-length vec))
(failed "method ~a has never been augmentable" m)))))
(for ([s (class/c-supers ctc)])
(let ([index (hash-ref method-ht s #f)])
(unless index
(failed "no public method ~a" s))
(let ([vec (vector-ref (class-beta-methods cls) index)])
(when (and (positive? (vector-length vec))
(not (vector-ref vec (sub1 (vector-length vec)))))
(failed "method ~a is not overrideable" s)))))
(for ([i (class/c-inners ctc)])
(let ([index (hash-ref method-ht i #f)])
(unless index
(failed "no public method ~a" i))
(let* ([super (vector-ref (class-supers cls) (sub1 (class-pos cls)))])
(unless (eq? (vector-ref (class-meth-flags cls) index) 'augmentable)
(failed "method ~a is not augmentable" i))))))
(for ([m (class/c-methods ctc)])
(unless (hash-ref method-ht m #f)
(failed "no public method ~a" m)))
(for ([m (class/c-overrides ctc)])
(check-overrideable m))
(for ([m (class/c-augments ctc)])
(let ([index (hash-ref method-ht m #f)])
(unless index
(failed "no public method ~a" m))
(let ([vec (vector-ref beta-methods index)])
(when (zero? (vector-length vec))
(failed "method ~a has never been augmentable" m)))))
(for ([s (class/c-supers ctc)])
(check-overrideable s))
(for ([i (class/c-inners ctc)])
(let ([index (hash-ref method-ht i #f)])
(unless index
(failed "no public method ~a" i))
(let* ([super (vector-ref (class-supers cls) (sub1 (class-pos cls)))])
(unless (eq? (vector-ref meth-flags index) 'augmentable)
(failed "method ~a is not augmentable" i)))))
(let ([field-ht (class-field-ht cls)])
(for ([m (class/c-fields ctc)])
(unless (hash-ref field-ht m #f)