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

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2010-05-16 10:43:40 +0100 (Sun, 16 May 2010)
New Revision: 9387

Modified:
   SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
   SQL-Abstract/1.x/trunk/t/01generate.t
Log:
Puke in bind-assert and rewrite test to stop T::E from puking itself

Modified: SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm
===================================================================
--- SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2010-05-16 09:09:54 UTC (rev 9386)
+++ SQL-Abstract/1.x/trunk/lib/SQL/Abstract.pm	2010-05-16 09:43:40 UTC (rev 9387)
@@ -1129,7 +1129,7 @@
   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]"
       }
     }
   }

Modified: SQL-Abstract/1.x/trunk/t/01generate.t
===================================================================
--- SQL-Abstract/1.x/trunk/t/01generate.t	2010-05-16 09:09:54 UTC (rev 9386)
+++ SQL-Abstract/1.x/trunk/t/01generate.t	2010-05-16 09:43:40 UTC (rev 9387)
@@ -598,52 +598,49 @@
 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 $maker = SQL::Abstract->new(%$new, $quoted
+      ? (quote_char => '`', name_sep => '.')
+      : ()
+    );
+
     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});
-    }
-  }
 
-  # test with quoted labels
-  {
-    my $sql_q = SQL::Abstract->new(%$new, quote_char => '`', name_sep => '.');
-
-    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}
+      );
     }
   }
 }