[Bast-commits] r6290 - in SQL-Abstract/1.x/trunk: . lib/SQL t

ribasushi at dev.catalyst.perl.org ribasushi at dev.catalyst.perl.org
Sat May 16 22:45:12 GMT 2009


Author: ribasushi
Date: 2009-05-16 22:45:12 +0000 (Sat, 16 May 2009)
New Revision: 6290

Modified:
   SQL-Abstract/1.x/trunk/Changes
   SQL-Abstract/1.x/trunk/Makefile.PL
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/04modifiers.t
Log:
Test and fix for obscure where-cond modification

Modified: SQL-Abstract/1.x/trunk/Changes
===================================================================
--- SQL-Abstract/1.x/trunk/Changes	2009-05-16 22:06:40 UTC (rev 6289)
+++ SQL-Abstract/1.x/trunk/Changes	2009-05-16 22:45:12 UTC (rev 6290)
@@ -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

Modified: SQL-Abstract/1.x/trunk/Makefile.PL
===================================================================
--- SQL-Abstract/1.x/trunk/Makefile.PL	2009-05-16 22:06:40 UTC (rev 6289)
+++ SQL-Abstract/1.x/trunk/Makefile.PL	2009-05-16 22:45:12 UTC (rev 6290)
@@ -18,6 +18,7 @@
 test_requires "Test::More"      => 0;
 test_requires "Test::Exception" => 0;
 test_requires "Test::Warn"      => 0;
+test_requires "Clone"           => 0.31;
 
 tests_recursive 't';
 

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-05-16 22:06:40 UTC (rev 6289)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2009-05-16 22:45:12 UTC (rev 6290)
@@ -615,18 +615,20 @@
 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 @@
     # 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 {

Modified: SQL-Abstract/1.x/trunk/t/04modifiers.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/04modifiers.t	2009-05-16 22:06:40 UTC (rev 6289)
+++ SQL-Abstract/1.x/trunk/t/04modifiers.t	2009-05-16 22:45:12 UTC (rev 6290)
@@ -8,6 +8,7 @@
 
 use Data::Dumper;
 use SQL::Abstract;
+use Clone;
 
 =begin
 Test -and -or and -nest modifiers, assuming the following:
@@ -371,7 +372,7 @@
  },
 );
 
-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 @@
 
     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 @@
     });
     is (@w, 0, 'No warnings within and-or tests')
       || diag join "\n", 'Emitted warnings:', @w;
+
+    is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged');
   }
 }
 




More information about the Bast-commits mailing list