#!/usr/bin/perl

use strict;
use warnings;

use Test::More 'no_plan';
use DBI;

my @connect_parameters
    = ( 'DBI:Pg:dbname=template1', 'user', 'pass',
        { ShowErrorStatement => 1,
          AutoCommit => 1,
          RaiseError => 1,
          PrintError => 0, } );

# An earlier version leaked socket connections
# and would eventually fail (or cause "Too many
# open files" errors elsewhere).  I loop a while
# here to detect that bug.
foreach my $iteration ( 1 .. 2_000 ) {

    warn "iteration $iteration\n";

    my $dbh = DBI->connect( @connect_parameters );
    isa_ok( $dbh, 'DBI::db' );

    my $one;
    ($one) = $dbh->selectrow_array( 'SELECT 1' );
    is( $one, 1, 'can select 1' );

    # this is fetched later
    my $sth = $dbh->prepare( 'SELECT 1' );
    $sth->execute;

    ok( ! $dbh->{InactiveDestroy},
        'dbh InactiveDestroy is off before fork' );

    my $pid = fork();
    if ( ! defined $pid ) {
        die "Can't fork: $!\n";
    }

    if ( $pid ) {
        # parent

        isa_ok( $dbh, 'DBI::db' );
    
        ($one) = $dbh->selectrow_array( 'SELECT 1' );
        is( $one, 1, 'parent can select 1 before child exits' );

        is( wait(), $pid, 'waited for child' );

        ($one) = $dbh->selectrow_array( 'SELECT 1' );
        is( $one, 1, 'parent can select 1 after child exits' );
    }
    else {
        # child

        my $child_dbh = $dbh->clone();
        isa_ok( $dbh, 'DBI::db' );
        isa_ok( $child_dbh, 'DBI::db' );

        ok( ! $dbh->{InactiveDestroy},
            'dbh InactiveDestroy is off in child after fork' );
        ok( ! $child_dbh->{InactiveDestroy},
            'child_dbh InactiveDestroy is off in child after fork' );

        $dbh->{InactiveDestroy} = 1;

        ok( $dbh->{InactiveDestroy},
            'dbh InactiveDestroy is on in child after fork' );
        ok( ! $child_dbh->{InactiveDestroy},
            'child_dbh InactiveDestroy is off in child after fork' );

        undef $dbh;
        ok( ! $dbh, 'death to dbh in child' );

        ($one) = $child_dbh->selectrow_array( 'SELECT 1' );
        is( $one, 1, 'child can select 1' );

        exit;
    }

    ($one) = $sth->fetchrow_array;
    is( $one, 1, 'select running before fork still works' );
}