view release on metacpan or  search on metacpan

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

#!/usr/local/bin/perl
#
#
#   This is a memory leak test.
#

use strict;
use warnings;
use utf8;
BEGIN {
    binmode(STDERR, ':utf8');
    binmode(STDOUT, ':utf8');
};

my $COUNT_CONNECT = 500;    # Number of connect/disconnect iterations
my $COUNT_PREPARE = 10000;  # Number of prepare/execute/finish iterations
my $COUNT_EVENTS = 10000;
my $TOTALMEM      = 0;

use Test::More;
use DBI;

plan skip_all => "Long fragile memory leak test (try with MEMORY_TEST on linux)\n"
  unless ( $^O eq 'linux' && $ENV{MEMORY_TEST} );


use lib 't','.';

use TestFirebird;
my $T = TestFirebird->new;

my ($dbh, $error_str) = $T->connect_to_database();

if ($error_str) {
    BAIL_OUT("Unknown: $error_str!");
}

unless ( $dbh->isa('DBI::db') ) {
    plan skip_all => 'Connection to database failed, cannot continue testing';
}
else {
    plan tests => 314 + ($COUNT_EVENTS / 1000 + 1);
}

ok($dbh, 'Connected to the database');

#DBI->trace(2, "trace.txt");

#
#   Find a possible new table name
#
my $table = find_new_table($dbh);
ok($table, qq{Table is '$table'});

#
#   Create a new table
#
my $def =<<"DEF";
CREATE TABLE $table (
    id     INTEGER NOT NULL PRIMARY KEY,
    name CHAR(64) CHARACTER SET ISO8859_1
)
DEF
ok( $dbh->do($def), qq{CREATE TABLE '$table'} );

my $ok;

#- Testing memory leaks in connect / disconnect

$ok = 0;
my $nok = 0;
for (my $i = 0;  $i < $COUNT_CONNECT;  $i++) {
    my ($dbh2, $error_str2) = $T->connect_to_database();
    if ($error_str2) {
        print "Cannot connect: $error_str2";
        $ok = 0;