Fix bug in method concretization for interface ctcs

There was a bug (unrelated to the last) caused by a
bad mutation of a method table when creating copies of
classes for interface contracts.

collects/racket/private/class-internal.rkt

@@ -3790,10 +3790,12 @@ An example
         [else
          ;; if there are contracted methods to concretize, do so
          (let* ([name (class-name cls)]
+                [ictc-meths (class-method-ictcs cls)]
                 [method-width (class-method-width cls)]
                 [method-ht (class-method-ht cls)]
-                [meths (class-methods cls)]
+                [meths (if (null? ictc-meths)
-                [ictc-meths (class-method-ictcs cls)]
+                           (class-methods cls)
+                           (make-vector method-width))]
                 [field-pub-width (class-field-pub-width cls)]
                 [field-ht (class-field-ht cls)]
                 [class-make (if name
@@ -3860,15 +3862,18 @@ An example
              (set-class-field-ref! c object-field-ref)
              (set-class-field-set!! c object-field-set!))
 
-           ;; then apply the projections to get the concrete method
+           ;; Don't concretize if all concrete
+           (unless (null? ictc-meths)
+             ;; First, fill up since we're empty
              (vector-copy! meths 0 (class-methods cls))
+             ;; Then apply the projections to get the concrete methods
              (for ([m (in-list ictc-meths)])
                (define index (hash-ref method-ht m))
                (define entry (vector-ref meths index))
                (define meth (car entry))
                (define ictc-infos (replace-ictc-blame (cadr entry) #f blame))
                (define wrapped-meth (concretize-ictc-method meth ictc-infos))
-             (vector-set! meths index wrapped-meth))
+               (vector-set! meths index wrapped-meth)))
 
            (hash-set! (class-ictc-classes cls) blame c)
            c)]))

collects/tests/racket/contract-test.rktl

@@ -8508,7 +8508,7 @@
       (send (new c%) m 3)))
 
   (test/spec-failed
-   'interface-higher-order-7
+   'interface-higher-order-8
    '(let* ([i1<%> (interface () [m (->m integer? number?)])]
            [i2<%> (interface (i1<%>) [m (->m number? integer?)])]
            [c% (class* object% (i2<%>) (super-new) (define/public (m x) x))])
@@ -8516,7 +8516,7 @@
    "top-level")
  
   (test/spec-failed
-   'interface-higher-order-7
+   'interface-higher-order-9
    '(let* ([i1<%> (interface () [m (->m integer? number?)])]
            [i2<%> (interface (i1<%>) [m (->m number? integer?)])]
            [c% (class* object% (i2<%>) (super-new) (define/public (m x) 3.14))])
@@ -8524,7 +8524,7 @@
    "(class c%)")
 
   (test/spec-passed
-   'interface-higher-order-8
+   'interface-higher-order-10
    '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
            [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
            [c% (class* object% (i2<%>) (super-new) (define/public (m x) x))]
@@ -8532,7 +8532,7 @@
       (send (new c2%) m 3)))
 
   (test/spec-passed
-   'interface-higher-order-10
+   'interface-higher-order-11
    '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
            [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
            [c% (contract (class/c)
@@ -8542,7 +8542,7 @@
       (send (new c%) m 3)))
 
   (test/neg-blame
-   'interface-higher-order-11
+   'interface-higher-order-12
    '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
            [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
            [c% (contract (class/c [m (->m integer? integer?)])
@@ -8552,7 +8552,7 @@
       (send (new c%) m 5.14)))
 
   (test/spec-failed
-   'interface-higher-order-11
+   'interface-higher-order-13
    '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
            [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
            [c% (contract (class/c m)
@@ -8563,7 +8563,7 @@
    "pos")
 
   (test/spec-failed
-   'interface-higher-order-12
+   'interface-higher-order-14
    '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
            [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
            [c% (contract (class/c)
@@ -8573,6 +8573,51 @@
       (send (new c%) m 5.14))
    "top-level")
 
+  (test/spec-passed
+   'interface-internal-name-1
+   '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
+           [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
+           [c% (class* object% (i2<%>)
+                 (super-new)
+                 (public [n m])
+                 (define n (λ (x) x)))])
+      (send (new c%) m 3)))
+
+  (test/spec-passed
+   'interface-internal-name-2
+   '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
+           [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
+           [c% (contract
+                 (class/c [m (->m integer? integer?)])
+                 (class* object% (i2<%>)
+                   (super-new)
+                   (public [n m])
+                   (define n (λ (x) x)))
+                 'pos
+                 'neg)])
+      (send (new c%) m 3)))
+
+  (test/spec-passed
+   'interface-mixin-1
+   '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
+           [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
+           [mixin (λ (cls)
+                    (class* cls (i2<%>)
+                      (super-new)
+                      (define/public (m x) x)))])
+      (send (new (mixin object%)) m 3)))
+
+  (test/spec-passed
+   'interface-bad-concretization-1
+   '(let* ([i1<%> (interface () [m (->m integer? integer?)])]
+           [i2<%> (interface (i1<%>) [m (->m integer? integer?)])]
+           [c% (class* object% (i2<%>) (super-new) (define/public (m x) x))]
+           [c2% (class c% (super-new))])
+      (send (new c2%) m 3)
+      (with-contract region
+        #:result integer?
+        (send (new c2%) m 3))))
+
 ;                                                                                    
 ;                                                                                    
 ;