view release on metacpan or  search on metacpan

t/00_weakmaps.t  view on Meta::CPAN

    is($ret, 200, 'delete returned the correct value');

    cmp_deeply([map refaddr($_), keys %$map], bag(map refaddr($_), @input_keys[0, 2]), 'correct 2 keys remain');
    is(keys(%$map), 2, 'map has 2 keys');
    is(keys(%$keys), 2, 'map has 2 keys');
    is(keys(%$values), 2, 'map has 2 keys');

    check_under_weakness($keys);
};

subtest 'exists' => sub {
    plan tests => 9;

    my ($map, $keys, $values) = create_map;

    my @input_keys = map { [$_ * 10] } (1 .. 100);
    @$map{@input_keys} = (201 .. 300);

    is(keys(%$map), 100, '%$map has 100 key/value pairs');

    ok(exists $map->{$input_keys[50]}, '50th input still exists');
    check_under_weakness($keys);
    is(keys(%$map), 100, '%map still has all 100 key/value pairs');

    my $foreign_object = [50];
    ok(! exists $map->{$foreign_object}, 'new foreign object does not exist');
    check_under_weakness($keys);
    is(keys(%$map), 100, '%map still has all of its 100 key/value pairs');
};

subtest 'scalar' => sub {
    plan tests => 3;

    my ($map, $keys, $values) = create_map;

    my @input_keys = map { [$_ * 10] } (1 .. 100);
    @$map{@input_keys} = (201 .. 300);


    my $scalar_values = scalar(%$values);
    is(scalar(%$map), $scalar_values, 'scalar(map) returns the same as an internal hashref of the same size');
};

subtest 'boolean' => sub {
    plan tests => 6;
    # TODO: skip, if perl is not recent enough (see perltie, and how it handles SCALAR when evaluating keys(%$map) in boolean context)

    my ($map, $keys, $values) = create_map;

    ok((keys %$map) ? 0 : 1, '(keys %$map) in boolean context == 0, when empty');
    ok((%$map) ? 0 : 1,      '(%$map) in boolean context == 0, when empty');

    my @input_keys = map { [$_ * 10] } (1 .. 10);
    @$map{@input_keys} = (201 .. 210);

    ok((keys %$map) ? 1 : 0, '(keys %$map) in boolean context == 1, when non-empty');
    ok((%$map) ? 1 : 0,      '(%$map) in boolean context == 1, when non-empty');
};

TODO: {
    local $TODO = "can't do it now, because the each function will automatically unweaken the keys for some reason";

    subtest 'attempt to do partial iteration with "each"' => sub {
        plan tests => 5;

        my ($map, $keys, $values) = create_map;

        {
            my @keys1 = ([ 10 ], [ 20 ], [ 30 ]);
            $map->{$_} = 100 foreach @keys1;
            is(keys(%$map), 3, 'map has 3 scoped lexical elements');
            note "calling the 'each' function twice";
            my @key_value_pairs = map { [each %$map] } (1 .. 2);
        }
        check_under_weakness($keys);
        is(keys(%$map), 0, 'map has 0 keys, it lost them when they went out of scope');
    };
}

subtest 'clear' => sub {
    plan tests => 4;

    my ($map, $keys, $values) = create_map;

    my @keys_values = map { [] } (1 .. 10);

    %$map = @keys_values[0 .. 9];
    is(keys %$keys, 5, 'there are 5 keys in the underlying hash');

    %$map = @keys_values[0 .. 5];
    is(keys %$keys, 3, 'there are 3 keys in the underlying hash');
};


sub check_under_weakness {
    my ($keys) = @_;

    my $total_count = keys %$keys;
    my $strong_count = 0;
    foreach my $key (values %$keys) {
        $strong_count++ unless isweak $key;
    }

    if ($strong_count == 0) {
        pass "all $total_count keys in underlying object are still weak refs";
    } else {
        fail "$strong_count keys (out of $total_count) in the underlying object have been unweakened";
    }
}