projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Integrate:
[p5sagit/p5-mst-13.2.git] / ext / B / t / optree_concise.t
CommitLineData
724aa791 1#!perl
2
3BEGIN {
4 chdir 't';
5 @INC = ('../lib', '../ext/B/t');
9cd8f857 6 require Config;
7 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
8 print "1..0 # Skip -- Perl configured without B module\n";
9 exit 0;
10 }
724aa791 11 require './test.pl';
12}
13
14# import checkOptree(), and %gOpts (containing test state)
15use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696 16use Config;
724aa791 17
cc02ea56 18plan tests => 23;
2ce64696 19SKIP: {
e77e2f14 20skip "no perlio in this build", 23 unless $Config::Config{useperlio};
724aa791 21
22$SIG{__WARN__} = sub {
23 my $err = shift;
24 $err =~ m/Subroutine re::(un)?install redefined/ and return;
25};
26#################################
27pass("CANONICAL B::Concise EXAMPLE");
28
29checkOptree ( name => 'canonical example w -basic',
30 bcopts => '-basic',
31 code => sub{$a=$b+42},
32 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
33# 7 <1> leavesub[\d+ refs?] K/REFC,1 ->(end)
34# - <@> lineseq KP ->7
35# 1 <;> nextstate(foo bar) v ->2
36# 6 <2> sassign sKS/2 ->7
37# 4 <2> add[t\d+] sK/2 ->5
38# - <1> ex-rv2sv sK/1 ->3
39# 2 <#> gvsv[*b] s ->3
40# 3 <$> const[IV 42] s ->4
41# - <1> ex-rv2sv sKRM*/1 ->6
42# 5 <#> gvsv[*a] s ->6
43EOT_EOT
44# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
45# - <@> lineseq KP ->7
46# 1 <;> nextstate(main 60 optree_concise.t:122) v ->2
47# 6 <2> sassign sKS/2 ->7
48# 4 <2> add[t1] sK/2 ->5
49# - <1> ex-rv2sv sK/1 ->3
50# 2 <$> gvsv(*b) s ->3
51# 3 <$> const(IV 42) s ->4
52# - <1> ex-rv2sv sKRM*/1 ->6
53# 5 <$> gvsv(*a) s ->6
54EONT_EONT
55
56checkOptree ( name => 'canonical example w -exec',
57 bcopts => '-exec',
58 code => sub{$a=$b+42},
59 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 60# 1 <;> nextstate(main 61 optree_concise.t:139) v
61# 2 <#> gvsv[*b] s
62# 3 <$> const[IV 42] s
63# 4 <2> add[t3] sK/2
64# 5 <#> gvsv[*a] s
65# 6 <2> sassign sKS/2
66# 7 <1> leavesub[1 ref] K/REFC,1
67EOT_EOT
724aa791 68# 1 <;> nextstate(main 61 optree_concise.t:139) v
69# 2 <$> gvsv(*b) s
70# 3 <$> const(IV 42) s
71# 4 <2> add[t1] sK/2
72# 5 <$> gvsv(*a) s
73# 6 <2> sassign sKS/2
74# 7 <1> leavesub[1 ref] K/REFC,1
75EONT_EONT
76
724aa791 77#################################
78pass("B::Concise OPTION TESTS");
79
80checkOptree ( name => '-base3 sticky-exec',
81 bcopts => '-base3',
82 code => sub{$a=$b+42},
83 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 841 <;> dbstate(main 24 optree_concise.t:132) v
852 <#> gvsv[*b] s
8610 <$> const[IV 42] s
8711 <2> add[t3] sK/2
8812 <#> gvsv[*a] s
8920 <2> sassign sKS/2
cc02ea56 9021 <1> leavesub[1 ref] K/REFC,1
724aa791 91EOT_EOT
724aa791 92# 1 <;> nextstate(main 62 optree_concise.t:161) v
93# 2 <$> gvsv(*b) s
94# 10 <$> const(IV 42) s
95# 11 <2> add[t1] sK/2
96# 12 <$> gvsv(*a) s
97# 20 <2> sassign sKS/2
98# 21 <1> leavesub[1 ref] K/REFC,1
99EONT_EONT
100
101checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
102 bcopts => '-basic',
103 code => sub{$a=$b+42},
104 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
10521 <1> leavesub[1 ref] K/REFC,1 ->(end)
106- <@> lineseq KP ->21
1071 <;> nextstate(main 32 optree_concise.t:164) v ->2
10820 <2> sassign sKS/2 ->21
10911 <2> add[t3] sK/2 ->12
110- <1> ex-rv2sv sK/1 ->10
1112 <#> gvsv[*b] s ->10
11210 <$> const[IV 42] s ->11
113- <1> ex-rv2sv sKRM*/1 ->20
11412 <#> gvsv[*a] s ->20
115EOT_EOT
116# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
117# - <@> lineseq KP ->21
118# 1 <;> nextstate(main 63 optree_concise.t:186) v ->2
119# 20 <2> sassign sKS/2 ->21
120# 11 <2> add[t1] sK/2 ->12
121# - <1> ex-rv2sv sK/1 ->10
122# 2 <$> gvsv(*b) s ->10
123# 10 <$> const(IV 42) s ->11
124# - <1> ex-rv2sv sKRM*/1 ->20
125# 12 <$> gvsv(*a) s ->20
126EONT_EONT
127
128checkOptree ( name => '-base4',
129 bcopts => [qw/ -basic -base4 /],
130 code => sub{$a=$b+42},
131 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
13213 <1> leavesub[1 ref] K/REFC,1 ->(end)
133- <@> lineseq KP ->13
1341 <;> nextstate(main 26 optree_concise.t:145) v ->2
13512 <2> sassign sKS/2 ->13
13610 <2> add[t3] sK/2 ->11
137- <1> ex-rv2sv sK/1 ->3
1382 <#> gvsv[*b] s ->3
1393 <$> const[IV 42] s ->10
140- <1> ex-rv2sv sKRM*/1 ->12
14111 <#> gvsv[*a] s ->12
142EOT_EOT
143# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
144# - <@> lineseq KP ->13
145# 1 <;> nextstate(main 64 optree_concise.t:193) v ->2
146# 12 <2> sassign sKS/2 ->13
147# 10 <2> add[t1] sK/2 ->11
148# - <1> ex-rv2sv sK/1 ->3
149# 2 <$> gvsv(*b) s ->3
150# 3 <$> const(IV 42) s ->10
151# - <1> ex-rv2sv sKRM*/1 ->12
152# 11 <$> gvsv(*a) s ->12
153EONT_EONT
154
155checkOptree ( name => "restore -base36 default",
156 bcopts => [qw/ -basic -base36 /],
157 code => sub{$a},
158 crossfail => 1,
159 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1603 <1> leavesub[1 ref] K/REFC,1 ->(end)
161- <@> lineseq KP ->3
1621 <;> nextstate(main 27 optree_concise.t:161) v ->2
163- <1> ex-rv2sv sK/1 ->-
1642 <#> gvsv[*a] s ->3
165EOT_EOT
166# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
167# - <@> lineseq KP ->3
168# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2
169# - <1> ex-rv2sv sK/1 ->-
170# 2 <$> gvsv(*a) s ->3
171EONT_EONT
172
173checkOptree ( name => "terse basic",
174 bcopts => [qw/ -basic -terse /],
175 code => sub{$a},
176 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
177UNOP (0x82b0918) leavesub [1]
178 LISTOP (0x82b08d8) lineseq
179 COP (0x82b0880) nextstate
180 UNOP (0x82b0860) null [15]
181 PADOP (0x82b0840) gvsv GV (0x82a818c) *a
182EOT_EOT
183# UNOP (0x8282310) leavesub [1]
184# LISTOP (0x82822f0) lineseq
185# COP (0x82822b8) nextstate
186# UNOP (0x812fc20) null [15]
187# SVOP (0x812fc00) gvsv GV (0x814692c) *a
188EONT_EONT
189
190checkOptree ( name => "sticky-terse exec",
191 bcopts => [qw/ -exec /],
192 code => sub{$a},
193 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 194COP (0x82b0d70) nextstate
195PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
196UNOP (0x82b0e08) leavesub [1]
197EOT_EOT
724aa791 198# COP (0x82828e0) nextstate
199# SVOP (0x82828a0) gvsv GV (0x814692c) *a
200# UNOP (0x8282938) leavesub [1]
201EONT_EONT
202
203pass("OPTIONS IN CMDLINE MODE");
204
205checkOptree ( name => 'cmdline invoke -basic works',
206 prog => 'sort @a',
207 #bcopts => '-basic', # default
208 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
209# 7 <@> leave[1 ref] vKP/REFC ->(end)
210# 1 <0> enter ->2
211# 2 <;> nextstate(main 1 -e:1) v ->3
212# 6 <@> sort vK ->7
213# 3 <0> pushmark s ->4
214# 5 <1> rv2av[t2] lK/1 ->6
215# 4 <#> gv[*a] s ->5
216EOT_EOT
217# 7 <@> leave[1 ref] vKP/REFC ->(end)
218# 1 <0> enter ->2
219# 2 <;> nextstate(main 1 -e:1) v ->3
220# 6 <@> sort vK ->7
221# 3 <0> pushmark s ->4
222# 5 <1> rv2av[t1] lK/1 ->6
223# 4 <$> gv(*a) s ->5
224EONT_EONT
225
226checkOptree ( name => 'cmdline invoke -exec works',
227 prog => 'sort @a',
228 bcopts => '-exec',
229 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
2301 <0> enter
2312 <;> nextstate(main 1 -e:1) v
2323 <0> pushmark s
2334 <#> gv[*a] s
2345 <1> rv2av[t2] lK/1
2356 <@> sort vK
2367 <@> leave[1 ref] vKP/REFC
237EOT_EOT
238# 1 <0> enter
239# 2 <;> nextstate(main 1 -e:1) v
240# 3 <0> pushmark s
241# 4 <$> gv(*a) s
242# 5 <1> rv2av[t1] lK/1
243# 6 <@> sort vK
244# 7 <@> leave[1 ref] vKP/REFC
245EONT_EONT
246
247checkOptree ( name => 'cmdline self-strict compile err',
248 prog => 'use strict; sort @a',
249 bcopts => [qw/ -basic -concise -exec /],
cc02ea56 250 noanchors => 1,
724aa791 251 expect => 'compilation errors',
252 expect_nt => 'compilation errors');
253
254checkOptree ( name => 'error at -e line 1',
255 prog => 'our @a; sort @a',
256 bcopts => [qw/ -basic -concise -exec /],
cc02ea56 257 noanchors => 1,
724aa791 258 expect => 'at -e line 1',
259 expect_nt => 'at -e line 1');
260
261checkOptree ( name => 'cmdline -basic -concise -exec works',
262 prog => 'our @a; sort @a',
263 bcopts => [qw/ -basic -concise -exec /],
264 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
265# 1 <0> enter
266# 2 <;> nextstate(main 1 -e:1) v
267# 3 <#> gv[*a] s
268# 4 <1> rv2av[t3] vK/OURINTR,1
269# 5 <;> nextstate(main 2 -e:1) v
270# 6 <0> pushmark s
271# 7 <#> gv[*a] s
272# 8 <1> rv2av[t5] lK/1
273# 9 <@> sort vK
274# a <@> leave[1 ref] vKP/REFC
275EOT_EOT
276# 1 <0> enter
277# 2 <;> nextstate(main 1 -e:1) v
278# 3 <$> gv(*a) s
279# 4 <1> rv2av[t2] vK/OURINTR,1
280# 5 <;> nextstate(main 2 -e:1) v
281# 6 <0> pushmark s
282# 7 <$> gv(*a) s
283# 8 <1> rv2av[t3] lK/1
284# 9 <@> sort vK
285# a <@> leave[1 ref] vKP/REFC
286EONT_EONT
287
288
289#################################
290pass("B::Concise STYLE/CALLBACK TESTS");
291
292use B::Concise qw( walk_output add_style set_style_standard add_callback );
293
294# new relative style, added by set_up_relative_test()
295@stylespec =
296 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
297 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
298 . "(x(;~=> #extra)x)\n" # new 'variable' used here
299
300 , " (*( )*) goto #seq\n"
cc02ea56 301 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791 302 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
303 );
304
305sub set_up_relative_test {
306 # add a new style, and a callback which adds an 'extra' property
307
308 add_style ( "relative" => @stylespec );
309 #set_style_standard ( "relative" );
310
311 add_callback
312 ( sub {
313 my ($h, $op, $format, $level, $style) = @_;
314
315 # callback marks up const ops
316 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
317 $h->{extra} = '';
318
cc02ea56 319 if ($lastnext and $$lastnext != $$op) {
320 $h->{goto} = ($h->{seq} eq '-')
321 ? 'unresolved' : $h->{seq};
322 }
323
724aa791 324 # 2 style specific behaviors
325 if ($style eq 'relative') {
326 $h->{extra} = 'RELATIVE';
327 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
328 }
329 elsif ($style eq 'scope') {
330 # supress printout entirely
331 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
332 }
333 });
334}
335
336#################################
337set_up_relative_test();
338pass("set_up_relative_test, new callback installed");
339
340checkOptree ( name => 'callback used, independent of style',
341 bcopts => [qw/ -concise -exec /],
342 code => sub{$a=$b+42},
343 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 3441 <;> nextstate(main 76 optree_concise.t:337) v
3452 <#> gvsv[*b] s
3463 <$> const[IV 42] CALLBACK s
3474 <2> add[t3] sK/2
3485 <#> gvsv[*a] s
3496 <2> sassign sKS/2
3507 <1> leavesub[1 ref] K/REFC,1
351EOT_EOT
352# 1 <;> nextstate(main 455 optree_concise.t:328) v
353# 2 <$> gvsv(*b) s
354# 3 <$> const(IV 42) CALLBACK s
355# 4 <2> add[t1] sK/2
356# 5 <$> gvsv(*a) s
357# 6 <2> sassign sKS/2
358# 7 <1> leavesub[1 ref] K/REFC,1
359EONT_EONT
360
361checkOptree ( name => "new 'relative' style, -exec mode",
362 bcopts => [qw/ -basic -relative /],
363 code => sub{$a=$b+42},
364 crossfail => 1,
365 #retry => 1,
366 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56 3677 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
368- <@> lineseq KP ->7 => RELATIVE
3691 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
3706 <2> sassign sKS ->7 => RELATIVE
3714 <2> add[t3] sK ->5 => RELATIVE
372- <1> ex-rv2sv sK ->3 => RELATIVE
3732 <#> gvsv[*b] s ->3 => RELATIVE
3743 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
375- <1> ex-rv2sv sKRM* ->6 => RELATIVE
3765 <#> gvsv[*a] s ->6 => RELATIVE
724aa791 377EOT_EOT
cc02ea56 378# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
379# - <@> lineseq KP ->7 => RELATIVE
380# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
381# 6 <2> sassign sKS ->7 => RELATIVE
382# 4 <2> add[t1] sK ->5 => RELATIVE
383# - <1> ex-rv2sv sK ->3 => RELATIVE
384# 2 <$> gvsv(*b) s ->3 => RELATIVE
385# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
386# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
387# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791 388EONT_EONT
389
390checkOptree ( name => "both -exec -relative",
391 bcopts => [qw/ -exec -relative /],
392 code => sub{$a=$b+42},
393 crossfail => 1,
394 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 3951 <;> nextstate(main 50 optree_concise.t:326) v
3962 <#> gvsv[*b] s
3973 <$> const[IV 42] CALLBACK s
3984 <2> add[t3] sK
3995 <#> gvsv[*a] s
4006 <2> sassign sKS
4017 <1> leavesub RELATIVE[1 ref] K
402EOT_EOT
403# 1 <;> nextstate(main 78 optree_concise.t:371) v
404# 2 <$> gvsv(*b) s
405# 3 <$> const(IV 42) CALLBACK s
406# 4 <2> add[t1] sK
407# 5 <$> gvsv(*a) s
408# 6 <2> sassign sKS
409# 7 <1> leavesub RELATIVE[1 ref] K
410EONT_EONT
411
412#################################
413
414@scopeops = qw( leavesub enter leave nextstate );
415add_style
416 ( 'scope' # concise copy
417 , "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
418 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
419 , " (*( )*) goto #seq\n"
420 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
421 );
422
423checkOptree ( name => "both -exec -scope",
424 bcopts => [qw/ -exec -scope /],
425 code => sub{$a=$b+42},
426 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 4271 <;> nextstate(main 50 optree_concise.t:337) v
4287 <1> leavesub[1 ref] K/REFC,1
429EOT_EOT
724aa791 4301 <;> nextstate(main 75 optree_concise.t:396) v
4317 <1> leavesub[1 ref] K/REFC,1
432EONT_EONT
433
434
435checkOptree ( name => "both -basic -scope",
436 bcopts => [qw/ -basic -scope /],
437 code => sub{$a=$b+42},
438 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4397 <1> leavesub[1 ref] K/REFC,1 ->(end)
4401 <;> nextstate(main 51 optree_concise.t:347) v ->2
441EOT_EOT
4427 <1> leavesub[1 ref] K/REFC,1 ->(end)
4431 <;> nextstate(main 76 optree_concise.t:407) v ->2
444EONT_EONT
445
2ce64696 446} #skip
724aa791 447
Unnamed repository; edit this file to name it for gitweb.