Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 156 lines (126 sloc) 3.692 kB
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
1 use v6;
2
3 use Test;
4
01cf81b @sorear [S04-statements/do.t] Add tests for do with loop labels, and fudge fo…
sorear authored
5 plan 27;
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
6
7 # L<S04/The do-once loop/"can't" put "statement modifier">
d286205 [t/spec] Correct and unfudge some tests.
jnthn authored
8 # Note in accordance with STD, conditionals are OK, loops are not.
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
9 eval_dies_ok 'my $i = 1; do { $i++ } while $i < 5;',
10 "'do' can't take the 'while' modifier";
11
12 eval_dies_ok 'my $i = 1; do { $i++ } until $i > 4;',
13 "'do' can't take the 'until' modifier";
14
15 eval_dies_ok 'my $i; do { $i++ } for 1..3;',
16 "'do' can't take the 'for' modifier";
17
18 eval_dies_ok 'my $i; do { $i++ } given $i;',
19 "'do' can't take the 'given' modifier";
20
d286205 [t/spec] Correct and unfudge some tests.
jnthn authored
21 eval_lives_ok 'my $i; do { $i++ } unless $i;',
22 "'do' can take the 'unless' modifier";
23
24 eval_lives_ok 'my $i = 1; do { $i++ } if $i;',
25 "'do' can take the 'if' modifier";
26
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
27 # L<S04/The do-once loop/statement "prefixing with" do>
28 {
29 my $x;
30 my ($a, $b, $c) = 'a' .. 'c';
31
32 $x = do if $a { $b } else { $c };
33 is $x, 'b', "prefixing 'if' statement with 'do' (then)";
34
35 $x = do if !$a { $b } else { $c };
36 is $x, 'c', "prefixing 'if' statement with 'do' (else)";
4d3ec37 [t/spec]: Unfudge a spectest in do.t.
pmichaud authored
37 }
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
38
39 =begin comment
40 If the final statement is a conditional which does not execute
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
41 any branch, the return value is undefined in item context and ()
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
42 in list context.
43 =end comment
01cf81b @sorear [S04-statements/do.t] Add tests for do with loop labels, and fudge fo…
sorear authored
44 #?niecza skip 'Nil'
4d3ec37 [t/spec]: Unfudge a spectest in do.t.
pmichaud authored
45 {
e704067 [t/spec] some more variable declaration fixes
moritz authored
46 my $x = do if 0 { 1 } elsif 0 { 2 };
8f9a119 [t/] unify compartmentalized undef and Object concepts into Mu
lwall authored
47 ok !$x.defined, 'when if does not execute any branch, return undefined';
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
48 }
49
50 {
51 my $ret = do given 3 {
52 when 3 { 1 }
53 };
54 is($ret, 1, 'do STMT works');
55 }
56
57 {
58 my $ret = do { given 3 {
59 when 3 { 1 }
60 } };
61 is($ret, 1, 'do { STMT } works');
62 }
63
64 # L<S04/The do-once loop/"you may use" do "on an expression">
65 {
66 my $ret = do 42;
67 is($ret, 42, 'do EXPR should also work (single number)');
68
69 $ret = do 3 + 2;
70 is($ret, 5, 'do EXPR should also work (simple + expr)');
71
72 $ret = do do 5;
73 is($ret, 5, 'nested do (1)');
74
75 $ret = do {do 5};
76 is($ret, 5, 'nested do (2)');
77
78 # precedence decisions do not cross a do boundary
79 $ret = 2 * do 2 + 5;
2e3530b [t/spec] Typo - s/ precendence / precedence /
Util authored
80 is($ret, 14, 'do affects precedence correctly');
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
81 }
82
83 # L<S04/The do-once loop/"can take" "loop control statements">
0da6e8f [t/spec] stop rakudo from prematurely aborting do.t
moritz authored
84 #?rakudo skip 'next() should also work on do blocks (?)'
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
85 {
86 my $i;
87 do {
88 $i++;
89 next;
90 $i--;
91 };
92 is $i, 1, "'next' works in 'do' block";
93 }
94
01cf81b @sorear [S04-statements/do.t] Add tests for do with loop labels, and fudge fo…
sorear authored
95 #?rakudo 3 skip "labels"
96 is eval('my $i; A: do { $i++; last A; $i-- }; $i'), 1,
97 "'last' works with label";
98 is eval('my $i; A: do { $i++; next A; $i-- }; $i'), 1,
99 "'next' works with label";
100 is eval('my $i; A: do { $i++; redo A until $i == 5; $i-- }; $i'), 4,
101 "'redo' works with label";
102
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
103 #?rakudo skip 'last not implemented'
104 {
105 is eval('
106 my $i;
107 do {
108 $i++;
109 last;
110 $i--;
111 };
112 $i;
113 '), 1, "'last' works in 'do' block";
114 }
115
116 # IRC notes:
117 # <agentzh> audreyt: btw, can i use redo in the do-once loop?
118 # <audreyt> it can, and it will redo it
119 #?rakudo skip 'redo not implemented'
120 {
121 is eval('
122 my $i;
123 do {
124 $i++;
125 redo if $i < 3;
126 $i--;
127 };
128 $i;
129 '), 2, "'redo' works in 'do' block";
130 }
131
3152b01 [t] some updates to README, and fixed all but one smartlink in t/spec/
moritz authored
132 # L<S04/The do-once loop/"bare block is not a do-once">
499fea9 [gsoc_spectest] moved do.t into spec, added tests, fudged for rakudo.…
Auzon authored
133 {
134 eval_dies_ok 'my $i; { $i++; next; $i--; }',
135 "bare block can't take 'next'";
136
137 eval_dies_ok 'my $i; { $i++; last; $i--; }',
138 "bare block can't take 'last'";
139
140 eval_dies_ok 'my $i; { $i++; redo; $i--; }',
141 "bare block can't take 'last'";
142 }
143
144 # L<S04/Statement parsing/"final closing curly on a line"
145 # reverts to semicolon>
146 {
147 my $a = do {
148 1 + 2;
149 } # no trailing `;'
150 is $a, 3, "final `}' on a line reverted to `;'";
151 }
1a356d7 [t/spec] tests for RT #61034
moritz authored
152
f11daa5 [t/spec] re-fudge do.t for rakudo
moritz authored
153 lives_ok { my $a = do given 5 {} }, 'empty do block lives (RT 61034)';
1a356d7 [t/spec] tests for RT #61034
moritz authored
154
155 # vim: ft=perl6
Something went wrong with that request. Please try again.