From: Peter Rabbitson <ribasushi@cpan.org>
Date: Thu, 26 Dec 2013 04:29:17 +0000 (+0100)
Subject: Centralize handling of in-test dumpering
X-Git-Tag: v1.75~10
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2fadf08e171ee68c239cec896075428ae21f2232;p=dbsrgits%2FSQL-Abstract.git

Centralize handling of in-test dumpering
---

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index c802be1..419d516 100644
--- a/lib/SQL/Abstract/Test.pm
+++ b/lib/SQL/Abstract/Test.pm
@@ -2,15 +2,17 @@ package SQL::Abstract::Test; # see doc at end of file
 
 use strict;
 use warnings;
-use base qw/Test::Builder::Module Exporter/;
+use base qw(Test::Builder::Module Exporter);
 use Data::Dumper;
 use Test::Builder;
 use Test::Deep ();
 use SQL::Abstract::Tree;
 
-our @EXPORT_OK = qw/&is_same_sql_bind &is_same_sql &is_same_bind
-                    &eq_sql_bind &eq_sql &eq_bind
-                    $case_sensitive $sql_differ/;
+our @EXPORT_OK = qw(
+  is_same_sql_bind is_same_sql is_same_bind
+  eq_sql_bind eq_sql eq_bind dumper diag_where
+  $case_sensitive $sql_differ
+);
 
 my $sqlat = SQL::Abstract::Tree->new;
 
@@ -79,6 +81,14 @@ sub is_same_bind {
   return $ret;
 }
 
+sub dumper {
+  Data::Dumper->new([])->Terse(1)->Indent(1)->Useqq(1)->Deparse(1)->Quotekeys(0)->Sortkeys(1)->Maxdepth(0)->Values([@_])->Dump;
+}
+
+sub diag_where{
+  $tb->diag( "Search term:\n" . &dumper );
+}
+
 sub _sql_differ_diag {
   my ($sql1, $sql2) = @_;
 
@@ -93,12 +103,10 @@ sub _sql_differ_diag {
 sub _bind_differ_diag {
   my ($bind_ref1, $bind_ref2) = @_;
 
-  local $Data::Dumper::Maxdepth;
-
   $tb->${\( $tb->in_todo ? 'note' : 'diag')} (
        "BIND values differ\n"
-      ."     got: " . Dumper($bind_ref1)
-      ."expected: " . Dumper($bind_ref2)
+      ."     got: " . dumper($bind_ref1)
+      ."expected: " . dumper($bind_ref2)
       );
 }
 
diff --git a/t/02where.t b/t/02where.t
index fc926f2..ee5dbd8 100644
--- a/t/02where.t
+++ b/t/02where.t
@@ -4,9 +4,8 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where) ];
 
-use Data::Dumper;
 use SQL::Abstract;
 
 # Make sure to test the examples, since having them break is somewhat
@@ -403,14 +402,10 @@ my @handle_tests = (
 );
 
 for my $case (@handle_tests) {
-    local $Data::Dumper::Terse = 1;
     my $sql = SQL::Abstract->new;
-    my($stmt, @bind);
-    lives_ok (sub {
-      ($stmt, @bind) = $sql->where($case->{where}, $case->{order});
-      is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
-        || diag "Search term:\n" . Dumper $case->{where};
-    });
+    my ($stmt, @bind) = $sql->where($case->{where}, $case->{order});
+    is_same_sql_bind($stmt, \@bind, $case->{stmt}, $case->{bind})
+      || diag_where ( $case->{where} );
 }
 
 dies_ok {
diff --git a/t/04modifiers.t b/t/04modifiers.t
index a3ac721..3e77cf3 100644
--- a/t/04modifiers.t
+++ b/t/04modifiers.t
@@ -4,9 +4,8 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)];
 
-use Data::Dumper;
 use SQL::Abstract;
 use Storable 'dclone';
 
@@ -384,8 +383,6 @@ for my $case (@and_or_tests) {
   TODO: {
     local $TODO = $case->{todo} if $case->{todo};
 
-    local $Data::Dumper::Terse = 1;
-
     my @w;
     local $SIG{__WARN__} = sub { push @w, @_ };
 
@@ -400,8 +397,7 @@ for my $case (@and_or_tests) {
         \@bind,
         $case->{stmt},
         $case->{bind},
-      )
-        || diag "Search term:\n" . Dumper $case->{where};
+      ) || diag_where( $case->{where} );
     });
     is (@w, 0, 'No warnings within and-or tests')
       || diag join "\n", 'Emitted warnings:', @w;
@@ -415,7 +411,6 @@ for my $case (@nest_tests) {
     local $TODO = $case->{todo} if $case->{todo};
 
     local $SQL::Abstract::Test::parenthesis_significant = 1;
-    local $Data::Dumper::Terse = 1;
 
     my $sql = SQL::Abstract->new ($case->{args} || {});
     lives_ok (sub {
@@ -425,8 +420,7 @@ for my $case (@nest_tests) {
         \@bind,
         $case->{stmt},
         $case->{bind},
-      )
-        || diag "Search term:\n" . Dumper $case->{where};
+      ) || diag_where ( $case->{where} );
     });
   }
 }
@@ -438,8 +432,6 @@ for my $case (@numbered_mods) {
   TODO: {
     local $TODO = $case->{todo} if $case->{todo};
 
-    local $Data::Dumper::Terse = 1;
-
     my @w;
     local $SIG{__WARN__} = sub { push @w, @_ };
     my $sql = SQL::Abstract->new ($case->{args} || {});
@@ -450,10 +442,10 @@ for my $case (@numbered_mods) {
         $old_s, \@old_b,
         $new_s, \@new_b,
         'Backcompat and the correct(tm) syntax result in identical statements',
-      ) || diag "Search terms:\n" . Dumper {
-          backcompat => $case->{backcompat},
-          correct => $case->{correct},
-        };
+      ) || diag_where ( {
+        backcompat => $case->{backcompat},
+        correct => $case->{correct},
+      });
     });
 
     ok (@w, 'Warnings were emitted about a mod_N construct');
diff --git a/t/05in_between.t b/t/05in_between.t
index 2ae0172..f39b3e6 100644
--- a/t/05in_between.t
+++ b/t/05in_between.t
@@ -4,9 +4,8 @@ use strict;
 use warnings;
 use Test::More;
 use Test::Exception;
-use SQL::Abstract::Test import => ['is_same_sql_bind'];
+use SQL::Abstract::Test import => [qw(is_same_sql_bind diag_where)];
 
-use Data::Dumper;
 use SQL::Abstract;
 
 my @in_between_tests = (
@@ -225,25 +224,23 @@ for my $case (@in_between_tests) {
     local $TODO = $case->{todo} if $case->{todo};
     local $SQL::Abstract::Test::parenthesis_significant = $case->{parenthesis_significant};
 
-    local $Data::Dumper::Terse = 1;
 
     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};
     }
     else {
-      lives_ok {
-        my ($stmt, @bind) = $sql->where($case->{where});
-        is_same_sql_bind(
-          $stmt,
-          \@bind,
-          $case->{stmt},
-          $case->{bind},
-        ) || diag "Search term:\n" . Dumper $case->{where};
-      } "$case->{test} doesn't die";
+      my ($stmt, @bind) = $sql->where($case->{where});
+      is_same_sql_bind(
+        $stmt,
+        \@bind,
+        $case->{stmt},
+        $case->{bind},
+      ) || diag_where ( $case->{where} );
     }
 
     is (@w, 0, $case->{test} || 'No warnings within in-between tests')
diff --git a/t/10test.t b/t/10test.t
index 23183a9..a3122e0 100644
--- a/t/10test.t
+++ b/t/10test.t
@@ -2,13 +2,12 @@
 
 use strict;
 use warnings;
-use List::Util qw(sum);
 
 use Test::More;
 
-use Data::Dumper;
-$Data::Dumper::Terse = 1;
-$Data::Dumper::Sortkeys = 1;
+use SQL::Abstract::Test import => [qw(
+  eq_sql_bind eq_sql eq_bind is_same_sql_bind dumper $sql_differ
+)];
 
 my @sql_tests = (
       # WHERE condition - equal
@@ -975,10 +974,6 @@ my @bind_tests = (
   },
 );
 
-use_ok('SQL::Abstract::Test', import => [qw(
-  eq_sql_bind eq_sql eq_bind is_same_sql_bind
-)]);
-
 for my $test ( @sql_tests ) {
 
   # this does not work on 5.8.8 and earlier :(
@@ -1010,11 +1005,11 @@ for my $test ( @sql_tests ) {
 
         if ($equal ^ $test->{equal}) {
           my ($ast1, $ast2) = map { SQL::Abstract::Test::parse ($_) } ($sql1, $sql2);
-          $_ = Dumper $_ for ($ast1, $ast2);
+          $_ = dumper($_) for ($ast1, $ast2);
 
           diag "sql1: $sql1";
           diag "sql2: $sql2";
-          note $SQL::Abstract::Test::sql_differ;
+          note $sql_differ || 'No differences found';
           note "ast1: $ast1";
           note "ast2: $ast2";
         }
@@ -1039,8 +1034,8 @@ for my $test (@bind_tests) {
       }
 
       if ($equal ^ $test->{equal}) {
-        diag("bind1: " . Dumper($bind1));
-        diag("bind2: " . Dumper($bind2));
+        diag("bind1: " . dumper($bind1));
+        diag("bind2: " . dumper($bind2));
       }
     }
   }
@@ -1074,7 +1069,7 @@ ok (! eq_sql (
   'SELECT owner_name FROM books me WHERE ( sUOrce = ? )',
 ));
 like(
-  $SQL::Abstract::Test::sql_differ,
+  $sql_differ,
   qr/\Q[ source ] != [ sUOrce ]/,
   'expected debug of literal diff',
 );
@@ -1084,7 +1079,7 @@ ok (! eq_sql (
   'SELECT owner_name FROM books me GROUP BY owner_name',
 ));
 like(
-  $SQL::Abstract::Test::sql_differ,
+  $sql_differ,
   qr/\QOP [ORDER BY] != [GROUP BY]/,
   'expected debug of op diff',
 );
@@ -1095,7 +1090,7 @@ ok (! eq_sql (
 ));
 
 like(
-  $SQL::Abstract::Test::sql_differ,
+  $sql_differ,
   qr|\Q[WHERE source = ?] != [N/A]|,
   'expected debug of missing branch',
 );
diff --git a/t/14roundtrippin.t b/t/14roundtrippin.t
index 7e0fda9..4d32207 100644
--- a/t/14roundtrippin.t
+++ b/t/14roundtrippin.t
@@ -4,11 +4,7 @@ use strict;
 use Test::More;
 use Test::Exception;
 
-use Data::Dumper;
-$Data::Dumper::Terse = 1;
-$Data::Dumper::Sortkeys = 1;
-
-use SQL::Abstract::Test import => ['is_same_sql'];
+use SQL::Abstract::Test import => [qw(is_same_sql dumper)];
 use SQL::Abstract::Tree;
 
 my $sqlat = SQL::Abstract::Tree->new;
@@ -65,7 +61,7 @@ for my $orig (@sql) {
     lc($orig),
     sprintf( 'roundtrip works (%s...)', substr $orig, 0, 20 )
   ) or do {
-    my ($ast1, $ast2) = map { Dumper $sqlat->parse($_) } ( $orig, $reassembled );
+    my ($ast1, $ast2) = map { dumper( $sqlat->parse($_) ) } ( $orig, $reassembled );
 
     note "ast1: $ast1";
     note "ast2: $ast2";