diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index 719c4c5b98..8187227ac6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -251,12 +251,14 @@ (recursive-sc-use both-dep))))) (define resolved-name (resolve-once type)) (define resolved-deps - (map (λ (dep) (lookup-type-alias dep values)) dep-ids)) + (for/list ([dep (in-list dep-ids)]) + (resolve-once (lookup-type-alias dep values)))) ;; resolved-deps->scs : (U 'untyped 'typed 'both) ;; -> (Listof Static-Contract) (define (resolved-deps->scs typed-side) - (for/list ([resolved-dep resolved-deps]) + (for/list ([resolved-dep (in-list resolved-deps)] + [dep (in-list deps)]) (loop resolved-dep typed-side rv))) ;; Now actually generate the static contracts diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/recursive-type-alias-terminates.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/recursive-type-alias-terminates.rkt new file mode 100644 index 0000000000..299d590cc7 --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/recursive-type-alias-terminates.rkt @@ -0,0 +1,22 @@ +#lang racket/load + +;; Test that contracts for mutually recursive class types do not +;; cause infinite loops when they execute. + +(module a typed/racket + (define-type X% + (Class [m (-> (Instance Y%) String)])) + (define-type Y% + (Class [m (-> (Instance X%) Any)])) + (: x X%) + (define x (class object% + (super-new) + (define/public (m y) "foo"))) + (: y Y%) + (define y (class object% + (super-new) + (define/public (m x) 0))) + (provide x y)) + +(require 'a) +(send (new x) m (new y))