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

In some ways, I'm still trying to decide exactly what some of these forms mean.

Browse Source 
For example, if we're in the java part of a beta-java chain, can we still add
an inner contract?  If so, it should affect each java-style overriding method
until we reach the next beta-style augmenting method.

It can just be confusing, because one might thing that inner in a
contract => needs an augmenting method in the subclass, super => needs
an overriding method in the subclass.  The latter is true, since only
the next immediate method can reach the super class's implementation,
but inner jumps to the next augmenting method, so the former isn't
necessarily true.

svn: r18179
This commit is contained in:
Stevie Strickland 2010-02-19 04:27:44 +00:00
parent b59955bc01
commit 5cc68fdd0f
2 changed files with 40 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2428,7 +2428,7 @@
(failed "method ~a was previously augmentable" m)))
(let ([flag (vector-ref meth-flags index)])
(when (eq? flag 'final)
(failed "method ~a is final, not overrideable" m)))))
(failed "method ~a is final" m)))))
(for ([m (class/c-augments ctc)])
(let ([index (hash-ref method-ht m #f)])
(unless index
@ -2442,16 +2442,19 @@
(failed "no public method ~a" s))
(let ([flag (vector-ref meth-flags index)])
(when (eq? flag 'final)
(failed "method ~a is final, not overrideable" s))
(failed "method ~a is final" s))
(when (eq? flag 'augmentable)
(failed "method ~a is augmentable, 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 meth-flags index) 'augmentable)
(failed "method ~a is not augmentable" i)))))
(let ([vec (vector-ref beta-methods index)])
(when (zero? (vector-length vec))
(failed "method ~a has never been augmentable" i)))
(let ([flag (vector-ref meth-flags index)])
(when (eq? flag 'final)
(failed "method ~a is final" i)))))
(let ([field-ht (class-field-ht cls)])
(for ([m (class/c-fields ctc)])
(unless (hash-ref field-ht m #f)

33
collects/tests/mzscheme/contract-test.ss
View File

@ -4181,7 +4181,7 @@
'pos
'neg))
(test/pos-blame
(test/spec-passed
'class/c-first-order-inner-4
'(contract (class/c (inner [m (-> any/c number? number?)]))
(let ([c% (class object% (super-new) (define/pubment (m x) (inner x m x)))])
@ -4197,6 +4197,15 @@
'pos
'neg))
(test/pos-blame
'class/c-first-order-inner-6
'(contract (class/c (inner [m (-> any/c number? number?)]))
(let* ([c% (class object% (super-new) (define/pubment (m x) (inner x m x)))]
[d% (class c% (super-new) (define/augride (m x) (add1 x)))])
(class d% (super-new) (define/override-final (m x) (add1 x))))
'pos
'neg))
(test/pos-blame
'class/c-first-order-override-1
'(contract (class/c (override [m (-> any/c number? number?)]))
@ -4428,6 +4437,28 @@
'neg)]
[e% (class d% (super-new) (define/augride (m x) (add1 x)))])
(send (new e%) m 3)))
;; Test that overriding an augmenting method can still be effected by an inner contract.
(test/neg-blame
'class/c-higher-order-inner-8
'(let* ([c% (contract (class/c (inner [m (-> any/c number? number?)]))
(class object% (super-new) (define/pubment (m x) (+ x (inner x m 3))))
'pos
'neg)]
[d% (class c% (super-new) (define/augride (m x) (add1 x)))]
[e% (class d% (super-new) (define/override (m x) (zero? (super m x))))])
(send (new e%) m 3)))
;; The inner contract can be added before the next augmenting method, as seen here.
(test/neg-blame
'class/c-higher-order-inner-9
'(let* ([c% (class object% (super-new) (define/pubment (m x) (+ x (inner x m 3))))]
[d% (contract (class/c (inner [m (-> any/c number? number?)]))
(class c% (super-new) (define/augride (m x) (add1 x)))
'pos
'neg)]
[e% (class d% (super-new) (define/override (m x) (zero? (super m x))))])
(send (new e%) m 3)))
;
;