libperl leaks a THREAD_KEY each time it is reloaded
[p5sagit/p5-mst-13.2.git] / ext / B / t / optree_samples.t
1 #!perl
2
3 BEGIN {
4     if ($ENV{PERL_CORE}){
5         chdir('t') if -d 't';
6         @INC = ('.', '../lib', '../ext/B/t');
7     } else {
8         unshift @INC, 't';
9         push @INC, "../../t";
10     }
11     require Config;
12     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
13         print "1..0 # Skip -- Perl configured without B module\n";
14         exit 0;
15     }
16     if ($Config::Config{'extensions'} !~ /\bData\/Dumper\b/) {
17         print
18             "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
19         exit 0;
20     }
21     if ($] < 5.009) {
22         print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
23         exit 0;
24     }
25     require 'test.pl';
26 }
27 use OptreeCheck;
28 use Config;
29 plan tests      => 20;
30 SKIP: {
31     skip "no perlio in this build", 20 unless $Config::Config{useperlio};
32
33 pass("GENERAL OPTREE EXAMPLES");
34
35 pass("IF,THEN,ELSE, ?:");
36
37 checkOptree ( name      => '-basic sub {if shift print then,else}',
38               bcopts    => '-basic',
39               code      => sub { if (shift) { print "then" }
40                                  else       { print "else" }
41                              },
42               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
43 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
44 # -     <@> lineseq KP ->9
45 # 1        <;> nextstate(main 426 optree.t:16) v ->2
46 # -        <1> null K/1 ->-
47 # 5           <|> cond_expr(other->6) K/1 ->a
48 # 4              <1> shift sK/1 ->5
49 # 3                 <1> rv2av[t2] sKRM/1 ->4
50 # 2                    <#> gv[*_] s ->3
51 # -              <@> scope K ->-
52 # -                 <0> ex-nextstate v ->6
53 # 8                 <@> print sK ->9
54 # 6                    <0> pushmark s ->7
55 # 7                    <$> const[PV "then"] s ->8
56 # f              <@> leave KP ->9
57 # a                 <0> enter ->b
58 # b                 <;> nextstate(main 424 optree.t:17) v ->c
59 # e                 <@> print sK ->f
60 # c                    <0> pushmark s ->d
61 # d                    <$> const[PV "else"] s ->e
62 EOT_EOT
63 # 9  <1> leavesub[1 ref] K/REFC,1 ->(end)
64 # -     <@> lineseq KP ->9
65 # 1        <;> nextstate(main 427 optree_samples.t:18) v ->2
66 # -        <1> null K/1 ->-
67 # 5           <|> cond_expr(other->6) K/1 ->a
68 # 4              <1> shift sK/1 ->5
69 # 3                 <1> rv2av[t1] sKRM/1 ->4
70 # 2                    <$> gv(*_) s ->3
71 # -              <@> scope K ->-
72 # -                 <0> ex-nextstate v ->6
73 # 8                 <@> print sK ->9
74 # 6                    <0> pushmark s ->7
75 # 7                    <$> const(PV "then") s ->8
76 # f              <@> leave KP ->9
77 # a                 <0> enter ->b
78 # b                 <;> nextstate(main 425 optree_samples.t:19) v ->c
79 # e                 <@> print sK ->f
80 # c                    <0> pushmark s ->d
81 # d                    <$> const(PV "else") s ->e
82 EONT_EONT
83
84 checkOptree ( name      => '-basic (see above, with my $a = shift)',
85               bcopts    => '-basic',
86               code      => sub { my $a = shift;
87                                  if ($a) { print "foo" }
88                                  else    { print "bar" }
89                              },
90               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
91 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
92 # -     <@> lineseq KP ->d
93 # 1        <;> nextstate(main 431 optree.t:68) v ->2
94 # 6        <2> sassign vKS/2 ->7
95 # 4           <1> shift sK/1 ->5
96 # 3              <1> rv2av[t3] sKRM/1 ->4
97 # 2                 <#> gv[*_] s ->3
98 # 5           <0> padsv[$a:431,435] sRM*/LVINTRO ->6
99 # 7        <;> nextstate(main 435 optree.t:69) v ->8
100 # -        <1> null K/1 ->-
101 # 9           <|> cond_expr(other->a) K/1 ->e
102 # 8              <0> padsv[$a:431,435] s ->9
103 # -              <@> scope K ->-
104 # -                 <0> ex-nextstate v ->a
105 # c                 <@> print sK ->d
106 # a                    <0> pushmark s ->b
107 # b                    <$> const[PV "foo"] s ->c
108 # j              <@> leave KP ->d
109 # e                 <0> enter ->f
110 # f                 <;> nextstate(main 433 optree.t:70) v ->g
111 # i                 <@> print sK ->j
112 # g                    <0> pushmark s ->h
113 # h                    <$> const[PV "bar"] s ->i
114 EOT_EOT
115 # d  <1> leavesub[1 ref] K/REFC,1 ->(end)
116 # -     <@> lineseq KP ->d
117 # 1        <;> nextstate(main 428 optree_samples.t:48) v ->2
118 # 6        <2> sassign vKS/2 ->7
119 # 4           <1> shift sK/1 ->5
120 # 3              <1> rv2av[t2] sKRM/1 ->4
121 # 2                 <$> gv(*_) s ->3
122 # 5           <0> padsv[$a:428,432] sRM*/LVINTRO ->6
123 # 7        <;> nextstate(main 432 optree_samples.t:49) v ->8
124 # -        <1> null K/1 ->-
125 # 9           <|> cond_expr(other->a) K/1 ->e
126 # 8              <0> padsv[$a:428,432] s ->9
127 # -              <@> scope K ->-
128 # -                 <0> ex-nextstate v ->a
129 # c                 <@> print sK ->d
130 # a                    <0> pushmark s ->b
131 # b                    <$> const(PV "foo") s ->c
132 # j              <@> leave KP ->d
133 # e                 <0> enter ->f
134 # f                 <;> nextstate(main 430 optree_samples.t:50) v ->g
135 # i                 <@> print sK ->j
136 # g                    <0> pushmark s ->h
137 # h                    <$> const(PV "bar") s ->i
138 EONT_EONT
139
140 checkOptree ( name      => '-exec sub {if shift print then,else}',
141               bcopts    => '-exec',
142               code      => sub { if (shift) { print "then" }
143                                  else       { print "else" }
144                              },
145               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
146 # 1  <;> nextstate(main 426 optree.t:16) v
147 # 2  <#> gv[*_] s
148 # 3  <1> rv2av[t2] sKRM/1
149 # 4  <1> shift sK/1
150 # 5  <|> cond_expr(other->6) K/1
151 # 6      <0> pushmark s
152 # 7      <$> const[PV "then"] s
153 # 8      <@> print sK
154 #            goto 9
155 # a  <0> enter 
156 # b  <;> nextstate(main 424 optree.t:17) v
157 # c  <0> pushmark s
158 # d  <$> const[PV "else"] s
159 # e  <@> print sK
160 # f  <@> leave KP
161 # 9  <1> leavesub[1 ref] K/REFC,1
162 EOT_EOT
163 # 1  <;> nextstate(main 436 optree_samples.t:123) v
164 # 2  <$> gv(*_) s
165 # 3  <1> rv2av[t1] sKRM/1
166 # 4  <1> shift sK/1
167 # 5  <|> cond_expr(other->6) K/1
168 # 6      <0> pushmark s
169 # 7      <$> const(PV "then") s
170 # 8      <@> print sK
171 #            goto 9
172 # a  <0> enter 
173 # b  <;> nextstate(main 434 optree_samples.t:124) v
174 # c  <0> pushmark s
175 # d  <$> const(PV "else") s
176 # e  <@> print sK
177 # f  <@> leave KP
178 # 9  <1> leavesub[1 ref] K/REFC,1
179 EONT_EONT
180
181 checkOptree ( name      => '-exec (see above, with my $a = shift)',
182               bcopts    => '-exec',
183               code      => sub { my $a = shift;
184                                  if ($a) { print "foo" }
185                                  else    { print "bar" }
186                              },
187               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
188 # 1  <;> nextstate(main 423 optree.t:16) v
189 # 2  <#> gv[*_] s
190 # 3  <1> rv2av[t3] sKRM/1
191 # 4  <1> shift sK/1
192 # 5  <0> padsv[$a:423,427] sRM*/LVINTRO
193 # 6  <2> sassign vKS/2
194 # 7  <;> nextstate(main 427 optree.t:17) v
195 # 8  <0> padsv[$a:423,427] s
196 # 9  <|> cond_expr(other->a) K/1
197 # a      <0> pushmark s
198 # b      <$> const[PV "foo"] s
199 # c      <@> print sK
200 #            goto d
201 # e  <0> enter 
202 # f  <;> nextstate(main 425 optree.t:18) v
203 # g  <0> pushmark s
204 # h  <$> const[PV "bar"] s
205 # i  <@> print sK
206 # j  <@> leave KP
207 # d  <1> leavesub[1 ref] K/REFC,1
208 EOT_EOT
209 # 1  <;> nextstate(main 437 optree_samples.t:112) v
210 # 2  <$> gv(*_) s
211 # 3  <1> rv2av[t2] sKRM/1
212 # 4  <1> shift sK/1
213 # 5  <0> padsv[$a:437,441] sRM*/LVINTRO
214 # 6  <2> sassign vKS/2
215 # 7  <;> nextstate(main 441 optree_samples.t:113) v
216 # 8  <0> padsv[$a:437,441] s
217 # 9  <|> cond_expr(other->a) K/1
218 # a      <0> pushmark s
219 # b      <$> const(PV "foo") s
220 # c      <@> print sK
221 #            goto d
222 # e  <0> enter 
223 # f  <;> nextstate(main 439 optree_samples.t:114) v
224 # g  <0> pushmark s
225 # h  <$> const(PV "bar") s
226 # i  <@> print sK
227 # j  <@> leave KP
228 # d  <1> leavesub[1 ref] K/REFC,1
229 EONT_EONT
230
231 checkOptree ( name      => '-exec sub { print (shift) ? "foo" : "bar" }',
232               code      => sub { print (shift) ? "foo" : "bar" },
233               bcopts    => '-exec',
234               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
235 # 1  <;> nextstate(main 428 optree.t:31) v
236 # 2  <0> pushmark s
237 # 3  <#> gv[*_] s
238 # 4  <1> rv2av[t2] sKRM/1
239 # 5  <1> shift sK/1
240 # 6  <@> print sK
241 # 7  <|> cond_expr(other->8) K/1
242 # 8      <$> const[PV "foo"] s
243 #            goto 9
244 # a  <$> const[PV "bar"] s
245 # 9  <1> leavesub[1 ref] K/REFC,1
246 EOT_EOT
247 # 1  <;> nextstate(main 442 optree_samples.t:144) v
248 # 2  <0> pushmark s
249 # 3  <$> gv(*_) s
250 # 4  <1> rv2av[t1] sKRM/1
251 # 5  <1> shift sK/1
252 # 6  <@> print sK
253 # 7  <|> cond_expr(other->8) K/1
254 # 8      <$> const(PV "foo") s
255 #            goto 9
256 # a  <$> const(PV "bar") s
257 # 9  <1> leavesub[1 ref] K/REFC,1
258 EONT_EONT
259
260 pass ("FOREACH");
261
262 checkOptree ( name      => '-exec sub { foreach (1..10) {print "foo $_"} }',
263               code      => sub { foreach (1..10) {print "foo $_"} },
264               bcopts    => '-exec',
265               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
266 # 1  <;> nextstate(main 443 optree.t:158) v
267 # 2  <0> pushmark s
268 # 3  <$> const[IV 1] s
269 # 4  <$> const[IV 10] s
270 # 5  <#> gv[*_] s
271 # 6  <{> enteriter(next->d last->g redo->7) lKS
272 # e  <0> iter s
273 # f  <|> and(other->7) K/1
274 # 7      <;> nextstate(main 442 optree.t:158) v
275 # 8      <0> pushmark s
276 # 9      <$> const[PV "foo "] s
277 # a      <#> gvsv[*_] s
278 # b      <2> concat[t4] sK/2
279 # c      <@> print vK
280 # d      <0> unstack s
281 #            goto e
282 # g  <2> leaveloop K/2
283 # h  <1> leavesub[1 ref] K/REFC,1
284 EOT_EOT
285 # 1  <;> nextstate(main 444 optree_samples.t:182) v
286 # 2  <0> pushmark s
287 # 3  <$> const(IV 1) s
288 # 4  <$> const(IV 10) s
289 # 5  <$> gv(*_) s
290 # 6  <{> enteriter(next->d last->g redo->7) lKS
291 # e  <0> iter s
292 # f  <|> and(other->7) K/1
293 # 7      <;> nextstate(main 443 optree_samples.t:182) v
294 # 8      <0> pushmark s
295 # 9      <$> const(PV "foo ") s
296 # a      <$> gvsv(*_) s
297 # b      <2> concat[t3] sK/2
298 # c      <@> print vK
299 # d      <0> unstack s
300 #            goto e
301 # g  <2> leaveloop K/2
302 # h  <1> leavesub[1 ref] K/REFC,1
303 EONT_EONT
304
305 checkOptree ( name      => '-basic sub { print "foo $_" foreach (1..10) }',
306               code      => sub { print "foo $_" foreach (1..10) }, 
307               bcopts    => '-basic',
308               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
309 # h  <1> leavesub[1 ref] K/REFC,1 ->(end)
310 # -     <@> lineseq KP ->h
311 # 1        <;> nextstate(main 445 optree.t:167) v ->2
312 # 2        <;> nextstate(main 445 optree.t:167) v ->3
313 # g        <2> leaveloop K/2 ->h
314 # 7           <{> enteriter(next->d last->g redo->8) lKS ->e
315 # -              <0> ex-pushmark s ->3
316 # -              <1> ex-list lK ->6
317 # 3                 <0> pushmark s ->4
318 # 4                 <$> const[IV 1] s ->5
319 # 5                 <$> const[IV 10] s ->6
320 # 6              <#> gv[*_] s ->7
321 # -           <1> null K/1 ->g
322 # f              <|> and(other->8) K/1 ->g
323 # e                 <0> iter s ->f
324 # -                 <@> lineseq sK ->-
325 # c                    <@> print vK ->d
326 # 8                       <0> pushmark s ->9
327 # -                       <1> ex-stringify sK/1 ->c
328 # -                          <0> ex-pushmark s ->9
329 # b                          <2> concat[t2] sK/2 ->c
330 # 9                             <$> const[PV "foo "] s ->a
331 # -                             <1> ex-rv2sv sK/1 ->b
332 # a                                <#> gvsv[*_] s ->b
333 # d                    <0> unstack s ->e
334 EOT_EOT
335 # h  <1> leavesub[1 ref] K/REFC,1 ->(end)
336 # -     <@> lineseq KP ->h
337 # 1        <;> nextstate(main 446 optree_samples.t:192) v ->2
338 # 2        <;> nextstate(main 446 optree_samples.t:192) v ->3
339 # g        <2> leaveloop K/2 ->h
340 # 7           <{> enteriter(next->d last->g redo->8) lKS ->e
341 # -              <0> ex-pushmark s ->3
342 # -              <1> ex-list lK ->6
343 # 3                 <0> pushmark s ->4
344 # 4                 <$> const(IV 1) s ->5
345 # 5                 <$> const(IV 10) s ->6
346 # 6              <$> gv(*_) s ->7
347 # -           <1> null K/1 ->g
348 # f              <|> and(other->8) K/1 ->g
349 # e                 <0> iter s ->f
350 # -                 <@> lineseq sK ->-
351 # c                    <@> print vK ->d
352 # 8                       <0> pushmark s ->9
353 # -                       <1> ex-stringify sK/1 ->c
354 # -                          <0> ex-pushmark s ->9
355 # b                          <2> concat[t1] sK/2 ->c
356 # 9                             <$> const(PV "foo ") s ->a
357 # -                             <1> ex-rv2sv sK/1 ->b
358 # a                                <$> gvsv(*_) s ->b
359 # d                    <0> unstack s ->e
360 EONT_EONT
361
362 checkOptree ( name      => '-exec -e foreach (1..10) {print qq{foo $_}}',
363               prog      => 'foreach (1..10) {print qq{foo $_}}',
364               bcopts    => '-exec',
365               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
366 # 1  <0> enter 
367 # 2  <;> nextstate(main 2 -e:1) v
368 # 3  <0> pushmark s
369 # 4  <$> const[IV 1] s
370 # 5  <$> const[IV 10] s
371 # 6  <#> gv[*_] s
372 # 7  <{> enteriter(next->e last->h redo->8) lKS
373 # f  <0> iter s
374 # g  <|> and(other->8) vK/1
375 # 8      <;> nextstate(main 1 -e:1) v
376 # 9      <0> pushmark s
377 # a      <$> const[PV "foo "] s
378 # b      <#> gvsv[*_] s
379 # c      <2> concat[t4] sK/2
380 # d      <@> print vK
381 # e      <0> unstack v
382 #            goto f
383 # h  <2> leaveloop vK/2
384 # i  <@> leave[1 ref] vKP/REFC
385 EOT_EOT
386 # 1  <0> enter 
387 # 2  <;> nextstate(main 2 -e:1) v
388 # 3  <0> pushmark s
389 # 4  <$> const(IV 1) s
390 # 5  <$> const(IV 10) s
391 # 6  <$> gv(*_) s
392 # 7  <{> enteriter(next->e last->h redo->8) lKS
393 # f  <0> iter s
394 # g  <|> and(other->8) vK/1
395 # 8      <;> nextstate(main 1 -e:1) v
396 # 9      <0> pushmark s
397 # a      <$> const(PV "foo ") s
398 # b      <$> gvsv(*_) s
399 # c      <2> concat[t3] sK/2
400 # d      <@> print vK
401 # e      <0> unstack v
402 #            goto f
403 # h  <2> leaveloop vK/2
404 # i  <@> leave[1 ref] vKP/REFC
405 EONT_EONT
406
407 checkOptree ( name      => '-exec sub { print "foo $_" foreach (1..10) }',
408               code      => sub { print "foo $_" foreach (1..10) }, 
409               bcopts    => '-exec',
410               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
411 # 1  <;> nextstate(main 445 optree.t:167) v
412 # 2  <;> nextstate(main 445 optree.t:167) v
413 # 3  <0> pushmark s
414 # 4  <$> const[IV 1] s
415 # 5  <$> const[IV 10] s
416 # 6  <#> gv[*_] s
417 # 7  <{> enteriter(next->d last->g redo->8) lKS
418 # e  <0> iter s
419 # f  <|> and(other->8) K/1
420 # 8      <0> pushmark s
421 # 9      <$> const[PV "foo "] s
422 # a      <#> gvsv[*_] s
423 # b      <2> concat[t2] sK/2
424 # c      <@> print vK
425 # d      <0> unstack s
426 #            goto e
427 # g  <2> leaveloop K/2
428 # h  <1> leavesub[1 ref] K/REFC,1
429 EOT_EOT
430 # 1  <;> nextstate(main 447 optree_samples.t:252) v
431 # 2  <;> nextstate(main 447 optree_samples.t:252) v
432 # 3  <0> pushmark s
433 # 4  <$> const(IV 1) s
434 # 5  <$> const(IV 10) s
435 # 6  <$> gv(*_) s
436 # 7  <{> enteriter(next->d last->g redo->8) lKS
437 # e  <0> iter s
438 # f  <|> and(other->8) K/1
439 # 8      <0> pushmark s
440 # 9      <$> const(PV "foo ") s
441 # a      <$> gvsv(*_) s
442 # b      <2> concat[t1] sK/2
443 # c      <@> print vK
444 # d      <0> unstack s
445 #            goto e
446 # g  <2> leaveloop K/2
447 # h  <1> leavesub[1 ref] K/REFC,1
448 EONT_EONT
449
450 pass("GREP: SAMPLES FROM PERLDOC -F GREP");
451
452 checkOptree ( name      => '@foo = grep(!/^\#/, @bar)',
453               code      => '@foo = grep(!/^\#/, @bar)',
454               bcopts    => '-exec',
455               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
456 # 1  <;> nextstate(main 496 (eval 20):1) v
457 # 2  <0> pushmark s
458 # 3  <0> pushmark s
459 # 4  <#> gv[*bar] s
460 # 5  <1> rv2av[t4] lKM/1
461 # 6  <@> grepstart lK
462 # 7  <|> grepwhile(other->8)[t5] lK
463 # 8      </> match(/"^#"/) s/RTIME
464 # 9      <1> not sK/1
465 #            goto 7
466 # a  <0> pushmark s
467 # b  <#> gv[*foo] s
468 # c  <1> rv2av[t2] lKRM*/1
469 # d  <2> aassign[t6] KS/COMMON
470 # e  <1> leavesub[1 ref] K/REFC,1
471 EOT_EOT
472 # 1  <;> nextstate(main 496 (eval 20):1) v
473 # 2  <0> pushmark s
474 # 3  <0> pushmark s
475 # 4  <$> gv(*bar) s
476 # 5  <1> rv2av[t2] lKM/1
477 # 6  <@> grepstart lK
478 # 7  <|> grepwhile(other->8)[t3] lK
479 # 8      </> match(/"^\\#"/) s/RTIME
480 # 9      <1> not sK/1
481 #            goto 7
482 # a  <0> pushmark s
483 # b  <$> gv(*foo) s
484 # c  <1> rv2av[t1] lKRM*/1
485 # d  <2> aassign[t4] KS/COMMON
486 # e  <1> leavesub[1 ref] K/REFC,1
487 EONT_EONT
488
489
490 pass("MAP: SAMPLES FROM PERLDOC -F MAP");
491
492 checkOptree ( name      => '%h = map { getkey($_) => $_ } @a',
493               code      => '%h = map { getkey($_) => $_ } @a',
494               bcopts    => '-exec',
495               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
496 # 1  <;> nextstate(main 501 (eval 22):1) v
497 # 2  <0> pushmark s
498 # 3  <0> pushmark s
499 # 4  <#> gv[*a] s
500 # 5  <1> rv2av[t8] lKM/1
501 # 6  <@> mapstart lK*
502 # 7  <|> mapwhile(other->8)[t9] lK
503 # 8      <0> enter l
504 # 9      <;> nextstate(main 500 (eval 22):1) v
505 # a      <0> pushmark s
506 # b      <0> pushmark s
507 # c      <#> gvsv[*_] s
508 # d      <#> gv[*getkey] s/EARLYCV
509 # e      <1> entersub[t5] lKS/TARG,1
510 # f      <#> gvsv[*_] s
511 # g      <@> list lK
512 # h      <@> leave lKP
513 #            goto 7
514 # i  <0> pushmark s
515 # j  <#> gv[*h] s
516 # k  <1> rv2hv[t2] lKRM*/1
517 # l  <2> aassign[t10] KS/COMMON
518 # m  <1> leavesub[1 ref] K/REFC,1
519 EOT_EOT
520 # 1  <;> nextstate(main 501 (eval 22):1) v
521 # 2  <0> pushmark s
522 # 3  <0> pushmark s
523 # 4  <$> gv(*a) s
524 # 5  <1> rv2av[t3] lKM/1
525 # 6  <@> mapstart lK*
526 # 7  <|> mapwhile(other->8)[t4] lK
527 # 8      <0> enter l
528 # 9      <;> nextstate(main 500 (eval 22):1) v
529 # a      <0> pushmark s
530 # b      <0> pushmark s
531 # c      <$> gvsv(*_) s
532 # d      <$> gv(*getkey) s/EARLYCV
533 # e      <1> entersub[t2] lKS/TARG,1
534 # f      <$> gvsv(*_) s
535 # g      <@> list lK
536 # h      <@> leave lKP
537 #            goto 7
538 # i  <0> pushmark s
539 # j  <$> gv(*h) s
540 # k  <1> rv2hv[t1] lKRM*/1
541 # l  <2> aassign[t5] KS/COMMON
542 # m  <1> leavesub[1 ref] K/REFC,1
543 EONT_EONT
544
545 checkOptree ( name      => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
546               code      => '%h=(); for $_(@a){$h{getkey($_)} = $_}',
547               bcopts    => '-exec',
548               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
549 # 1  <;> nextstate(main 505 (eval 24):1) v
550 # 2  <0> pushmark s
551 # 3  <0> pushmark s
552 # 4  <#> gv[*h] s
553 # 5  <1> rv2hv[t2] lKRM*/1
554 # 6  <2> aassign[t3] vKS
555 # 7  <;> nextstate(main 506 (eval 24):1) v
556 # 8  <0> pushmark sM
557 # 9  <#> gv[*a] s
558 # a  <1> rv2av[t6] sKRM/1
559 # b  <#> gv[*_] s
560 # c  <1> rv2gv sKRM/1
561 # d  <{> enteriter(next->o last->r redo->e) lKS
562 # p  <0> iter s
563 # q  <|> and(other->e) K/1
564 # e      <;> nextstate(main 505 (eval 24):1) v
565 # f      <#> gvsv[*_] s
566 # g      <#> gv[*h] s
567 # h      <1> rv2hv sKR/1
568 # i      <0> pushmark s
569 # j      <#> gvsv[*_] s
570 # k      <#> gv[*getkey] s/EARLYCV
571 # l      <1> entersub[t10] sKS/TARG,1
572 # m      <2> helem sKRM*/2
573 # n      <2> sassign vKS/2
574 # o      <0> unstack s
575 #            goto p
576 # r  <2> leaveloop K/2
577 # s  <1> leavesub[1 ref] K/REFC,1
578 EOT_EOT
579 # 1  <;> nextstate(main 505 (eval 24):1) v
580 # 2  <0> pushmark s
581 # 3  <0> pushmark s
582 # 4  <$> gv(*h) s
583 # 5  <1> rv2hv[t1] lKRM*/1
584 # 6  <2> aassign[t2] vKS
585 # 7  <;> nextstate(main 506 (eval 24):1) v
586 # 8  <0> pushmark sM
587 # 9  <$> gv(*a) s
588 # a  <1> rv2av[t3] sKRM/1
589 # b  <$> gv(*_) s
590 # c  <1> rv2gv sKRM/1
591 # d  <{> enteriter(next->o last->r redo->e) lKS
592 # p  <0> iter s
593 # q  <|> and(other->e) K/1
594 # e      <;> nextstate(main 505 (eval 24):1) v
595 # f      <$> gvsv(*_) s
596 # g      <$> gv(*h) s
597 # h      <1> rv2hv sKR/1
598 # i      <0> pushmark s
599 # j      <$> gvsv(*_) s
600 # k      <$> gv(*getkey) s/EARLYCV
601 # l      <1> entersub[t4] sKS/TARG,1
602 # m      <2> helem sKRM*/2
603 # n      <2> sassign vKS/2
604 # o      <0> unstack s
605 #            goto p
606 # r  <2> leaveloop K/2
607 # s  <1> leavesub[1 ref] K/REFC,1
608 EONT_EONT
609
610 checkOptree ( name      => 'map $_+42, 10..20',
611               code      => 'map $_+42, 10..20',
612               bcopts    => '-exec',
613               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
614 # 1  <;> nextstate(main 497 (eval 20):1) v
615 # 2  <0> pushmark s
616 # 3  <$> const[AV ] s
617 # 4  <1> rv2av lKPM/1
618 # 5  <@> mapstart K
619 # 6  <|> mapwhile(other->7)[t7] K
620 # 7      <#> gvsv[*_] s
621 # 8      <$> const[IV 42] s
622 # 9      <2> add[t2] sK/2
623 #            goto 6
624 # a  <1> leavesub[1 ref] K/REFC,1
625 EOT_EOT
626 # 1  <;> nextstate(main 511 (eval 26):1) v
627 # 2  <0> pushmark s
628 # 3  <$> const(AV ) s
629 # 4  <1> rv2av lKPM/1
630 # 5  <@> mapstart K
631 # 6  <|> mapwhile(other->7)[t4] K
632 # 7      <$> gvsv(*_) s
633 # 8      <$> const(IV 42) s
634 # 9      <2> add[t1] sK/2
635 #            goto 6
636 # a  <1> leavesub[1 ref] K/REFC,1
637 EONT_EONT
638
639 pass("CONSTANTS");
640
641 checkOptree ( name      => '-e use constant j => qq{junk}; print j',
642               prog      => 'use constant j => qq{junk}; print j',
643               bcopts    => '-exec',
644               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
645 # 1  <0> enter 
646 # 2  <;> nextstate(main 71 -e:1) v
647 # 3  <0> pushmark s
648 # 4  <$> const[PV "junk"] s
649 # 5  <@> print vK
650 # 6  <@> leave[1 ref] vKP/REFC
651 EOT_EOT
652 # 1  <0> enter 
653 # 2  <;> nextstate(main 71 -e:1) v
654 # 3  <0> pushmark s
655 # 4  <$> const(PV "junk") s
656 # 5  <@> print vK
657 # 6  <@> leave[1 ref] vKP/REFC
658 EONT_EONT
659
660 } # skip
661
662 __END__
663
664 #######################################################################
665
666 checkOptree ( name      => '-exec sub a { print (shift) ? "foo" : "bar" }',
667               code      => sub { print (shift) ? "foo" : "bar" },
668               bcopts    => '-exec',
669               expect    => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
670    insert threaded reference here
671 EOT_EOT
672    insert non-threaded reference here
673 EONT_EONT
674