From 2dd8725cbde48bb616958839ec2a4e76a8257ba4 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Mon, 24 Feb 2014 17:14:42 -0500 Subject: [PATCH] Fix infinite loop in List: expander in subtyping The match expander calls `resolve` during subtyping, which is a problem for types that recur through the environment like Struct types because it doesn't coordinate with the cache for subtyping. Closes PR 14364 original commit: 7585581f00a40f59d5f29159622a10640cfbdec9 --- .../typed-racket-lib/typed-racket/types/subtype.rkt | 13 +++++++++++-- .../tests/typed-racket/succeed/pr14364.rkt | 7 +++++++ 2 files changed, 18 insertions(+), 2 deletions(-) create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14364.rkt diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index 3299592f..35483c32 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -310,8 +310,17 @@ (subtype* t1 t*) (subtype* t2 (simple-Un (-val null) (make-MPairTop))) (subtype* t2 t))] - [((List: ts) (Sequence: (list t*))) - (subtypes* A0 ts (map (λ (_) t*) ts))] + ;; Note: this next case previously used the List: match expander, but + ;; using that would cause an infinite loop in certain cases + ;; (i.e., Struct types, see PR 14364) because the expander + ;; uses `resolve`. This is not normally a problem, but during + ;; subtyping it's dangerous to call functions that can cause + ;; substitution and thus more subtyping checks. + ;; + ;; Instead, we can just check for Null here since combined with + ;; the Pair: case above and resolution of types like Mu, all the + ;; List: cases should be covered. + [((Value: '()) (Sequence: (list t*))) A0] [((HeterogeneousVector: ts) (Sequence: (list t*))) (subtypes* A0 ts (map (λ (_) t*) ts))] [((Vector: t) (Sequence: (list t*))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14364.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14364.rkt new file mode 100644 index 00000000..04c1f882 --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/pr14364.rkt @@ -0,0 +1,7 @@ +#lang typed/racket + +;; A test for PR 14364. Should not infinite loop. + +(struct: (X) Foo ([y : (U X (Pair (Foo X) (Foo X)))])) +(: x (Foo String)) +(define x (Foo "a"))