Normalize handling of expected warnings/exceptions in tests
Peter Rabbitson [Thu, 26 Dec 2013 05:26:51 +0000 (06:26 +0100)]
t/01generate.t
t/04modifiers.t
t/05in_between.t

index 328abc3..5d68e1f 100644 (file)
@@ -328,7 +328,7 @@ my @tests = (
               stmt   => 'INSERT INTO test (a, b, c, d, e) VALUES (?, ?, ?, ?, ?)',
               stmt_q => 'INSERT INTO `test` (`a`, `b`, `c`, `d`, `e`) VALUES (?, ?, ?, ?, ?)',
               bind   => [qw/1 2 3 4/, { answer => 42}],
-              warning_like => qr/HASH ref as bind value in insert is not supported/i,
+              warns  => qr/HASH ref as bind value in insert is not supported/i,
       },
       {
               func   => 'update',
@@ -394,25 +394,25 @@ my @tests = (
               func   => 'insert',
               new    => {bindtype => 'columns'},
               args   => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", '02/02/02']}],
-              exception_like => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
+              throws => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
       },
       {
               func   => 'update',
               new    => {bindtype => 'columns'},
               args   => ['test', {a => 1, b => \["to_date(?, 'MM/DD/YY')", '02/02/02']}, {a => {'between', [1,2]}}],
-              exception_like => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
+              throws => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
       },
       {
               func   => 'select',
               new    => {bindtype => 'columns'},
               args   => ['test', '*', { a => \["= to_date(?, 'MM/DD/YY')", '02/02/02']}],
-              exception_like => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
+              throws => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
       },
       {
               func   => 'select',
               new    => {bindtype => 'columns'},
               args   => ['test', '*', { a => {'<' => \["to_date(?, 'MM/DD/YY')", '02/02/02']}, b => 8 }],
-              exception_like => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
+              throws => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
       },
       {
               func   => 'select',
@@ -426,7 +426,7 @@ my @tests = (
               func   => 'select',
               new    => {bindtype => 'columns'},
               args   => ['test', '*', { a => {-in => \["(SELECT d FROM to_date(?, 'MM/DD/YY') AS d)", '02/02/02']}, b => 8 }],
-              exception_like => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
+              throws => qr/bindtype 'columns' selected, you need to pass: \[column_name => bind_value\]/,
       },
       {
               func   => 'insert',
@@ -542,7 +542,7 @@ my @tests = (
               bind => [],
       },
       {
-              exception_like => qr/
+              throws => qr/
                 \QSQL::Abstract before v1.75 used to generate incorrect SQL \E
                 \Qwhen the -IN operator was given an undef-containing list: \E
                 \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E
@@ -556,7 +556,7 @@ my @tests = (
               bind => [ 42, 42 ],
       },
       {
-              exception_like => qr/
+              throws => qr/
                 \QSQL::Abstract before v1.75 used to generate incorrect SQL \E
                 \Qwhen the -IN operator was given an undef-containing list: \E
                 \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E
@@ -572,7 +572,7 @@ my @tests = (
       {
               func => 'select',
               args => ['test', '*', { a => { -in => undef } }],
-              exception_like => qr/Argument passed to the 'IN' operator can not be undefined/,
+              throws => qr/Argument passed to the 'IN' operator can not be undefined/,
       },
 );
 
@@ -593,23 +593,17 @@ for my $t (@tests) {
       ($stmt, @bind) = $maker->$op (@ { $t->{args} } );
     };
 
-    if ($t->{exception_like}) {
+    if (my $e = $t->{throws}) {
       throws_ok(
         sub { $cref->() },
-        $t->{exception_like},
-        "throws the expected exception ($t->{exception_like})"
+        $e,
+      );
+    }
+    else {
+      warnings_exist(
+        sub { $cref->() },
+        $t->{warns} || [],
       );
-    } else {
-      if ($t->{warning_like}) {
-        warning_like(
-          sub { $cref->() },
-          $t->{warning_like},
-          "issues the expected warning ($t->{warning_like})"
-        );
-      }
-      else {
-        $cref->();
-      }
 
       is_same_sql_bind(
         $stmt,
index 27db12c..3504e6b 100644 (file)
@@ -2,6 +2,7 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)];
 
 use SQL::Abstract;
@@ -381,14 +382,11 @@ for my $case (@and_or_tests) {
   TODO: {
     local $TODO = $case->{todo} if $case->{todo};
 
-    my @w;
-    local $SIG{__WARN__} = sub { push @w, @_ };
-
     my $sql = SQL::Abstract->new ($case->{args} || {});
 
     my $where_copy = dclone($case->{where});
 
-    lives_ok (sub {
+    warnings_are {
       my ($stmt, @bind) = $sql->where($case->{where});
       is_same_sql_bind(
         $stmt,
@@ -396,9 +394,7 @@ for my $case (@and_or_tests) {
         $case->{stmt},
         $case->{bind},
       ) || diag_where( $case->{where} );
-    });
-    is (@w, 0, 'No warnings within and-or tests')
-      || diag join "\n", 'Emitted warnings:', @w;
+    } [], 'No warnings within and-or tests';
 
     is_deeply ($case->{where}, $where_copy, 'Where conditions unchanged');
   }
@@ -423,17 +419,16 @@ for my $case (@nest_tests) {
   }
 }
 
-
-
-my $w_str = "\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0\E";
 for my $case (@numbered_mods) {
   TODO: {
     local $TODO = $case->{todo} if $case->{todo};
 
+    # not using Test::Warn here - variable amount of warnings
     my @w;
     local $SIG{__WARN__} = sub { push @w, @_ };
+
     my $sql = SQL::Abstract->new ($case->{args} || {});
-    lives_ok (sub {
+    {
       my ($old_s, @old_b) = $sql->where($case->{backcompat});
       my ($new_s, @new_b) = $sql->where($case->{correct});
       is_same_sql_bind(
@@ -444,17 +439,12 @@ for my $case (@numbered_mods) {
         backcompat => $case->{backcompat},
         correct => $case->{correct},
       });
-    });
-
-    ok (@w, 'Warnings were emitted about a mod_N construct');
-
-    my @non_match;
-    for (@w) {
-      push @non_match, $_ if ($_ !~ /$w_str/);
-    }
+    };
 
-    is (@non_match, 0, 'All warnings match the deprecation message')
-      || diag join "\n", 'Rogue warnings:', @non_match;
+    ok ( (grep
+      { $_ =~ qr/\QUse of [and|or|nest]_N modifiers is deprecated and will be removed in SQLA v2.0/ }
+      @w
+    ), 'Warnings were emitted about a mod_N construct');
   }
 }
 
index 1cb6b43..8162741 100644 (file)
@@ -1,6 +1,7 @@
 use strict;
 use warnings;
 use Test::More;
+use Test::Warn;
 use Test::Exception;
 use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)];
 
@@ -66,7 +67,7 @@ my @in_between_tests = (
   ( map { {
     where => { x => { -between => $_ } },
     test => 'invalid -between args',
-    exception => qr|Operator 'BETWEEN' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref|,
+    throws => qr|Operator 'BETWEEN' requires either an arrayref with two defined values or expressions, or a single literal scalarref/arrayref-ref|,
   } } (
     [ 1, 2, 3 ],
     [ 1, undef, 3 ],
@@ -192,7 +193,7 @@ my @in_between_tests = (
     test => '-in with an array of function array refs with args',
   },
   {
-    exception => qr/
+    throws => qr/
       \QSQL::Abstract before v1.75 used to generate incorrect SQL \E
       \Qwhen the -IN operator was given an undef-containing list: \E
       \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E
@@ -205,7 +206,7 @@ my @in_between_tests = (
     test => '-in with undef as an element',
   },
   {
-    exception => qr/
+    throws => qr/
       \QSQL::Abstract before v1.75 used to generate incorrect SQL \E
       \Qwhen the -IN operator was given an undef-containing list: \E
       \Q!!!AUDIT YOUR CODE AND DATA!!! (the upcoming Data::Query-based \E
@@ -224,17 +225,17 @@ for my $case (@in_between_tests) {
     local $TODO = $case->{todo} if $case->{todo};
     local $SQL::Abstract::Test::parenthesis_significant = $case->{parenthesis_significant};
 
-
-    my @w;
-    local $SIG{__WARN__} = sub { push @w, @_ };
-
     my $sql = SQL::Abstract->new ($case->{args} || {});
 
-    if ($case->{exception}) {
-      throws_ok { $sql->where($case->{where}) } $case->{exception};
+    if (my $e = $case->{throws}) {
+      throws_ok { $sql->where($case->{where}) } $e;
     }
     else {
-      my ($stmt, @bind) = $sql->where($case->{where});
+      my ($stmt, @bind);
+      warnings_are {
+        ($stmt, @bind) = $sql->where($case->{where});
+      } [], 'No warnings within in-between tests';
+
       is_same_sql_bind(
         $stmt,
         \@bind,
@@ -242,9 +243,6 @@ for my $case (@in_between_tests) {
         $case->{bind},
       ) || diag_where ( $case->{where} );
     }
-
-    is (@w, 0, $case->{test} || 'No warnings within in-between tests')
-      || diag join "\n", 'Emitted warnings:', @w;
   }
 }