diff options
author | Mark H Weaver <mhw@netris.org> | 2013-02-28 06:26:22 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-02-28 06:26:22 -0500 |
commit | b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0 (patch) | |
tree | 08645899f26015e12d23cd4fcb1230429c15dde5 | |
parent | 5ccc3764b3e17a328dad515d9a74123653f1fef9 (diff) | |
download | guile-b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0.tar.gz |
Fix duplicate removal of with-fluids.
Based on a patch by David Kastrup <dak@gnu.org>.
Fixes <http://bugs.gnu.org/13838>.
* libguile/fluids.c (scm_i_make_with_fluids): Remove the duplicate
binding instead of the last binding.
* test-suite/tests/fluids.test: Add test, and fix existing duplicate
tests.
* THANKS: Thanks David Kastrup.
-rw-r--r-- | THANKS | 1 | ||||
-rw-r--r-- | libguile/fluids.c | 5 | ||||
-rw-r--r-- | test-suite/tests/fluids.test | 30 |
3 files changed, 27 insertions, 9 deletions
@@ -94,6 +94,7 @@ For fixes or providing information which led to a fix: David Jaquay Paul Jarc Steve Juranich + David Kastrup Richard Kim Bruce Korb René Köcher diff --git a/libguile/fluids.c b/libguile/fluids.c index f1c09cb30..277246e35 100644 --- a/libguile/fluids.c +++ b/libguile/fluids.c @@ -1,4 +1,5 @@ -/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012, 2013 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public License @@ -326,6 +327,8 @@ scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals) { vals[i] = vals[j]; /* later bindings win */ n--; + fluids[j] = fluids[n]; + vals[j] = vals[n]; break; } } diff --git a/test-suite/tests/fluids.test b/test-suite/tests/fluids.test index 9ed846c05..5552fd936 100644 --- a/test-suite/tests/fluids.test +++ b/test-suite/tests/fluids.test @@ -18,7 +18,8 @@ ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-fluids) - :use-module (test-suite lib)) + :use-module (test-suite lib) + :use-module (system base compile)) (define exception:syntax-error @@ -78,16 +79,29 @@ (not (fluid-ref a)))))) (with-test-prefix "with-fluids with duplicate fluid" + ;; These tests must be compiled, because the evaluator + ;; effectively transforms (with-fluids ((a 1) (b 2)) ...) + ;; into (with-fluids ((a 1)) (with-fluids ((b 2)) ...)) + (pass-if "last value wins" - (with-fluids ((a 1) - (a 2)) - (eqv? (fluid-ref a) 2))) + (compile '(with-fluids ((a 1) + (a 2)) + (eqv? (fluid-ref a) 2)) + #:env (current-module))) + (pass-if "remove the duplicate, not the last binding" + (compile '(with-fluids ((a 1) + (a 2) + (b 3)) + (eqv? (fluid-ref b) 3)) + #:env (current-module))) + (pass-if "original value restored" - (and (with-fluids ((a 1) - (a 2)) - (eqv? (fluid-ref a) 2)) - (eqv? (fluid-ref a) #f)))) + (compile '(and (with-fluids ((a 1) + (a 2)) + (eqv? (fluid-ref a) 2)) + (eqv? (fluid-ref a) #f)) + #:env (current-module)))) (pass-if "fluid values are thread-local" (if (provided? 'threads) |