diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2016-12-23 12:09:09 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2016-12-23 12:09:09 -0800 |
commit | c968457672379368478a3aa064e1d7f2d00280a7 (patch) | |
tree | 4eff12ec4accff2f9ae2abc3bec7f9b9b385ec7d /tests/011/special-1.tl | |
parent | 34fe393aba5271cba73b60fb5fcad646099c7f28 (diff) | |
download | txr-c968457672379368478a3aa064e1d7f2d00280a7.tar.gz txr-c968457672379368478a3aa064e1d7f2d00280a7.tar.bz2 txr-c968457672379368478a3aa064e1d7f2d00280a7.zip |
bugfix: dynamic env handling in parallel binding
In the parallel binding (let ((x s) (s 0) (y s)) ...),
both x and y must bind to the prior value of s,
not to the new value 0. We have the bug that if
s is a special variable, the initialization of y
sees the new dynamic environment which contains the
new value, so x gets the previous, y gets new.
This commit fixes it.
* eval.c (reparent_env): New static function.
(bindings_helper): Separate logic into two loops,
for sequential and parallel binding, so we don't
have to repeatedly test this condition in the loop
body, and can think separately about each case and
streamline it. Nothing new happens under sequential
binding; the behavior that is wrong for parallel
binding is right for sequential. Under parallel binding,
what we do is reset the dynamic environment to the
original one prior to each evaluation of an initform.
Then if the evaluation changes to a new dynamic
environment (a special variable is being bound),
we notice this and hook the new environment into
a local stack, changing it parent pointer. At the
end, we install this stack as the new dynamic env.
Thus each init form is evaluated in the original
dynamic env.
* tests/011/special-1.tl: New tests added.
Diffstat (limited to 'tests/011/special-1.tl')
-rw-r--r-- | tests/011/special-1.tl | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/tests/011/special-1.tl b/tests/011/special-1.tl index 7461b730..aa791354 100644 --- a/tests/011/special-1.tl +++ b/tests/011/special-1.tl @@ -1,5 +1,34 @@ +(load "../common") + (let ((x (with-out-string-stream (*stdout*) [format *stdout* "wo"] (format t "rld!")))) (format *stdout* "Hello, ") (put-line x)) + +(defvar *spec* :global) + +(defvar *fun* (let* ((*spec* :local) + (fun (lambda () *spec*)) + (x *spec*)) + (test (call fun) :local) + (test x :local) + (set *spec* :local2) + fun)) + +(let ((*spec* *spec*)) + (test *spec* :global) + (set *spec* :clobber) + (test (call *fun*) :clobber)) + +(test *spec* :global) + +(test (call *fun*) :global) + +(let ((x *spec*) + (*spec* :local) + (y *spec*)) + (let ((z *spec*) + (*spec* nil) + (w *spec*)) + (test (list *spec* x y z w) (nil :global :global :local :local)))) |