From: Peter Rabbitson <ribasushi@cpan.org>
Date: Tue, 17 Mar 2015 15:31:56 +0000 (+0100)
Subject: Run the entire test suite under replicated SQLite on DBICTEST_VIA_REPLICATED
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fd2c6658f;p=dbsrgits%2FDBIx-Class-Historic.git

Run the entire test suite under replicated SQLite on DBICTEST_VIA_REPLICATED

There isn't real replication, the reader and writer in fact talk to the same
on-disk file. Still this is effective enough to put into CI.
---

diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index b7f24ee..6f0cb12 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -25,7 +25,7 @@ use DBIx::Class::StartupCheck;
 use DBIx::Class::Exception;
 
 __PACKAGE__->mk_group_accessors(inherited => '_skip_namespace_frames');
-__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve');
+__PACKAGE__->_skip_namespace_frames('^DBIx::Class|^SQL::Abstract|^Try::Tiny|^Class::Accessor::Grouped|^Context::Preserve|^Moose::Meta::');
 
 # FIXME - this is not really necessary, and is in
 # fact going to slow things down a bit
diff --git a/maint/travis-ci_scripts/20_install.bash b/maint/travis-ci_scripts/20_install.bash
index 054b908..c5b9895 100755
--- a/maint/travis-ci_scripts/20_install.bash
+++ b/maint/travis-ci_scripts/20_install.bash
@@ -101,6 +101,12 @@ if [[ "$POISON_ENV" = "true" ]] ; then
   export DBI_DSN="dbi:ODBC:server=NonexistentServerAddress"
   export DBI_DRIVER="ADO"
 
+  # if we have Moose - try to run everything under replicated
+  # FIXME - when switching to Moo kill this
+  if [[ "$CLEANTEST" != "true" ]] && perl -M5.008003 -e 1 &>/dev/null ; then
+    export DBICTEST_VIA_REPLICATED=1
+  fi
+
   # some people do in fact set this - boggle!!!
   # it of course won't work before 5.8.4
   if perl -M5.008004 -e 1 &>/dev/null ; then
diff --git a/t/52leaks.t b/t/52leaks.t
index a4673b1..ece1a45 100644
--- a/t/52leaks.t
+++ b/t/52leaks.t
@@ -55,7 +55,8 @@ my $weak_registry = {};
 my $has_dt;
 
 # Skip the heavy-duty leak tracing when just doing an install
-unless (DBICTest::RunMode->is_plain) {
+# or when having Moose crap all over everything
+if ( !$ENV{DBICTEST_VIA_REPLICATED} and !DBICTest::RunMode->is_plain ) {
 
   # redefine the bless override so that we can catch each and every object created
   no warnings qw/redefine once/;
diff --git a/t/99dbic_sqlt_parser.t b/t/99dbic_sqlt_parser.t
index a1be722..a9e708f 100644
--- a/t/99dbic_sqlt_parser.t
+++ b/t/99dbic_sqlt_parser.t
@@ -3,6 +3,8 @@ use DBIx::Class::Optional::Dependencies -skip_all_without => 'deploy';
 use strict;
 use warnings;
 
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
 use Test::More;
 use Test::Warn;
 use Test::Exception;
diff --git a/t/icdt/engine_specific/sqlite.t b/t/icdt/engine_specific/sqlite.t
index 8a152ab..837d62f 100644
--- a/t/icdt/engine_specific/sqlite.t
+++ b/t/icdt/engine_specific/sqlite.t
@@ -17,10 +17,15 @@ use DBICTest;
 
   my $storage = $schema->storage;
 
-  is(
-    ref $storage, 'DBIx::Class::Storage::DBI',
-    'Starting with generic storage'
-  );
+  if ($ENV{DBICTEST_VIA_REPLICATED}) {
+    $storage = $storage->master;
+  }
+  else {
+    is(
+      ref $storage, 'DBIx::Class::Storage::DBI',
+      'Starting with generic storage'
+    );
+  }
 
   # Calling date_time_parser should cause the storage to be reblessed,
   # so that we can pick up datetime_parser_type from subclasses
diff --git a/t/lib/DBICTest.pm b/t/lib/DBICTest.pm
index f2b2773..39a8af9 100644
--- a/t/lib/DBICTest.pm
+++ b/t/lib/DBICTest.pm
@@ -219,7 +219,7 @@ sub _database {
         # set a *DBI* disconnect callback, to make sure the physical SQLite
         # file is still there (i.e. the test does not attempt to delete
         # an open database, which fails on Win32)
-        if (my $guard_cb = __mk_disconnect_guard($db_file)) {
+        if (! $storage->{master} and my $guard_cb = __mk_disconnect_guard($db_file)) {
           $dbh->{Callbacks} = {
             connect => sub { $guard_cb->('connect') },
             disconnect => sub { $guard_cb->('disconnect') },
@@ -320,6 +320,14 @@ sub init_schema {
 
     my $schema;
 
+    if (
+      $ENV{DBICTEST_VIA_REPLICATED} &&=
+        ( !$args{storage_type} && !defined $args{sqlite_use_file} )
+    ) {
+      $args{storage_type} = ['::DBI::Replicated', { balancer_type => '::Random' }];
+      $args{sqlite_use_file} = 1;
+    }
+
     my @dsn = $self->_database(%args);
 
     if ($args{compose_connection}) {
@@ -337,6 +345,9 @@ sub init_schema {
 
     if ( !$args{no_connect} ) {
       $schema->connection(@dsn);
+
+      $schema->storage->connect_replicants(\@dsn)
+        if $ENV{DBICTEST_VIA_REPLICATED};
     }
 
     if ( !$args{no_deploy} ) {
diff --git a/t/lib/DBICTest/SQLTracerObj.pm b/t/lib/DBICTest/SQLTracerObj.pm
index 23baeb3..5763639 100644
--- a/t/lib/DBICTest/SQLTracerObj.pm
+++ b/t/lib/DBICTest/SQLTracerObj.pm
@@ -6,7 +6,16 @@ use warnings;
 
 use base 'DBIx::Class::Storage::Statistics';
 
-sub query_start { push @{$_[0]{sqlbinds}}, [ ($_[1] =~ /^\s*(\S+)/)[0], [ $_[1], @{ $_[2]||[] } ] ] }
+sub query_start {
+  my ($self, $sql, $bind) = @_;
+
+  my $op = ($sql =~ /^\s*(\S+)/)[0];
+
+  $sql =~ s/^ \s* \Q$op\E \s+ \[ .+? \]/$op/x
+    if $ENV{DBICTEST_VIA_REPLICATED};
+
+  push @{$self->{sqlbinds}}, [ $op, [ $sql, @{ $bind || [] } ] ];
+}
 
 # who the hell came up with this API >:(
 for my $txn (qw(begin rollback commit)) {
diff --git a/t/storage/base.t b/t/storage/base.t
index 1861855..451f7e6 100644
--- a/t/storage/base.t
+++ b/t/storage/base.t
@@ -10,11 +10,13 @@ use Data::Dumper;
 
 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
 
-is( ref($schema->storage), 'DBIx::Class::Storage::DBI::SQLite',
-    'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite' );
-
 my $storage = $schema->storage;
-$storage->ensure_connected;
+
+is(
+  ref($storage),
+  'DBIx::Class::Storage::DBI::SQLite',
+  'Storage reblessed correctly into DBIx::Class::Storage::DBI::SQLite'
+) unless $ENV{DBICTEST_VIA_REPLICATED};
 
 throws_ok {
     $schema->storage->throw_exception('test_exception_42');
diff --git a/t/storage/dbh_do.t b/t/storage/dbh_do.t
index 952fa1c..727c245 100644
--- a/t/storage/dbh_do.t
+++ b/t/storage/dbh_do.t
@@ -9,6 +9,10 @@ use DBICTest;
 my $schema = DBICTest->init_schema();
 my $storage = $schema->storage;
 
+$storage = $storage->master
+  if $ENV{DBICTEST_VIA_REPLICATED};
+
+
 # test (re)connection
 for my $disconnect (0, 1) {
   $schema->storage->_dbh->disconnect if $disconnect;
diff --git a/t/storage/debug.t b/t/storage/debug.t
index e023fff..ccf7feb 100644
--- a/t/storage/debug.t
+++ b/t/storage/debug.t
@@ -2,6 +2,8 @@ use strict;
 use warnings;
 no warnings 'once';
 
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
 use Test::More;
 use Test::Exception;
 use Try::Tiny;
diff --git a/t/storage/disable_sth_caching.t b/t/storage/disable_sth_caching.t
index d6dcc03..494780d 100644
--- a/t/storage/disable_sth_caching.t
+++ b/t/storage/disable_sth_caching.t
@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
 use Test::More;
 use lib qw(t/lib);
 use DBICTest;
diff --git a/t/storage/on_connect_do.t b/t/storage/on_connect_do.t
index 115fadb..6fccbb1 100644
--- a/t/storage/on_connect_do.t
+++ b/t/storage/on_connect_do.t
@@ -1,6 +1,8 @@
 use strict;
 use warnings;
 
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
 # !!! do not replace this with done_testing - tests reside in the callbacks
 # !!! number of calls is important
 use Test::More tests => 13;
diff --git a/t/storage/savepoints.t b/t/storage/savepoints.t
index 5866e6d..3da77f1 100644
--- a/t/storage/savepoints.t
+++ b/t/storage/savepoints.t
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use DBIx::Class::_Util qw(modver_gt_or_eq sigwarn_silencer);
 
 use lib qw(t/lib);
 use DBICTest;
@@ -227,6 +228,15 @@ for ('', keys %$env2optdep) { SKIP: {
 
   is_deeply( $schema->storage->savepoints, [], 'All savepoints forgotten' );
 
+SKIP: {
+  skip "Reading inexplicably fails on very old replicated DBD::SQLite<1.33", 1 if (
+    $ENV{DBICTEST_VIA_REPLICATED}
+      and
+    $prefix eq 'SQLite Internal DB'
+      and
+    ! modver_gt_or_eq('DBD::SQLite', '1.33')
+  );
+
   ok($ars->search({ name => 'in_outer_transaction' })->first,
     'commit from outer transaction');
   ok($ars->search({ name => 'in_outer_transaction2' })->first,
@@ -236,6 +246,7 @@ for ('', keys %$env2optdep) { SKIP: {
   is $ars->search({ name => 'in_inner_transaction_rolling_back' })->first,
     undef,
     'rollback from inner transaction';
+}
 
 ### cleanupz
   $schema->storage->dbh_do(sub { $_[1]->do("DROP TABLE artist") });
@@ -244,6 +255,8 @@ for ('', keys %$env2optdep) { SKIP: {
 done_testing;
 
 END {
+  local $SIG{__WARN__} = sigwarn_silencer( qr/Internal transaction state of handle/ )
+    unless modver_gt_or_eq('DBD::SQLite', '1.33');
   eval { $schema->storage->dbh_do(sub { $_[1]->do("DROP TABLE artist") }) } if defined $schema;
   undef $schema;
 }
diff --git a/xt/extra/lean_startup.t b/xt/extra/lean_startup.t
index 072f585..5995324 100644
--- a/xt/extra/lean_startup.t
+++ b/xt/extra/lean_startup.t
@@ -83,6 +83,8 @@ BEGIN {
   }
 }
 
+BEGIN { $ENV{DBICTEST_VIA_REPLICATED} = 0 }
+
 #######
 ### This is where the test starts
 #######