Test that ::parent keeps the dbh alive for the child.

lib/Cxn.pm

@@ -135,9 +135,10 @@ sub connect {
          },
       );
    }
-   PTDEBUG && _d($dbh, 'Connected dbh to', $self->{name});
 
-   return $self->set_dbh($dbh);
+   $dbh = $self->set_dbh($dbh);
+   PTDEBUG && _d($dbh, 'Connected dbh to', $self->{hostname},$self->{dsn_name});
+   return $dbh;
 }
 
 sub set_dbh {
@@ -219,14 +220,17 @@ sub name {
 sub DESTROY {
    my ($self) = @_;
 
+   PTDEBUG && _d('Destroying cxn');
+
    if ( $self->{parent} ) {
-      PTDEBUG && _d('Not disconnecting dbh in parent');
+      PTDEBUG && _d($self->{dbh}, 'Not disconnecting dbh in parent');
    }
    elsif ( $self->{dbh}
            && blessed($self->{dbh})
            && $self->{dbh}->can("disconnect") )
    {
-      PTDEBUG && _d('Disconnecting dbh', $self->{dbh}, $self->{name});
+      PTDEBUG && _d($self->{dbh}, 'Disconnecting dbh on', $self->{hostname},
+         $self->{dsn_name});
       $self->{dbh}->disconnect();
    }
 

t/lib/Cxn.t

@@ -9,7 +9,7 @@ BEGIN {
 use strict;
 use warnings FATAL => 'all';
 use English qw(-no_match_vars);
-use Test::More tests => 19;
+use Test::More;
 
 use Sandbox;
 use OptionParser;
@@ -251,9 +251,65 @@ is_deeply(
 @ARGV = ();
 $o->get_opts();
 
+# #############################################################################
+# The parent of a forked Cxn should not disconnect the dbh in DESTORY
+# because the child still has access to it.
+# #############################################################################
+
+my $sync_file = "/tmp/pt-cxn-sync.$PID";
+my $outfile   = "/tmp/pt-cxn-outfile.$PID";
+
+my $pid;
+{
+   my $parent_cxn = make_cxn(
+      dsn_string => 'h=127.1,P=12345,u=msandbox,p=msandbox',
+      parent     => 1,
+   );
+   $parent_cxn->connect();
+
+   $pid = fork();
+   if ( defined($pid) && $pid == 0 ) {
+      # I am the child.
+      # Wait for the parent to leave this code block which will cause
+      # the $parent_cxn to be destroyed.
+      PerconaTest::wait_for_files($sync_file);
+      $parent_cxn->{parent} = 0;
+      eval {
+         $parent_cxn->dbh->do("SELECT 123 INTO OUTFILE '$outfile'");
+         $parent_cxn->dbh->disconnect();
+      };
+      warn $EVAL_ERROR if $EVAL_ERROR;
+      exit;
+   }
+}
+
+# Let the child know that we (the parent) have left that ^ code block,
+# so our copy of $parent_cxn has been destroyed, but hopefully the child's
+# copy is still alive, i.e. has an active/not-disconnected dbh.
+diag(`touch $sync_file`);
+
+# Wait for the child.
+waitpid($pid, 0);
+
+ok(
+   -f $outfile,
+   "Child created outfile"
+);
+
+my $output = `cat $outfile 2>/dev/null`;
+
+is(
+   $output,
+   "123\n",
+   "Child executed query"
+);
+
+unlink $sync_file if -f $sync_file;
+unlink $outfile if -f $outfile;
+
 # #############################################################################
 # Done.
 # #############################################################################
 $master_dbh->disconnect() if $master_dbh;
 ok($sb->ok(), "Sandbox servers") or BAIL_OUT(__FILE__ . " broke the sandbox");
-exit;
+done_testing;