X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fsqlmaker%2Fdbihacks_internals.t;h=4e34f13e662e6c0ae3ef3a6f19a13d4341494b31;hb=555df627fa78458a6d0338ef90059139e952f8c1;hp=a225cdcf630d62b7131eb3dbc621380b11cfdb9a;hpb=95da0f23897e2dc2292462546c06ff604bebeefd;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/sqlmaker/dbihacks_internals.t b/t/sqlmaker/dbihacks_internals.t
index a225cdc..4e34f13 100644
--- a/t/sqlmaker/dbihacks_internals.t
+++ b/t/sqlmaker/dbihacks_internals.t
@@ -1,13 +1,15 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
 use strict;
 use warnings;
 use Test::More;
 use Test::Warn;
+use Test::Exception;
+
 
-use lib qw(t/lib);
 use DBICTest ':DiffSQL';
-use DBIx::Class::_Util 'UNRESOLVABLE_CONDITION';
+use DBIx::Class::_Util qw( UNRESOLVABLE_CONDITION dump_value );
 
-use Data::Dumper;
 BEGIN {
   if ( eval { require Test::Differences } ) {
     no warnings 'redefine';
@@ -32,7 +34,7 @@ my $num = bless( \do { my $foo = 69 }, 'DBICTest::SillyInt' );
 is($num, 69, 'test overloaded object is "sane"');
 is("$num", 69, 'test overloaded object is "sane"');
 
-for my $t (
+my @tests = (
   {
     where => { artistid => 1, charfield => undef },
     cc_result => { artistid => 1, charfield => undef },
@@ -81,11 +83,18 @@ for my $t (
   },
   {
     where => { -and => [ \'foo=bar',  [ { artistid => { '=', $num } } ], { name => 'Caterwauler McCrae'} ] },
-    cc_result => { '' => \'foo=bar', name => 'Caterwauler McCrae', artistid => $num },
+    cc_result => { -and => [ \'foo=bar' ], name => 'Caterwauler McCrae', artistid => $num },
     sql => 'WHERE foo=bar AND artistid = ? AND name = ?',
     efcc_result => { name => 'Caterwauler McCrae', artistid => $num },
   },
   {
+    where => { -and => [ \'foo=bar',  [ { artistid => { '=', $num } } ], { name => 'Caterwauler McCrae'}, \'buzz=bozz' ] },
+    cc_result => { -and => [ \'foo=bar', \'buzz=bozz' ], name => 'Caterwauler McCrae', artistid => $num },
+    sql => 'WHERE foo=bar AND artistid = ? AND name = ? AND buzz=bozz',
+    collapsed_sql => 'WHERE foo=bar AND buzz=bozz AND artistid = ? AND name = ?',
+    efcc_result => { name => 'Caterwauler McCrae', artistid => $num },
+  },
+  {
     where => { artistid => [ $num ], rank => [ 13, 2, 3 ], charfield => [ undef ] },
     cc_result => { artistid => $num, charfield => undef, rank => [13, 2, 3] },
     sql => 'WHERE artistid = ? AND charfield IS NULL AND ( rank = ? OR rank = ? OR rank = ? )',
@@ -147,10 +156,17 @@ for my $t (
 
   ) ),
   {
-    where => { -or => [ -and => [ foo => { '!=', undef }, bar => { -in => [ 69, 42 ] } ], foo => { '=', { -value => undef } } ] },
-    sql => 'WHERE ( foo IS NOT NULL AND bar IN ( ?, ? ) ) OR foo IS NULL',
-    collapsed_sql => 'WHERE foo IS NULL OR ( bar IN ( ?, ? ) AND foo IS NOT NULL )',
+    where => { -or => [
+      -and => [ foo => { '!=', { -value => undef } }, bar => { -in => [ 69, 42 ] } ],
+      foo => { '=', { -value => undef } },
+      baz => { '!=' => { -ident => 'bozz' } },
+      baz => { -ident => 'buzz' },
+    ] },
+    sql => 'WHERE ( foo IS NOT NULL AND bar IN ( ?, ? ) ) OR foo IS NULL OR baz != bozz OR baz = buzz',
+    collapsed_sql => 'WHERE baz != bozz OR baz = buzz OR foo IS NULL OR ( bar IN ( ?, ? ) AND foo IS NOT NULL )',
     cc_result => { -or => [
+      baz => { '!=' => { -ident => 'bozz' } },
+      baz => { '=' => { -ident => 'buzz' } },
       foo => undef,
       { bar => { -in => [ 69, 42 ] }, foo => { '!=', undef } }
     ] },
@@ -350,24 +366,255 @@ for my $t (
         [ { 'me.title' => 'Spoonful of bees' } ],
     ]},
     cc_result => {
-      '' => \[
+      -and => [ \[
         "LOWER(me.title) LIKE ?",
         '%spoon%',
-      ],
+      ]],
       'me.title' => 'Spoonful of bees',
     },
     sql => 'WHERE LOWER(me.title) LIKE ? AND me.title = ?',
     efcc_result => { 'me.title' => 'Spoonful of bees' },
+  },
+
+  # crazy literals
+  {
+    where => {
+      -or => [
+        \'foo = bar',
+      ],
+    },
+    sql => 'WHERE foo = bar',
+    cc_result => {
+      -and => [
+        \'foo = bar',
+      ],
+    },
+    efcc_result => {},
+  },
+  {
+    where => {
+      -or => [
+        \'foo = bar',
+        \'baz = ber',
+      ],
+    },
+    sql => 'WHERE foo = bar OR baz = ber',
+    collapsed_sql => 'WHERE baz = ber OR foo = bar',
+    cc_result => {
+      -or => [
+        \'baz = ber',
+        \'foo = bar',
+      ],
+    },
+    efcc_result => {},
+  },
+  {
+    where => {
+      -and => [
+        \'foo = bar',
+        \'baz = ber',
+      ],
+    },
+    sql => 'WHERE foo = bar AND baz = ber',
+    cc_result => {
+      -and => [
+        \'foo = bar',
+        \'baz = ber',
+      ],
+    },
+    efcc_result => {},
+  },
+  {
+    where => {
+      -and => [
+        \'foo = bar',
+        \'baz = ber',
+        x => { -ident => 'y' },
+      ],
+    },
+    sql => 'WHERE foo = bar AND baz = ber AND x = y',
+    cc_result => {
+      -and => [
+        \'foo = bar',
+        \'baz = ber',
+      ],
+      x => { '=' => { -ident => 'y' } }
+    },
+    efcc_result => { x => { -ident => 'y' } },
+  },
+);
+
+# these die as of SQLA 1.80 - make sure we do not transform them
+# into something usable instead
+for my $lhs (undef, '', { -ident => 'foo' }, { -value => 'foo' } ) {
+  no warnings 'uninitialized';
+
+  for my $w (
+    ( map { { -or => $_ }, (ref $lhs ? () : { @$_ } ) }
+      [ $lhs => "foo" ],
+      [ $lhs => { "=" => "bozz" } ],
+      [ $lhs => { "=" => \"bozz" } ],
+      [ $lhs => { -max => \"bizz" } ],
+    ),
+
+    (ref $lhs) ? () : (
+      { -or => [ -and => { $lhs => "baz" }, bizz => "buzz" ] },
+      { -or => [ foo => "bar", { $lhs => "baz" }, bizz => "buzz" ] },
+      { foo => "bar", -or => { $lhs => "baz" } },
+      { foo => "bar", -or => { $lhs => \"baz" }, bizz => "buzz" },
+    ),
+
+    { foo => "bar", -and => [ $lhs => \"baz" ], bizz => "buzz" },
+    { foo => "bar", -or => [ $lhs => \"baz" ], bizz => "buzz" },
+
+    { -or => [ foo => "bar", [ $lhs => \"baz" ], bizz => "buzz" ] },
+    { -or => [ foo => "bar", $lhs => \"baz", bizz => "buzz" ] },
+    { -or => [ foo => "bar", $lhs => \["baz"], bizz => "buzz" ] },
+    { -or => [ $lhs => \"baz" ] },
+    { -or => [ $lhs => \["baz"] ] },
+
+  ) {
+    push @tests, {
+      where => $w,
+      throw => qr/
+        \QSupplying an empty left hand side argument is not supported in \E(?:array|hash)-pairs
+          |
+        \QIllegal use of top-level '-\E(?:value|ident)'
+      /x,
+    }
+  }
+}
+
+# these are deprecated as of SQLA 1.79 - make sure we do not transform
+# them without losing the warning
+for my $lhs (undef, '') {
+  for my $rhs ( \"baz", \[ "baz" ] ) {
+    no warnings 'uninitialized';
+
+    my $expected_warning = qr/\QHash-pairs consisting of an empty string with a literal are deprecated/;
+
+    push @tests, {
+      where => { $lhs => $rhs },
+      cc_result => { -and => [ $rhs ] },
+      efcc_result => {},
+      sql => 'WHERE baz',
+      warn => $expected_warning,
+    };
+
+    for my $w (
+      { foo => "bar", -and => { $lhs => $rhs }, bizz => "buzz" },
+      { foo => "bar", $lhs => $rhs, bizz => "buzz" },
+    ) {
+      push @tests, {
+        where => $w,
+        cc_result => {
+          -and => [ $rhs ],
+          bizz => "buzz",
+          foo => "bar",
+        },
+        efcc_result => {
+          foo => "bar",
+          bizz => "buzz",
+        },
+        sql => 'WHERE baz AND bizz = ? AND foo = ?',
+        warn => $expected_warning,
+      };
+    }
   }
+}
+
+# lots of extra silly tests with a false column
+for my $eq (
+  \"= baz",
+  \[ "= baz" ],
+  { '=' => { -ident => 'baz' } },
+  { '=' => \'baz' },
 ) {
+  for my $where (
+    { foo => "bar", -and => [ 0 => $eq ], bizz => "buzz" },
+    { foo => "bar", -or => [ 0 => $eq ], bizz => "buzz" },
+    { foo => "bar", -and => { 0 => $eq }, bizz => "buzz" },
+    { foo => "bar", -or => { 0 => $eq }, bizz => "buzz" },
+    { foo => "bar", 0 => $eq, bizz => "buzz" },
+  ) {
+    push @tests, {
+      where => $where,
+      cc_result => {
+        0 => $eq,
+        foo => 'bar',
+        bizz => 'buzz',
+      },
+      efcc_result => {
+        foo => 'bar',
+        bizz => 'buzz',
+        ( ref $eq eq 'HASH' ? ( 0 => $eq->{'='} ) : () ),
+      },
+      sql => 'WHERE 0 = baz AND bizz = ? AND foo = ?',
+    };
+
+    push @tests, {
+      where => { -or => $where },
+      cc_result => { -or => [
+        "0" => $eq,
+        bizz => 'buzz',
+        foo => 'bar',
+      ]},
+      efcc_result => {},
+      sql => 'WHERE 0 = baz OR bizz = ? OR foo = ?',
+    }
+
+  }
+
+  for my $where (
+    [ foo => "bar", -and => [ 0 => $eq ], bizz => "buzz" ],
+    [ foo => "bar", -or => [ 0 => $eq ], bizz => "buzz" ],
+    [ foo => "bar", -and => { 0 => $eq }, bizz => "buzz" ],
+    [ foo => "bar", -or => { 0 => $eq }, bizz => "buzz" ],
+    [ foo => "bar", 0 => $eq, bizz => "buzz" ],
+  ) {
+    push @tests, {
+      where => { -or => $where },
+      cc_result => { -or => [
+        "0" => $eq,
+        bizz => 'buzz',
+        foo => 'bar',
+      ]},
+      efcc_result => {},
+      sql => 'WHERE foo = ? OR 0 = baz OR bizz = ?',
+      collapsed_sql => 'WHERE 0 = baz OR bizz = ? OR foo = ?',
+    }
+  }
+
+  for my $where (
+    [ {foo => "bar"}, -and => { 0 => "baz" }, bizz => "buzz" ],
+    [ -or => [ foo => "bar", -or => { 0 => "baz" }, bizz => "buzz" ] ],
+  ) {
+    push @tests, {
+      where => { -or => $where },
+      cc_result => { -or => [
+        "0" => 'baz',
+        bizz => 'buzz',
+        foo => 'bar',
+      ]},
+      efcc_result => {},
+      sql => 'WHERE foo = ? OR 0 = ? OR bizz = ?',
+      collapsed_sql => 'WHERE 0 = ? OR bizz = ? OR foo = ?',
+    };
+  }
+
+};
 
+for my $t (@tests) {
   for my $w (
     $t->{where},
     $t->{where},  # do it twice, make sure we didn't destory the condition
     [ -and => $t->{where} ],
     [ -AND => $t->{where} ],
     { -OR => [ -AND => $t->{where} ] },
-    ( keys %{$t->{where}} <= 1 ? [ %{$t->{where}} ] : () ),
+    ( ( keys %{$t->{where}} == 1 and length( (keys %{$t->{where}})[0] ) )
+      ? [ %{$t->{where}} ]
+      : ()
+    ),
     ( (keys %{$t->{where}} == 1 and $t->{where}{-or})
       ? ( ref $t->{where}{-or} eq 'HASH'
         ? [ map { $_ => $t->{where}{-or}{$_} } sort keys %{$t->{where}{-or}} ]
@@ -376,20 +623,25 @@ for my $t (
       : ()
     ),
   ) {
-    my $name = do { local ($Data::Dumper::Indent, $Data::Dumper::Terse, $Data::Dumper::Sortkeys) = (0, 1, 1); Dumper $w };
+    die unless Test::Builder->new->is_passing;
 
-    my ($generated_sql) = $sm->where($w);
+    my $name = do { local $Data::Dumper::Indent = 0; dump_value $w };
 
-    is_same_sql ( $generated_sql, $t->{sql}, "Expected SQL from $name" )
-      if exists $t->{sql};
+    my ($collapsed_cond, $collapsed_cond_as_sql);
 
-    my $collapsed_cond = $schema->storage->_collapse_cond($w);
+    if ($t->{throw}) {
+      throws_ok {
+        $collapsed_cond = $schema->storage->_collapse_cond($w);
+        ($collapsed_cond_as_sql) = $sm->where($collapsed_cond);
+      } $t->{throw}, "Exception on attempted collapse/render of $name"
+        and
+      next;
+    }
 
-    is_same_sql(
-      ($sm->where($collapsed_cond))[0],
-      ( $t->{collapsed_sql} || $t->{sql} || $generated_sql ),
-      "Collapse did not alter *the semantics* of the final SQL based on $name",
-    );
+    warnings_exist {
+      $collapsed_cond = $schema->storage->_collapse_cond($w);
+      ($collapsed_cond_as_sql) = $sm->where($collapsed_cond);
+    } $t->{warn} || [], "Expected warning when collapsing/rendering $name";
 
     is_deeply(
       $collapsed_cond,
@@ -397,19 +649,37 @@ for my $t (
       "Expected collapsed condition produced on $name",
     );
 
+    my ($original_sql) = do {
+      local $SIG{__WARN__} = sub {};
+      $sm->where($w);
+    };
+
+    is_same_sql ( $original_sql, $t->{sql}, "Expected original SQL from $name" )
+      if exists $t->{sql};
+
+    is_same_sql(
+      $collapsed_cond_as_sql,
+      ( $t->{collapsed_sql} || $t->{sql} || $original_sql ),
+      "Collapse did not alter *the semantics* of the final SQL based on $name",
+    );
+
     is_deeply(
-      $schema->storage->_extract_fixed_condition_columns($w),
+      $schema->storage->_extract_fixed_condition_columns($collapsed_cond),
       $t->{efcc_result},
       "Expected fixed_condition produced on $name",
     );
 
     is_deeply(
-      $schema->storage->_extract_fixed_condition_columns($w, 'consider_nulls'),
+      $schema->storage->_extract_fixed_condition_columns($collapsed_cond, 'consider_nulls'),
       $t->{efcc_n_result},
       "Expected fixed_condition including NULLs produced on $name",
     ) if $t->{efcc_n_result};
 
-    die unless Test::Builder->new->is_passing;
+    is_deeply(
+      $collapsed_cond,
+      $t->{cc_result},
+      "Collapsed condition result unaltered by fixed condition extractor",
+    );
   }
 }