From 53d30648f95d7215c714a9b915fe8b91aea81277 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 12 Feb 2014 10:15:49 -0600 Subject: [PATCH] fix class/c contract-name implementation specifically, fix the case where a field doesn't have a contract, but just has to exist --- .../racket-pkgs/racket-test/tests/racket/contract/name.rkt | 1 + racket/collects/racket/private/class-c-new.rkt | 7 +++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt index 5bc805493a..ec7a532f11 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt @@ -352,6 +352,7 @@ (override [o (->m (<=/c 2) integer?)]) (augment [p (->m (<=/c 3) integer?)]) (augride [q (->m (<=/c 4) integer?)]))) + (test-name '(class/c (field n)) (class/c (field n))) (test-name '(struct/dc s [a integer?] diff --git a/racket/collects/racket/private/class-c-new.rkt b/racket/collects/racket/private/class-c-new.rkt index 3a0020eba6..4835068886 100644 --- a/racket/collects/racket/private/class-c-new.rkt +++ b/racket/collects/racket/private/class-c-new.rkt @@ -448,7 +448,9 @@ [else (define field-names (for/list ([(fld ctc) (in-hash (ext-class/c-contract-table-of-flds-to-ctcs c))]) - `(,fld ,(contract-name ctc)))) + (if (just-check-existence? ctc) + fld + `(,fld ,(contract-name ctc))))) (define init-fields '()) (define init-names (filter @@ -468,7 +470,8 @@ (set! init-fields (cons clause init-fields)) #f] [else clause])])))) - (set! field-names (filter (λ (x) (not (member (car x) (map car init-fields)))) + (set! field-names (filter (λ (x) (or (not (pair? x)) + (not (member (car x) (map car init-fields))))) field-names)) (define meth-names