Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 206 lines (154 sloc) 5.039 kB
288e046 [t] and [t/spec]
moritz authored
1 use v6;
2
3 use Test;
4
5 # L<S06/Wrapping>
6
7 # TODO
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
8 # nextsame, nextwith, callsame
9 # unwrap with no args pops the top most (is this spec?)
288e046 [t] and [t/spec]
moritz authored
10 #
11 # mutating wraps -- those should be "deep", as in not touching coderefs
12 # but actually mutating how the coderef works.
13
2a3fab4 @jnthn Test for unwrapping using the handle itself.
jnthn authored
14 plan 66;
288e046 [t] and [t/spec]
moritz authored
15
16 my @log;
17
18 sub foo {
19 push @log, "foo";
20 }
21
22 sub wrapper {
23 push @log, "wrapper before";
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
24 try { callwith() };
288e046 [t] and [t/spec]
moritz authored
25 push @log, "wrapper after";
26 }
27
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
28 sub other_wrapper () {
288e046 [t] and [t/spec]
moritz authored
29 push @log, "wrapper2";
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
30 try { callwith() };
288e046 [t] and [t/spec]
moritz authored
31 }
32
33 foo();
34 is(+@log, 1, "one event logged");
35 is(@log[0], "foo", "it's foo");
36
19afa8a [t/spec] Tests for out-of-order unwrapping and making sure re-unwrapp…
jnthn authored
37 dies_ok { &foo.unwrap() }, 'cannot upwrap a never-wrapped sub.';
38
288e046 [t] and [t/spec]
moritz authored
39 @log = ();
40
41 wrapper();
42 is(+@log, 2, "two events logged");
43 is(@log[0], "wrapper before", "wrapper before");
44 is(@log[1], "wrapper after", "wrapper after");
45
46 @log = ();
47
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
48 my $wrapped = &foo.wrap(&wrapper);
288e046 [t] and [t/spec]
moritz authored
49
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
50 foo();
288e046 [t] and [t/spec]
moritz authored
51
7552681 [t/spec] fudge wrap.t for rakudo, and simplify a bit
moritz authored
52 is @log.join('|'), 'wrapper before|foo|wrapper after', 'logged the correct events';
288e046 [t] and [t/spec]
moritz authored
53
54 @log = ();
55
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
56 my $doublywrapped = &foo.wrap(&other_wrapper);
57 foo();
288e046 [t] and [t/spec]
moritz authored
58
59 is(+@log, 4, "four events");
60 is(@log[0], "wrapper2", "additional wrapping takes effect");
61 is(@log[1], "wrapper before", "... on top of initial wrapping");
62
63 @log = ();
64
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
65 &foo.unwrap($doublywrapped);
66 foo();
67
288e046 [t] and [t/spec]
moritz authored
68 is(+@log, 3, "old wrapped sub was not destroyed");
69 is(@log[0], "wrapper before", "the original wrapper is still in effect");
70
71 @log = ();
72
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
73 &foo.unwrap($wrapped);
74 foo();
288e046 [t] and [t/spec]
moritz authored
75
a3ec362 Review, correct and simplify (as in relying on less unrelated feature…
jnthn authored
76 is(+@log, 1, "one events for unwrapped (should be back to original now)");
77 is(@log[0], "foo", "got execpted value");
19afa8a [t/spec] Tests for out-of-order unwrapping and making sure re-unwrapp…
jnthn authored
78
79 @log = ();
80
81 $wrapped = &foo.wrap(&wrapper);
82 $doublywrapped = &foo.wrap(&other_wrapper);
83 &foo.unwrap($wrapped);
84 foo();
85 is(+@log, 2, "out of order unwrapping gave right number of results");
86 is(@log[0], "wrapper2", "got execpted value from remaining wrapper");
87 is(@log[1], "foo", "got execpted value from original sub");
88
89 dies_ok { &foo.unwrap($wrapped) }, "can't re-unwrap an already unwrapped sub";
08292a3 merge wrapping.t into wrap.t
moritz authored
90
91
92
93 # from wrapping.t
94
95 #First level wrapping
96 sub hi { "Hi" };
97 is( hi, "Hi", "Basic sub." );
98 my $handle;
99 lives_ok( { $handle = &hi.wrap({ callsame() ~ " there" }) },
100 "Basic wrapping works ");
101
102 ok( $handle, "Recieved handle for unwrapping." );
103 is( hi, "Hi there", "Function produces expected output after wrapping" );
104
105 #unwrap the handle
106 lives_ok { $handle = &hi.unwrap( $handle )}, "unwrap the function";
107
108 is( hi, "Hi", "Function is no longer wrapped." );
109
110 #Check 10 levels of wrapping
111 #useless function.
112 sub levelwrap($n) {
113 return $n;
114 }
115
116 # Make sure useless function does it's job.
117 is( levelwrap( 1 ), 1, "Sanity test." );
118 is( levelwrap( 2 ), 2, "Sanity test." );
119
f37fce0 @jnthn Unfudge some todo tests in wrap.t; fudge a test for .callwith, which …
jnthn authored
120 #?rakudo todo 'callwith'
08292a3 merge wrapping.t into wrap.t
moritz authored
121 lives_ok { &levelwrap.callwith( 1 )},
122 "Check that functions have a 'callwith' that works. ";
123
7552681 [t/spec] fudge wrap.t for rakudo, and simplify a bit
moritz authored
124 #?DOES 20
08292a3 merge wrapping.t into wrap.t
moritz authored
125 {
126 for (1..10) -> $num {
127 lives_ok {
128 &levelwrap.wrap({
129 callwith( $^t + 1 );
130 }),
131 " Wrapping #$num"
132 }, "wrapping $num";
133 is( levelwrap( 1 ), 1 + $num, "Checking $num level wrapping" );
134 }
135 }
136
137 #Check removal of wrap in the middle by handle.
138 sub functionA {
139 return 'z';
140 }
141 is( functionA(), 'z', "Sanity." );
142 my $middle;
143 lives_ok { $middle = &functionA.wrap(sub { return 'y' ~ callsame })},
144 "First wrapping lived";
145 is( functionA(), "yz", "Middle wrapper sanity." );
146 lives_ok { &functionA.wrap(sub { return 'x' ~ callsame })},
147 'Second wraping lived';
148 is( functionA(), "xyz", "three wrappers sanity." );
149 lives_ok { &functionA.unwrap( $middle )}, 'unwrap the middle wrapper.';
150 is( functionA(), "xz", "First wrapper and final function only, middle removed." );
151
152 #temporization (end scope removal of wrapping)
153 #?rakudo skip 'temp and wrap'
154 {
155 sub functionB {
156 return 'xxx';
157 }
158 is( functionB, "xxx", "Sanity" );
159 {
160 try {
161 temp &functionB.wrap({ return 'yyy' });
162 };
163 is( functionB, 'yyy', 'Check that function is wrapped.' );
164 }
165 is( functionB, 'xxx', "Wrap is now out of scope, should be back to normal." );
166 }
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
167
251efb0 @jnthn A bunch more unfudging for wrap.t; think we pass more of this now tha…
jnthn authored
168 #?rakudo todo 'RT 70267: call to nextsame with nowhere to go'
ea4ad2a [t/spec] Test for RT 70267: {nextsame}()
kyle authored
169 dies_ok { {nextsame}() }, '{nextsame}() dies properly';
170
d33a201 [t/spec] Test for RT 66658: .wrap gets lexicals confused
kyle authored
171 # RT #66658
0d74a86 @colomon Epic fudging for niecza.
colomon authored
172 #?niecza skip "undefined undefined"
d33a201 [t/spec] Test for RT 66658: .wrap gets lexicals confused
kyle authored
173 {
174 sub meet( $person ) { return "meet $person" }
175 sub greet( $person ) { return "greet $person" }
176
177 my $wrapped;
178
179 for &greet, &meet -> $wrap {
180 my $name = $wrap.name;
181 $wrap.wrap({ $wrapped = $name; callsame; });
182 }
183
184 ok ! $wrapped.defined, 'wrapper test variable is undefined';
185 is greet('japhb'), 'greet japhb', 'wrapped greet() works';
186 is $wrapped, 'greet', 'wrapper sees lexical from time of wrap (greet)';
187
188 undefine $wrapped;
189
190 ok ! $wrapped.defined, 'wrapper test variable is undefined';
191 is meet('masak'), 'meet masak', 'wrapped meet() works';
192 is $wrapped, 'meet', 'wrapper sees lexical from time of wrap (meet)';
193 }
194
2a3fab4 @jnthn Test for unwrapping using the handle itself.
jnthn authored
195 {
196 sub foo() { 1 }
197 my $h = &foo.wrap(-> { 1 + callsame });
198 is foo(), 2, 'wrap worked (sanity)';
199 $h.restore();
200 is foo(), 1, 'could unwrap by calling .restore on the handle';
201 }
202
e76dd4c @moritz s/done_testing/done/ as per recent S24 changes
moritz authored
203 done;
ea4ad2a [t/spec] Test for RT 70267: {nextsame}()
kyle authored
204
7f29bc5 [t/spec] Add vim: lines everywhere.
kyle authored
205 # vim: ft=perl6
Something went wrong with that request. Please try again.