~ chicken-core (chicken-5) 339ca57996c94295d828398eb6217c1168ca10dd
commit 339ca57996c94295d828398eb6217c1168ca10dd Author: megane <meganeka@gmail.com> AuthorDate: Sat Dec 1 10:24:16 2018 +0200 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Thu Dec 13 15:44:38 2018 +0100 Fix renaming issue with 'the' The 'the' macro calls check-and-validate-type which will eventually call simplify-type on the type. simplify-type renames type variables with gensym and sets the ##core#real-name property, perhaps because of prettier messages for the user. Finally the 'the' macro expander uses the property to undo the renaming. Fixes #1563. * scrutinizer.scm (simplify-type): Don't set the ##core#real-name property for renamed tvs * tests/typematch-tests.scm: Add test * tests/scrutiny.expected: Update Signed-off-by: Evan Hanson <evhan@foldling.org> Signed-off-by: felix <felix@call-with-current-continuation.org> diff --git a/scrutinizer.scm b/scrutinizer.scm index 840cda3d..a8c8b3de 100644 --- a/scrutinizer.scm +++ b/scrutinizer.scm @@ -1224,9 +1224,7 @@ (set! typeenv (append (map (lambda (v) (let ((v (if (symbol? v) v (first v)))) - (let ((v* (gensym v))) - (mark-variable v* '##core#real-name v) - (cons v v*)))) + (cons v (gensym v)))) typevars) typeenv)) (set! constraints diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index 665d7008..e445ebbb 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -40,7 +40,7 @@ Warning: at toplevel: (scrutiny-tests.scm:29) in procedure call to `scheme#+', expected argument #2 of type `number' but was given an argument of type `symbol' Warning: at toplevel: - assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a) (procedure scheme#car ((pair a *)) a))' + assignment of value of type `fixnum' to toplevel variable `scheme#car' does not match declared type `(forall (a335) (procedure scheme#car ((pair a335 *)) a335))' Warning: at toplevel: expected a single result in `let' binding of `g19', but received 2 results diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm index 821ef731..231207f2 100644 --- a/tests/typematch-tests.scm +++ b/tests/typematch-tests.scm @@ -403,6 +403,9 @@ ;; The tv "foo" and "foo" in struct should have no relation ((forall (foo) (list (struct foo) foo)) 'ok)) +;; Issue #1563 +(compiler-typecase (the (forall (a) a) 1) ((forall (a) (list a)) 'ok)) + (assert (compiler-typecase 1 ('a #t)))Trap