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
91
|
#!/usr/bin/perl
use v5.14;
use warnings;
use Test2::V0;
use Syntax::Keyword::Match;
use Syntax::Keyword::Match::Deparse;
use B::Deparse;
my $deparser = B::Deparse->new();
sub is_deparsed
{
my ( $sub, $exp, $name ) = @_;
my $got = $deparser->coderef2text( $sub );
# Deparsed output is '{ ... }'-wrapped
$got = ( $got =~ m/^{\n(.*)\n}$/s )[0];
$got =~ s/^ //mg;
# Deparsed output will have a lot of pragmata and so on
1 while $got =~ s/^\s*(?:use|no) \w+.*\n//;
$got =~ s/^BEGIN \{\n.*?\n\}\n//s;
# Trim a trailing linefeed
chomp $got;
is( $got, $exp, $name );
}
is_deparsed
sub { match(1 : ==) { case(1) { YES() } case(2) { NO() } } },
"match (1 : ==) {\n" .
" case (1) {YES();}\n" .
" case (2) {NO();}\n" .
"};",
'match/case on ==';
is_deparsed
sub { match('a' : eq) { case('a') { YES() } case('b') { NO() } } },
"match ('a' : eq) {\n" .
" case ('a') {YES();}\n" .
" case ('b') {NO();}\n" .
"};",
'match/case on eq';
is_deparsed
sub { match('a' : =~) { case(m/a/) { YES() } case(m/b/) { NO() } } },
"match ('a' : =~) {\n" .
" case (m/a/u) {YES();}\n" .
" case (m/b/u) {NO();}\n" .
"};",
'match/case on =~';
is_deparsed
eval q(sub { match('OBJ' : isa) { case(AClass) { YES() } case(BClass) { NO() } } }),
"match ('OBJ' : isa) {\n" .
" case ('AClass') {YES();}\n" .
" case ('BClass') {NO();}\n" .
"};",
'match/case on isa' if $^V ge v5.32.0;
is_deparsed
sub { match(1 : ==) { case(1) { YES() } case(2) { NO() } default { ALSO_NO() } } },
"match (1 : ==) {\n" .
" case (1) {YES();}\n" .
" case (2) {NO();}\n" .
" default {ALSO_NO();}\n" .
"};",
'match/case with default';
is_deparsed
sub { match(1 : ==) { case(1), case(2) { YES() } case(3) { NO() } } },
"match (1 : ==) {\n" .
" case (1), case (2) {YES();}\n" .
" case (3) {NO();}\n" .
"};",
'match/case with multiple case conditions';
is_deparsed
sub { match(1 : ==) { case if (rand > 0.5) { MAYBE() } case(2) { NO() } } },
"match (1 : ==) {\n" .
" case if (rand > 0.5) {MAYBE();}\n" .
" case (2) {NO();}\n" .
"};",
'match/case with case if';
done_testing;
|
