Tie-Subset

 view release on metacpan or  search on metacpan

lib/Tie/Subset/Hash.pm  view on Meta::CPAN

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
        my ($self) = @_;
        warnings::warnif("clearing of ".ref($self)." not (yet) supported, ignoring");
        return;
}
 
sub SCALAR {
        my ($self) = @_;
        # I'm not sure why the following counts as two statements in the coverage tool
        # uncoverable branch true
        # uncoverable statement count:2
        return scalar %{$self->{keys}} if $] lt '5.026';
        my %keys = map {$_=>1} grep {exists $self->{hash}{$_}} keys %{$self->{keys}};
        return scalar keys %keys;
}
 
sub UNTIE {
        my ($self) = @_;
        $self->{hash} = undef;
        $self->{keys} = undef;
        return;
}

lib/Tie/Subset/Hash/Masked.pm  view on Meta::CPAN

151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
        my ($self) = @_;
        warnings::warnif("clearing of ".ref($self)." not (yet) supported, ignoring");
        return;
}
 
sub SCALAR {
        my ($self) = @_;
        # I'm not sure why the following counts as two statements in the coverage tool
        # uncoverable branch true
        # uncoverable statement count:2
        return scalar %{$self->{hash}} if $] lt '5.026';
        my %keys = map {$_=>1} keys %{$self->{hash}};
        delete @keys{ keys %{$self->{mask}} };
        return scalar keys %keys;
}
 
sub UNTIE {
        my ($self) = @_;
        $self->{hash} = undef;
        $self->{mask} = undef;
        return;

t/10_hash.t  view on Meta::CPAN

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
ok !exists $subset{ghi};
 
# Iterating
# mostly tested above via the is_deeply checks
ok delete $hash{bbb}; # remove from underlying hash
is_deeply [sort keys %subset], [qw/ aaa ccc zzz /];
is_deeply [sort values %subset], [777,789,888];
 
# Scalar
SKIP: {
        skip "test fails on pre-5.8.9 Perls", 1 if $] lt '5.008009';
        # Since it's mostly here for code coverage, it's ok to skip it
        # scalar(%hash) really only gets useful on Perl 5.26+ anyway (returns the number of keys)
        if ( $] lt '5.026' )
                { is scalar(%subset), scalar( %{tied(%subset)->{keys}} ) }
        else
                { is scalar(%subset), 3 }
}
 
# delete-ing
{
        no warnings FATAL=>'all'; use warnings;  ## no critic (ProhibitNoWarnings)
        my @w = warns {
                ok !defined(delete $subset{jkl});

t/15_hash_masked.t  view on Meta::CPAN

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
ok !exists $masked{lll};
 
# Iterating
# mostly tested above via the is_deeply checks
ok delete $hash{jkl}; # remove from underlying hash
is_deeply [sort keys %masked], [qw/ def ghi xxx /];
is_deeply [sort values %masked], [222,777,888];
 
# Scalar
SKIP: {
        skip "test fails on pre-5.8.9 Perls", 1 if $] lt '5.008009';
        # Since it's mostly here for code coverage, it's ok to skip it
        # scalar(%hash) really only gets useful on Perl 5.26+ anyway (returns the number of keys)
        if ( $] lt '5.026' )
                { is scalar(%masked), scalar( %{tied(%masked)->{hash}} ) }
        else
                { is scalar(%masked), 3 }
}
 
# delete-ing
{
        no warnings FATAL=>'all'; use warnings;  ## no critic (ProhibitNoWarnings)
        my @w = warns {
                ok !defined(delete $masked{ccc});

t/20_array.t  view on Meta::CPAN

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
is $subset[6], undef;
is $subset[7], undef;
is $subset[8], undef;
is $subset[-1], undef;
 
# Exists
ok exists $subset[0];
ok !exists $subset[20];
SKIP: {
        skip "work around some kind of apparent regression in 5.14 and 5.16", 1
                if $] ge '5.014' && $] lt '5.018';
        ok !exists $subset[-1];
}
 
# Storing
ok $subset[1]=42;
{
        # author tests make warnings fatal, disable that here
        no warnings FATAL=>'all'; use warnings;  ## no critic (ProhibitNoWarnings)
        my @w = warns {
                ok !defined($subset[7]=999);

t/20_array.t  view on Meta::CPAN

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
ok exception { tie my @foo, 'Tie::Subset' };
ok exception { Tie::Subset::TIEARRAY('Tie::Subset::Foobar', []) };
 
# Not Supported
{
        no warnings FATAL=>'all'; use warnings;  ## no critic (ProhibitNoWarnings)
        ok 1==grep { /\b\Qnot (yet) supported\E\b/ } warns {
                $#subset = 1;
        };
        SKIP: {
                skip "test fails on pre-5.24 Perls", 1 if $] lt '5.024';
                # Since it's only here for code coverage, it's ok to skip it
                ok 1==grep { /\b\Qnot (yet) supported\E\b/ } warns {
                        @subset = ();
                };
        }
        ok 1==grep { /\b\Qnot (yet) supported\E\b/ } warns {
                push @subset, 'a';
        };
        ok 1==grep { /\b\Qnot (yet) supported\E\b/ } warns {
                pop @subset;