~ chicken-core (chicken-5) 8b25ee067396446c6f7ca5d36f5adb04c6f165c5

commit 8b25ee067396446c6f7ca5d36f5adb04c6f165c5
Author:     felix <felix@z.(none)>
AuthorDate: Fri Mar 25 09:13:11 2011 +0100
Commit:     felix <felix@z.(none)>
CommitDate: Fri Mar 25 09:13:11 2011 +0100

    fixed functor tests and incorrect syntax check; better error message for mismatch

diff --git a/expand.scm b/expand.scm
index 77ac7ca8..968709ad 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1313,7 +1313,7 @@
  (##sys#er-transformer
   (lambda (x r c)
     (let ((len (length x)))
-      (##sys#check-syntax 'module x '(_ symbol _ . #(_ 1)))
+      (##sys#check-syntax 'module x '(_ symbol _ . #(_ 0)))
       (cond ((and (fx>= len 4) (c (r '=) (caddr x)))
 	     (let* ((x (##sys#strip-syntax x))
 		    (name (cadr x))
diff --git a/modules.scm b/modules.scm
index 0c13f7d2..d60560e2 100644
--- a/modules.scm
+++ b/modules.scm
@@ -368,7 +368,7 @@
 
 (define (##sys#find-export sym mod indirect)
   (let ((exports (module-export-list mod)))
-    (let loop ((xl (if (eq? #t exports) (module-exists-list mod) exports)))
+    (let loop ((xl (if (eq? #t exports) (module-exist-list mod) exports)))
       (cond ((null? xl) #f)
 	    ((eq? sym (car xl)))
 	    ((pair? (car xl))
@@ -773,7 +773,9 @@
 	(when (pair? missing)
 	  (##sys#syntax-error-hook
 	   'module 
-	   (string-append 
-	    "argument module `" (symbol->string mname) "' does not match required signature "
+	   (apply
+	    string-append 
+	    "argument module `" (symbol->string mname) "' does not match required signature\n"
 	    "in instantiation `" (symbol->string name) "' of functor `"
-	    (symbol->string fname) "'")))))))
+	    (symbol->string fname) "', because the following required exports are missing:\n"
+	    (map (lambda (s) (string-append "\n  " (symbol->string s))) missing))))))))
diff --git a/tests/functor-tests.scm b/tests/functor-tests.scm
index 6db7b14a..1b307fd5 100644
--- a/tests/functor-tests.scm
+++ b/tests/functor-tests.scm
@@ -69,7 +69,7 @@
 (import (rename test-q2 (list->queue l2q2) (queue->list q2l2)))
 (import (rename test-q3 (list->queue l2q3) (queue->list q2l3)))
 
-(define long-list (list-tabulate 1000 identity))
+(define long-list (list-tabulate (cond-expand (csi 500) (else 1000)) identity))
 
 (print "Queue representation #1:")
 (time (q2l1 (l2q1 long-list)))
@@ -92,35 +92,41 @@
 
 ;; Test for errors
 
+#+csi
+(begin
+
 (module m1 ())
 
 (test-error 
  "argument mismatch"
- (module m2 = (breadth-first m1)))
+ (eval '(module m2 = (breadth-first m1))))
 
 (test-error
  "undefined module"
- (module m2 = (breadth-first hunoz)))
+ (eval '(module m2 = (breadth-first hunoz))))
 
 (test-error
  "undefined interface"
- (module m2 HUNOZ))
+ (eval '(module m2 HUNOZ)))
 
 (test-error
  "undefined interface in functor"
- (functor (f1 (X HUNOZ)) ()))
+ (eval '(functor (f1 (X HUNOZ)) ())))
 
 (test-error
  "undefined interface in functor result"
- (functor (f1 (X ())) HUNOZ))
+ (eval '(functor (f1 (X ())) HUNOZ)))
+
+)
 
 
 ;; Test alternative instantiation syntax:
 
 (functor (frob (X (yibble))) *
-  (import chicken X) yibble)
+  (import chicken X)
+  yibble)
 
-(test-equal?
+(test-equal
  "alternative functor instantiation syntax"
  (module yabble = frob (import scheme) (define yibble 99))
  99)
diff --git a/tests/test.scm b/tests/test.scm
index c16de6a5..e1f57b71 100644
--- a/tests/test.scm
+++ b/tests/test.scm
@@ -85,7 +85,8 @@
     ((_ name expr)
      (run-equal
       name
-      (lambda () (handle-exceptions ex *fail-token* expr)) *fail-token* eq?) )
+      (lambda () (handle-exceptions ex *fail-token* expr))
+      *fail-token* eq?) )
     ((_ expr) (test-error 'expr expr))))
 
 (define-syntax test-assert