move clause rendering to better calling convention

[scpubgit/Q-Branch.git] / lib / SQL / Abstract / Test.pm

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index 8eeab4c..71fba6c 100644 (file)
--- a/lib/SQL/Abstract/Test.pm
+++ b/lib/SQL/Abstract/Test.pm
@@ -7,6 +7,33 @@ 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
@@ -119,6 +146,11 @@ sub _sql_differ_diag {
   my $sql1 = shift || '';
   my $sql2 = shift || '';
 
+  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"