5 @INC = ('../lib', '../ext/B/t');
7 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
8 print "1..0 # Skip -- Perl configured without B module\n";
14 # import checkOptree(), and %gOpts (containing test state)
15 use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
20 skip "no perlio in this build", 23 unless $Config::Config{useperlio};
22 $SIG{__WARN__} = sub {
24 $err =~ m/Subroutine re::(un)?install redefined/ and return;
26 #################################
27 pass("CANONICAL B::Concise EXAMPLE");
29 checkOptree ( name => 'canonical example w -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
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
56 checkOptree ( name => 'canonical example w -exec',
58 code => sub{$a=$b+42},
59 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
60 # 1 <;> nextstate(main 61 optree_concise.t:139) v
62 # 3 <$> const[IV 42] s
66 # 7 <1> leavesub[1 ref] K/REFC,1
68 # 1 <;> nextstate(main 61 optree_concise.t:139) v
70 # 3 <$> const(IV 42) s
74 # 7 <1> leavesub[1 ref] K/REFC,1
77 #################################
78 pass("B::Concise OPTION TESTS");
80 checkOptree ( name => '-base3 sticky-exec',
82 code => sub{$a=$b+42},
83 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
84 1 <;> dbstate(main 24 optree_concise.t:132) v
90 21 <1> leavesub[1 ref] K/REFC,1
92 # 1 <;> nextstate(main 62 optree_concise.t:161) v
94 # 10 <$> const(IV 42) s
97 # 20 <2> sassign sKS/2
98 # 21 <1> leavesub[1 ref] K/REFC,1
101 checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
103 code => sub{$a=$b+42},
104 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
105 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
106 - <@> lineseq KP ->21
107 1 <;> nextstate(main 32 optree_concise.t:164) v ->2
108 20 <2> sassign sKS/2 ->21
109 11 <2> add[t3] sK/2 ->12
110 - <1> ex-rv2sv sK/1 ->10
111 2 <#> gvsv[*b] s ->10
112 10 <$> const[IV 42] s ->11
113 - <1> ex-rv2sv sKRM*/1 ->20
114 12 <#> gvsv[*a] s ->20
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
128 checkOptree ( name => '-base4',
129 bcopts => [qw/ -basic -base4 /],
130 code => sub{$a=$b+42},
131 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
132 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
133 - <@> lineseq KP ->13
134 1 <;> nextstate(main 26 optree_concise.t:145) v ->2
135 12 <2> sassign sKS/2 ->13
136 10 <2> add[t3] sK/2 ->11
137 - <1> ex-rv2sv sK/1 ->3
139 3 <$> const[IV 42] s ->10
140 - <1> ex-rv2sv sKRM*/1 ->12
141 11 <#> gvsv[*a] s ->12
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
155 checkOptree ( name => "restore -base36 default",
156 bcopts => [qw/ -basic -base36 /],
159 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
160 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
162 1 <;> nextstate(main 27 optree_concise.t:161) v ->2
163 - <1> ex-rv2sv sK/1 ->-
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
173 checkOptree ( name => "terse basic",
174 bcopts => [qw/ -basic -terse /],
176 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
177 UNOP (0x82b0918) leavesub [1]
178 LISTOP (0x82b08d8) lineseq
179 COP (0x82b0880) nextstate
180 UNOP (0x82b0860) null [15]
181 PADOP (0x82b0840) gvsv GV (0x82a818c) *a
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
190 checkOptree ( name => "sticky-terse exec",
191 bcopts => [qw/ -exec /],
193 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
194 COP (0x82b0d70) nextstate
195 PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
196 UNOP (0x82b0e08) leavesub [1]
198 # COP (0x82828e0) nextstate
199 # SVOP (0x82828a0) gvsv GV (0x814692c) *a
200 # UNOP (0x8282938) leavesub [1]
203 pass("OPTIONS IN CMDLINE MODE");
205 checkOptree ( name => 'cmdline invoke -basic works',
207 #bcopts => '-basic', # default
208 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
209 # 7 <@> leave[1 ref] vKP/REFC ->(end)
211 # 2 <;> nextstate(main 1 -e:1) v ->3
213 # 3 <0> pushmark s ->4
214 # 5 <1> rv2av[t2] lK/1 ->6
217 # 7 <@> leave[1 ref] vKP/REFC ->(end)
219 # 2 <;> nextstate(main 1 -e:1) v ->3
221 # 3 <0> pushmark s ->4
222 # 5 <1> rv2av[t1] lK/1 ->6
226 checkOptree ( name => 'cmdline invoke -exec works',
229 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
231 2 <;> nextstate(main 1 -e:1) v
236 7 <@> leave[1 ref] vKP/REFC
239 # 2 <;> nextstate(main 1 -e:1) v
242 # 5 <1> rv2av[t1] lK/1
244 # 7 <@> leave[1 ref] vKP/REFC
247 checkOptree ( name => 'cmdline self-strict compile err',
248 prog => 'use strict; sort @a',
249 bcopts => [qw/ -basic -concise -exec /],
251 expect => 'compilation errors',
252 expect_nt => 'compilation errors');
254 checkOptree ( name => 'error at -e line 1',
255 prog => 'our @a; sort @a',
256 bcopts => [qw/ -basic -concise -exec /],
258 expect => 'at -e line 1',
259 expect_nt => 'at -e line 1');
261 checkOptree ( 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');
266 # 2 <;> nextstate(main 1 -e:1) v
268 # 4 <1> rv2av[t3] vK/OURINTR,1
269 # 5 <;> nextstate(main 2 -e:1) v
272 # 8 <1> rv2av[t5] lK/1
274 # a <@> leave[1 ref] vKP/REFC
277 # 2 <;> nextstate(main 1 -e:1) v
279 # 4 <1> rv2av[t2] vK/OURINTR,1
280 # 5 <;> nextstate(main 2 -e:1) v
283 # 8 <1> rv2av[t3] lK/1
285 # a <@> leave[1 ref] vKP/REFC
289 #################################
290 pass("B::Concise STYLE/CALLBACK TESTS");
292 use B::Concise qw( walk_output add_style set_style_standard add_callback );
294 # new relative style, added by set_up_relative_test()
296 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
297 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
298 . "(x(;~=> #extra)x)\n" # new 'variable' used here
300 , " (*( )*) goto #seq\n"
301 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
302 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
305 sub set_up_relative_test {
306 # add a new style, and a callback which adds an 'extra' property
308 add_style ( "relative" => @stylespec );
309 #set_style_standard ( "relative" );
313 my ($h, $op, $format, $level, $style) = @_;
315 # callback marks up const ops
316 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
319 if ($lastnext and $$lastnext != $$op) {
320 $h->{goto} = ($h->{seq} eq '-')
321 ? 'unresolved' : $h->{seq};
324 # 2 style specific behaviors
325 if ($style eq 'relative') {
326 $h->{extra} = 'RELATIVE';
327 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
329 elsif ($style eq 'scope') {
330 # supress printout entirely
331 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
336 #################################
337 set_up_relative_test();
338 pass("set_up_relative_test, new callback installed");
340 checkOptree ( 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');
344 1 <;> nextstate(main 76 optree_concise.t:337) v
346 3 <$> const[IV 42] CALLBACK s
350 7 <1> leavesub[1 ref] K/REFC,1
352 # 1 <;> nextstate(main 455 optree_concise.t:328) v
354 # 3 <$> const(IV 42) CALLBACK s
357 # 6 <2> sassign sKS/2
358 # 7 <1> leavesub[1 ref] K/REFC,1
361 checkOptree ( name => "new 'relative' style, -exec mode",
362 bcopts => [qw/ -basic -relative /],
363 code => sub{$a=$b+42},
366 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
367 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
368 - <@> lineseq KP ->7 => RELATIVE
369 1 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
370 6 <2> sassign sKS ->7 => RELATIVE
371 4 <2> add[t3] sK ->5 => RELATIVE
372 - <1> ex-rv2sv sK ->3 => RELATIVE
373 2 <#> gvsv[*b] s ->3 => RELATIVE
374 3 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
375 - <1> ex-rv2sv sKRM* ->6 => RELATIVE
376 5 <#> gvsv[*a] s ->6 => RELATIVE
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
390 checkOptree ( name => "both -exec -relative",
391 bcopts => [qw/ -exec -relative /],
392 code => sub{$a=$b+42},
394 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
395 1 <;> nextstate(main 50 optree_concise.t:326) v
397 3 <$> const[IV 42] CALLBACK s
401 7 <1> leavesub RELATIVE[1 ref] K
403 # 1 <;> nextstate(main 78 optree_concise.t:371) v
405 # 3 <$> const(IV 42) CALLBACK s
409 # 7 <1> leavesub RELATIVE[1 ref] K
412 #################################
414 @scopeops = qw( leavesub enter leave nextstate );
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])?)"
423 checkOptree ( name => "both -exec -scope",
424 bcopts => [qw/ -exec -scope /],
425 code => sub{$a=$b+42},
426 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
427 1 <;> nextstate(main 50 optree_concise.t:337) v
428 7 <1> leavesub[1 ref] K/REFC,1
430 1 <;> nextstate(main 75 optree_concise.t:396) v
431 7 <1> leavesub[1 ref] K/REFC,1
435 checkOptree ( name => "both -basic -scope",
436 bcopts => [qw/ -basic -scope /],
437 code => sub{$a=$b+42},
438 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
439 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
440 1 <;> nextstate(main 51 optree_concise.t:347) v ->2
442 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
443 1 <;> nextstate(main 76 optree_concise.t:407) v ->2