~ 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