From d642105b65cab5593969c8047107fae402fe814c Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Mon, 5 Sep 2011 16:58:47 -0700 Subject: [PATCH] Fixed subtyping for StructTop. Closes PR11099. original commit: c62f09ac5b5d4788d06401010eb7cfd02a91c623 --- collects/tests/typed-racket/succeed/pr11099.rkt | 11 +++++++++++ collects/typed-racket/types/printer.rkt | 2 +- collects/typed-racket/types/subtype.rkt | 3 ++- 3 files changed, 14 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-racket/succeed/pr11099.rkt diff --git a/collects/tests/typed-racket/succeed/pr11099.rkt b/collects/tests/typed-racket/succeed/pr11099.rkt new file mode 100644 index 00000000..3f172bbc --- /dev/null +++ b/collects/tests/typed-racket/succeed/pr11099.rkt @@ -0,0 +1,11 @@ +#lang typed/racket + +(struct: (X) b ([bar : (Vectorof X)])) + +(define: b-val : (b Integer) + (b (ann (vector 1) (Vectorof Integer)))) + + +(if (b? b-val) + (b-bar b-val) + #f) diff --git a/collects/typed-racket/types/printer.rkt b/collects/typed-racket/types/printer.rkt index d05033c6..0f2bd311 100644 --- a/collects/typed-racket/types/printer.rkt +++ b/collects/typed-racket/types/printer.rkt @@ -196,7 +196,7 @@ [(Name: stx) (fp "~a" (syntax-e stx))] [(app has-name? (? values name)) (fp "~a" name)] - [(StructTop: st) (fp "~a" st)] + [(StructTop: st) (fp "(struct-top: ~a)" st)] [(BoxTop:) (fp "Box")] [(ChannelTop:) (fp "Channel")] [(ThreadCellTop:) (fp "ThreadCell")] diff --git a/collects/typed-racket/types/subtype.rkt b/collects/typed-racket/types/subtype.rkt index 32e762d7..4e0c6466 100644 --- a/collects/typed-racket/types/subtype.rkt +++ b/collects/typed-racket/types/subtype.rkt @@ -383,7 +383,8 @@ [proc* (fail! proc proc*)] [else A0])]) (subtype/flds* A flds flds*))] - [((Struct: _ _ _ _ _ _ _ _) (StructTop: (== s type-equal?))) + [((Struct: nm _ _ _ _ _ _ _) (StructTop: (Struct: nm* _ _ _ _ _ _ _))) (=> nevermind) + (unless (free-identifier=? nm nm*) (nevermind)) A0] ;ephemerons are covariant [((Ephemeron: s) (Ephemeron: t))