view release on metacpan or  search on metacpan

t/04hv.t  view on Meta::CPAN

    defined &lock_keys or skip 'no restricted hashes', $skip;

    {
        BEGIN { $skip += 8 }

        my %hash = qw/a b c d/;
        lock_keys(%hash, qw/a c e/);
        my $hv   = clone \%hash;

        is  join(':', sort keys %$hv),
                                    'a:c',  'locked HV retains keys';
        ok  !exists( $hv->{e} ),            'exists still works';
        ok  eval { $hv->{e} = 1 },          'permitted key';
        ok  !eval { $hv->{f} = 1 },         'forbidden key';
        
        delete $hv->{a};
        ok  !exists( $hv->{a} ),            'delete still works';

        unlock_keys(%$hv);
        ok  eval { $hv->{f} = 1 },          'can be unlocked';
        ok  exists( $hv->{f} ),             '...and insert now works';
        ok  !eval { $hash{f} = 1 },         '...but parent is still locked';
    }

    {
        BEGIN { $skip += 5 }

        my %hash = qw/a b c d/;
        lock_keys(%hash);
        lock_value(%hash, 'a');
        my $hv   = clone \%hash;

        is  $hv->{a},       'b',            'locked value is retained';
        ok  !eval { $hv->{a} = 1 },         '...but cannot be changed';

        unlock_value(%$hv, 'a');
        ok  eval { $hv->{a} = 1 },          'can be unlocked';
        is  $hv->{a},       1,              '...and can now be changed';
        ok  !eval { $hash{a} = 1 },         '...but parent is still locked';
    }

    BEGIN { $tests += $skip }
}

BEGIN { plan tests => $tests }