view release on metacpan or  search on metacpan

t/040-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/041-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 } } };