From: Peter Rabbitson <ribasushi@cpan.org>
Date: Sun, 16 May 2010 09:43:40 +0000 (+0000)
Subject: Puke in bind-assert and rewrite test to stop T::E from puking itself
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3a06278c0b7a87c5d3c64bdaa0ed0895f03133f2;p=scpubgit%2FQ-Branch.git

Puke in bind-assert and rewrite test to stop T::E from puking itself
---

diff --git a/lib/SQL/Abstract.pm b/lib/SQL/Abstract.pm
index 70b38b7..207a7c7 100644
--- a/lib/SQL/Abstract.pm
+++ b/lib/SQL/Abstract.pm
@@ -1129,7 +1129,7 @@ sub _assert_bindval_matches_bindtype {
   if ($self->{bindtype} eq 'columns') {
     for (@_) {
       if (!defined $_ || ref($_) ne 'ARRAY' || @$_ != 2) {
-        die "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
+        puke "bindtype 'columns' selected, you need to pass: [column_name => bind_value]"
       }
     }
   }
diff --git a/t/01generate.t b/t/01generate.t
index ee56e60..24c6705 100644
--- a/t/01generate.t
+++ b/t/01generate.t
@@ -598,52 +598,49 @@ my @tests = (
 plan tests => scalar(grep { !$_->{warning_like} } @tests) * 2
             + scalar(grep { $_->{warning_like} } @tests) * 4;
 
-for (@tests) {
+for my $t (@tests) {
   local $"=', ';
 
-  my $new = $_->{new} || {};
+  my $new = $t->{new} || {};
   $new->{debug} = $ENV{DEBUG} || 0;
 
-  # test without quoting labels
-  {
-    my $sql = SQL::Abstract->new(%$new);
+  for my $quoted (0, 1) {
 
-    my $func = $_->{func};
-    my($stmt, @bind);
-    my $test = sub {
-      ($stmt, @bind) = $sql->$func(@{$_->{args}})
-    };
-    if ($_->{exception_like}) {
-      throws_ok { &$test } $_->{exception_like}, "throws the expected exception ($_->{exception_like})";
-    } else {
-      if ($_->{warning_like}) {
-        warning_like { &$test } $_->{warning_like}, "throws the expected warning ($_->{warning_like})";
-      } else {
-        &$test;
-      }
-      is_same_sql_bind($stmt, \@bind, $_->{stmt}, $_->{bind});
-    }
-  }
+    my $maker = SQL::Abstract->new(%$new, $quoted
+      ? (quote_char => '`', name_sep => '.')
+      : ()
+    );
 
-  # test with quoted labels
-  {
-    my $sql_q = SQL::Abstract->new(%$new, quote_char => '`', name_sep => '.');
+    my($stmt, @bind);
 
-    my $func_q = $_->{func};
-    my($stmt_q, @bind_q);
-    my $test = sub {
-      ($stmt_q, @bind_q) = $sql_q->$func_q(@{$_->{args}})
+    my $cref = sub {
+      my $op = $t->{func};
+      ($stmt, @bind) = $maker->$op (@ { $t->{args} } );
     };
-    if ($_->{exception_like}) {
-      throws_ok { &$test } $_->{exception_like}, "throws the expected exception ($_->{exception_like})";
+
+    if ($t->{exception_like}) {
+      throws_ok(
+        sub { $cref->() },
+        $t->{exception_like},
+        "throws the expected exception ($t->{exception_like})"
+      );
     } else {
-      if ($_->{warning_like}) {
-        warning_like { &$test } $_->{warning_like}, "throws the expected warning ($_->{warning_like})";
-      } else {
-        &$test;
+      if ($t->{warning_like}) {
+        warning_like(
+          sub { $cref->() },
+          $t->{warning_like},
+          "issues the expected warning ($t->{warning_like})"
+        );
       }
-
-      is_same_sql_bind($stmt_q, \@bind_q, $_->{stmt_q}, $_->{bind});
+      else {
+        $cref->();
+      }
+      is_same_sql_bind(
+        $stmt,
+        \@bind,
+        $quoted ? $t->{stmt_q}: $t->{stmt},
+        $t->{bind}
+      );
     }
   }
 }