Author: theory
Date: Wed Oct 28 11:01:51 2009
New Revision: 13445
Modified:
dbi/trunk/t/70callbacks.t
Log:
Added `ChildCallbacks` tests.
Modified: dbi/trunk/t/70callbacks.t
==============================================================================
--- dbi/trunk/t/70callbacks.t (original)
+++ dbi/trunk/t/70callbacks.t Wed Oct 28 11:01:51 2009
@@ -9,7 +9,7 @@
BEGIN {
plan skip_all => '$h->{Callbacks} attribute not supported for
DBI::PurePerl'
if $DBI::PurePerl && $DBI::PurePerl; # doubled to avoid typo
warning
- plan tests => 53;
+ plan tests => 61;
}
$| = 1;
@@ -165,6 +165,28 @@
is $called{cached}, 1, "connect_cached.reused called";
is $called{new}, 1, "connect_cached.new not called again";
+
+# --- test ChildCallbacks.
+%called = ();
+$args[-1] = {
+ Callbacks => {
+ ping => sub { $called{ping}++; return; },
+ ChildCallbacks => {
+ execute => sub { $called{execute}++; return; },
+ fetch => sub { $called{fetch}++; return; },
+ }
+ }
+};
+
+ok $dbh = DBI->connect(@args), "Create handle with ChildCallbacks";
+ok $dbh->ping, 'Ping';
+is $called{ping}, 1, 'Ping callback should have been called';
+ok my $sth = $dbh->prepare('SELECT name from t'), 'Prepare a statement handle
(child)';
+ok $sth->execute, 'Execute';
+is $called{execute}, 1, 'Execute callback should have been called';
+ok $sth->fetch, 'Fetch';
+is $called{execute}, 1, 'Fetch callback should have been called';
+
__END__
A generic 'transparent' callback looks like this:
