From 25907189f3a533cf50b494a04a3fbceb1b485134 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Fri, 17 Jan 2014 12:05:48 -0500
Subject: [PATCH] Fix evt chaperones for multiple-valued evts

---
 .../racket-test/tests/racket/chaperone.rktl   | 11 +++++
 racket/src/racket/src/struct.c                | 46 +++++++++++++++----
 2 files changed, 49 insertions(+), 8 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
index e21dda7c74..8eb17cd9c1 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
@@ -1119,6 +1119,17 @@
   (test #t chaperone-of? (chaperone-evt an-e void) an-e)
   (test 18 (chaperone-evt an-e void) 9))
 
+;; test multiple valued evts
+(let ([evt (handle-evt always-evt (lambda (x) (values 0 0)))]
+      [redirect-1 (lambda (evt) (values evt (lambda args (apply values args))))]
+      [redirect-2 (lambda (evt) (values evt identity))]
+      [redirect-3 (lambda (evt) (values evt (lambda args 5)))]
+      [redirect-4 (lambda (evt) (values evt (lambda args (values 1 2))))])
+  (test-values '(0 0) (lambda () (sync (chaperone-evt evt redirect-1))))
+  (err/rt-test (sync (chaperone-evt evt redirect-2)))
+  (err/rt-test (sync (chaperone-evt evt redirect-3)))
+  (err/rt-test (sync (chaperone-evt evt redirect-4))))
+
 ;; ----------------------------------------
 ;; channel chaperones
 
diff --git a/racket/src/racket/src/struct.c b/racket/src/racket/src/struct.c
index a7139d3a9b..642c2cb06d 100644
--- a/racket/src/racket/src/struct.c
+++ b/racket/src/racket/src/struct.c
@@ -3372,14 +3372,44 @@ Scheme_Object *handle_evt_p(int argc, Scheme_Object *argv[])
 static Scheme_Object *do_chaperone_result_guard_proc(int is_impersonator, void *data, int argc, Scheme_Object *argv[])
 {
   Scheme_Object *proc = (Scheme_Object *)data, *o, *a[1];
+  Scheme_Object **received_vals, **guard_argv;
+  int received_cnt, i;
+
+  /* in case calling `proc` mutates argv */
+  guard_argv = MALLOC_N(Scheme_Object *, argc);
+  memcpy(guard_argv, argv, sizeof(Scheme_Object *) * argc);
+
+  o = _scheme_apply_multi(proc, argc, guard_argv);
+
+  if (SAME_OBJ(o, SCHEME_MULTIPLE_VALUES)) {
+    received_cnt = scheme_multiple_count;
+    received_vals = scheme_multiple_array;
+    scheme_detach_multple_array(received_vals);
+  } else {
+      a[0] = o;
+      received_vals = a;
+      received_cnt = 1;
+  }
+
+  if (received_cnt != argc) {
+    scheme_raise_exn(MZEXN_FAIL_CONTRACT_ARITY,
+                     "evt %s: returned wrong number of values\n"
+                     "  %s : %V\n"
+                     "  expected count: %d\n"
+                     "  returned count: %d\n",
+                     is_impersonator ? "impersonator" : "chaperone",
+                     is_impersonator ? "impersonator" : "chaperone",
+                     proc,
+                     argc, received_cnt);
+  }
+
+  if (!is_impersonator) {
+    for (i = 0; i < argc; i++) {
+      if (!scheme_chaperone_of(received_vals[i], argv[i]))
+        scheme_wrong_chaperoned("evt result", "value", argv[i], received_vals[i]);
+    }
+  }
 
-  a[0] = argv[0];
-  o = _scheme_apply(proc, 1, a);
-  
-  if (!is_impersonator)
-    if (!scheme_chaperone_of(o, a[0]))
-      scheme_wrong_chaperoned("evt result", "value", a[0], o);
-  
   return o;
 }
 
@@ -3447,7 +3477,7 @@ static Scheme_Object *do_chaperone_guard_proc(int is_impersonator, void *data, i
                                        : chaperone_result_guard_proc),
                                       (void *)vals[1], 
                                       "evt-result-chaperone", 
-                                      1, 1);
+                                      1, -1);
   a[1] = o;
 
   return scheme_wrap_evt(1, a);