X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fstorage%2Fdebug.t;h=ccf7feb4e8774fd41f5f43f4a67f144ee3fa70b3;hb=1e1cc55ea27a0f41b4f300b41de94e4d2f45d12d;hp=f28d4b5f7a8d50e1818b3dacf264decd5efa370d;hpb=68b8ba54e535ba5e68e044b3bedec73b20500b72;p=dbsrgits%2FDBIx-Class.git diff --git a/t/storage/debug.t b/t/storage/debug.t index f28d4b5..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; @@ -24,6 +26,7 @@ $schema->storage->debugobj(DBIx::Class::Storage::Statistics->new); ok ( $schema->storage->debug(1), 'debug' ); $schema->storage->debugfh($lfn->openw); +$schema->storage->debugfh->autoflush(1); $schema->resultset('CD')->count; my @loglines = $lfn->slurp; @@ -94,7 +97,6 @@ die "How did that fail... $exception" is_deeply(\@warnings, [], 'No warnings with unicode on STDERR'); - # test debugcb and debugobj protocol { my $rs = $schema->resultset('CD')->search( { @@ -136,4 +138,40 @@ is_deeply(\@warnings, [], 'No warnings with unicode on STDERR'); is_deeply ( $do->{_traced_bind}, \@bind_trace ); } +# recreate test as seen in DBIx::Class::QueryLog +# the rationale is that if someone uses a non-IO::Handle object +# on CPAN, many are *bound* to use one on darkpan. Thus this +# test to ensure there is no future silent breakage +{ + my $output = ""; + + { + package DBICTest::_Printable; + + sub print { + my ($self, @args) = @_; + $output .= join('', @args); + } + } + + $schema->storage->debugobj(undef); + $schema->storage->debug(1); + $schema->storage->debugfh( bless {}, "DBICTest::_Printable" ); + $schema->storage->txn_do( sub { $schema->resultset('Artist')->count } ); + + like ( + $output, + qr/ + \A + ^ \QBEGIN WORK\E \s*? + ^ \QSELECT COUNT( * ) FROM artist me:\E \s*? + ^ \QCOMMIT\E \s*? + \z + /xm + ); + + $schema->storage->debug(0); + $schema->storage->debugfh(undef); +} + done_testing;