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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use Syntax::Keyword::Match;
# literals
{
my $ok;
match("abc" : eq) {
case("abc") { $ok++ }
case("def") { fail('Not this one sorry'); }
}
ok( $ok, 'Literal match' );
}
# case expressions
{
my $ok;
my $second = "second";
match("second" : eq) {
case("first") { fail("Not first") }
case($second) { $ok++ }
case("third") { fail("Not third") }
}
ok( $ok, 'Expression match' );
}
# default
{
my $ok;
match("xyz" : eq) {
case("a") { fail("Not a") }
case("b") { fail("Not b") }
default { $ok++ }
}
ok( $ok, 'Default block executed' );
}
# expressions evaluated just once
{
my $evalcount;
sub topicexpr { $evalcount++; return "string" }
my $ok;
match(topicexpr() : eq) {
case("abc") { fail('Nope'); }
case("def") { fail('Still nope'); }
case("string") { $ok++ }
}
ok( $ok, 'Function call match' );
is( $evalcount, 1, 'Topic expression evaluated just once' );
}
# Constant but non-literal expressions are accepted
{
my $ok;
match("XY" : eq) {
case("X" . "Y") { $ok++ }
}
ok( $ok, 'Constant non-literal parses' );
}
# overloaded 'eq' operator
{
my $equal;
package Greedy {
use overload 'eq' => sub { $equal };
}
sub greedy_is_ten
{
match(bless [], "Greedy" : eq) {
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' );
}
done_testing;
|
