From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sat, 16 May 2009 22:45:12 +0000 (+0000)
Subject: Test and fix for obscure where-cond modification
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FQ-Branch.git;a=commitdiff_plain;h=ce261791e61ffd1bd7b4e5e27582fbcfbfbfad3a

Test and fix for obscure where-cond modification
---

diff --git a/Changes b/Changes
index 3522f38..5b55c5c 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for SQL::Abstract
 
+    - make sure that sql generation does not mutate the supplied
+      where condition structure
+
 revision 1.54  2009-05-07 17:23 (UTC)
 ----------------------------
     - allow special_operators to take both code refs and method names
diff --git a/Makefile.PL b/Makefile.PL
index 6ecb727..801726e 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -18,6 +18,7 @@ test_requires "Test::Deep"      => 0;
 test_requires "Test::More"      => 0;
 test_requires "Test::Exception" => 0;
 test_requires "Test::Warn"      => 0;
+test_requires "Clone"           => 0.31;
 
 tests_recursive 't';
 
diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index ed4bb33..cc64945 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -615,18 +615,20 @@ sub _where_hashpair_HASHREF {
 sub _where_field_op_ARRAYREF {
   my ($self, $k, $op, $vals) = @_;
 
-  if(@$vals) {
-    $self->_debug("ARRAY($vals) means multiple elements: [ @$vals ]");
+  my @vals = @$vals;  #always work on a copy
+
+  if(@vals) {
+    $self->_debug("ARRAY($vals) means multiple elements: [ @vals ]");
 
     # see if the first element is an -and/-or op
     my $logic;
-    if ($vals->[0] =~ /^ - ( AND|OR ) $/ix) {
+    if ($vals[0] =~ /^ - ( AND|OR ) $/ix) {
       $logic = uc $1;
-      shift @$vals;
+      shift @vals;
     }
 
-    # distribute $op over each remaining member of @$vals, append logic if exists
-    return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+    # distribute $op over each remaining member of @vals, append logic if exists
+    return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
 
     # LDNOTE : had planned to change the distribution logic when 
     # $op =~ $self->{inequality_op}, because of Morgan laws : 
@@ -635,7 +637,7 @@ sub _where_field_op_ARRAYREF {
     # WHERE field != 22 AND field != 33.
     # To do this, replace the above to roughly :
     # my $logic = ($op =~ $self->{inequality_op}) ? 'AND' : 'OR';
-    # return $self->_recurse_where([map { {$k => {$op, $_}} } @$vals], $logic);
+    # return $self->_recurse_where([map { {$k => {$op, $_}} } @vals], $logic);
 
   } 
   else {
diff --git a/t/04modifiers.t b/t/04modifiers.t
index dfc0f78..cce81f2 100644
--- a/t/04modifiers.t
+++ b/t/04modifiers.t
@@ -8,6 +8,7 @@ use SQL::Abstract::Test import => ['is_same_sql_bind'];
 
 use Data::Dumper;
 use SQL::Abstract;
+use Clone;
 
 =begin
 Test -and -or and -nest modifiers, assuming the following:
@@ -371,7 +372,7 @@ my @nest_tests = (
  },
 );
 
-plan tests => @and_or_tests*3 + @numbered_mods*4 + @nest_tests*2;
+plan tests => @and_or_tests*4 + @numbered_mods*4 + @nest_tests*2;
 
 for my $case (@and_or_tests) {
   TODO: {
@@ -381,7 +382,10 @@ for my $case (@and_or_tests) {
 
     my @w;
     local $SIG{__WARN__} = sub { push @w, @_ };
+
     my $sql = SQL::Abstract->new ($case->{args} || {});
+    my $where_copy = Clone::clone ($case->{where});
+
     lives_ok (sub { 
       my ($stmt, @bind) = $sql->where($case->{where});
       is_same_sql_bind(
@@ -394,6 +398,8 @@ for my $case (@and_or_tests) {
     });
     is (@w, 0, 'No warnings within and-or tests')
       || diag join "\n", 'Emitted warnings:', @w;
+
+    is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged');
   }
 }