lib: fix issue uncovered by recent vm CALL insn change.

The functions funcall1 through funcall4, when invoking a VM
function, are not defending against the case when there
are more arguments than the function can take.

As a result, some :mass-delegate tests in tests/012/oop.tl
are failing. They expect an :error result, but the calls
are succeeding in spite of passing too many parameters
via the delegate interface.

The tests/012/lambda.tl suite should catch this, but
it has unfortunate weaknesses.

* lib.c (funcall1, funcall2, funcall3, funcall4):
When dispatching the general VM case via
vm_execute_closure, check that if the closure has
fewer fixed parameters than arguments we are passing,
it must be variadic, or else there is an error.

* tests/012/lambda.tl (call-lambda-fixed): New function.
Unlike call-lambda, which uses the apply dot syntax,
this switches on the argument list shape and dispatches
direct calls. These compile to the CALL instruction
cases with four arguments or less which will exercise
funcall, funcall1, ... funcall4. Also, adding some missing
test cases that probe behavior with excess arguments.

1 files changed, 25 insertions, 2 deletions

diff --git a/tests/012/lambda.tl b/tests/012/lambda.tl
index ec3b2cae..811dbcfc 100644
--- a/tests/012/lambda.tl
+++ b/tests/012/lambda.tl
@@ -3,12 +3,28 @@
 (defun call-lambda (fn . args)
   [fn . args])
 
+(defun call-lambda-fixed (fn . args)
+  (tree-case args
+    (() [fn])
+    ((a1) [fn a1])
+    ((a1 a2) [fn a1 a2])
+    ((a1 a2 a3) [fn a1 a2 a3])
+    ((a1 a2 a3 a4) [fn a1 a2 a3 a4])
+    ((a1 a2 a3 a4 a5) [fn a1 a2 a3 a4 a5])
+    ((a1 . r) [fn a1 . r])
+    ((a1 a2 . r) [fn a1 a2 . r])
+    ((a1 a2 a3 . r) [fn a1 a2 a3 . r])
+    ((a1 a2 a3 a4 . r) [fn a1 a2 a3 a4 . r])
+    ((a1 a2 a3 a4 a5 . r) [fn a1 a2 a3 a4 a5 . r])
+    (r [fn . r])))
+
 (defmacro ltest (:match :form f)
   (([(lambda . @rest) . @args] @expected)
    (if *compile-test*
      ^(progn
         (test [(lambda ,*rest) ,*args] ,expected)
-        (test (call-lambda (lambda ,*rest) ,*args) ,expected))
+        (test (call-lambda (lambda ,*rest) ,*args) ,expected)
+        (test (call-lambda-fixed (lambda ,*rest) ,*args) ,expected))
      ^(test [(lambda ,*rest) ,*args] ,expected)))
   ((@else . rest) (compile-error f "bad syntax")))
 
@@ -17,17 +33,22 @@
 
 (mltest
   [(lambda ())] nil
+  [(lambda ()) 1] :error
   [(lambda (a) a)] :error
   [(lambda (a) a) 1] 1
+  [(lambda (a) a) 1 2] :error
   [(lambda (a b) (list a b)) 1] :error
   [(lambda (a b) (list a b)) 1 2] (1 2)
+  [(lambda (a b) (list a b)) 1 2 3] :error
   [(lambda (a b c) (list a b c)) 1 2] :error
-  [(lambda (a b c) (list a b c)) 1 2 3] (1 2 3))
+  [(lambda (a b c) (list a b c)) 1 2 3] (1 2 3)
+  [(lambda (a b c) (list a b c)) 1 2 3 4] :error)
 
 (mltest
   [(lambda (: a) a)] nil
   [(lambda (: (a 1)) a)] 1
   [(lambda (: (a 1)) a) 2] 2
+  [(lambda (: (a 1)) a) 2 3] :error
   [(lambda (: (a 1 a-p)) (list a a-p))] (1 nil)
   [(lambda (: (a 1 a-p)) (list a a-p)) 2] (2 t))
 
@@ -35,6 +56,8 @@
   [(lambda (x : a) (list x a))] :error
   [(lambda (x : (a 1)) (list x a))] :error
   [(lambda (x : (a 1)) (list x a)) 2] (2 1)
+  [(lambda (x : (a 1)) (list x a)) 2 3] (2 3)
+  [(lambda (x : (a 1)) (list x a)) 2 3 4] :error
   [(lambda (x : (a 1 a-p)) (list x a a-p))] :error
   [(lambda (x : (a 1 a-p)) (list x a a-p)) 2] (2 1 nil))