Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 153 lines (119 sloc) 5.429 kB
a285d29 [t] move flip-flop.t to spec/
moritz authored
1 use v6;
2
3 use Test;
4
d262e2e @peschwa Add a test for flip-flop with "True but $seqnum".
peschwa authored
5 plan 40;
a285d29 [t] move flip-flop.t to spec/
moritz authored
6
7 # L<S03/Changes to Perl 5 operators/flipflop operator is now done with>
8
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
9
10 # Basic ff
11 {
12 $_ = "1";
13 ok (1 ff 1), 'flip-flop operator implemented';
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
14
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
15 ok (1 fff 1), 'fff operator implemented';
16 }
a285d29 [t] move flip-flop.t to spec/
moritz authored
17
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
18
19 # test basic flip-flop operation
20 {
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
21
22 sub test_ff($code, @a) {
f2fad85 @sorear [S03-operators/flip-flop] Simplify and fix scoping
sorear authored
23 my $ret = '';
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
24 for @a {
25 $ret ~= $code.($_) ?? $_ !! 'x';
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
26 }
27 return $ret;
28 }
29
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
30 is test_ff({/B/ ff /D/ }, <A B C D E>), 'xBCDx', '/B/ ff /D/, lhs != rhs';
31 is test_ff({/B/ ^ff /D/ }, <A B C D E>), 'xxCDx', '/B/ ^ff /D/, lhs != rhs';
32 is test_ff({/B/ ff^ /D/ }, <A B C D E>), 'xBCxx', '/B/ ff^ /D/, lhs != rhs';
33 is test_ff({/B/ ^ff^ /D/ }, <A B C D E>), 'xxCxx', '/B/ ^ff^ /D/, lhs != rhs';
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
34
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
35 is test_ff({/B/ fff /D/ }, <A B C D E>), 'xBCDx', '/B/ fff /D/, lhs != rhs';
36 is test_ff({/B/ ^fff /D/ }, <A B C D E>), 'xxCDx', '/B/ ^fff /D/, lhs != rhs';
37 is test_ff({/B/ fff^ /D/ }, <A B C D E>), 'xBCxx', '/B/ fff^ /D/, lhs != rhs';
38 is test_ff({/B/ ^fff^ /D/}, <A B C D E>), 'xxCxx', '/B/ ^fff^ /D/, lhs != rhs';
39
40 is test_ff({/B/ ff /B/ }, <A B A B A>), 'xBxBx', '/B/ ff /B/, lhs == rhs';
41 is test_ff({/B/ ^ff /B/ }, <A B A B A>), 'xxxxx', '/B/ ^ff /B/, lhs == rhs';
42 is test_ff({/B/ ff^ /B/ }, <A B A B A>), 'xxxxx', '/B/ ff^ /B/, lhs == rhs';
43 is test_ff({/B/ ^ff^ /B/ }, <A B A B A>), 'xxxxx', '/B/ ^ff^ /B/, lhs == rhs';
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
44
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
45 is test_ff({/B/ fff /B/ }, <A B A B A>), 'xBABx', '/B/ fff /B/, lhs == rhs';
46 is test_ff({/B/ ^fff /B/ }, <A B A B A>), 'xxABx', '/B/ ^fff /B/, lhs == rhs';
47 is test_ff({/B/ fff^ /B/ }, <A B A B A>), 'xBAxx', '/B/ fff^ /B/, lhs == rhs';
48 is test_ff({/B/ ^fff^ /B/}, <A B A B A>), 'xxAxx', '/B/ ^fff^ /B/, lhs == rhs';
c1ee42c @sorear Test "state" semantics of ff, $x ff * handling
sorear authored
49
50 is test_ff({/B/ ff * }, <A B C D E>), 'xBCDE', '/B/ ff *';
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
51 }
52
53
54 # test flip-flop sequence management
55 {
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
56 sub test_ff_cnt($code, @a) {
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
57 my $ret = '';
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
58 for @a {
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
59 my $i;
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
60 $ret ~= (($i = $code.($_)) ?? $_ !! 'x') ~ $i;
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
61 }
62 return $ret;
63 }
64
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
65 is test_ff_cnt({/B/ ff /D/ }, <A B C D E>), 'xB1C2D3x', '/B/ ff /D/, seq #s, lhs != rhs';
66 is test_ff_cnt({/B/ ^ff /D/ }, <A B C D E>), 'xxC2D3x', '/B/ ^ff /D/, seq #s, lhs != rhs';
67 is test_ff_cnt({/B/ ff^ /D/ }, <A B C D E>), 'xB1C2xx', '/B/ ff^ /D/, seq #s, lhs != rhs';
68 is test_ff_cnt({/B/ ^ff^ /D/ }, <A B C D E>), 'xxC2xx', '/B/ ^ff^ /D/, seq #s, lhs != rhs';
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
69
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
70 is test_ff_cnt({/B/ fff /D/ }, <A B C D E>), 'xB1C2D3x', '/B/ fff /D/, seq #s, lhs != rhs';
71 is test_ff_cnt({/B/ ^fff /D/ }, <A B C D E>), 'xxC2D3x', '/B/ ^fff /D/, seq #s, lhs != rhs';
72 is test_ff_cnt({/B/ fff^ /D/ }, <A B C D E>), 'xB1C2xx', '/B/ fff^ /D/, seq #s, lhs != rhs';
73 is test_ff_cnt({/B/ ^fff^ /D/}, <A B C D E>), 'xxC2xx', '/B/ ^fff^ /D/, seq #s, lhs != rhs';
74
75 is test_ff_cnt({/B/ ff /B/ }, <A B A B A>), 'xB1xB1x', '/B/ ff /B/, seq #s, lhs == rhs';
76 is test_ff_cnt({/B/ ^ff /B/ }, <A B A B A>), 'xxxxx', '/B/ ^ff /B/, seq #s, lhs == rhs';
77 is test_ff_cnt({/B/ ff^ /B/ }, <A B A B A>), 'xxxxx', '/B/ ff^ /B/, seq #s, lhs == rhs';
78 is test_ff_cnt({/B/ ^ff^ /B/ }, <A B A B A>), 'xxxxx', '/B/ ^ff^ /B/, seq #s, lhs == rhs';
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
79
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
80 is test_ff_cnt({/B/ fff /B/ }, <A B A B A>), 'xB1A2B3x', '/B/ fff /B/, seq #s, lhs == rhs';
81 is test_ff_cnt({/B/ ^fff /B/ }, <A B A B A>), 'xxA2B3x', '/B/ ^fff /B/, seq #s, lhs == rhs';
82 is test_ff_cnt({/B/ fff^ /B/ }, <A B A B A>), 'xB1A2xx', '/B/ fff^ /B/, seq #s, lhs == rhs';
83 is test_ff_cnt({/B/ ^fff^ /B/}, <A B A B A>), 'xxA2xx', '/B/ ^fff^ /B/, seq #s, lhs == rhs';
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
84 }
85
86
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
87 # See thread "till (the flipflop operator, formerly ..)" on p6l started by Ingo
88 # Blechschmidt, especially Larry's reply:
89 # http://www.nntp.perl.org/group/perl.perl6.language/24098
90 # make sure calls to external sub uses the same ff each time
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
91 {
92 sub check_ff($i) {
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
93 $_ = $i;
94 return (/B/ ff /D/) ?? $i !! 'x';
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
95 }
96
97 my $ret = "";
98 $ret ~= check_ff('A');
99 $ret ~= check_ff('B');
100 $ret ~= check_ff('C');
101 $ret ~= check_ff('D');
102 $ret ~= check_ff('E');
103 is $ret, 'xBCDx', 'calls from different locations use the same ff';
104 }
105
c1ee42c @sorear Test "state" semantics of ff, $x ff * handling
sorear authored
106 # From the same thread, making sure that clones get different states
107 {
108 my $ret = "";
109 for 0,1 {
110 sub check_ff($_) { (/B/ ff /D/) ?? $_ !! 'x' }
111 $ret ~= check_ff('A');
112 $ret ~= check_ff('B');
113 $ret ~= check_ff('C');
114 }
115 is $ret, 'xBCxBC', 'different clones of the sub get different ff'
116 }
eb0af12 @felliott [flipflop.t] add tests for flipflop op
felliott authored
117
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
118 # make sure {lhs,rhs} isn't evaluated when state is {true,false}
9c40515 @dnmfarrell fixed appended RT number to be within quoted string
dnmfarrell authored
119 #?rakudo skip 'dubious scoping? RT #124548'
a285d29 [t] move flip-flop.t to spec/
moritz authored
120 {
121
bb5077a @FROGGS eval => EVAL in S03 and S04
FROGGS authored
122 # keep track of # of times lhs and rhs are EVAL'd by adding
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
123 # a state var to both sides.
124 sub ff_eval($code, $lhs, $rhs, @a) {
125 my $lhs_run = 0;
126 my $rhs_run = 0;
a285d29 [t] move flip-flop.t to spec/
moritz authored
127
f2fad85 @sorear [S03-operators/flip-flop] Simplify and fix scoping
sorear authored
128 for @a { $code.({$lhs_run++; ?$lhs}, {$rhs_run++; ?$rhs}); }
a285d29 [t] move flip-flop.t to spec/
moritz authored
129
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
130 return [$lhs_run, $rhs_run];
263bc16 [spec] Add more tests for flipflop. TimToady++ once again
bacek authored
131 }
132
a87fde4 @lizmat s/is_deeply/is-deeply/g
lizmat authored
133 is-deeply ff_eval({@_[0]() ff @_[1]()}, /B/, /B/, <A B A B A>),
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
134 [5, 2], "count lhs & rhs evals for ff";
55d2edf [spec] Refactor flipflop.t test for readability
bacek authored
135
e63e982 @jnthn Fudge flip-flop.t for Rakudo.
jnthn authored
136
a87fde4 @lizmat s/is_deeply/is-deeply/g
lizmat authored
137 is-deeply ff_eval({@_[0]() fff @_[1]()}, /B/, /B/, <A B A B A>),
3f8b669 @felliott [S03/flip-flop] rewrite flip-flop tests
felliott authored
138 [3, 2], "count lhs & rhs evals for fff";
55d2edf [spec] Refactor flipflop.t test for readability
bacek authored
139 }
140
9c40515 @dnmfarrell fixed appended RT number to be within quoted string
dnmfarrell authored
141 #?rakudo skip 'NYM flip-flop with "True but $seqnum" RT #124549'
d262e2e @peschwa Add a test for flip-flop with "True but $seqnum".
peschwa authored
142 {
143 my $result;
144 for <A B C B A> -> $a {
145 if $a ~~ ("B" fff "B") {
146 $result ~= $a
147 }
148 }
149 is $result, 'BCB', 'smart-matching against a flip-flop works';
150 }
151
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
152 # vim: ft=perl6
Something went wrong with that request. Please try again.