From a3d77986cb1f2793a77f23234f7e39cf82348b58 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 7 Apr 2014 22:18:16 -0500 Subject: [PATCH] fix object/c & fields that just have to exist closes PR 14437 --- .../tests/racket/contract/object.rkt | 30 ++++++++++++++++++- .../collects/racket/private/class-c-old.rkt | 2 +- 2 files changed, 30 insertions(+), 2 deletions(-) diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/object.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/object.rkt index bdec975267..efdfeed783 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/object.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/object.rkt @@ -158,4 +158,32 @@ 'pos 'neg)]) (set-field! n pre-o #t) - (get-field n o)))) + (get-field n o))) + +(test/spec-passed/result + 'object/c-field-existence + '(send (contract + (object/c + (field foo bar) + (baz (->m integer? integer?))) + (new (class object% + (super-new) + (field (foo 0) (bar 0)) + (define/public (baz n) n))) + 'pos 'neg) + baz 1) + 1) + +(test/spec-passed/result + 'object/c-field-existence2 + '(send (contract + (object/c + (field foo bar) + (baz (->m integer? (listof integer?)))) + (new (class object% + (super-new) + (field (foo 0) (bar 1)) + (define/public (baz n) (list foo bar)))) + 'pos 'neg) + baz 1) + '(0 1))) diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt index 456cbf423e..517d883c92 100644 --- a/racket/collects/racket/private/class-c-old.rkt +++ b/racket/collects/racket/private/class-c-old.rkt @@ -1307,7 +1307,7 @@ (unless (null? fields) (for ([f (in-list fields)] [c (in-list field-contracts)]) - (when c + (unless (just-check-existence? c) (define fi (hash-ref field-ht f)) (define p-pos ((contract-projection c) (blame-add-field-context blame f #:swap? #f))) (define p-neg ((contract-projection c) (blame-add-field-context blame f #:swap? #t)))