Ancient

 view release on metacpan or  search on metacpan

t/2022-doubly-memory-leaks.t  view on Meta::CPAN

    plan tests => 1;
    no_leaks_ok(sub {
        for (1..100) {
            my $list = doubly->new();
            $list->bulk_add(1, 2, 3, 4, 5);
            $list->destroy();
        }
    }, 'bulk_add does not leak');
};

# Test 16: Verify no accumulating leaks over many iterations
subtest 'no accumulating leaks' => sub {
    plan tests => 1;
    my $baseline = leaked_count(sub {
        for (1..10) {
            my $list = doubly->new($_);
            $list->add($_*2) for 1..5;
            $list->destroy();
        }
    });

    my $larger = leaked_count(sub {
        for (1..100) {
            my $list = doubly->new($_);
            $list->add($_*2) for 1..5;
            $list->destroy();
        }
    });

    my $ratio = $larger / ($baseline || 1);
    ok($ratio < 2, "leak count does not scale with iterations (ratio: $ratio)")
        or diag("baseline=$baseline, larger=$larger - indicates per-iteration leak");
};

done_testing();

t/7009-vec-benchmark.t  view on Meta::CPAN

use Time::HiRes qw(time);
use lib 'blib/lib', 'blib/arch';

BEGIN { use_ok('nvec') }

# Create a decent-sized vector for benchmarking
my @data = map { rand() } 1..10000;
my $v = nvec::new(\@data);

# Benchmark sum operation (custom op should be fast)
my $iterations = 10000;
my $start = time();
my $result;
for (1..$iterations) {
    $result = $v->sum();
}
my $elapsed = time() - $start;
my $ops_per_sec = int($iterations / $elapsed);

# Use TODO for performance tests - they vary by platform
# Skip hard failures, just report the performance
TODO: {
    local $TODO = "Performance varies by platform" if $ops_per_sec < 50000;
    ok($ops_per_sec > 50000, "sum() fast: $ops_per_sec ops/sec (should be >50k with custom ops)");
}

# Benchmark chained operations
$start = time();
for (1..$iterations) {
    my $x = $v->add($v)->scale(2.0)->sum();
}
$elapsed = time() - $start;
$ops_per_sec = int($iterations / $elapsed);

TODO: {
    local $TODO = "Performance varies by platform" if $ops_per_sec < 5000;
    ok($ops_per_sec > 5000, "chained ops: $ops_per_sec ops/sec");
}

diag "Benchmark complete - custom ops working efficiently";

done_testing;

t/8001-file-callbacks.t  view on Meta::CPAN

    file::each_line($test_file, sub { });
    is($_, "original", '$_ restored after each_line');
};

subtest 'each_line empty file' => sub {
    my $empty = "$tmpdir/empty.txt";
    file::spew($empty, "");

    my $count = 0;
    file::each_line($empty, sub { $count++ });
    is($count, 0, 'no iterations for empty file');
};

subtest 'each_line nonexistent file' => sub {
    my @collected;
    file::each_line("$tmpdir/nonexistent.txt", sub {
        push @collected, shift;
    });
    is(scalar(@collected), 0, 'no lines from nonexistent file');
};

t/9001-leak-const-leak.t  view on Meta::CPAN

# Helper to get current RSS in KB
sub get_rss {
    my $pid = $$;
    my $rss = `ps -o rss= -p $pid`;
    chomp $rss;
    return $rss + 0;
}

# Helper to test for memory leak
# Runs $code $iterations times, checks memory doesn't grow more than $threshold KB
sub test_no_leak {
    my ($name, $code, $iterations, $threshold) = @_;
    $iterations //= 100_000;
    $threshold //= 10_000;  # 10MB threshold
    
    # Warmup
    $code->() for 1..1000;
    
    my $before = get_rss();
    $code->() for 1..$iterations;
    my $after = get_rss();
    
    my $growth = $after - $before;
    ok($growth < $threshold, "$name: memory growth ${growth}KB < ${threshold}KB threshold");
    
    if ($growth >= $threshold) {
        diag("LEAK DETECTED: $name grew by ${growth}KB after $iterations iterations");
    }
}

# Test c() with scalars
test_no_leak("c(scalar)", sub {
    my $x = const::c(42);
});

# Test c() with strings
test_no_leak("c(string)", sub {

t/9002-leak-slot-leak.t  view on Meta::CPAN

# Helper to get current RSS in KB
sub get_rss {
    my $pid = $$;
    my $rss = `ps -o rss= -p $pid`;
    chomp $rss;
    return $rss + 0;
}

# Helper to test for memory leak
sub test_no_leak {
    my ($name, $code, $iterations, $threshold) = @_;
    $iterations //= 100_000;
    $threshold //= 10_000;  # 10MB threshold
    
    # Warmup
    $code->() for 1..1000;
    
    my $before = get_rss();
    $code->() for 1..$iterations;
    my $after = get_rss();
    
    my $growth = $after - $before;
    ok($growth < $threshold, "$name: memory growth ${growth}KB < ${threshold}KB threshold");
    
    if ($growth >= $threshold) {
        diag("LEAK DETECTED: $name grew by ${growth}KB after $iterations iterations");
    }
}

# Test slot accessor get
test_slot(42);
test_no_leak("slot accessor get", sub {
    my $x = test_slot();
});

# Test slot accessor set

t/9002-leak-slot-leak.t  view on Meta::CPAN

test_no_leak("slot with arrayref", sub {
    test_slot3([1, 2, 3]);
    my $x = test_slot3();
});

# Test watchers (add and trigger)
my $counter = 0;
slot::watch('test_slot', sub { $counter++ });
test_no_leak("slot with watcher", sub {
    test_slot(42);
}, 10_000);  # Fewer iterations since watchers are slower
slot::unwatch('test_slot');

# Test slot::index (constant lookup)
test_no_leak("slot::index", sub {
    my $i = slot::index('test_slot');
});

# Test slot::clear
test_no_leak("slot::clear", sub {
    slot::clear('test_slot');

t/9003-leak-util-leak.t  view on Meta::CPAN

# Helper to get current RSS memory in KB
sub get_rss {
    my $rss = `ps -o rss= -p $$`;
    chomp $rss;
    return $rss + 0;
}

# Test for memory leaks
# Run code many times and check memory doesn't grow significantly
sub test_no_leak {
    my ($name, $code, $iterations, $threshold_kb) = @_;
    $iterations //= 10_000;  # Reduced from 100k to avoid SEGV in util
    $threshold_kb //= 5_000;  # 5MB threshold
    
    # Warmup
    $code->() for 1..100;
    
    my $before = get_rss();
    
    $code->() for 1..$iterations;
    
    my $after = get_rss();
    my $diff = $after - $before;
    
    my $passed = $diff < $threshold_kb;
    ok($passed, "$name - memory growth: ${diff}KB (threshold: ${threshold_kb}KB)");
    
    if (!$passed) {
        diag("Memory before: ${before}KB");
        diag("Memory after: ${after}KB");

t/9004-leak-noop-leak.t  view on Meta::CPAN

# Helper to get current RSS in KB
sub get_rss {
    my $pid = $$;
    my $rss = `ps -o rss= -p $pid`;
    chomp $rss;
    return $rss + 0;
}

# Helper to test for memory leak
sub test_no_leak {
    my ($name, $code, $iterations, $threshold) = @_;
    $iterations //= 100_000;
    $threshold //= 10_000;  # 10MB threshold
    
    # Warmup
    $code->() for 1..1000;
    
    my $before = get_rss();
    $code->() for 1..$iterations;
    my $after = get_rss();
    
    my $growth = $after - $before;
    ok($growth < $threshold, "$name: memory growth ${growth}KB < ${threshold}KB threshold");
    
    if ($growth >= $threshold) {
        diag("LEAK DETECTED: $name grew by ${growth}KB after $iterations iterations");
    }
}

# Test noop - should be extremely fast and have zero allocations
test_no_leak("noop()", sub {
    noop();
}, 1_000_000);

# Test noop via full name
test_no_leak("noop::noop()", sub {

t/9005-leak-doubly-leak.t  view on Meta::CPAN

# Helper to get current RSS memory in KB
sub get_rss {
    my $rss = `ps -o rss= -p $$`;
    chomp $rss;
    return $rss + 0;
}

# Test for memory leaks
# Run code many times and check memory doesn't grow significantly
sub test_no_leak {
    my ($name, $code, $iterations, $threshold_kb) = @_;
    $iterations //= 100_000;
    $threshold_kb //= 10_000;  # 10MB default threshold
    
    # Warmup
    $code->() for 1..1000;
    
    my $before = get_rss();
    
    $code->() for 1..$iterations;
    
    my $after = get_rss();
    my $diff = $after - $before;
    
    my $passed = $diff < $threshold_kb;
    ok($passed, "$name - memory growth: ${diff}KB (threshold: ${threshold_kb}KB)");
    
    if (!$passed) {
        diag("Memory before: ${before}KB");
        diag("Memory after: ${after}KB");

t/9006-leak-util-hof-leak.t  view on Meta::CPAN

# Helper to get current RSS in KB
sub get_rss {
    my $rss = `ps -o rss= -p $$`;
    chomp $rss;
    return $rss + 0;
}

# Test for memory leaks
sub test_no_leak {
    my ($name, $code, $iterations, $threshold_kb) = @_;
    $iterations //= 10_000;
    $threshold_kb //= 5_000;
    
    $code->() for 1..100;  # Warmup
    
    my $before = get_rss();
    $code->() for 1..$iterations;
    my $after = get_rss();
    
    my $diff = $after - $before;
    my $passed = $diff < $threshold_kb;
    ok($passed, "$name - memory growth: ${diff}KB");
    diag("LEAK: before=${before}KB after=${after}KB") unless $passed;
}

# Test dig
my $nested = { a => { b => { c => 42 } } };

t/9007-leak-const-extended-leak.t  view on Meta::CPAN

plan tests => 12;

# Helper to get current RSS in KB
sub get_rss {
    my $rss = `ps -o rss= -p $$`;
    chomp $rss;
    return $rss + 0;
}

sub test_no_leak {
    my ($name, $code, $iterations, $threshold_kb) = @_;
    $iterations //= 50_000;
    $threshold_kb //= 10_000;
    
    $code->() for 1..500;  # Warmup
    
    my $before = get_rss();
    $code->() for 1..$iterations;
    my $after = get_rss();
    
    my $diff = $after - $before;
    my $passed = $diff < $threshold_kb;
    ok($passed, "$name - memory growth: ${diff}KB");
    diag("LEAK: before=${before}KB after=${after}KB") unless $passed;
}

# Test c() with undef
test_no_leak("c(undef)", sub {