~ chicken-core (chicken-5) 087ee9c2ee8f586ef865cfda95ea491b2370d88f

commit 087ee9c2ee8f586ef865cfda95ea491b2370d88f
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Sep 9 16:48:22 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Sep 9 16:48:22 2011 +0200

    resurrected enforcement test for user-decls

diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm
index 5c86b438..42c3b273 100644
--- a/tests/scrutiny-tests.scm
+++ b/tests/scrutiny-tests.scm
@@ -88,6 +88,21 @@
 (when (foo7 x)
   (+ x 1))				; will warn about "x" being a string
 
+;; declared procedure types are enforcing
+(define-type s2s (string -> symbol))
+
+(: foo8 s2s)
+(define (foo8 x) (string->symbol x))
+(: foo9 s2s)
+(declare (enforce-argument-types foo9))
+(define (foo9 x) (string->symbol x))
+
+(define (foo10 x)
+  (foo8 x)
+  (+ x 1)			; foo8 does not enforce x (no warning)
+  (foo9 x)			; + enforces number on x
+  (+ x 1))			; foo9 does enforce
+
 ;; trigger warnings for incompatible types in "the" forms
 (define (foo10 x)
   (string-append (the pair (substring x 0 10))) ; 1
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index cdfb24f4..c735c802 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 (a92) (procedure car ((pair a92 *)) a92))'
+  assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a105) (procedure car ((pair a105 *)) a105))'
 
 Warning: at toplevel:
   expected in `let' binding of `g8' a single result, but were given 2 results
@@ -63,11 +63,17 @@ Warning: in toplevel procedure `foo6':
 Warning: at toplevel:
   scrutiny-tests.scm:89: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
 
+Warning: in toplevel procedure `foo10':
+  scrutiny-tests.scm:103: in procedure call to `foo9', expected argument #1 of type `string', but was given an argument of type `number'
+
+Warning: in toplevel procedure `foo10':
+  scrutiny-tests.scm:104: in procedure call to `+', expected argument #1 of type `number', but was given an argument of type `string'
+
 Note: in toplevel procedure `foo10':
   expression returns a result of type `string', but is declared to return `pair', which is not a subtype
 
 Warning: in toplevel procedure `foo10':
-  scrutiny-tests.scm:93: in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `pair'
+  scrutiny-tests.scm:108: in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `pair'
 
 Warning: in toplevel procedure `foo10':
   expression returns 2 values but is declared to have a single result
@@ -79,6 +85,6 @@ Warning: in toplevel procedure `foo10':
   expression returns zero values but is declared to have a single result of type `*'
 
 Warning: in toplevel procedure `foo10':
-  scrutiny-tests.scm:96: in procedure call to `*', expected argument #1 of type `number', but was given an argument of type `string'
+  scrutiny-tests.scm:111: in procedure call to `*', expected argument #1 of type `number', but was given an argument of type `string'
 
 Warning: redefinition of standard binding: car