1 files changed, 147 insertions, 0 deletions
diff --git a/t/16destroy.t b/t/16destroy.t
new file mode 100644
index 0000000..a2945c4
--- /dev/null
+++ b/t/16destroy.t
@@ -0,0 +1,147 @@
+#!perl -w
+
+use strict;
+
+use Test::More tests => 20;
+
+BEGIN{ use_ok( 'DBI' ) }
+
+my $expect_active;
+
+## main Test Driver Package
+{
+    package DBD::Test;
+
+    use strict;
+    use warnings;
+
+    my $drh = undef;
+
+    sub driver {
+        return $drh if $drh;
+        my ($class, $attr) = @_;
+        $class = "${class}::dr";
+        ($drh) = DBI::_new_drh($class, {
+            Name    => 'Test',
+            Version => '1.0',
+        }, 77 );
+        return $drh;
+    }
+
+    sub CLONE { undef $drh }
+}
+
+## Test Driver
+{
+    package DBD::Test::dr;
+
+    use warnings;
+    use Test::More;
+
+    sub connect { # normally overridden, but a handy default
+        my($drh, $dbname, $user, $auth, $attrs)= @_;
+        my ($outer, $dbh) = DBI::_new_dbh($drh);
+        $dbh->STORE(Active => 1);
+        $dbh->STORE(AutoCommit => 1);
+        $dbh->STORE( $_ => $attrs->{$_}) for keys %$attrs;
+        return $outer;
+    }
+
+    $DBD::Test::dr::imp_data_size = 0;
+    cmp_ok($DBD::Test::dr::imp_data_size, '==', 0, '... check DBD::Test::dr::imp_data_size to avoid typo');
+}
+
+## Test db package
+{
+    package DBD::Test::db;
+
+    use strict;
+    use warnings;
+    use Test::More;
+
+    $DBD::Test::db::imp_data_size = 0;
+    cmp_ok($DBD::Test::db::imp_data_size, '==', 0, '... check DBD::Test::db::imp_data_size to avoid typo');
+
+    sub STORE {
+        my ($dbh, $attrib, $value) = @_;
+        # would normally validate and only store known attributes
+        # else pass up to DBI to handle
+        if ($attrib eq 'AutoCommit') {
+            # convert AutoCommit values to magic ones to let DBI
+            # know that the driver has 'handled' the AutoCommit attribute
+            $value = ($value) ? -901 : -900;
+        }
+        return $dbh->{$attrib} = $value if $attrib =~ /^examplep_/;
+        return $dbh->SUPER::STORE($attrib, $value);
+    }
+
+    sub DESTROY {
+        if ($expect_active < 0) { # inside child
+            my $self = shift;
+            exit $self->FETCH('Active') || 0 unless $^O eq 'MSWin32';
+
+            # On Win32, the forked child is actually a thread. So don't exit,
+            # and report failure directly.
+            fail 'Child should be inactive on DESTROY' if $self->FETCH('Active');
+        } else {
+            return $expect_active
+                ? ok( shift->FETCH('Active'), 'Should be active in DESTROY')
+                : ok( !shift->FETCH('Active'), 'Should not be active in DESTROY');
+        }
+    }
+}
+
+my $dsn = 'dbi:ExampleP:dummy';
+
+$INC{'DBD/Test.pm'} = 'dummy';  # required to fool DBI->install_driver()
+ok my $drh = DBI->install_driver('Test'), 'Install test driver';
+
+NOSETTING: {
+    # Try defaults.
+    ok my $dbh = $drh->connect, 'Connect to test driver';
+    ok $dbh->{Active}, 'Should start active';
+    $expect_active = 1;
+}
+
+IAD: {
+    # Try InactiveDestroy.
+    ok my $dbh = $drh->connect($dsn, '', '', { InactiveDestroy => 1 }),
+        'Create with ActiveDestroy';
+    ok $dbh->{InactiveDestroy}, 'InactiveDestroy should be set';
+    ok $dbh->{Active}, 'Should start active';
+    $expect_active = 0;
+}
+
+AIAD: {
+    # Try AutoInactiveDestroy.
+    ok my $dbh = $drh->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
+        'Create with AutoInactiveDestroy';
+    ok $dbh->{AutoInactiveDestroy}, 'InactiveDestroy should be set';
+    ok $dbh->{Active}, 'Should start active';
+    $expect_active = 1;
+}
+
+FORK: {
+    # Try AutoInactiveDestroy and fork.
+    ok my $dbh = $drh->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
+        'Create with AutoInactiveDestroy again';
+    ok $dbh->{AutoInactiveDestroy}, 'InactiveDestroy should be set';
+    ok $dbh->{Active}, 'Should start active';
+
+    my $pid = eval { fork() };
+    if (not defined $pid) {
+        chomp $@;
+        my $msg = "AutoInactiveDestroy destroy test skipped";
+        diag "$msg because $@\n";
+        pass $msg; # in lieu of the child status test
+    }
+    elsif ($pid) {
+        # parent.
+        $expect_active = 1;
+        wait;
+        ok $? == 0, 'Child should be inactive on DESTROY';
+    } else {
+        # child.
+        $expect_active = -1;
+    }
+}