view release on metacpan or  search on metacpan

t/60leaks.t  view on Meta::CPAN

use strict;
use warnings;

use DBI;
use Test::More;
use vars qw($test_dsn $test_user $test_password);
use lib 't', '.';
require 'lib.pl';

my $COUNT_CONNECT = 4000;     # Number of connect/disconnect iterations
my $COUNT_PREPARE = 30000;    # Number of prepare/execute/finish iterations
my $COUNT_BIND    = 10000;    # Number of bind_param iterations
my $have_storable;

if (!$ENV{EXTENDED_TESTING}) {
        plan skip_all => "Skip \$ENV{EXTENDED_TESTING} is not set\n";
}

eval { require Proc::ProcessTable; };
if ($@) {
        plan skip_all => "module Proc::ProcessTable not installed \n";
}

eval { require Storable };
$have_storable = $@ ? 0 : 1;

my $have_pt_size = grep { $_ eq 'size' } Proc::ProcessTable->new('cache_ttys' => $have_storable)->fields;

unless ($have_pt_size) {
        plan skip_all => "module Proc::ProcessTable does not support size attribute on current platform\n";
}

my ($dbh, $sth);
eval {$dbh= DBI->connect($test_dsn, $test_user, $test_password,
                                            { RaiseError => 1, PrintError => 1, AutoCommit => 0 });};
if ($@) {
        plan skip_all =>
                "no database connection";
}
$dbh->disconnect;
plan tests => 27 * 2;

sub size {
    my($p, $pt);
    $pt = Proc::ProcessTable->new('cache_ttys' => $have_storable);
    for $p (@{$pt->table()}) {
        if ($p->pid() == $$) {
            return $p->size();
        }
    }
    die "Cannot find my own process?!?\n";
    exit 0;
}

for my $mysql_server_prepare (0, 1) {

note "Testing memory leaks with mysql_server_prepare=$mysql_server_prepare\n";

$dbh= DBI->connect($test_dsn, $test_user, $test_password,
                   { RaiseError => 1, PrintError => 1, AutoCommit => 0, mysql_server_prepare => $mysql_server_prepare, mysql_server_prepare_disable_fallback => 1 });

ok $dbh->do("DROP TABLE IF EXISTS dbd_mysql_t60leaks");

my $create= <<EOT;
CREATE TABLE dbd_mysql_t60leaks (
    id INT(4) NOT NULL DEFAULT 0,
    name VARCHAR(64) NOT NULL DEFAULT ''
    )
EOT

ok $dbh->do($create);