1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0 qw( :DEFAULT !match );
use Syntax::Keyword::Match;
package AClass {}
package BClass {}
# literals
{
my $ok;
match(bless [], "AClass" : isa) {
case(AClass) { $ok++ }
case(BClass) { fail('Not this one sorry'); }
}
ok( $ok, 'Literal match' );
}
# default
{
my $ok;
match(bless [], "CClass" : isa) {
case(AClass) { fail("Not AClass") }
case(BClass) { fail("Not BClass") }
default { $ok++ }
}
ok( $ok, 'Default block executed' );
}
# overloaded ->isa method
{
my $equal;
package Greedy {
sub isa { $equal };
}
sub greedy_is_ten
{
match(bless [], "Greedy" : isa) {
case(Ten) { return "YES" }
default { return "NO" }
}
}
$equal = 1;
is( greedy_is_ten, "YES", 'Greedy is 10 when set' );
$equal = 0;
is( greedy_is_ten, "NO", 'Greedy is not 10 when unset' );
}
{
no Syntax::Keyword::Match;
sub match { return "normal function" }
is( match, "normal function", 'match() parses as a normal function call' );
}
done_testing;
|
