~ chicken-core (chicken-5) 2ee23dcd68e790676ef739d83ec1cf4239ac4cd4

commit 2ee23dcd68e790676ef739d83ec1cf4239ac4cd4
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Nov 13 12:35:18 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Nov 13 12:35:18 2010 +0100

    fixed incorrect llist check (thanks to Alan Post)

diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index f69e080b..e2efd577 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -188,6 +188,7 @@
  line-number-database-2
  line-number-database-size
  llist-length
+ llist-match?
  load-identifier-database
  load-inline-file
  load-type-database
diff --git a/compiler.scm b/compiler.scm
index 00d0cdb0..90fd2dbc 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -2185,7 +2185,7 @@
 						     (test varname 'value)
 						     (proper-list? llist) ) ] )
 					  (when (and name 
-						     (not (= (llist-length llist) (length (cdr subs)))))
+						     (not (llist-match? llist (cdr subs))))
 					    (quit
 					     "~a: procedure `~a' called with wrong number of arguments" 
 					     (source-info->line name)
diff --git a/support.scm b/support.scm
index 661392dc..8dd2e282 100644
--- a/support.scm
+++ b/support.scm
@@ -265,7 +265,14 @@
 (define decompose-lambda-list ##sys#decompose-lambda-list)
 
 (define (llist-length llist)
-  (##core#inline "C_u_i_length" llist))
+  (##core#inline "C_u_i_length" llist))	; stops at non-pair node
+
+(define (llist-match? llist args)	; assumes #!optional/#!rest/#!key have been expanded
+  (let loop ((llist llist) (args args))
+    (cond ((null? llist) (null? args))
+	  ((symbol? llist))
+	  ((null? args) #f)
+	  (else (loop (cdr llist) (cdr args))))))
 
 
 ;;; Profiling instrumentation:
diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
index 923c4358..f402f75d 100644
--- a/tests/compiler-tests.scm
+++ b/tests/compiler-tests.scm
@@ -132,3 +132,14 @@
                           ((foreign-lambda* int ((c-string str))
                                             "C_return(strlen(str));")
                            "foo\x00bar")))
+
+
+;; failed compile-time argument count check (reported by Alan Post)
+;; cbb27fe380ff8e45cdf04d812e1ec649bf45ca47
+
+(define (foo)
+  (define (bar #!key a)
+    (define (baz)
+      (bar a: #t))
+    baz)
+  bar)