From b8d8f8b9292a4755d2c63bc7a955d75d96eb05e0 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Thu, 28 Feb 2013 06:26:22 -0500
Subject: [PATCH] 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.
---
 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 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)