diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index 89aa1857c7..97c9927d5d 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -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)