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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
#! nqp
say('
sub test_line($rxsub,$target,$expect,$desc) {
my $expect_substr := nqp::substr($expect, 0, 1) eq "<"
?? nqp::substr($expect, 1, nqp::chars($expect) - 2)
!! "";
try {
my $cursor := NQPMatch."!cursor_init"($target, :c(0));
my $match := $rxsub($cursor).MATCH;
if $expect_substr {
my $got := ~$match."!dump_str"("mob");
my $m := nqp::index($got, $expect_substr) >= 0;
ok($m, $desc);
say("# got: $got\n# expected: $expect_substr") unless $m;
}
else {
ok($expect eq "y" ?? $match !! !$match, $desc);
}
CATCH {
if $expect_substr {
my $m := nqp::index(~$_, $expect_substr) >= 0;
ok($m, $desc);
say("# got: $_\n# expected: $expect") unless $m;
}
else {
ok(0, $desc);
say("# ERROR: $_");
}
}
}
}
');
my @files := [
'rx_captures',
'rx_qcaps',
'rx_basic',
'rx_quantifiers',
'rx_metachars',
'rx_charclass',
'rx_backtrack',
'rx_subrules',
'rx_modifiers',
'rx_goal'
];
my $tests := 0;
for @files -> $fn {
say("say('# file: $fn');");
my $contents := slurp('t/qregex/' ~ $fn);
my @lines := nqp::split("\n", $contents);
my $todo := 0;
for @lines -> $line {
my $m := $line ~~ /'# todo ' (\d*)/;
if $m {
$todo := $m[0] eq '' ?? 1 !! +$m[0];
say("#TODO: <{$m[0]}> $todo");
}
else {
next if $line ~~ /^\s*\# | ^\s*$ /;
if $todo {
$todo := $todo - 1;
next;
}
my @parts := match($line, /\T+/, :global);
my $regex := @parts[0];
my $target := @parts[1];
my $expect := @parts[2];
if $expect ~~ /^'['/ {
next;
}
my $desc := @parts[3];
my $expect_substr := nqp::substr($expect, 0, 1) eq "<"
?? nqp::substr($expect, 1, nqp::chars($expect) - 2)
!! "";
next if $expect_substr eq 'Unsupported' || $expect_substr eq 'Unrecognized';
$target := subst($target, /\\x(<[a..fA..F0..9]>**4)/, -> $m { '\\x['~$m[0]~']' }, :global);
$target := subst($target, /\"/, -> $m { '\\"' }, :global);
$target := subst($target, /\{/, -> $m { '\\{' }, :global);
$target := subst($target, /\}/, -> $m { '\\}' }, :global);
$target := subst($target, /\\\]/, -> $m { '\\\\]' }, :global);
$desc := nqp::escape($desc);
$target := '' if $target eq "''";
$tests := $tests + 1;
say("test_line(/$regex{$desc ~~ /comments/ ?? "\n" !! ""}/,\"$target\",'$expect',\"$desc\");");
}
}
say("say('# done with file $fn');");
}
say("say('1..$tests');");
# vim: ft=perl6
|
