From 460b1fe7b3402d81bf239fdc3881a80413df4888 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 20 Jul 2012 12:51:54 -0400 Subject: [PATCH] Ensure that structs don't overlap with simple values. Reported by Ray Racine. Please merge to release. original commit: 4a90c6c1fea75fac3132de7df70e5e7e8207b311 --- collects/tests/typed-racket/succeed/poly-struct-pred.rkt | 9 +++++++++ collects/typed-racket/types/remove-intersect.rkt | 6 ++++-- 2 files changed, 13 insertions(+), 2 deletions(-) create mode 100644 collects/tests/typed-racket/succeed/poly-struct-pred.rkt diff --git a/collects/tests/typed-racket/succeed/poly-struct-pred.rkt b/collects/tests/typed-racket/succeed/poly-struct-pred.rkt new file mode 100644 index 00000000..ee3fa951 --- /dev/null +++ b/collects/tests/typed-racket/succeed/poly-struct-pred.rkt @@ -0,0 +1,9 @@ +#lang typed/racket + +(struct: (X) s ([v : X])) + +(: f : (All (X) (U 'foo (s X)) -> (s X))) +(define (f t) + (match t + [(s value) (s value)] + [_ (error 'fail)])) \ No newline at end of file diff --git a/collects/typed-racket/types/remove-intersect.rkt b/collects/typed-racket/types/remove-intersect.rkt index 0cd68b85..9e7a0f71 100644 --- a/collects/typed-racket/types/remove-intersect.rkt +++ b/collects/typed-racket/types/remove-intersect.rkt @@ -66,8 +66,10 @@ [(or (list (Pair: _ _) _) (list _ (Pair: _ _))) #f] - [(or (list (Value: '()) (Struct: n _ flds _ _ _ _ _)) - (list (Struct: n _ flds _ _ _ _ _) (Value: '()))) + [(or (list (Value: (? (λ (e) (or (null? e) (symbol? e) (number? e) (boolean? e) (pair? e) (keyword? e))))) + (Struct: n _ flds _ _ _ _ _)) + (list (Struct: n _ flds _ _ _ _ _) + (Value: (? (λ (e) (or (null? e) (symbol? e) (number? e) (boolean? e) (pair? e) (keyword? e))))))) #f] [(list (Struct: n _ flds _ _ _ _ _) (Struct: n* _ flds* _ _ _ _ _)) (=> nevermind)