Fix type->contract for recursive Name types
Certain mutually recursive Name types would generate contracts that infinite loop when triggered.
This commit is contained in:
parent
d37be5f6c5
commit
663e96afd6
|
@ -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
|
||||
|
|
|
@ -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))
|
Loading…
Reference in New Issue
Block a user