X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FAbstract%2FTest.pm;h=e163f2c5987a0758e96bce06276e752b45f96d83;hb=116bc0b69bc3d55647a4e195cf212a6af38ba5b8;hp=8a455e255790f0121a1d37b31cf42d9325e6c23c;hpb=d5b7788a4027ca20b3e7fb1f2b4ba50ee619d2cd;p=scpubgit%2FQ-Branch.git

diff --git a/lib/SQL/Abstract/Test.pm b/lib/SQL/Abstract/Test.pm
index 8a455e2..e163f2c 100644
--- a/lib/SQL/Abstract/Test.pm
+++ b/lib/SQL/Abstract/Test.pm
@@ -7,11 +7,40 @@ use Test::Builder;
 use Test::Deep ();
 use SQL::Abstract::Tree;
 
-if (my $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}: $@";
+{
+  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);
+      return $e1 if our $Stab_Check_Rec;
+      local $Stab_Check_Rec = 1;
+      my $e2 = $self->$orig($e1);
+      my ($d1, $d2) = map Data::Dumper::Concise::Dumper($_), $e1, $e2;
+      (our $tb)->is_eq(
+        $d2, $d1,
+        'expand_expr stability ok'
+      ) or do {
+        require Path::Tiny;
+        Path::Tiny->new('e1')->spew($d1);
+        Path::Tiny->new('e2')->spew($d2);
+        system('diff -u e1 e2 1>&2');
+        die "Differences between e1 and e2, bailing out";
+      };
+      return $e1;
+    };
+    no strict 'refs'; no warnings 'redefine';
+    *{"${class}::expand_expr"} = $wrapped;
+  }
 }
 
 our @EXPORT_OK = qw(