Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

166 lines (124 sloc) 4.896 kb
#!/usr/bin/env perl
use perl5i::latest;
use lib 't/lib';
use Test::More;
use Test::perl5i;
my @a = ( 0 .. 5 );
my @b = ( 3 .. 8 );
my $i;
is_deeply( $i = @a->intersect(\@b), [ 3, 4, 5 ], 'Simple number intersect' );
is_deeply( $i = @b->intersect(\@a), [ 3, 4, 5 ], 'Simple number intersect' );
my @i = @b->intersect(\@a);
is scalar @i, 3, "Returns an array in list context";
# No arguments
is_deeply( $i = @a->intersect, \@a, 'No arguments' );
# Empty array
is_deeply( $i = @a->intersect([]), [], 'Intersect with an empty array');
is_deeply( $i = []->diff, [], 'Diff an empty array' );
# Dies when called with non-arrayref arguments
throws_ok { @a->intersect('foo') } qr/Arguments must be/;
throws_ok { @a->intersect({ foo => 1 }) } qr/Arguments must be/;
throws_ok { []->intersect(\'foo') } qr/Arguments must be/;
throws_ok { @a->intersect(undef, \@a) } qr/Arguments must be/;
# Works with strings also
is_deeply( $i = [qw(foo bar)]->intersect(['bar']), ['bar'], 'Works ok with strings' );
# Mix strings and numbers
is_deeply( $i = [qw(foo bar)]->intersect(\@a), [], 'Mix strings and numbers' );
# Mix numbers and strings
is_deeply( $i = @a->intersect([qw(foo bar)]), [], 'Mix numbers and strings' );
# Ordering shouldn't matter in the top level array
is_deeply( $i = [ 1, 2 ]->intersect([ 2, 1 ]), [ 1, 2, ] );
# ... but it matters for there down ( see [ github 96 ] )
is_deeply( $i = [ [ 1, 2 ] ]->intersect([ [ 2, 1 ] ]), [ ] );
# Diff more than two arrays
is_deeply( $i = @a->intersect(\@b, [ 4, 'foo' ] ), [ 4 ], 'Intersect more than two arrays' );
is_deeply( $i = @a->intersect(\@b, [ 3, 5, 12 ] ), [ 3, 5 ], 'Intersect more than two arrays' );
is_deeply(
$i = [ { foo => 1 }, { foo => \2 } ]->intersect( [ { foo => \2 } ] ),
[ { foo => \2 } ],
'Works for nested data structures',
);
# Test undef
{
my @array = (1,2,undef,4);
is_deeply( $i = @array->intersect([1,2,4,undef]), [ 1, 2, undef, 4 ] );
is_deeply( $i = @array->intersect([1,2,4]), [ 1, 2, 4 ] );
}
# Test REF
{
my $ref1 = \42;
my $ref2 = \42;
my @array = (1,2,\$ref1,4);
is_deeply( $i = @array->intersect([4,\$ref2,2,1]), \@array );
my $ref3 = \23;
is_deeply( $i = @array->intersect([1,2,\$ref3,4]), [1, 2, 4] );
}
# Stress test deep comparison
my $code = sub { 'foo' };
my $foo = [
qw( foo bar baz ), # plain elements
{ foo => 2 }, # hash reference
{ bar => 1 }, # hash reference
[ # array reference of ...
qw( foo bar baz ), # plain elements and ...
{ foo => { foo => $code } } # hash reference with hash ref as value
] # with code ref as value
];
my $bar = [
qw( foo baz ), # bar is missing
{ foo => 1 }, # 1 != 2, bar =! foo
[ # this arrayref is identical
qw( foo bar baz ),
{ foo => { foo => $code } }
],
[ qw( foo baz ), \'gorch' ] # this is unique to $bar
];
is_deeply(
$i = $foo->intersect($bar),
[ 'foo', 'baz', [ qw(foo bar baz), { foo => { foo => $code } } ] ],
"stress test 1"
);
is_deeply(
$i = $bar->intersect($foo),
[ 'foo', 'baz', [ qw(foo bar baz), { foo => { foo => $code } } ] ],
"stress test 2"
);
is_deeply( $i = [ $code ]->intersect([ sub { 'bar' }]), [ ] );
is_deeply( $i = [ $code ]->intersect([ $code ]), [ $code ] );
# Test overloading
{
package Number;
use overload
'0+' => sub { 42 },
fallback => 1;
sub new { bless {} }
}
{
package String;
use overload
'""' => sub { 'foo' },
fallback => 1;
sub new { bless {} }
}
my $answer = Number->new;
my $string = String->new;
# Minimal testing of overloaded classes
ok( $answer == 42 );
ok( $string eq 'foo' );
is_deeply( $i = [ $answer, $string ]->intersect([ 'foo', 42 ]), [ $answer, $string ] );
# Overloaded objects vs. scalars
is_deeply( $i = [ $answer, $string ]->intersect([ 'foo' ]), [ $string ] );
is_deeply( $i = [ $answer, $string ]->intersect([ 42 ]), [ $answer ] );
is_deeply( $i = [ 42, 'foo' ]->intersect([ $answer ]), [ 42 ] );
is_deeply( $i = [ 42, 'foo' ]->intersect([ $string ]), [ 'foo' ] );
# Overloaded objects vs. overloaded objects.
is_deeply( $i = [ $answer, $string ]->diff([ $string ]), [ $answer ] );
is_deeply( $i = [ $answer, $string ]->diff([ $answer ]), [ $string ] );
is_deeply( $i = [ $answer, $string ]->diff([ $answer ]), [ 'foo' ] );
# Objects vs. objects
my $object = bless {}, 'Object';
is_deeply( $i = [ $object ]->intersect( [ $object ]), [ $object ] );
# Overloaded objects vs. non-overloaded objects
is_deeply( $i = [ $object ]->intersect( [ $answer ] ), [ ] );
is_deeply( $i = [ $answer ]->intersect( [ $object ] ), [ ] );
done_testing();
Jump to Line
Something went wrong with that request. Please try again.