~ chicken-core (chicken-5) d6845c138174d13c12406c4297f83ee80ad15dca
commit d6845c138174d13c12406c4297f83ee80ad15dca Author: Peter Bex <peter.bex@xs4all.nl> AuthorDate: Sat Jul 7 11:40:23 2012 +0200 Commit: felix <felix@call-with-current-continuation.org> CommitDate: Sat Jul 7 22:35:25 2012 +0200 Resolve user-defined scrutiny types at canonicalization time, before with-property-restore in each module's expansion is compiled away and ##compiler#type-abbreviation properties are restored. Fixes #884. Signed-off-by: felix <felix@call-with-current-continuation.org> diff --git a/compiler.scm b/compiler.scm index 94d178de..68061e09 100644 --- a/compiler.scm +++ b/compiler.scm @@ -538,7 +538,7 @@ ((##core#the) `(##core#the - ,(##sys#strip-syntax (cadr x)) + ,(validate-type (##sys#strip-syntax (cadr x)) #f) ,(caddr x) ,(walk (cadddr x) e se dest ldest h ln))) diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm index 5f0f56a1..abe01f72 100644 --- a/tests/scrutiny-tests.scm +++ b/tests/scrutiny-tests.scm @@ -134,3 +134,11 @@ (import chicken scheme) (define (blabla) (+ 1 'x))) + +;; Reported by megane in #884: +;; +;; Custom types defined in modules need to be resolved during canonicalization +(module bar () + (import chicken scheme) + (define-type footype string) + (the footype "bar")) \ No newline at end of file diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index 609757c5..a79e854d 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -37,7 +37,7 @@ Warning: at toplevel: (scrutiny-tests.scm:28) in procedure call to `+', 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 `car' does not match declared type `(forall (a132) (procedure car ((pair a132 *)) a132))' + assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a140) (procedure car ((pair a140 *)) a140))' Warning: at toplevel: expected in `let' binding of `g8' a single result, but were given 2 resultsTrap