-
Notifications
You must be signed in to change notification settings - Fork 135
/
polymorphism.t
88 lines (56 loc) · 1.89 KB
/
polymorphism.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
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/der_grammar.t.
It has (hopefully) been, and should continue to be, updated to
be valid perl6.
=end pod
plan 28;
grammar Other {
regex abc { a (<.bee>) c }
regex bee { b }
regex def { d <eh> f }
regex eh { e }
}
grammar Another is Other { };
grammar Yet::Another is Another {
regex bee { B }
regex def { D <eh> F }
};
# Test derivation and Liskov substitutability...
ok 'abc' ~~ m/ ^ (<Another::abc>) $ /, '<Another::abc>' ;
is(~$/, "abc", 'abc $/');
is(~$0, "abc", 'abc $0');
ok('abc' ~~ m/ (<Another::bee>) /, '<Another::bee>');
is(~$/, "b", 'bee $/');
is(~$0, "b", 'bee $0');
ok('b' ~~ m/ (<Another::bee>) /, '<Another::bee>');
ok('def' ~~ m/^ (<Another::def>) $/, '(<Another::def>)');
is(~$/, "def", 'def $/');
is(~$0, "def", 'def $0');
ok('def' ~~ m/^ <.Another::def> $/, '<.Another::def>');
is(~$/, "def", '.def $/');
ok($0 ne "def", '.def $0');
# Test rederivation and polymorphism...
ok('aBc' ~~ m/^ (<Yet::Another::abc>) $/, '<Yet::Another::abc>');
is(~$/, "aBc", 'abc $/');
is(~$0, "aBc", 'abc $0');
ok('abc' !~~ m/ (<Yet::Another::bee>) /, 'abc <Yet::Another::bee>');
ok('aBc' ~~ m/ (<Yet::Another::bee>) /, 'aBc <Yet::Another::bee>');
is(~$/, "B", 'Yet::Another::bee $/');
is(~$0, "B", 'Yet::Another::bee $0');
ok('def' !~~ m/^ (<Yet::Another::def>) $/, 'def (<Yet::Another::def>)');
ok('DeF' ~~ m/^ (<Yet::Another::def>) $/, 'DeF (<Yet::Another::def>)');
is(~$/, "DeF", 'DeF $/');
is(~$0, "DeF", 'DeF $0');
ok('DeF' ~~ m/^ <.Yet::Another::def> $/, '<?Yet::Another::def>');
is(~$/, "DeF", '.Yet::Another.def $/');
# Non-existent rules...
eval_dies_ok q{ 'abc' ~~ m/ (<Another.sea>) / }, '<Another.sea>';
# RT #63466
{
eval_dies_ok q{ 'x' ~~ / <No::Such::Rule> / },
'match against No::Such::Rule dies';
}
# vim: ft=perl6