suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: allow missing fields in object/c-common-fields-stronger?

Browse Source 
Change `object/c-common-fields-stronger?` to only compare the fields
common to both objects.
This commit is contained in:
Ben Greenman 2018-05-11 10:36:58 -04:00
parent 8ec3edaa95
commit a539825dc9
2 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-test/tests/racket/contract/stronger.rkt
View File

@ -453,6 +453,9 @@
(ctest #t contract-stronger? (ctest #t contract-stronger?
(object/c (field (f (<=/c 4)))) (object/c (field (f (<=/c 4))))
(object/c (field (f (<=/c 4))))) (object/c (field (f (<=/c 4)))))
(ctest #t contract-stronger?
(object/c (field (f (<=/c 4))))
(object/c))
(ctest #t contract-stronger? (ctest #t contract-stronger?
(object/c (m (-> any/c (<=/c 3))) (object/c (m (-> any/c (<=/c 3)))
(n (-> any/c any/c))) (n (-> any/c any/c)))

21
racket/collects/racket/private/class-c-old.rkt
View File

@ -1641,16 +1641,17 @@
(names-sel this)) (names-sel this))
(for/and ([this-name (in-list (names-sel this))] (for/and ([this-name (in-list (names-sel this))]
[this-ctc (in-list (ctcs-sel this))]) [this-ctc (in-list (ctcs-sel this))])
(for/or ([that-name (in-list (names-sel that))] (or (not (member this-name (names-sel that)))
[that-ctc (in-list (ctcs-sel that))]) (for/or ([that-name (in-list (names-sel that))]
(and (equal? this-name that-name) [that-ctc (in-list (ctcs-sel that))])
(contract-equivalent? (and (equal? this-name that-name)
(if (just-check-existence? this-ctc) (contract-equivalent?
any/c (if (just-check-existence? this-ctc)
this-ctc) any/c
(if (just-check-existence? that-ctc) this-ctc)
any/c (if (just-check-existence? that-ctc)
that-ctc))))))) any/c
that-ctc))))))))
(define-struct base-object/c (methods method-contracts fields field-contracts) (define-struct base-object/c (methods method-contracts fields field-contracts)
#:property prop:custom-write custom-write-property-proc #:property prop:custom-write custom-write-property-proc