=pod

=encoding utf-8

=head1 PURPOSE

Test that match::simple works.

=head1 AUTHOR

Toby Inkster E<lt>tobyink@cpan.orgE<gt>.

=head1 COPYRIGHT AND LICENCE

This software is copyright (c) 2013-2014 by Toby Inkster.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.


=cut

use strict;
use warnings;
use Test::More;
use Test::Fatal;

use match::simple;

diag(sprintf('implementation: %s', match::simple::IMPLEMENTATION));

my $obj = do {
	package Local::SomeClass;
	use overload q[""] => sub { q(XXX) }, fallback => 1;
	bless [];
};

sub does_match {
	my ($a, $b, $name) = @_;
	my ($as, $bs) = map do {
		no if ($] >= 5.010001), 'overloading';
		ref($_) ? qq[$_] : defined($_) ? qq["$_"] : q[undef];
	}, @_;
	$name ||= "$as matches $bs";
	ok(
		$a |M| $b,
		$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(
		!($a |M| $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 ($] >= 5.010001 and $] < 5.020000)
{
	my $obj3 = eval q{
		no warnings;
		package Local::YetAnotherClass;
		use overload q[~~] => sub { $_[1] };
		bless [];
	};
	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 { "Foo" |M| { foo => 1 } },
	q(Matching against a regexp throws an exception.),
);
ok(
	exception { "Foo" |M| \*STDOUT },
	q(Matching against a filehandle throws an exception.),
);

done_testing;