From cd596e5277e53e910a14972ae812eee58c7786b5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 12 Oct 2019 16:20:16 -0600
Subject: [PATCH] cs: fix error reporting for `apply` on a non-list

---
 pkgs/racket-test-core/tests/racket/basic.rktl |  2 ++
 racket/src/cs/rumble/procedure.ss             | 19 +++++++++++--------
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/basic.rktl b/pkgs/racket-test-core/tests/racket/basic.rktl
index 4cff672c48..d600534ccb 100644
--- a/pkgs/racket-test-core/tests/racket/basic.rktl
+++ b/pkgs/racket-test-core/tests/racket/basic.rktl
@@ -1497,6 +1497,8 @@
 (err/rt-test (apply (lambda x x) 1))
 (err/rt-test (apply (lambda x x) 1 2))
 (err/rt-test (apply (lambda x x) 1 '(2 . 3)))
+(err/rt-test (apply 10 '(2 . 3)))
+(err/rt-test (apply 10 0 '(2 . 3)))
 
 (test '(b e h) map cadr '((a b) (d e) (g h)))
 (test '(5 7 9) map + '(1 2 3) '(4 5 6))
diff --git a/racket/src/cs/rumble/procedure.ss b/racket/src/cs/rumble/procedure.ss
index 0fcc88daca..db425e3689 100644
--- a/racket/src/cs/rumble/procedure.ss
+++ b/racket/src/cs/rumble/procedure.ss
@@ -42,16 +42,18 @@
     [(proc args)
      (if (#%procedure? proc)
          (#2%apply proc args)
-         (#2%apply (extract-procedure proc (length args)) args))]
+         (#2%apply (extract-procedure proc (and (#%list? args) (length args))) args))]
     [(proc)
      (raise-arity-error 'apply (|#%app| arity-at-least 2) proc)]
     [(proc . argss)
      (if (#%procedure? proc)
          (#2%apply #2%apply proc argss)
-         (let ([len (let loop ([argss argss])
+         (let ([len (let loop ([argss argss] [accum 0])
                       (cond
-                       [(null? (cdr argss)) (length (car argss))]
-                       [else (fx+ 1 (loop (cdr argss)))]))])
+                       [(null? (cdr argss)) (let ([l (car argss)])
+                                              (and (#%list? l)
+                                                   (+ accum (length l))))]
+                       [else (loop (cdr argss) (fx+ 1 accum))]))])
            (#2%apply #2%apply (extract-procedure proc len) argss)))]))
 
 (define-syntax (|#%app| stx)
@@ -87,7 +89,8 @@
 (define (do-extract-procedure f orig-f n-args success-k fail-k)
   (cond
    [(#%procedure? f)
-    (if (chez:procedure-arity-includes? f n-args)
+    (if (or (not n-args)
+            (chez:procedure-arity-includes? f n-args))
         (if success-k
             (success-k f)
             f)
@@ -100,7 +103,7 @@
        [(fixnum? v)
         (let ([a (struct-property-ref prop:procedure-arity rtd #f)])
           (cond
-           [(and a (not (bitwise-bit-set? (unsafe-struct*-ref f a) n-args)))
+           [(and a n-args (not (bitwise-bit-set? (unsafe-struct*-ref f a) n-args)))
             (wrong-arity-wrapper orig-f)]
            [else
             (do-extract-procedure (unsafe-struct-ref f v) orig-f n-args success-k wrong-arity-wrapper)]))]
@@ -116,13 +119,13 @@
        [else
         (let ([a (struct-property-ref prop:procedure-arity rtd #f)])
           (cond
-           [(and a (not (bitwise-bit-set? (unsafe-struct*-ref f a) n-args)))
+           [(and a n-args (not (bitwise-bit-set? (unsafe-struct*-ref f a) n-args)))
             (wrong-arity-wrapper orig-f)]
            [else
             (do-extract-procedure
              v
              orig-f
-             (fx+ n-args 1)
+             (and n-args (fx+ n-args 1))
              (lambda (v)
                (cond
                 [(not v) (case-lambda)]