X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F01generate.t;h=87bce6a44fdacd2753fdfd329385594615ac608b;hb=0236f122f73090f9773bae7a6941a286c86ff889;hp=e6d1c6cd2e223dca98cd307c3f85cefdc343399d;hpb=85327cd53cf6ff59413f4d0bf70e2e624c38b572;p=scpubgit%2FQ-Branch.git

diff --git a/t/01generate.t b/t/01generate.t
index e6d1c6c..87bce6a 100644
--- a/t/01generate.t
+++ b/t/01generate.t
@@ -4,7 +4,7 @@ use Test::More;
 use Test::Warn;
 use Test::Exception;
 
-use SQL::Abstract::Test import => [qw( is_same_sql_bind diag_where dumper )];
+use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where dumper)];
 
 use SQL::Abstract;
 
@@ -16,7 +16,6 @@ use SQL::Abstract;
 #
 #################
 
-
 my @tests = (
       {
               func   => 'select',
@@ -75,6 +74,14 @@ my @tests = (
               bind   => ['boom']
       },
       {
+              # this is maybe wrong but a single arg doesn't get quoted
+              func   => 'select',
+              args   => ['test', 'id', { a => { '!=', 'boom' } }],
+              stmt   => 'SELECT id FROM test WHERE ( a != ? )',
+              stmt_q => 'SELECT id FROM `test` WHERE ( `a` != ? )',
+              bind   => ['boom']
+      },
+      {
               func   => 'update',
               args   => ['test', {a => 'boom'}, {a => undef}],
               stmt   => 'UPDATE test SET a = ? WHERE ( a IS NULL )',
@@ -83,6 +90,13 @@ my @tests = (
       },
       {
               func   => 'update',
+              args   => ['test', {a => undef }, {a => 'boom'}],
+              stmt   => 'UPDATE test SET a = ? WHERE ( a = ? )',
+              stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` = ? )',
+              bind   => [undef,'boom']
+      },
+      {
+              func   => 'update',
               args   => ['test', {a => 'boom'}, { a => {'!=', "bang" }} ],
               stmt   => 'UPDATE test SET a = ? WHERE ( a != ? )',
               stmt_q => 'UPDATE `test` SET `a` = ? WHERE ( `a` != ? )',
@@ -619,7 +633,7 @@ my @tests = (
 );
 
 # check is( not) => undef
-for my $op ( qw(not is is_not), 'is not' ) {
+for my $op (qw(not is is_not), 'is not') {
   (my $sop = uc $op) =~ s/_/ /gi;
 
   $sop = 'IS NOT' if $sop eq 'NOT';
@@ -638,7 +652,7 @@ for my $op ( qw(not is is_not), 'is not' ) {
 }
 
 # check single-element inequality ops for no warnings
-for my $op ( qw(!= <>) ) {
+for my $op (qw(!= <>)) {
   for my $val (undef, 42) {
     push @tests, {
       func => 'where',
@@ -674,7 +688,7 @@ for my $op (qw(not_like not_rlike), 'not like', 'not rlike', 'is not like','is n
 }
 
 # check all multi-element inequality/not-like ops for warnings
-for my $op ( qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') {
+for my $op (qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like','is not rlike') {
   (my $sop = uc $op) =~ s/_/ /gi;
 
   push @tests, {
@@ -688,7 +702,7 @@ for my $op ( qw(!= <> not_like not_rlike), 'not like', 'not rlike', 'is not like
 }
 
 # check all like/not-like ops for empty-arrayref warnings
-for my $op ( qw(like rlike not_like not_rlike), 'not like', 'not rlike', 'is like', 'is not like', 'is rlike', 'is not rlike') {
+for my $op (qw(like rlike not_like not_rlike), 'not like', 'not rlike', 'is like', 'is not like', 'is rlike', 'is not rlike') {
   (my $sop = uc $op) =~ s/_/ /gi;
 
   push @tests, {
@@ -726,9 +740,6 @@ for my $lhs (undef, '') {
     [ foo => "bar", $lhs => \["baz"], bizz => "buzz" ],
     [ $lhs => \"baz" ],
     [ $lhs => \["baz"] ],
-
-    # except for this one, that is automagically arrayified
-    { foo => "bar", -or => { $lhs => \"baz" }, bizz => "buzz" },
   ) {
     push @tests, {
       func => 'where',
@@ -741,6 +752,7 @@ for my $lhs (undef, '') {
 ## deprecations - sorta worked, likely abused by folks
   for my $where_arg (
     # the arrayref forms of this never worked and throw above
+    { foo => "bar", -or => { $lhs => \"baz" }, bizz => "buzz" },
     { foo => "bar", -and => { $lhs => \"baz" }, bizz => "buzz" },
     { foo => "bar", $lhs => \"baz", bizz => "buzz" },
     { foo => "bar", $lhs => \["baz"], bizz => "buzz" },
@@ -840,27 +852,30 @@ for my $t (@tests) {
 
     my $cref = sub {
       my $op = $t->{func};
-      ($stmt, @bind) = $maker->$op (@ { $t->{args} } );
+      ($stmt, @bind) = $maker->$op(@{ $t->{args} });
     };
 
     if (my $e = $t->{throws}) {
       throws_ok(
         sub { $cref->() },
         $e,
-      ) || diag dumper ({ args => $t->{args}, result => $stmt });
+      ) || diag dumper({ args => $t->{args}, result => $stmt });
     }
     else {
-      warnings_like(
-        sub { $cref->() },
-        $t->{warns} || [],
-      ) || diag dumper ({ args => $t->{args}, result => $stmt });
+      lives_ok(sub {
+        alarm(5); local $SIG{ALRM} = sub { die "Timed out" };
+        warnings_like(
+          sub { $cref->() },
+          $t->{warns} || [],
+        ) || diag dumper({ args => $t->{args}, result => $stmt });
+      }) || diag dumper({ args => $t->{args}, result => $stmt, threw => $@ });
 
       is_same_sql_bind(
         $stmt,
         \@bind,
         $quoted ? $t->{stmt_q}: $t->{stmt},
         $t->{bind}
-      );
+      ) || diag dumper({ args => $t->{args}, result => $stmt });;
     }
   }
 }