From 2cf7700ea500ec1fa51307201f32e850235c8e10 Mon Sep 17 00:00:00 2001 From: Noah Lavine Date: Sun, 21 Apr 2013 11:25:49 -0400 Subject: [PATCH] Bugfix in vm-engine.c * libguile/vm-engine.c: fix off-by-one error in bind-rest instruction. * test-suite/tests/rtl.test: test the fix. --- libguile/vm-engine.c | 8 ++++++-- test-suite/tests/rtl.test | 26 ++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 2 deletions(-) diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index fa8c8fc..a8fede6 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1585,12 +1585,16 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM_UNPACK_RTL_24 (op, dst); - while (nargs-- > dst) + for (; nargs > dst; nargs--) { - rest = scm_cons (LOCAL_REF (nargs), rest); + rest = scm_cons (LOCAL_REF (nargs - 1), rest); LOCAL_SET (nargs, SCM_UNDEFINED); } + /* we need nargs = dst + 1 so that a call to reserve-locals after + this won't overwrite the list we just consed up. */ + nargs = dst + 1; + LOCAL_SET (dst, rest); RESET_FRAME (dst + 1); diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test index e97a801..04324fa 100644 --- a/test-suite/tests/rtl.test +++ b/test-suite/tests/rtl.test @@ -265,3 +265,29 @@ (box-ref 0 1) (return 0) (end-program)))))) + +(with-test-prefix "bind-rest" + ;; check that bind-rest leaves nargs set correctly + (pass-if-equal "nargs = 0" + '() + ((assemble-program + '((begin-program foo) + (assert-nargs-ee/locals 0 1) + (bind-rest 0) + ;; nonintuitive, but the output of bind-rest has to count as an + ;; argument for reserve-locals to work. therefore, even if we + ;; started with 0 arguments, we end up with one. + (assert-nargs-ee 1) + (return 0) + (end-program))))) + + (pass-if-equal "nargs = 3" + '(b c) + ((assemble-program + '((begin-program foo) + (assert-nargs-ee/locals 3 0) + (bind-rest 1) + (assert-nargs-ee 2) + (return 1) + (end-program))) + 'a 'b 'c))) -- 1.7.10.4