summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-02-28 06:26:22 -0500
committerMark H Weaver <mhw@netris.org>2013-02-28 06:26:22 -0500
commitb8d8f8b9292a4755d2c63bc7a955d75d96eb05e0 (patch)
tree08645899f26015e12d23cd4fcb1230429c15dde5
parent5ccc3764b3e17a328dad515d9a74123653f1fef9 (diff)
downloadguile-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--THANKS1
-rw-r--r--libguile/fluids.c5
-rw-r--r--test-suite/tests/fluids.test30
3 files changed, 27 insertions, 9 deletions
diff --git a/THANKS b/THANKS
index fc2bf4924..a39473f31 100644
--- a/THANKS
+++ b/THANKS
@@ -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)