X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTest.pm;h=7296d3911715ea9c4d563480b4f9443dbb7dc522;hb=4c0c44047baaff3fbe79da82dc87704b511aa514;hp=5a820649b611e79651377c768f48fcd24ec7e3bb;hpb=70c6f0e91c090ef8fe0d2ceb1466bcf9e484cfb9;p=dbsrgits%2FSQL-Abstract.git

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index 5a82064..7296d39 100644
--- a/lib/SQL/Abstract/Test.pm
+++ b/lib/SQL/Abstract/Test.pm
@@ -2,11 +2,38 @@ 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);
 use Test::Builder;
 use Test::Deep ();
 use SQL::Abstract::Tree;
 
+{
+  my $class;
+  if ($class = $ENV{SQL_ABSTRACT_TEST_AGAINST}) {
+    my $mod = join('/', split '::', $class).".pm";
+    require $mod;
+    eval qq{sub SQL::Abstract () { "\Q${class}\E" }; 1}
+      or die "Failed to create const sub for ${class}: $@";
+  }
+  if ($ENV{SQL_ABSTRACT_TEST_EXPAND_STABILITY}) {
+    $class ||= do { require SQL::Abstract; 'SQL::Abstract' };
+    my $orig = $class->can('expand_expr');
+    require Data::Dumper::Concise;
+    my $wrapped = sub {
+      my ($self, @args) = @_;
+      my $e1 = $self->$orig(@args);
+      my $e2 = $self->$orig($e1);
+      (our $tb)->is_eq(
+        (map Data::Dumper::Concise::Dumper($_), $e1, $e2),
+        'expand_expr stability ok'
+      );
+      return $e1;
+    };
+    no strict 'refs'; no warnings 'redefine';
+    *{"${class}::expand_expr"} = $wrapped;
+  }
+}
+
 our @EXPORT_OK = qw(
   is_same_sql_bind is_same_sql is_same_bind
   eq_sql_bind eq_sql eq_bind dumper diag_where
@@ -20,7 +47,7 @@ our $parenthesis_significant = 0;
 our $order_by_asc_significant = 0;
 
 our $sql_differ; # keeps track of differing portion between SQLs
-our $tb = __PACKAGE__->builder;
+our $tb; # not documented, but someone might be overriding it anyway
 
 sub _unpack_arrayrefref {
 
@@ -28,7 +55,7 @@ sub _unpack_arrayrefref {
   for (1,2) {
     my $chunk = shift @_;
 
-    if ( ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY' ) {
+    if (ref $chunk eq 'REF' and ref $$chunk eq 'ARRAY') {
       my ($sql, @bind) = @$$chunk;
       push @args, ($sql, \@bind);
     }
@@ -52,6 +79,7 @@ sub is_same_sql_bind {
   my $same_bind = eq_bind($bind_ref1, $bind_ref2);
 
   # call Test::Builder::ok
+  my $tb = $tb || __PACKAGE__->builder;
   my $ret = $tb->ok($same_sql && $same_bind, $msg);
 
   # add debugging info
@@ -73,6 +101,7 @@ sub is_same_sql {
   my $same_sql = eq_sql($sql1, $sql2);
 
   # call Test::Builder::ok
+  my $tb = $tb || __PACKAGE__->builder;
   my $ret = $tb->ok($same_sql, $msg);
 
   # add debugging info
@@ -91,6 +120,7 @@ sub is_same_bind {
   my $same_bind = eq_bind($bind_ref1, $bind_ref2);
 
   # call Test::Builder::ok
+  my $tb = $tb || __PACKAGE__->builder;
   my $ret = $tb->ok($same_bind, $msg);
 
   # add debugging info
@@ -112,14 +142,22 @@ sub dumper {
 }
 
 sub diag_where{
-  $tb->diag( "Search term:\n" . &dumper );
+  my $tb = $tb || __PACKAGE__->builder;
+  $tb->diag("Search term:\n" . &dumper);
 }
 
 sub _sql_differ_diag {
   my $sql1 = shift || '';
   my $sql2 = shift || '';
 
-  $tb->${\( $tb->in_todo ? 'note' : 'diag')} (
+  my $tb = $tb || __PACKAGE__->builder;
+
+  if (my $profile = $ENV{SQL_ABSTRACT_TEST_TREE_PROFILE}) {
+    my $sqlat = SQL::Abstract::Tree->new(profile => $profile);
+    $_ = $sqlat->format($_) for ($sql1, $sql2);
+  }
+
+  $tb->${\($tb->in_todo ? 'note' : 'diag')} (
        "SQL expressions differ\n"
       ." got: $sql1\n"
       ."want: $sql2\n"
@@ -130,7 +168,8 @@ sub _sql_differ_diag {
 sub _bind_differ_diag {
   my ($bind_ref1, $bind_ref2) = @_;
 
-  $tb->${\( $tb->in_todo ? 'note' : 'diag')} (
+  my $tb = $tb || __PACKAGE__->builder;
+  $tb->${\($tb->in_todo ? 'note' : 'diag')} (
     "BIND values differ " . dumper({ got => $bind_ref1, want => $bind_ref2 })
   );
 }
@@ -159,8 +198,8 @@ sub _eq_sql {
   my ($left, $right) = @_;
 
   # one is defined the other not
-  if ( (defined $left) xor (defined $right) ) {
-    $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse ($_) : 'N/A' } ($left, $right) );
+  if ((defined $left) xor (defined $right)) {
+    $sql_differ = sprintf ("[%s] != [%s]\n", map { defined $_ ? $sqlat->unparse($_) : 'N/A' } ($left, $right) );
     return 0;
   }
 
@@ -176,14 +215,14 @@ sub _eq_sql {
 
   # one is empty
   if (@$left == 0 or @$right == 0) {
-    $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse ($_) : 'N/A'} ($left, $right) );
+    $sql_differ = sprintf ("left: %s\nright: %s\n", map { @$_ ? $sqlat->unparse($_) : 'N/A'} ($left, $right) );
     return 0;
   }
 
   # one is a list, the other is an op with a list
   elsif (ref $left->[0] xor ref $right->[0]) {
     $sql_differ = sprintf ("[%s] != [%s]\nleft: %s\nright: %s\n", map
-      { ref $_ ? $sqlat->unparse ($_) : $_ }
+      { ref $_ ? $sqlat->unparse($_) : $_ }
       ($left->[0], $right->[0], $left, $right)
     );
     return 0;
@@ -196,7 +235,7 @@ sub _eq_sql {
         if (! $sql_differ or $sql_differ !~ /left\:\s .+ right:\s/xs) {
           $sql_differ ||= '';
           $sql_differ .= "\n" unless $sql_differ =~ /\n\z/;
-          $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) );
+          $sql_differ .= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) );
         }
         return 0;
       }
@@ -208,7 +247,7 @@ sub _eq_sql {
   else {
 
     # unroll parenthesis if possible/allowed
-    unless ( $parenthesis_significant ) {
+    unless ($parenthesis_significant) {
       $sqlat->_parenthesis_unroll($_) for $left, $right;
     }
 
@@ -217,7 +256,7 @@ sub _eq_sql {
       $sqlat->_strip_asc_from_order_by($_) for $left, $right;
     }
 
-    if ( $left->[0] ne $right->[0] ) {
+    if ($left->[0] ne $right->[0]) {
       $sql_differ = sprintf "OP [$left->[0]] != [$right->[0]] in\nleft: %s\nright: %s\n",
         $sqlat->unparse($left),
         $sqlat->unparse($right)
@@ -237,7 +276,7 @@ sub _eq_sql {
     # if operators are identical, compare operands
     else {
       my $eq = _eq_sql($left->[1], $right->[1]);
-      $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse ($_) } ($left, $right) ) if not $eq;
+      $sql_differ ||= sprintf ("left: %s\nright: %s\n", map { $sqlat->unparse($_) } ($left, $right) ) if not $eq;
       return $eq;
     }
   }