Tie-Subset

 view release on metacpan or  search on metacpan

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

	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

	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

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

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

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

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;