~ chicken-core (chicken-5) bae148680cf3ed65dc344b53121a2aa7e60f3bf3

commit bae148680cf3ed65dc344b53121a2aa7e60f3bf3
Author:     felix <felix@z.(none)>
AuthorDate: Thu Mar 24 21:01:13 2011 +0100
Commit:     felix <felix@z.(none)>
CommitDate: Thu Mar 24 21:01:13 2011 +0100

    added alternative syntax to functor-tests

diff --git a/expand.scm b/expand.scm
index 2aaf4aab..77ac7ca8 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1320,7 +1320,7 @@
 		    (app (cadddr x)))
 	       (cond ((symbol? app)
 		      (cond ((fx> len 4)
-			     ;; suggested by syn
+			     ;; feature suggested by syn:
 			     ;;
 			     ;; (module NAME = FUNCTORNAME BODY ...)
 			     ;; ~>
diff --git a/tests/functor-tests.scm b/tests/functor-tests.scm
index 18d39689..6db7b14a 100644
--- a/tests/functor-tests.scm
+++ b/tests/functor-tests.scm
@@ -4,6 +4,12 @@
 (use srfi-1 data-structures extras)
 
 
+(include "test.scm")
+(test-begin)
+
+;;
+
+
 (include "test-queue")
 (include "breadth-first")
 
@@ -83,3 +89,43 @@
 
 ;;XXX shows (""), which looks wrong:
 (pp (show 8 (search next-char '())))	;XXX assert
+
+;; Test for errors
+
+(module m1 ())
+
+(test-error 
+ "argument mismatch"
+ (module m2 = (breadth-first m1)))
+
+(test-error
+ "undefined module"
+ (module m2 = (breadth-first hunoz)))
+
+(test-error
+ "undefined interface"
+ (module m2 HUNOZ))
+
+(test-error
+ "undefined interface in functor"
+ (functor (f1 (X HUNOZ)) ()))
+
+(test-error
+ "undefined interface in functor result"
+ (functor (f1 (X ())) HUNOZ))
+
+
+;; Test alternative instantiation syntax:
+
+(functor (frob (X (yibble))) *
+  (import chicken X) yibble)
+
+(test-equal?
+ "alternative functor instantiation syntax"
+ (module yabble = frob (import scheme) (define yibble 99))
+ 99)
+
+
+;;
+
+(test-end)