suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix evt chaperones for multiple-valued evts

Browse Source
This commit is contained in:
Asumu Takikawa 2014-01-17 12:05:48 -05:00
parent 27f62a591e
commit 25907189f3
2 changed files with 49 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkgs/racket-pkgs/racket-test/tests/racket/chaperone.rktl
View File

@ -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

46
racket/src/racket/src/struct.c
View File

@ -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);