view release on metacpan or  search on metacpan

t/02simple.t  view on Meta::CPAN

		$name,
	);
}

sub doesnt_match {
	my ($a, $b, $name) = @_;
	my ($as, $bs) = map do {
		no if ($] >= 5.010001), 'overloading';
		ref($_) ? qq[$_] : defined($_) ? qq["$_"] : q[undef];
	}, @_;
	$name ||= "$as NOT matches $bs";
	ok(
		!match::simple::XS::match($a, $b),
		$name,
	);
}

# If the right hand side is "undef", then there is only a match if
# the left hand side is also "undef".
does_match(undef, undef);
doesnt_match($_, undef)
	for 0, 1, q(), q(XXX), [], {}, sub {}, $obj;

# If the right hand side is a non-reference, then the match is a
# simple string match.
does_match(q(xxx), q(xxx));
doesnt_match($_, q(xxx))
	for 0, 1, q(), q(XXX), [], {}, sub {}, $obj;

# If the right hand side is a reference to a regexp, then the left
# hand is evaluated.
does_match(q(xxx), qr(xxx), 'q(xxx) |M| qr(xxx)');
does_match(q(wwwxxxyyyzzz), qr(xxx), 'q(wwwxxxyyyzzz) |M| qr(xxx)');
doesnt_match($_, qr(xxx))
	for 0, 1, q(), q(XXX), [], {}, sub {}, $obj;
doesnt_match(qr(xxx), q(xxx));

# If the right hand side is a code reference, then it is called in a
# boolean context with the left hand side being passed as an
# argument.
does_match(1, sub {$_});
doesnt_match(0, sub {$_});
does_match(1, sub {$_[0]});
doesnt_match(0, sub {$_[0]});
does_match(1, sub {1});
does_match(0, sub {1});

# If the right hand side is an object which provides a "MATCH"
# method, then it this is called as a method, with the left hand side
# being passed as an argument.
my $obj2 = do {
	package Local::SomeOtherClass;
	sub MATCH { $_[1] }
	bless [];
};
does_match(1, $obj2);
doesnt_match(0, $obj2);

# If the right hand side is an object which overloads "~~", then a
# true smart match is performed.
if ( $] le '5.036000' ) {
	my $obj3 = eval q{
		no warnings;
		no strict 'refs';
		package Local::YetAnotherClass;
		use overload q[~~] => sub { $_[1] }, fallback => 1;
		bless [];
	};
	my $e = $@;
	ok($obj3, 'eval worked') or diag($e);
	does_match(1, $obj3);
	doesnt_match(0, $obj3);
}

# If the right hand side is an arrayref, then the operator recurses
# into the array, with the match succeeding if the left hand side
# matches any array element.
does_match(q(x), [qw(x y z)], 'q(x) |M| [qw(x y z)]');

# If any other value appears on the right hand side, the operator
# will croak.
ok(
	exception { match::simple::XS::match("Foo", { foo => 1 }) },
	q(Matching against a regexp throws an exception.),
);
ok(
	exception { match::simple::XS::match("Foo", \*STDOUT) },
	q(Matching against a filehandle throws an exception.),
);

done_testing;