view release on metacpan or  search on metacpan

t/9030-leak-object.t  view on Meta::CPAN

subtest 'readonly access no leak' => sub {
    my $obj = new LeakReadonly fixed => 'immutable';
    no_leaks_ok {
        for (1..1000) {
            my $v = $obj->fixed;
        }
    } 'readonly access no leak';
};

subtest 'typed properties no leak' => sub {
    my $obj = new LeakTyped num => 3.14, arr => [1, 2, 3], hash => { a => 1 };
    no_leaks_ok {
        for (1..1000) {
            my $n = $obj->num;
            my $a = $obj->arr;
            my $h = $obj->hash;
        }
    } 'typed get no leak';
};

subtest 'typed setter no leak' => sub {
    my $obj = new LeakTyped num => 0, arr => [], hash => {};
    my $arr = [1, 2, 3];
    my $hash = { x => 1 };
    no_leaks_ok {
        for (1..1000) {
            $obj->num(3.14);
            $obj->arr($arr);
            $obj->hash($hash);
        }
    } 'typed set no leak';
};

subtest 'prototype operations no leak' => sub {
    my $parent = new LeakPerson name => 'Parent', age => 50;
    my $child = new LeakPerson name => 'Child', age => 20;
    object::set_prototype($child, $parent);

    no_leaks_ok {
        for (1..1000) {
            my $proto = object::prototype($child);
        }
    } 'prototype get no leak';
};

subtest 'freeze check no leak' => sub {
    my $obj = new LeakPerson name => 'Freeze', age => 30;
    object::freeze($obj);
    no_leaks_ok {
        for (1..1000) {
            my $f = object::is_frozen($obj);
        }
    } 'is_frozen no leak';
};

subtest 'lock check no leak' => sub {
    my $obj = new LeakPerson name => 'Lock', age => 30;
    object::lock($obj);
    no_leaks_ok {
        for (1..1000) {
            my $l = object::is_locked($obj);
        }
    } 'is_locked no leak';
};

subtest 'type introspection no leak' => sub {
    no_leaks_ok {
        for (1..1000) {
            my $has = object::has_type('Str');
            my @types = object::list_types();
        }
    } 'type introspection no leak';
};

done_testing;