view release on metacpan or  search on metacpan

eg/keyword-vs-native.pl  view on Meta::CPAN

# === Missing-key safety: native autovivifies under deref-on-write ===
my $miss_native = exists $data->{users}[5] ? $data->{users}[5]{name} : undef;
my $miss_kw     = pathget $data, "/users/5/name";
defined $miss_native and die 'native test data wrong';
defined $miss_kw     and die 'kw test data wrong';
print "missing key: both undef, but pathget did NOT autovivify users[5]\n";
print "  users count after pathget: ", scalar(@{$data->{users}}), "\n";

# === Throughput ===
print "\nBenchmark (1M iterations each):\n";
cmpthese(-1, {
    'native deref'   => sub { my $v = $data->{users}[0]{addr}{city}; },
    'pathget const'  => sub { my $v = pathget $data, "/users/0/addr/city"; },
    'pathget dyn'    => sub { my $p = "/users/0/addr/city";
                              my $v = pathget $data, $p; },
});

print "\nMissing-key throughput:\n";
cmpthese(-1, {
    'native (exists chain)' => sub {

t/stress.t  view on Meta::CPAN

my $ITERATIONS = 1000;

subtest 'stress: repeated path_get' => sub {
    my $data = { a => { b => { c => { d => { e => 'deep' } } } } };

    no_leaks_ok {
        for (1..$ITERATIONS) {
            path_get($data, '/a/b/c/d/e');
        }
    } "path_get $ITERATIONS iterations";
};

subtest 'stress: repeated path_set overwrite' => sub {
    my $data = { key => 'initial' };

    no_leaks_ok {
        for my $i (1..$ITERATIONS) {
            path_set($data, '/key', "value$i");
        }
    } "path_set overwrite $ITERATIONS iterations";
};

subtest 'stress: create and destroy paths' => sub {
    no_leaks_ok {
        for (1..$ITERATIONS) {
            my $data = {};
            path_set($data, '/a/b/c/d/e', 'val');
            path_delete($data, '/a/b/c/d/e');
            path_delete($data, '/a/b/c/d');
            path_delete($data, '/a/b/c');
            path_delete($data, '/a/b');
            path_delete($data, '/a');
        }
    } "create/destroy $ITERATIONS iterations";
};

subtest 'stress: missing paths' => sub {
    my $data = { a => { b => 1 } };

    no_leaks_ok {
        for (1..$ITERATIONS) {
            path_get($data, '/a/b/c/d/e');
            path_get($data, '/x/y/z');
            path_exists($data, '/missing/path');
            path_delete($data, '/not/here');
        }
    } "missing paths $ITERATIONS iterations";
};

subtest 'stress: array operations' => sub {
    no_leaks_ok {
        for (1..$ITERATIONS) {
            my $data = { arr => [] };
            for my $i (0..9) {
                path_set($data, "/arr/$i", $i * 2);
            }
            for my $i (0..9) {
                path_get($data, "/arr/$i");
            }
        }
    } "array operations $ITERATIONS iterations";
};

subtest 'stress: patha_get' => sub {
    my $data = { a => { b => { c => { d => { e => 'deep' } } } } };
    my @path = qw(a b c d e);

    no_leaks_ok {
        for (1..$ITERATIONS) {
            patha_get($data, \@path);
        }
    } "patha_get $ITERATIONS iterations";
};

subtest 'stress: patha_set/delete cycle' => sub {
    my @path = qw(x y z);

    no_leaks_ok {
        for (1..$ITERATIONS) {
            my $data = {};
            patha_set($data, \@path, 'val');
            patha_delete($data, \@path);
        }
    } "patha_set/delete $ITERATIONS iterations";
};

subtest 'stress: mixed string and array API' => sub {
    no_leaks_ok {
        for (1..$ITERATIONS) {
            my $data = {};
            path_set($data, '/a/b/c', 1);
            patha_get($data, ['a', 'b', 'c']);
            patha_set($data, ['a', 'b', 'd'], 2);
            path_get($data, '/a/b/d');
            path_delete($data, '/a/b/c');
            patha_delete($data, ['a', 'b', 'd']);
        }
    } "mixed API $ITERATIONS iterations";
};

subtest 'stress: complex values' => sub {
    no_leaks_ok {
        for (1..$ITERATIONS) {
            my $data = {};
            my $complex = {
                arr => [1, 2, { nested => 'hash' }],
                deep => { a => { b => { c => 'd' } } },
            };
            path_set($data, '/item', $complex);
            path_get($data, '/item/arr/2/nested');
            path_get($data, '/item/deep/a/b/c');
        }
    } "complex values $ITERATIONS iterations";
};

subtest 'stress: error paths (eval)' => sub {
    no_leaks_ok {
        for (1..$ITERATIONS) {
            path_get({}, 'invalid');
            eval { path_set({}, '', 'x') };
            eval { path_delete({}, '') };
        }
    } "error paths $ITERATIONS iterations";
};

# Memory growth test (not using no_leaks_ok)
subtest 'memory stability check' => sub {
    plan skip_all => 'ps -o rss= not portable'
        unless $^O =~ /^(?:linux|darwin)$/;

    # Sanitizers (ASan/MSan) maintain shadow memory that grows independently
    # of allocations; a strict RSS budget produces false positives there.
    my $under_sanitizer = ($ENV{LD_PRELOAD} && $ENV{LD_PRELOAD} =~ /(?:asan|msan|tsan|ubsan)/i)

xt/threads.t  view on Meta::CPAN

            pathc_set($data, $cp_set, "alice-$tid-$i");
            my $v = pathc_get($data, $cp_get);
            return [$tid, $i, "got=$v"] if $v ne "alice-$tid-$i";
        }
        return [$tid, $ITERS, 'ok'];
    });
} 0 .. $N - 1;

for my $t (@threads) {
    my $r = $t->join;
    is($r->[2], 'ok', "thread $r->[0] completed $ITERS iterations");
}

done_testing;