mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix duplicate removal of with-fluids.

Browse source 
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.
This commit is contained in:
Mark H Weaver 2013-02-28 06:26:22 -05:00
parent 5ccc3764b3
commit b8d8f8b929
3 changed files with 27 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

1
THANKS
View file

@ -94,6 +94,7 @@ For fixes or providing information which led to a fix:
David Jaquay David Jaquay
Paul Jarc Paul Jarc
Steve Juranich Steve Juranich
David Kastrup
Richard Kim Richard Kim
Bruce Korb Bruce Korb
René Köcher René Köcher

5
libguile/fluids.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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 */ vals[i] = vals[j]; /* later bindings win */
n--; n--;
fluids[j] = fluids[n];
vals[j] = vals[n];
break; break;
} }
} }

30
test-suite/tests/fluids.test
View file

@ -18,7 +18,8 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-fluids) (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 (define exception:syntax-error
@ -78,16 +79,29 @@
(not (fluid-ref a)))))) (not (fluid-ref a))))))
(with-test-prefix "with-fluids with duplicate fluid" (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" (pass-if "last value wins"
(with-fluids ((a 1) (compile '(with-fluids ((a 1)
(a 2)) (a 2))
(eqv? (fluid-ref 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" (pass-if "original value restored"
(and (with-fluids ((a 1) (compile '(and (with-fluids ((a 1)
(a 2)) (a 2))
(eqv? (fluid-ref a) 2)) (eqv? (fluid-ref a) 2))
(eqv? (fluid-ref a) #f)))) (eqv? (fluid-ref a) #f))
#:env (current-module))))
(pass-if "fluid values are thread-local" (pass-if "fluid values are thread-local"
(if (provided? 'threads) (if (provided? 'threads)