From 42dd447a06aa614930a256f34ae34547cf58617c Mon Sep 17 00:00:00 2001
From: John Croisant <john@croisant.net>
Date: Sat, 14 Apr 2018 20:49:03 -0500
Subject: [PATCH] Raise error if apply is called with invalid args.

* If called with only the procedure, but no args list.
* If called with a final arg that is not a proper list.
---
 lib/init-7.scm       |  6 +++---
 tests/r7rs-tests.scm |  6 ++++++
 vm.c                 | 16 ++++++++++++----
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/lib/init-7.scm b/lib/init-7.scm
index 04fa47bf..e9af9f37 100644
--- a/lib/init-7.scm
+++ b/lib/init-7.scm
@@ -43,12 +43,12 @@
          (append-helper (cdr lol) (car lol)))
        (reverse o))))
 
-(define (apply proc . args)
+(define (apply proc arg1 . args)
   (if (null? args)
-      (proc)
+      (apply1 proc arg1)
       ((lambda (lol)
          (apply1 proc (append2 (reverse (cdr lol)) (car lol))))
-       (reverse args))))
+       (reverse (cons arg1 args)))))
 
 ;; map with a fast-path for single lists
 
diff --git a/tests/r7rs-tests.scm b/tests/r7rs-tests.scm
index df6aaa4b..e9ee59b3 100644
--- a/tests/r7rs-tests.scm
+++ b/tests/r7rs-tests.scm
@@ -1591,6 +1591,12 @@
 (test #t (call-with-current-continuation procedure?))
 
 (test 7 (apply + (list 3 4)))
+(test 7 (apply + 3 4 (list)))
+(test-error (apply +)) ;; not enough args
+(test-error (apply + 3)) ;; final arg not a list
+(test-error (apply + 3 4)) ;; final arg not a list
+(test-error (apply + '(2 3 . 4))) ;; final arg is improper
+
 
 (define compose
   (lambda (f g)
diff --git a/vm.c b/vm.c
index 132f2236..8439a7a8 100644
--- a/vm.c
+++ b/vm.c
@@ -1174,10 +1174,18 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
     bc = sexp_procedure_code(self);
     cp = sexp_procedure_vars(self);
     ip = (sexp_bytecode_data(bc)+sexp_unbox_fixnum(stack[fp+1])) - sizeof(sexp);
-    for (top=fp-j+i-1; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
-      stack[top] = sexp_car(tmp2);
-    top = fp+i-j+1;
-    fp = k;
+    {
+      int prev_top = top;
+      for (top=fp-j+i-1; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
+        stack[top] = sexp_car(tmp2);
+      top = fp+i-j+1;
+      fp = k;
+      /* if final cdr of tmp2 isn't null, then args list was improper */
+      if (! sexp_nullp(tmp2)) {
+        top = prev_top;
+        sexp_raise("apply: improper args list", sexp_list1(ctx, stack[prev_top-2]));
+      }
+    }
     goto make_call;
   case SEXP_OP_TAIL_CALL:
     _ALIGN_IP();