class/c: allow local method names

Prior to this change, a method/field name defined with
define-local-method-name was not contractable.

collects/racket/private/class-internal.rkt

@@ -3049,11 +3049,13 @@
     (syntax-case stx ()
       [x
        (identifier? #'x)
-       (values #'(quote x) #f)]
+       (with-syntax ([id (localize #'x)])
+         (values #'`id #f))]
       [(x ctc)
        (identifier? #'x)
-       (values #'(quote x) 
+       (with-syntax ([id (localize #'x)])
-               #`(coerce-contract '#,form-name (let ([x ctc]) x)))]
+         (values #'`id
+                 #`(coerce-contract '#,form-name (let ([x ctc]) x))))]
       [_
        (raise-syntax-error form-name "expected identifier or (id contract)" stx)]))
   (define (parse-names-ctcs stx)
@@ -3071,11 +3073,13 @@
          (let ([symbols (for/list ([id (in-list (syntax->list #'(f-id ...)))])
                           (unless (identifier? id)
                             (raise-syntax-error 'class/c "expected identifier" stx))
-                          #`(quote #,id))])
+                          (with-syntax ([id (localize id)])
+                            #'`id))])
            (values meths (append (reverse symbols) fields)))]
         [id
          (identifier? #'id)
-         (values (cons #'(quote id) meths) fields)]
+         (with-syntax ([id (localize #'id)])
+           (values (cons #'`id meths) fields))]
         [_
          (raise-syntax-error 'class/c "expected identifier or (field id ...)" stx)])))
   (define (parse-spec stx)

collects/tests/racket/contract-test.rktl

@@ -6490,6 +6490,33 @@
               'pos
               'neg))
 
+  (test/spec-passed
+   'class/c-first-order-local-method-1
+   '(let ()
+     (define-local-member-name m)
+     (contract (class/c [m (->m number? number?)])
+               (class object% (super-new) (define/public (m x) 3))
+               'pos
+               'neg)))
+
+  (test/pos-blame
+   'class/c-first-order-local-method-2
+   '(let ()
+     (define-local-member-name m)
+     (contract (class/c [m (->m number? number? number?)])
+               (class object% (super-new) (define/public (m x) 3))
+               'pos
+               'neg)))
+
+  (test/pos-blame
+   'class/c-first-order-local-method-3
+   '(let ()
+     (define-local-member-name m)
+     (contract (class/c [m (->m number? number? number?)])
+               (class object% (super-new))
+               'pos
+               'neg)))
+
   (test/spec-passed
    'class/c-first-order-opaque-method-1
    '(contract (class/c #:opaque [m (-> any/c number? number?)])
@@ -6523,6 +6550,25 @@
       'pos
       'neg))
 
+  (test/pos-blame
+   'class/c-first-order-opaque-method-5
+   '(contract
+      (class/c #:opaque [m (-> any/c number? number?)] [n (-> any/c number?)])
+      (let ()
+        (define-local-member-name n)
+        (class object% (super-new) (define/public (m x) 3) (define/public (n) 4)))
+      'pos
+      'neg))
+
+  (test/spec-passed
+   'class/c-first-order-opaque-method-6
+   '(let ()
+      (define-local-member-name n)
+      (contract (class/c #:opaque [m (-> any/c number? number?)] [n (-> any/c number?)])
+                (class object% (super-new) (define/public (m x) 3) (define/public (n) 4))
+                'pos
+                'neg)))
+
   (test/pos-blame
    'class/c-first-order-field-1
    '(contract (class/c (field [n number?]))
@@ -6551,6 +6597,33 @@
               'pos
               'neg))
 
+  (test/spec-passed
+   'class/c-first-order-local-field-1
+   '(let ()
+      (define-local-member-name n)
+      (contract (class/c (field n))
+                (class object% (super-new) (field [n 3]))
+                'pos
+                'neg)))
+
+  (test/spec-passed
+   'class/c-first-order-local-field-2
+   '(let ()
+      (define-local-member-name n)
+      (contract (class/c (field [n integer?]))
+                (class object% (super-new) (field [n 3]))
+                'pos
+                'neg)))
+
+  (test/pos-blame
+   'class/c-first-order-local-field-3
+   '(let ()
+      (define-local-member-name n)
+      (contract (class/c (field [n integer?]))
+                (class object% (super-new))
+                'pos
+                'neg)))
+ 
   (test/spec-passed
    'class/c-first-order-opaque-field-1
    '(contract (class/c #:opaque (field n))
@@ -6808,6 +6881,25 @@
               'pos
               'neg))
 
+  (test/spec-passed
+   'class/c-first-order-local-inner-1
+   '(let ()
+      (define-local-member-name m)
+      (contract (class/c (inner m) m)
+                (let ([c% (class object% (super-new) (define/pubment (m x) (inner x m x)))])
+                  (class c% (super-new) (define/augride (m x) (add1 x))))
+                'pos
+                'neg)))
+
+  (test/pos-blame
+   'class/c-first-order-local-inner-2
+   '(let ()
+      (define-local-member-name m)
+      (contract (class/c (inner m))
+                object%
+                'pos
+                'neg)))
+              
   (test/pos-blame
    'class/c-first-order-override-1
    '(contract (class/c (override [m (-> any/c number? number?)]))
@@ -6893,6 +6985,25 @@
               'pos
               'neg))
 
+  (test/pos-blame
+   'class/c-first-order-local-override-1
+   '(let ()
+     (define-local-member-name m)
+     (contract (class/c (override m))
+               object%
+               'pos
+               'neg)))
+
+  (test/spec-passed
+   'class/c-first-order-local-override-2
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c (override m))
+                           (class object% (super-new) (define/public (m) 3))
+                           'pos
+                           'neg))
+      (class c% (super-new) (define/override (m) 5))))
+
   (test/pos-blame
    'class/c-first-order-augment-1
    '(contract (class/c (augment [m (-> any/c number? number?)]))
@@ -6976,6 +7087,25 @@
               'pos
               'neg))
 
+  (test/pos-blame
+   'class/c-first-order-local-augment-1
+   '(let ()
+      (define-local-member-name m)
+      (contract (class/c (augment m))
+                object%
+                'pos
+                'neg)))
+
+  (test/spec-passed
+   'class/c-first-order-local-augment-2
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c (augment m))
+                           (class object% (super-new) (define/pubment (m) 3))
+                           'pos
+                           'neg))
+      (class c% (super-new) (inherit m))))
+  
   (test/pos-blame
    'class/c-first-order-augride-1
    '(contract (class/c (augride [m (-> any/c number? number?)]))
@@ -7063,6 +7193,26 @@
               'pos
               'neg))
 
+  (test/pos-blame
+   'class/c-first-order-local-augride-1
+   '(let ()
+      (define-local-member-name m)
+      (contract (class/c (augride m))
+                object%
+                'pos
+                'neg)))
+
+  (test/spec-passed
+   'class/c-first-order-local-augride-2
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c (augride m))
+                           (class (class object% (super-new) (define/pubment (m) 3))
+                             (super-new) (define/augride (m) 4))
+                           'pos
+                           'neg))
+      (class c% (super-new) (inherit m))))
+  
   (test/pos-blame
    'class/c-first-order-inherit-1
    '(let* ([c% (contract (class/c (inherit [m (-> any/c number? number?)]))
@@ -7108,6 +7258,28 @@
            [d% (class c% (super-new) (inherit m) (define/public (f) (m 5)))])
       (send (new d%) f)))
 
+  (test/pos-blame
+   'class/c-first-order-local-inherit-1
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c (inherit [m (-> any/c number? number?)]))
+                           object%
+                           'pos
+                           'neg))
+      (define d% (class c% (super-new) (inherit m) (define/public (f) (m 5))))
+      (send (new d%) f)))
+
+  (test/spec-passed
+   'class/c-first-order-local-inherit-2
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c (inherit [m (-> any/c number? number?)]))
+                           (class object% (super-new) (define/public (m x) x))
+                           'pos
+                           'neg))
+      (define d% (class c% (super-new) (inherit m) (define/public (f) (m 5))))
+      (send (new d%) f)))
+  
   (test/spec-passed
    'class/c-first-order-absent-1
    '(contract (class/c (absent m)) object% 'pos 'neg))
@@ -7130,6 +7302,21 @@
               'pos
               'neg))
 
+  (test/spec-passed
+   'class/c-first-order-local-absent-1
+   '(let ()
+      (define-local-member-name f)
+      (contract (class/c (absent (field f))) object% 'pos 'neg)))
+
+  (test/pos-blame
+   'class/c-first-order-local-absent-2
+   '(let ()
+      (define-local-member-name f)
+      (contract (class/c (absent (field f)))
+                (class object% (super-new) (field [f 3]))
+                'pos
+                'neg)))
+              
   (test/spec-passed
    'class/c-first-order-opaque-absent-1
    '(contract (class/c #:opaque (absent (field f))) object% 'pos 'neg))
@@ -7287,6 +7474,26 @@
            [d% (class c% (super-new) (define/override (m) (super m 5)))])
       (send (new d%) m)))
 
+  (test/spec-passed
+   'class/c-higher-order-local-method-1
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c [m (-> any/c number? number?)])
+                           (class object% (super-new) (define/public (m x) (add1 x)))
+                           'pos
+                           'neg))
+      (send (new c%) m 3)))
+
+  (test/neg-blame
+   'class/c-higher-order-local-method-2
+   '(let ()
+      (define-local-member-name m)
+      (define c% (contract (class/c [m (-> any/c number? number?)])
+                           (class object% (super-new) (define/public (m x) (add1 x)))
+                           'pos
+                           'neg))
+      (send (new c%) m #f)))
+
   (test/spec-passed
    'class/c-higher-order-super-1
    '(let* ([c% (contract (class/c [m (-> any/c integer? integer?)]
@@ -7937,6 +8144,24 @@
               'pos
               'neg))
 
+  (test/pos-blame
+   'object/c-first-order-local-method-1
+   '(let ()
+      (define-local-member-name m)
+      (contract (object/c [m (-> any/c number? number?)])
+                (new object%)
+                'pos
+                'neg)))
+
+  (test/spec-passed
+   'object/c-first-order-local-method-2
+   '(let ()
+      (define-local-member-name m)
+      (contract (object/c [m (-> any/c number? number?)])
+                (new (class object% (super-new) (define/public (m x) (add1 x))))
+                'pos
+                'neg)))
+  
   (test/pos-blame
    'object/c-first-order-field-1
    '(contract (object/c (field [n number?]))
@@ -7951,6 +8176,24 @@
               'pos
               'neg))
 
+  (test/pos-blame
+   'object/c-first-order-local-field-1
+   '(let ()
+      (define-local-member-name n)
+      (contract (object/c (field [n number?]))
+                (new object%)
+                'pos
+                'neg)))
+
+  (test/spec-passed
+   'object/c-first-order-local-field-2
+   '(let ()
+      (define-local-member-name n)
+      (contract (object/c (field [n number?]))
+                (new (class object% (super-new) (field [n 3])))
+                'pos
+                'neg)))
+
   (test/spec-passed/result
    'object/c-higher-order-field-1
    '(get-field