-
Notifications
You must be signed in to change notification settings - Fork 135
/
dot.t
120 lines (90 loc) · 3.62 KB
/
dot.t
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
111
112
113
114
115
116
117
118
119
120
use v6;
use Test;
=begin pod
This file was derived from the perl5 CPAN module Perl6::Rules,
version 0.3 (12 Apr 2004), file t/capture.t.
It has (hopefully) been, and should continue to be, updated to
be valid perl6.
# L<S05/Accessing captured subpatterns/The array elements of the regex's>
Broken:
## L<S05/Extensible metasyntax (C<< <...> >>)/A leading C<.> causes>
=end pod
plan 61;
my regex dotdot { (.)(.) };
ok("zzzabcdefzzz" ~~ m/(a.)<.dotdot>(..)/, 'Match');
ok($/, 'Matched');
is(~$/, "abcdef", 'Captured');
is(~$/[0], 'ab', '$/[0]');
is(~$0, 'ab', '$0');
is(~$/[1], 'ef', '$/[1]');
is(~$1, 'ef', '$1');
ok(!defined($/[2]), 'no $/[2]');
ok(!defined($2), 'no $2');
ok(!defined($/<dotdot>), 'no $/<dotdot>');
ok("zzzabcdefzzz" ~~ m/(a.)<dotdot>(..)/, 'Match');
ok($/, 'Matched');
is(~$/, "abcdef", 'Captured');
is(~$/[0], 'ab', '$/[0]');
is(~$0, 'ab', '$0');
is(~$/[1], 'ef', '$/[1]');
is(~$1, 'ef', '$1');
ok(!defined($/[2]), '$/[2]');
ok(!defined($2), '$2');
is(~$/<dotdot>, 'cd', '$/<dotdot>');
is(~$/<dotdot>[0], 'c', '$/<dotdot>[0]');
is(~$/<dotdot>[1], 'd', '$/<dotdot>[1]');
ok(!defined(try { $/<dotdot>[2] }), '$/<dotdot>[2]');
ok("abcd" ~~ m/(a(b(c))(d))/, 'Nested captured');
is(~$0, "abcd", 'Nested $0');
is(~$0[0], "bc", 'Nested $1');
is(~$0[0][0], "c", 'Nested $2');
is(~$0[1], "d", 'Nested $3');
# L<S05/Backslash reform/Backreferences>
ok("bookkeeper" ~~ m/(((\w)$0)+)/, 'Backreference');
is(~$0, 'ookkee', 'Captured');
#?rakudo todo 'really? :-)'
is(~$0[0], 'ee', 'Captured');
# L<S05/Accessing captured subrules/The hash entries>
my regex single { o | k | e };
#?rakudo 3 todo 'dubious test'
ok("bookkeeper" ~~ m/<single> ($<single>)/, 'Named backref');
is(~$/<single>, 'o', 'Named capture');
is(~$0, 'o', 'Backref capture');
#?rakudo 3 todo 'dubious test'
ok("bookkeeper" ~~ m/(<.single>) ($0)/, 'Positional backref');
is(~$0, 'o', 'Named capture');
is(~$1, 'o', 'Backref capture');
ok(!( "bokeper" ~~ m/(<.single>) ($0)/ ), 'Failed positional backref');
# XXX wtf?
ok !( "bokeper" ~~ m/<single> ($<single>)/ ) , 'Failed named backref';
is("\$0", '$'~'0', 'Non-translation of non-interpolated "\\$0"');
is('$0', '$'~'0', 'Non-translation of non-interpolated \'$0\'');
is(q{$0}, '$'~'0', 'Non-translation of non-interpolated q{$0}');
is(q[$0], '$'~'0', 'Non-translation of non-interpolated q[$0]');
is(q<$0>, '$'~'0', 'Non-translation of non-interpolated q<$0>');
is(q/$0/, '$'~'0', 'Non-translation of non-interpolated q/$0/');
is(q!$0!, '$'~'0', 'Non-translation of non-interpolated q!$0!');
is(q|$0|, '$'~'0', 'Non-translation of non-interpolated q|$0|');
# L<S05/Grammars/Just like the methods of a class, the rule definitions of a grammar are inherited>
grammar English { regex name { john } }
grammar French { regex name { jean } }
grammar Russian { regex name { ivan } }
ok("john" ~~ m/<.English::name> | <.French::name> | <.Russian::name>/, 'English name');
is(~$/, "john", 'Match is john');
ok($/ ne "jean", "Match isn't jean");
#?rakudo todo 'needs review'
is(~$/<name>, "john", 'Name is john');
ok("jean" ~~ m/<.English::name> | <.French::name> | <.Russian::name>/, 'French name');
is(~$/, "jean", 'Match is jean');
#?rakudo todo 'needs review'
is(~$/<name>, "jean", 'Name is jean');
ok("ivan" ~~ m/<.English::name> | <.French::name> | <.Russian::name>/, 'Russian name');
is(~$/, "ivan", 'Match is ivan');
#?rakudo todo 'needs review'
is(~$/<name>, "ivan", 'Name is ivan');
my regex name { <.English::name> | <.French::name> | <.Russian::name> }
ok("john" ~~ m/<name>/, 'English metaname');
is(~$/, "john", 'Metaname match is john');
ok(~$/ ne "jean", "Metaname match isn't jean");
is(~$/<name>, "john", 'Metaname is john');
# vim: ft=perl6