#!/usr/local/bin/perl
#
#   $Id: 60leaks.t,v 1.1.1.1 1999/07/13 08:14:45 joe Exp $
#
#   This is a skeleton test. For writing new tests, take this file
#   and modify/extend it.
#
my $COUNT_CONNECT = 4000;   # Number of connect/disconnect iterations
my $COUNT_PREPARE = 10000;  # Number of prepare/execute/finish iterations
my $haveStorable;
eval { require Proc::ProcessTable; };
if ($@  ||  !$ENV{SLOW_TESTS}) {
    print "1..0\n";
    exit 0;
}
eval { require Storable };
$haveStorable = $@ ? 0 : 1;
sub size {
    my($p, $pt);
    $pt = Proc::ProcessTable->new('cache_ttys' => $haveStorable);
    foreach $p (@{$pt->table()}) {
        if ($p->pid() == $$) {
            return $p->size();
        }
    }
    die "Cannot find my own process?!?\n";
    exit 0;
}
#
#   Make -w happy
#
$test_dsn = $test_user = $test_password = '';
#
#   Include lib.pl
#
require DBI;
$mdriver = "";
foreach $file ("lib.pl", "t/lib.pl") {
    do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
                           exit 10;
                      }
    if ($mdriver ne '') {
        last;
    }
}
if ($mdriver eq 'whatever') {
    print "1..0\n";
    exit 0;
}
#
#   Main loop; leave this untouched, put tests after creating
#   the new table.
#
while (Testing()) {
    #
    #   Connect to the database
    Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
                                        $test_password)),
         undef,
         "Attempting to connect.\n")
           or ErrMsgF("Cannot connect: Error %s.\n\n"
                      . "Make sure, your database server is up and running.\n"
                      . "Check that '$test_dsn' references a valid database"
                      . " name.\nDBI error message: $DBI::errstr");
    #
    #   Find a possible new table name
    #
    Test($state or $table = FindNewTable($dbh))
           or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
                      $dbh->errstr);
    #
    #   Create a new table; EDIT THIS!
    #
    Test($state or ($def = TableDefinition($table,
                                           ["id",   "INTEGER",  4, 0],
                                           ["name", "CHAR",    64, 0]),
                    $dbh->do($def)))
           or ErrMsgF("Cannot create table: Error %s.\n",
                      $dbh->errstr);
    my($size, $prevSize, $ok, $notOk, $dbh2, $msg);
    if (!$state) {
        print "Testing memory leaks in connect/disconnect\n";
        $msg = "Possible memory leak in connect/disconnect detected";
        $ok = 0;
        $notOk = 0;
        for (my $i = 0;  $i < $COUNT_CONNECT;  $i++) {
            if (!($dbh2 = DBI->connect($test_dsn, $test_user,
                                       $test_password))) {
                $ok = 0;
                $msg = "Cannot connect: $DBI::errstr\n";
                last;
            }
            $dbh2->disconnect();
            undef $dbh2;
            if ($i % 100  ==  99) {
                $size = size();
                if (defined($prevSize)  &&  $size == $prevSize) {
                    ++$ok;
                } else {
                    ++$notOk;
                }
                $prevSize = $size;
            }
        }
    }
    Test($state or ($ok > $notOk))
        or print "$msg\n";
    if (!$state) {
        print "Testing memory leaks in prepare/execute/finish\n";
        $msg = "Possible memory leak in prepare/execute/finish detected";
        $ok = 0;
        $notOk = 0;
        undef $prevSize;
        for (my $i = 0;  $i < $COUNT_PREPARE;  $i++) {
            my $sth = $dbh->prepare("SELECT * FROM $table");
            $sth->execute();
            $sth->finish();
            undef $sth;
            if ($i % 100  ==  99) {
                $size = size();
                if (defined($prevSize)  &&  $size == $prevSize) {
                    ++$ok;
                } else {
                    ++$notOk;
                }
                $prevSize = $size;
            }
        }
    }
    Test($state or ($ok > $notOk))
        or print "$msg\n";
    if (!$state) {
        print "Testing memory leaks in fetchrow_arrayref\n";
        $msg = "Possible memory leak in fetchrow_arrayref detected";
        # Insert some records into the test table
        my $row;
        foreach $row ([1, 'Jochen Wiedmann'],
                      [2, 'Andreas König'],
                      [3, 'Tim Bunce'],
                      [4, 'Alligator Descartes'],
                      [5, 'Jonathan Leffler']) {
            $dbh->do(sprintf("INSERT INTO $table VALUES (%d, %s)",
                             $row->[0], $dbh->quote($row->[1])));
        }
        $ok = 0;
        $notOk = 0;
        undef $prevSize;
        for (my $i = 0;  $i < $COUNT_PREPARE;  $i++) {
            {
                my $sth = $dbh->prepare("SELECT * FROM $table");
                $sth->execute();
                my $row;
                while ($row = $sth->fetchrow_arrayref()) {
                }
                $sth->finish();
            }
            if ($i % 100  ==  99) {
                $size = size();
                if (defined($prevSize)  &&  $size == $prevSize) {
                    ++$ok;
                } else {
                    ++$notOk;
                }
                $prevSize = $size;
            }
        }
    }
    Test($state or ($ok > $notOk))
        or print "$msg\n";
    if (!$state) {
        print "Testing memory leaks in fetchrow_hashref\n";
        $msg = "Possible memory leak in fetchrow_hashref detected";
        $ok = 0;
        $notOk = 0;
        undef $prevSize;
        for (my $i = 0;  $i < $COUNT_PREPARE;  $i++) {
            {
                my $sth = $dbh->prepare("SELECT * FROM $table");
                $sth->execute();
                my $row;
                while ($row = $sth->fetchrow_hashref()) {
                }
                $sth->finish();
            }
            if ($i % 100  ==  99) {
                $size = size();
                if (defined($prevSize)  &&  $size == $prevSize) {
                    ++$ok;
                } else {
                    ++$notOk;
                }
                $prevSize = $size;
            }
        }
    }
    Test($state or ($ok > $notOk))
        or print "$msg\n";
    #
    #   Finally drop the test table.
    #
    Test($state or $dbh->do("DROP TABLE $table"))
           or ErrMsgF("Cannot DROP test table $table: %s.\n",
                      $dbh->errstr);
    Test($state or $dbh->disconnect);
}