~ 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 results
Trap