projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to CPAN 1.87_63
[p5sagit/p5-mst-13.2.git] / ext / B / t / optree_concise.t
CommitLineData
724aa791 1#!perl
2
3BEGIN {
5638aaac 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 }
9cd8f857 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 }
19e169bf 16 # require 'test.pl'; # now done by OptreeCheck
724aa791 17}
18
19# import checkOptree(), and %gOpts (containing test state)
20use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696 21use Config;
724aa791 22
b37cb821 23my $tests = 23;
24plan tests => $tests;
2ce64696 25SKIP: {
b37cb821 26skip "no perlio in this build", $tests unless $Config::Config{useperlio};
724aa791 27
28$SIG{__WARN__} = sub {
29 my $err = shift;
30 $err =~ m/Subroutine re::(un)?install redefined/ and return;
31};
32#################################
33pass("CANONICAL B::Concise EXAMPLE");
34
09337566 35my @open_todo;
36sub open_todo {
37 if (((caller 0)[10]||{})->{open}) {
38 @open_todo = (skip => "\$^OPEN is set");
39 }
40}
41open_todo;
42
724aa791 43checkOptree ( name => 'canonical example w -basic',
44 bcopts => '-basic',
45 code => sub{$a=$b+42},
09337566 46 @open_todo,
724aa791 47 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
19e169bf 48# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
724aa791 49# - <@> lineseq KP ->7
d5ec2987 50# 1 <;> nextstate(foo bar) v:{ ->2
724aa791 51# 6 <2> sassign sKS/2 ->7
19e169bf 52# 4 <2> add[t3] sK/2 ->5
724aa791 53# - <1> ex-rv2sv sK/1 ->3
54# 2 <#> gvsv[*b] s ->3
55# 3 <$> const[IV 42] s ->4
56# - <1> ex-rv2sv sKRM*/1 ->6
57# 5 <#> gvsv[*a] s ->6
58EOT_EOT
59# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
60# - <@> lineseq KP ->7
d5ec2987 61# 1 <;> nextstate(main 60 optree_concise.t:122) v:{ ->2
724aa791 62# 6 <2> sassign sKS/2 ->7
63# 4 <2> add[t1] sK/2 ->5
64# - <1> ex-rv2sv sK/1 ->3
65# 2 <$> gvsv(*b) s ->3
66# 3 <$> const(IV 42) s ->4
67# - <1> ex-rv2sv sKRM*/1 ->6
68# 5 <$> gvsv(*a) s ->6
69EONT_EONT
70
71checkOptree ( name => 'canonical example w -exec',
72 bcopts => '-exec',
73 code => sub{$a=$b+42},
09337566 74 @open_todo,
724aa791 75 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 76# 1 <;> nextstate(main 61 optree_concise.t:139) v:{
724aa791 77# 2 <#> gvsv[*b] s
78# 3 <$> const[IV 42] s
79# 4 <2> add[t3] sK/2
80# 5 <#> gvsv[*a] s
81# 6 <2> sassign sKS/2
82# 7 <1> leavesub[1 ref] K/REFC,1
83EOT_EOT
d5ec2987 84# 1 <;> nextstate(main 61 optree_concise.t:139) v:{
724aa791 85# 2 <$> gvsv(*b) s
86# 3 <$> const(IV 42) s
87# 4 <2> add[t1] sK/2
88# 5 <$> gvsv(*a) s
89# 6 <2> sassign sKS/2
90# 7 <1> leavesub[1 ref] K/REFC,1
91EONT_EONT
92
724aa791 93#################################
94pass("B::Concise OPTION TESTS");
95
96checkOptree ( name => '-base3 sticky-exec',
97 bcopts => '-base3',
98 code => sub{$a=$b+42},
09337566 99 @open_todo,
724aa791 100 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 1011 <;> dbstate(main 24 optree_concise.t:132) v:{
724aa791 1022 <#> gvsv[*b] s
10310 <$> const[IV 42] s
10411 <2> add[t3] sK/2
10512 <#> gvsv[*a] s
10620 <2> sassign sKS/2
cc02ea56 10721 <1> leavesub[1 ref] K/REFC,1
724aa791 108EOT_EOT
d5ec2987 109# 1 <;> nextstate(main 62 optree_concise.t:161) v:{
724aa791 110# 2 <$> gvsv(*b) s
111# 10 <$> const(IV 42) s
112# 11 <2> add[t1] sK/2
113# 12 <$> gvsv(*a) s
114# 20 <2> sassign sKS/2
115# 21 <1> leavesub[1 ref] K/REFC,1
116EONT_EONT
117
118checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
119 bcopts => '-basic',
120 code => sub{$a=$b+42},
09337566 121 @open_todo,
724aa791 122 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
12321 <1> leavesub[1 ref] K/REFC,1 ->(end)
124- <@> lineseq KP ->21
d5ec2987 1251 <;> nextstate(main 32 optree_concise.t:164) v:{ ->2
724aa791 12620 <2> sassign sKS/2 ->21
12711 <2> add[t3] sK/2 ->12
128- <1> ex-rv2sv sK/1 ->10
1292 <#> gvsv[*b] s ->10
13010 <$> const[IV 42] s ->11
131- <1> ex-rv2sv sKRM*/1 ->20
13212 <#> gvsv[*a] s ->20
133EOT_EOT
134# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
135# - <@> lineseq KP ->21
d5ec2987 136# 1 <;> nextstate(main 63 optree_concise.t:186) v:{ ->2
724aa791 137# 20 <2> sassign sKS/2 ->21
138# 11 <2> add[t1] sK/2 ->12
139# - <1> ex-rv2sv sK/1 ->10
140# 2 <$> gvsv(*b) s ->10
141# 10 <$> const(IV 42) s ->11
142# - <1> ex-rv2sv sKRM*/1 ->20
143# 12 <$> gvsv(*a) s ->20
144EONT_EONT
145
146checkOptree ( name => '-base4',
147 bcopts => [qw/ -basic -base4 /],
148 code => sub{$a=$b+42},
09337566 149 @open_todo,
724aa791 150 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
15113 <1> leavesub[1 ref] K/REFC,1 ->(end)
152- <@> lineseq KP ->13
d5ec2987 1531 <;> nextstate(main 26 optree_concise.t:145) v:{ ->2
724aa791 15412 <2> sassign sKS/2 ->13
15510 <2> add[t3] sK/2 ->11
156- <1> ex-rv2sv sK/1 ->3
1572 <#> gvsv[*b] s ->3
1583 <$> const[IV 42] s ->10
159- <1> ex-rv2sv sKRM*/1 ->12
16011 <#> gvsv[*a] s ->12
161EOT_EOT
162# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
163# - <@> lineseq KP ->13
d5ec2987 164# 1 <;> nextstate(main 64 optree_concise.t:193) v:{ ->2
724aa791 165# 12 <2> sassign sKS/2 ->13
166# 10 <2> add[t1] sK/2 ->11
167# - <1> ex-rv2sv sK/1 ->3
168# 2 <$> gvsv(*b) s ->3
169# 3 <$> const(IV 42) s ->10
170# - <1> ex-rv2sv sKRM*/1 ->12
171# 11 <$> gvsv(*a) s ->12
172EONT_EONT
173
174checkOptree ( name => "restore -base36 default",
175 bcopts => [qw/ -basic -base36 /],
176 code => sub{$a},
177 crossfail => 1,
09337566 178 @open_todo,
724aa791 179 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1803 <1> leavesub[1 ref] K/REFC,1 ->(end)
181- <@> lineseq KP ->3
1821 <;> nextstate(main 27 optree_concise.t:161) v ->2
183- <1> ex-rv2sv sK/1 ->-
1842 <#> gvsv[*a] s ->3
185EOT_EOT
186# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
187# - <@> lineseq KP ->3
188# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2
189# - <1> ex-rv2sv sK/1 ->-
190# 2 <$> gvsv(*a) s ->3
191EONT_EONT
192
193checkOptree ( name => "terse basic",
194 bcopts => [qw/ -basic -terse /],
195 code => sub{$a},
196 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
197UNOP (0x82b0918) leavesub [1]
198 LISTOP (0x82b08d8) lineseq
199 COP (0x82b0880) nextstate
200 UNOP (0x82b0860) null [15]
201 PADOP (0x82b0840) gvsv GV (0x82a818c) *a
202EOT_EOT
203# UNOP (0x8282310) leavesub [1]
204# LISTOP (0x82822f0) lineseq
205# COP (0x82822b8) nextstate
206# UNOP (0x812fc20) null [15]
207# SVOP (0x812fc00) gvsv GV (0x814692c) *a
208EONT_EONT
209
210checkOptree ( name => "sticky-terse exec",
211 bcopts => [qw/ -exec /],
212 code => sub{$a},
213 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 214COP (0x82b0d70) nextstate
215PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
216UNOP (0x82b0e08) leavesub [1]
217EOT_EOT
724aa791 218# COP (0x82828e0) nextstate
219# SVOP (0x82828a0) gvsv GV (0x814692c) *a
220# UNOP (0x8282938) leavesub [1]
221EONT_EONT
222
223pass("OPTIONS IN CMDLINE MODE");
224
19e169bf 225checkOptree ( name => 'cmdline invoke -basic works',
226 prog => 'sort @a',
227 errs => [ 'Useless use of sort in void context at -e line 1.',
228 'Name "main::a" used only once: possible typo at -e line 1.',
229 ],
724aa791 230 #bcopts => '-basic', # default
09337566 231 @open_todo,
724aa791 232 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
233# 7 <@> leave[1 ref] vKP/REFC ->(end)
234# 1 <0> enter ->2
d5ec2987 235# 2 <;> nextstate(main 1 -e:1) v:{ ->3
724aa791 236# 6 <@> sort vK ->7
237# 3 <0> pushmark s ->4
238# 5 <1> rv2av[t2] lK/1 ->6
239# 4 <#> gv[*a] s ->5
240EOT_EOT
241# 7 <@> leave[1 ref] vKP/REFC ->(end)
242# 1 <0> enter ->2
d5ec2987 243# 2 <;> nextstate(main 1 -e:1) v:{ ->3
724aa791 244# 6 <@> sort vK ->7
245# 3 <0> pushmark s ->4
246# 5 <1> rv2av[t1] lK/1 ->6
247# 4 <$> gv(*a) s ->5
248EONT_EONT
249
19e169bf 250checkOptree ( name => 'cmdline invoke -exec works',
251 prog => 'sort @a',
252 errs => [ 'Useless use of sort in void context at -e line 1.',
253 'Name "main::a" used only once: possible typo at -e line 1.',
254 ],
255 bcopts => '-exec',
09337566 256 @open_todo,
19e169bf 257 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 2581 <0> enter
d5ec2987 2592 <;> nextstate(main 1 -e:1) v:{
724aa791 2603 <0> pushmark s
2614 <#> gv[*a] s
2625 <1> rv2av[t2] lK/1
2636 <@> sort vK
2647 <@> leave[1 ref] vKP/REFC
265EOT_EOT
266# 1 <0> enter
d5ec2987 267# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 268# 3 <0> pushmark s
269# 4 <$> gv(*a) s
270# 5 <1> rv2av[t1] lK/1
271# 6 <@> sort vK
272# 7 <@> leave[1 ref] vKP/REFC
273EONT_EONT
274
5e251bf1 275;
19e169bf 276
5e251bf1 277checkOptree
278 ( name => 'cmdline self-strict compile err using prog',
279 prog => 'use strict; sort @a',
280 bcopts => [qw/ -basic -concise -exec /],
19e169bf 281 errs => 'Global symbol "@a" requires explicit package name at -e line 1.',
282 expect => 'nextstate',
283 expect_nt => 'nextstate',
284 noanchors => 1, # allow simple expectations to work
5e251bf1 285 );
724aa791 286
5e251bf1 287checkOptree
288 ( name => 'cmdline self-strict compile err using code',
289 code => 'use strict; sort @a',
290 bcopts => [qw/ -basic -concise -exec /],
5e251bf1 291 errs => 'Global symbol "@a" requires explicit package name at .*? line 1.',
19e169bf 292 note => 'this test relys on a kludge which copies $@ to rendering when empty',
293 expect => 'Global symbol',
294 expect_nt => 'Global symbol',
295 noanchors => 1, # allow simple expectations to work
5e251bf1 296 );
297
298checkOptree
299 ( name => 'cmdline -basic -concise -exec works',
300 prog => 'our @a; sort @a',
301 bcopts => [qw/ -basic -concise -exec /],
19e169bf 302 errs => ['Useless use of sort in void context at -e line 1.'],
09337566 303 @open_todo,
5e251bf1 304 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 305# 1 <0> enter
d5ec2987 306# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 307# 3 <#> gv[*a] s
308# 4 <1> rv2av[t3] vK/OURINTR,1
d5ec2987 309# 5 <;> nextstate(main 2 -e:1) v:{
724aa791 310# 6 <0> pushmark s
311# 7 <#> gv[*a] s
312# 8 <1> rv2av[t5] lK/1
313# 9 <@> sort vK
314# a <@> leave[1 ref] vKP/REFC
315EOT_EOT
316# 1 <0> enter
d5ec2987 317# 2 <;> nextstate(main 1 -e:1) v:{
724aa791 318# 3 <$> gv(*a) s
319# 4 <1> rv2av[t2] vK/OURINTR,1
d5ec2987 320# 5 <;> nextstate(main 2 -e:1) v:{
724aa791 321# 6 <0> pushmark s
322# 7 <$> gv(*a) s
323# 8 <1> rv2av[t3] lK/1
324# 9 <@> sort vK
325# a <@> leave[1 ref] vKP/REFC
326EONT_EONT
327
328
329#################################
330pass("B::Concise STYLE/CALLBACK TESTS");
331
332use B::Concise qw( walk_output add_style set_style_standard add_callback );
333
334# new relative style, added by set_up_relative_test()
335@stylespec =
336 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
337 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
338 . "(x(;~=> #extra)x)\n" # new 'variable' used here
339
340 , " (*( )*) goto #seq\n"
cc02ea56 341 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791 342 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
343 );
344
345sub set_up_relative_test {
346 # add a new style, and a callback which adds an 'extra' property
347
348 add_style ( "relative" => @stylespec );
349 #set_style_standard ( "relative" );
350
351 add_callback
352 ( sub {
353 my ($h, $op, $format, $level, $style) = @_;
354
355 # callback marks up const ops
356 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
357 $h->{extra} = '';
358
cc02ea56 359 if ($lastnext and $$lastnext != $$op) {
360 $h->{goto} = ($h->{seq} eq '-')
361 ? 'unresolved' : $h->{seq};
362 }
363
724aa791 364 # 2 style specific behaviors
365 if ($style eq 'relative') {
366 $h->{extra} = 'RELATIVE';
367 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
368 }
369 elsif ($style eq 'scope') {
370 # supress printout entirely
371 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
372 }
373 });
374}
375
376#################################
377set_up_relative_test();
378pass("set_up_relative_test, new callback installed");
379
380checkOptree ( name => 'callback used, independent of style',
381 bcopts => [qw/ -concise -exec /],
382 code => sub{$a=$b+42},
09337566 383 @open_todo,
724aa791 384 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
d5ec2987 3851 <;> nextstate(main 76 optree_concise.t:337) v:{
724aa791 3862 <#> gvsv[*b] s
3873 <$> const[IV 42] CALLBACK s
3884 <2> add[t3] sK/2
3895 <#> gvsv[*a] s
3906 <2> sassign sKS/2
3917 <1> leavesub[1 ref] K/REFC,1
392EOT_EOT
d5ec2987 393# 1 <;> nextstate(main 455 optree_concise.t:328) v:{
724aa791 394# 2 <$> gvsv(*b) s
395# 3 <$> const(IV 42) CALLBACK s
396# 4 <2> add[t1] sK/2
397# 5 <$> gvsv(*a) s
398# 6 <2> sassign sKS/2
399# 7 <1> leavesub[1 ref] K/REFC,1
400EONT_EONT
401
402checkOptree ( name => "new 'relative' style, -exec mode",
403 bcopts => [qw/ -basic -relative /],
404 code => sub{$a=$b+42},
405 crossfail => 1,
406 #retry => 1,
407 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56 4087 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
409- <@> lineseq KP ->7 => RELATIVE
4101 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
4116 <2> sassign sKS ->7 => RELATIVE
4124 <2> add[t3] sK ->5 => RELATIVE
413- <1> ex-rv2sv sK ->3 => RELATIVE
4142 <#> gvsv[*b] s ->3 => RELATIVE
4153 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
416- <1> ex-rv2sv sKRM* ->6 => RELATIVE
4175 <#> gvsv[*a] s ->6 => RELATIVE
724aa791 418EOT_EOT
cc02ea56 419# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
420# - <@> lineseq KP ->7 => RELATIVE
421# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
422# 6 <2> sassign sKS ->7 => RELATIVE
423# 4 <2> add[t1] sK ->5 => RELATIVE
424# - <1> ex-rv2sv sK ->3 => RELATIVE
425# 2 <$> gvsv(*b) s ->3 => RELATIVE
426# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
427# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
428# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791 429EONT_EONT
430
431checkOptree ( name => "both -exec -relative",
432 bcopts => [qw/ -exec -relative /],
433 code => sub{$a=$b+42},
434 crossfail => 1,
435 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 4361 <;> nextstate(main 50 optree_concise.t:326) v
4372 <#> gvsv[*b] s
4383 <$> const[IV 42] CALLBACK s
4394 <2> add[t3] sK
4405 <#> gvsv[*a] s
4416 <2> sassign sKS
4427 <1> leavesub RELATIVE[1 ref] K
443EOT_EOT
444# 1 <;> nextstate(main 78 optree_concise.t:371) v
445# 2 <$> gvsv(*b) s
446# 3 <$> const(IV 42) CALLBACK s
447# 4 <2> add[t1] sK
448# 5 <$> gvsv(*a) s
449# 6 <2> sassign sKS
450# 7 <1> leavesub RELATIVE[1 ref] K
451EONT_EONT
452
453#################################
454
455@scopeops = qw( leavesub enter leave nextstate );
456add_style
457 ( 'scope' # concise copy
458 , "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
459 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
460 , " (*( )*) goto #seq\n"
461 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
462 );
463
464checkOptree ( name => "both -exec -scope",
465 bcopts => [qw/ -exec -scope /],
466 code => sub{$a=$b+42},
467 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 4681 <;> nextstate(main 50 optree_concise.t:337) v
4697 <1> leavesub[1 ref] K/REFC,1
470EOT_EOT
724aa791 4711 <;> nextstate(main 75 optree_concise.t:396) v
4727 <1> leavesub[1 ref] K/REFC,1
473EONT_EONT
474
475
476checkOptree ( name => "both -basic -scope",
477 bcopts => [qw/ -basic -scope /],
478 code => sub{$a=$b+42},
479 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4807 <1> leavesub[1 ref] K/REFC,1 ->(end)
4811 <;> nextstate(main 51 optree_concise.t:347) v ->2
482EOT_EOT
4837 <1> leavesub[1 ref] K/REFC,1 ->(end)
4841 <;> nextstate(main 76 optree_concise.t:407) v ->2
485EONT_EONT
486
2ce64696 487} #skip
724aa791 488
Unnamed repository; edit this file to name it for gitweb.