Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 379 lines (309 sloc) 9.829 kb
288e046 [t] and [t/spec]
moritz authored
1 use v6;
2
3 use Test;
69acfcf @jnthn Wrap tests need 'use soft' (they did by spec before, but no implementati...
jnthn authored
4 use soft;
288e046 [t] and [t/spec]
moritz authored
5
6 # L<S06/Wrapping>
7
8 # TODO
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
9 # nextsame, nextwith, callsame
10 # unwrap with no args pops the top most (is this spec?)
288e046 [t] and [t/spec]
moritz authored
11 #
12 # mutating wraps -- those should be "deep", as in not touching coderefs
13 # but actually mutating how the coderef works.
14
9bb5c8c @lizmat Adjust text count
lizmat authored
15 plan 85;
288e046 [t] and [t/spec]
moritz authored
16
17 my @log;
18
19 sub foo {
20 push @log, "foo";
21 }
22
23 sub wrapper {
24 push @log, "wrapper before";
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
25 try { callwith() };
288e046 [t] and [t/spec]
moritz authored
26 push @log, "wrapper after";
27 }
28
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
29 sub other_wrapper () {
288e046 [t] and [t/spec]
moritz authored
30 push @log, "wrapper2";
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
31 try { callwith() };
288e046 [t] and [t/spec]
moritz authored
32 }
33
34 foo();
35 is(+@log, 1, "one event logged");
36 is(@log[0], "foo", "it's foo");
37
19afa8a [t/spec] Tests for out-of-order unwrapping and making sure re-unwrapping...
jnthn authored
38 dies_ok { &foo.unwrap() }, 'cannot upwrap a never-wrapped sub.';
39
288e046 [t] and [t/spec]
moritz authored
40 @log = ();
41
42 wrapper();
43 is(+@log, 2, "two events logged");
44 is(@log[0], "wrapper before", "wrapper before");
45 is(@log[1], "wrapper after", "wrapper after");
46
47 @log = ();
48
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
49 my $wrapped = &foo.wrap(&wrapper);
288e046 [t] and [t/spec]
moritz authored
50
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
51 foo();
288e046 [t] and [t/spec]
moritz authored
52
7552681 [t/spec] fudge wrap.t for rakudo, and simplify a bit
moritz authored
53 is @log.join('|'), 'wrapper before|foo|wrapper after', 'logged the correct events';
288e046 [t] and [t/spec]
moritz authored
54
55 @log = ();
56
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
57 my $doublywrapped = &foo.wrap(&other_wrapper);
58 foo();
288e046 [t] and [t/spec]
moritz authored
59
60 is(+@log, 4, "four events");
61 is(@log[0], "wrapper2", "additional wrapping takes effect");
62 is(@log[1], "wrapper before", "... on top of initial wrapping");
63
64 @log = ();
65
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
66 &foo.unwrap($doublywrapped);
67 foo();
68
288e046 [t] and [t/spec]
moritz authored
69 is(+@log, 3, "old wrapped sub was not destroyed");
70 is(@log[0], "wrapper before", "the original wrapper is still in effect");
71
72 @log = ();
73
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
74 &foo.unwrap($wrapped);
75 foo();
288e046 [t] and [t/spec]
moritz authored
76
a3ec362 Review, correct and simplify (as in relying on less unrelated features) ...
jnthn authored
77 is(+@log, 1, "one events for unwrapped (should be back to original now)");
78 is(@log[0], "foo", "got execpted value");
19afa8a [t/spec] Tests for out-of-order unwrapping and making sure re-unwrapping...
jnthn authored
79
80 @log = ();
81
82 $wrapped = &foo.wrap(&wrapper);
83 $doublywrapped = &foo.wrap(&other_wrapper);
84 &foo.unwrap($wrapped);
85 foo();
86 is(+@log, 2, "out of order unwrapping gave right number of results");
87 is(@log[0], "wrapper2", "got execpted value from remaining wrapper");
88 is(@log[1], "foo", "got execpted value from original sub");
89
90 dies_ok { &foo.unwrap($wrapped) }, "can't re-unwrap an already unwrapped sub";
08292a3 merge wrapping.t into wrap.t
moritz authored
91
92 #First level wrapping
93 sub hi { "Hi" };
94 is( hi, "Hi", "Basic sub." );
95 my $handle;
96 lives_ok( { $handle = &hi.wrap({ callsame() ~ " there" }) },
97 "Basic wrapping works ");
98
99 ok( $handle, "Recieved handle for unwrapping." );
100 is( hi, "Hi there", "Function produces expected output after wrapping" );
101
102 #unwrap the handle
103 lives_ok { $handle = &hi.unwrap( $handle )}, "unwrap the function";
104
105 is( hi, "Hi", "Function is no longer wrapped." );
106
107 #Check 10 levels of wrapping
108 #useless function.
109 sub levelwrap($n) {
110 return $n;
111 }
112
113 # Make sure useless function does it's job.
114 is( levelwrap( 1 ), 1, "Sanity test." );
115 is( levelwrap( 2 ), 2, "Sanity test." );
116
f37fce0 @jnthn Unfudge some todo tests in wrap.t; fudge a test for .callwith, which we ...
jnthn authored
117 #?rakudo todo 'callwith'
08292a3 merge wrapping.t into wrap.t
moritz authored
118 lives_ok { &levelwrap.callwith( 1 )},
119 "Check that functions have a 'callwith' that works. ";
120
7552681 [t/spec] fudge wrap.t for rakudo, and simplify a bit
moritz authored
121 #?DOES 20
08292a3 merge wrapping.t into wrap.t
moritz authored
122 {
123 for (1..10) -> $num {
124 lives_ok {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
125 &levelwrap.wrap({
126 callwith( $^t + 1 );
127 }),
128 " Wrapping #$num"
08292a3 merge wrapping.t into wrap.t
moritz authored
129 }, "wrapping $num";
130 is( levelwrap( 1 ), 1 + $num, "Checking $num level wrapping" );
131 }
132 }
133
134 #Check removal of wrap in the middle by handle.
135 sub functionA {
136 return 'z';
137 }
138 is( functionA(), 'z', "Sanity." );
139 my $middle;
140 lives_ok { $middle = &functionA.wrap(sub { return 'y' ~ callsame })},
141 "First wrapping lived";
142 is( functionA(), "yz", "Middle wrapper sanity." );
143 lives_ok { &functionA.wrap(sub { return 'x' ~ callsame })},
144 'Second wraping lived';
145 is( functionA(), "xyz", "three wrappers sanity." );
146 lives_ok { &functionA.unwrap( $middle )}, 'unwrap the middle wrapper.';
147 is( functionA(), "xz", "First wrapper and final function only, middle removed." );
148
149 #temporization (end scope removal of wrapping)
b1a65f0 @lizmat Unfudges, skip -> todo and other clarifications in S06 testing
lizmat authored
150 sub functionB {
151 return 'xxx';
152 }
08292a3 merge wrapping.t into wrap.t
moritz authored
153 {
154 is( functionB, "xxx", "Sanity" );
155 {
156 try {
157 temp &functionB.wrap({ return 'yyy' });
158 };
159 is( functionB, 'yyy', 'Check that function is wrapped.' );
160 }
b1a65f0 @lizmat Unfudges, skip -> todo and other clarifications in S06 testing
lizmat authored
161 #?rakudo todo 'temp and wrap'
08292a3 merge wrapping.t into wrap.t
moritz authored
162 is( functionB, 'xxx', "Wrap is now out of scope, should be back to normal." );
163 }
b1a65f0 @lizmat Unfudges, skip -> todo and other clarifications in S06 testing
lizmat authored
164 #?rakudo todo 'temp and wrap'
165 is( functionB, 'xxx', "Wrap is now out of scope, should be back to normal." );
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
166
25668e6 @coke Prefer RT #XXXXXX
coke authored
167 #?rakudo todo 'RT #70267: call to nextsame with nowhere to go'
ea4ad2a [t/spec] Test for RT 70267: {nextsame}()
kyle authored
168 dies_ok { {nextsame}() }, '{nextsame}() dies properly';
169
d33a201 [t/spec] Test for RT 66658: .wrap gets lexicals confused
kyle authored
170 # RT #66658
0d74a86 @colomon Epic fudging for niecza.
colomon authored
171 #?niecza skip "undefined undefined"
d33a201 [t/spec] Test for RT 66658: .wrap gets lexicals confused
kyle authored
172 {
173 sub meet( $person ) { return "meet $person" }
174 sub greet( $person ) { return "greet $person" }
175
176 my $wrapped;
177
178 for &greet, &meet -> $wrap {
179 my $name = $wrap.name;
180 $wrap.wrap({ $wrapped = $name; callsame; });
181 }
182
183 ok ! $wrapped.defined, 'wrapper test variable is undefined';
184 is greet('japhb'), 'greet japhb', 'wrapped greet() works';
185 is $wrapped, 'greet', 'wrapper sees lexical from time of wrap (greet)';
186
187 undefine $wrapped;
188
189 ok ! $wrapped.defined, 'wrapper test variable is undefined';
190 is meet('masak'), 'meet masak', 'wrapped meet() works';
191 is $wrapped, 'meet', 'wrapper sees lexical from time of wrap (meet)';
192 }
193
2a3fab4 @jnthn Test for unwrapping using the handle itself.
jnthn authored
194 {
195 sub foo() { 1 }
196 my $h = &foo.wrap(-> { 1 + callsame });
197 is foo(), 2, 'wrap worked (sanity)';
198 $h.restore();
199 is foo(), 1, 'could unwrap by calling .restore on the handle';
200 }
201
2f7692d @moritz RT #69312, repeated &routine.wrap in a loop
moritz authored
202 # RT #69312
148f92c @coke rakudo.jvm fudge
coke authored
203 #?rakudo.jvm skip "control operator crossed continuation barrier"
2f7692d @moritz RT #69312, repeated &routine.wrap in a loop
moritz authored
204 {
205 my @t = gather {
206 sub triangle { take '=' x 3; }
207 for reverse ^3 -> $n {
208 &triangle.wrap({
209 take '=' x $n;
210 callsame;
211 take '=' x $n;
212 });
213 }
214 triangle();
215 }
216 is @t.join("\n"), "\n=\n==\n===\n==\n=\n", 'multiple wrappings in a loop';
217 }
218
aedecf7 @moritz failing test for RT #77472, wrap on a multi
moritz authored
219 # RT #77472
220 {
221 multi multi-to-wrap($x) {
222 $x * 2;
223 };
224 &multi-to-wrap.wrap({
225 2 * callsame;
226 });
5a33f7d @coke fudge for rakudo.parrot release
coke authored
227 #?rakudo.parrot todo "?"
adc10fd @coke fudge for rakudo.jvm release
coke authored
228 #?rakudo.jvm todo "?"
aedecf7 @moritz failing test for RT #77472, wrap on a multi
moritz authored
229 is multi-to-wrap(5), 20, 'can wrap a multi';
230 }
231
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
232 {
233 my $didfoo;
234
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
235 my role SomeTrait {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
236 method apply_handles($attr: Mu $pkg) {
237 my $name = $attr.name;
238 my $accessor = $name.subst(/^../, '');
239 my $r = sub ($obj, |args) is rw {
240 my (|c) ::= callsame;
241 c;
242 }
243 $pkg.^find_method($accessor).wrap($r);
244 }
245 method foo { $didfoo++ }
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
246 }
247
248 multi trait_mod:<is>(Attribute $var, :$wtf!) {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
249 die "Must have accessor" unless $var.has-accessor;
250 $var.set_rw;
251 $var does SomeTrait;
252 $var.foo;
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
253 }
254
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
255 my class foo {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
256 has $.x is rw is wtf = 16;
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
257 }
258
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
259 ok $didfoo, "Did foo, capture return";
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
260 my $foo = foo.new; # x = 16;
261 my $bar = foo.new(x => 32);
adc10fd @coke fudge for rakudo.jvm release
coke authored
262 #?rakudo.parrot 2 todo 'RT #122259'
263 #?rakudo.moar 2 todo 'RT #122259'
264 #?rakudo.jvm 3 skip 'RT #122259'
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
265 is $foo.x, 16, "default works with wrapped accessor, capture return";
266 is $bar.x, 32, "BUILD binding works with wrapped accessor, capture return";
267 try $bar.x = 64;
268 is $bar.x, 64, "assignment works with wrapped accessor, capture return";
269 }
270
271 {
272 my $didfoo;
273
274 my role SomeTrait {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
275 method apply_handles($attr: Mu $pkg) {
276 my $name = $attr.name;
277 my $accessor = $name.subst(/^../, '');
278 my $r = sub ($obj, |args) is rw {
279 return callsame;
280 }
281 $pkg.^find_method($accessor).wrap($r);
282 }
283 method foo { $didfoo++ }
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
284 }
285
286 multi trait_mod:<is>(Attribute $var, :$wtf!) {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
287 die "Must have accessor" unless $var.has-accessor;
288 $var.set_rw;
289 $var does SomeTrait;
290 $var.foo;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
291 }
292
293 my class foo {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
294 has $.x is rw is wtf = 16;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
295 }
296
297 ok $didfoo, "Did foo, return callsame";
298 my $foo = foo.new; # x = 16;
299 my $bar = foo.new(x => 32);
300 is $foo.x, 16, "default works with wrapped accessor, return callsame";
301 is $bar.x, 32, "BUILD binding works with wrapped accessor, return callsame";
302 try $bar.x = 64;
d9f950a @lizmat Fudge tests for RT #122259
lizmat authored
303 #?rakudo todo 'RT #122259'
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
304 is $bar.x, 64, "assignment works with wrapped accessor, return callsame";
305 }
306
307 {
308 my $didfoo;
309
310 my role SomeTrait {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
311 method apply_handles($attr: Mu $pkg) {
312 my $name = $attr.name;
313 my $accessor = $name.subst(/^../, '');
314 my $r = sub ($obj, |args) is rw {
315 callsame;
316 }
317 $pkg.^find_method($accessor).wrap($r);
318 }
319 method foo { $didfoo++ }
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
320 }
321
322 multi trait_mod:<is>(Attribute $var, :$wtf!) {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
323 die "Must have accessor" unless $var.has-accessor;
324 $var.set_rw;
325 $var does SomeTrait;
326 $var.foo;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
327 }
328
329 my class foo {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
330 has $.x is rw is wtf = 16;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
331 }
332
333 ok $didfoo, "Did foo, callsame";
334 my $foo = foo.new; # x = 16;
335 my $bar = foo.new(x => 32);
336 is $foo.x, 16, "default works with wrapped accessor, callsame";
337 is $bar.x, 32, "BUILD binding works with wrapped accessor, callsame";
338 try $bar.x = 64;
339 is $bar.x, 64, "assignment works with wrapped accessor, callsame";
340 }
341
342 {
343 my $didfoo;
344
345 my role SomeTrait {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
346 method apply_handles($attr: Mu $pkg) {
347 my $name = $attr.name;
348 my $accessor = $name.subst(/^../, '');
349 my $r = sub ($obj, |args) is rw {
350 nextsame;
351 }
352 $pkg.^find_method($accessor).wrap($r);
353 }
354 method foo { $didfoo++ }
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
355 }
356
357 multi trait_mod:<is>(Attribute $var, :$wtf!) {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
358 die "Must have accessor" unless $var.has-accessor;
359 $var.set_rw;
360 $var does SomeTrait;
361 $var.foo;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
362 }
363
364 my class foo {
6429cf8 @lizmat De-tab and get indenting right
lizmat authored
365 has $.x is rw is wtf = 16;
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
366 }
367
368 ok $didfoo, "Did foo, nextsame";
369 my $foo = foo.new; # x = 16;
370 my $bar = foo.new(x => 32);
371 is $foo.x, 16, "default works with wrapped accessor, nextsame";
372 is $bar.x, 32, "BUILD binding works with wrapped accessor, nextsame";
373 try $bar.x = 64;
d9f950a @lizmat Fudge tests for RT #122259
lizmat authored
374 #?rakudo todo 'RT #122259'
d48718f @TimToady test more ways of returning a wrapped rw accessor
TimToady authored
375 is $bar.x, 64, "assignment works with wrapped accessor, nextsame";
e257fed @TimToady add tests for wrapped rw accessors
TimToady authored
376 }
377
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
378 # vim: ft=perl6
Something went wrong with that request. Please try again.