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

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

collects/scheme/private/class-internal.ss

@@ -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)))])
+          (let ([vec (vector-ref beta-methods index)])
-            (unless (eq? (vector-ref meth-flags index) 'augmentable)
+            (when (zero? (vector-length vec))
-              (failed "method ~a is not augmentable" i)))))
+              (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)

collects/tests/mzscheme/contract-test.ss

@@ -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?)]))
@@ -4429,6 +4438,28 @@
            [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)))
+  
 ;                                                              
 ;                                                              
 ;             ;;        ;;                     ;    ;;