[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.7-135-gb8d8f8b

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0

The branch, stable-2.0 has been updated
       via  b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0 (commit)
      from  5ccc3764b3e17a328dad515d9a74123653f1fef9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0
Author: Mark H Weaver <address@hidden>
Date:   Thu Feb 28 06:26:22 2013 -0500

    Fix duplicate removal of with-fluids.
    
    Based on a patch by David Kastrup <address@hidden>.
    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.

-----------------------------------------------------------------------

Summary of changes:
 THANKS                       |    1 +
 libguile/fluids.c            |    5 ++++-
 test-suite/tests/fluids.test |   30 ++++++++++++++++++++++--------
 3 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/THANKS b/THANKS
index fc2bf49..a39473f 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 f1c09cb..277246e 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 9ed846c..5552fd9 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)


hooks/post-receive
-- 
GNU Guile