This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Move all the xxxpvs() macros to handy.h.
[perl5.git] / ext / B / t / optree_concise.t
CommitLineData
724aa791
JC		 1#!perl
2
3BEGIN {
5638aaac
SM		 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
NC		 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
JC		 17}
18
19# import checkOptree(), and %gOpts (containing test state)
20use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696 21use Config;
724aa791 22
b37cb821
NC		 23my $tests = 23;
24plan tests => $tests;
2ce64696 25SKIP: {
b37cb821 26skip "no perlio in this build", $tests unless $Config::Config{useperlio};
724aa791
JC		 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
35checkOptree ( name => 'canonical example w -basic',
36 bcopts => '-basic',
37 code => sub{$a=$b+42},
38 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
19e169bf 39# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
724aa791
JC		 40# - <@> lineseq KP ->7
41# 1 <;> nextstate(foo bar) v ->2
42# 6 <2> sassign sKS/2 ->7
19e169bf 43# 4 <2> add[t3] sK/2 ->5
724aa791
JC		 44# - <1> ex-rv2sv sK/1 ->3
45# 2 <#> gvsv[*b] s ->3
46# 3 <$> const[IV 42] s ->4
47# - <1> ex-rv2sv sKRM*/1 ->6
48# 5 <#> gvsv[*a] s ->6
49EOT_EOT
50# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
51# - <@> lineseq KP ->7
52# 1 <;> nextstate(main 60 optree_concise.t:122) v ->2
53# 6 <2> sassign sKS/2 ->7
54# 4 <2> add[t1] sK/2 ->5
55# - <1> ex-rv2sv sK/1 ->3
56# 2 <$> gvsv(*b) s ->3
57# 3 <$> const(IV 42) s ->4
58# - <1> ex-rv2sv sKRM*/1 ->6
59# 5 <$> gvsv(*a) s ->6
60EONT_EONT
61
62checkOptree ( name => 'canonical example w -exec',
63 bcopts => '-exec',
64 code => sub{$a=$b+42},
65 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 66# 1 <;> nextstate(main 61 optree_concise.t:139) v
67# 2 <#> gvsv[*b] s
68# 3 <$> const[IV 42] s
69# 4 <2> add[t3] sK/2
70# 5 <#> gvsv[*a] s
71# 6 <2> sassign sKS/2
72# 7 <1> leavesub[1 ref] K/REFC,1
73EOT_EOT
724aa791
JC		 74# 1 <;> nextstate(main 61 optree_concise.t:139) v
75# 2 <$> gvsv(*b) s
76# 3 <$> const(IV 42) s
77# 4 <2> add[t1] sK/2
78# 5 <$> gvsv(*a) s
79# 6 <2> sassign sKS/2
80# 7 <1> leavesub[1 ref] K/REFC,1
81EONT_EONT
82
724aa791
JC		 83#################################
84pass("B::Concise OPTION TESTS");
85
86checkOptree ( name => '-base3 sticky-exec',
87 bcopts => '-base3',
88 code => sub{$a=$b+42},
89 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 901 <;> dbstate(main 24 optree_concise.t:132) v
912 <#> gvsv[*b] s
9210 <$> const[IV 42] s
9311 <2> add[t3] sK/2
9412 <#> gvsv[*a] s
9520 <2> sassign sKS/2
cc02ea56 9621 <1> leavesub[1 ref] K/REFC,1
724aa791 97EOT_EOT
724aa791
JC		 98# 1 <;> nextstate(main 62 optree_concise.t:161) v
99# 2 <$> gvsv(*b) s
100# 10 <$> const(IV 42) s
101# 11 <2> add[t1] sK/2
102# 12 <$> gvsv(*a) s
103# 20 <2> sassign sKS/2
104# 21 <1> leavesub[1 ref] K/REFC,1
105EONT_EONT
106
107checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
108 bcopts => '-basic',
109 code => sub{$a=$b+42},
110 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
11121 <1> leavesub[1 ref] K/REFC,1 ->(end)
112- <@> lineseq KP ->21
1131 <;> nextstate(main 32 optree_concise.t:164) v ->2
11420 <2> sassign sKS/2 ->21
11511 <2> add[t3] sK/2 ->12
116- <1> ex-rv2sv sK/1 ->10
1172 <#> gvsv[*b] s ->10
11810 <$> const[IV 42] s ->11
119- <1> ex-rv2sv sKRM*/1 ->20
12012 <#> gvsv[*a] s ->20
121EOT_EOT
122# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
123# - <@> lineseq KP ->21
124# 1 <;> nextstate(main 63 optree_concise.t:186) v ->2
125# 20 <2> sassign sKS/2 ->21
126# 11 <2> add[t1] sK/2 ->12
127# - <1> ex-rv2sv sK/1 ->10
128# 2 <$> gvsv(*b) s ->10
129# 10 <$> const(IV 42) s ->11
130# - <1> ex-rv2sv sKRM*/1 ->20
131# 12 <$> gvsv(*a) s ->20
132EONT_EONT
133
134checkOptree ( name => '-base4',
135 bcopts => [qw/ -basic -base4 /],
136 code => sub{$a=$b+42},
137 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
13813 <1> leavesub[1 ref] K/REFC,1 ->(end)
139- <@> lineseq KP ->13
1401 <;> nextstate(main 26 optree_concise.t:145) v ->2
14112 <2> sassign sKS/2 ->13
14210 <2> add[t3] sK/2 ->11
143- <1> ex-rv2sv sK/1 ->3
1442 <#> gvsv[*b] s ->3
1453 <$> const[IV 42] s ->10
146- <1> ex-rv2sv sKRM*/1 ->12
14711 <#> gvsv[*a] s ->12
148EOT_EOT
149# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
150# - <@> lineseq KP ->13
151# 1 <;> nextstate(main 64 optree_concise.t:193) v ->2
152# 12 <2> sassign sKS/2 ->13
153# 10 <2> add[t1] sK/2 ->11
154# - <1> ex-rv2sv sK/1 ->3
155# 2 <$> gvsv(*b) s ->3
156# 3 <$> const(IV 42) s ->10
157# - <1> ex-rv2sv sKRM*/1 ->12
158# 11 <$> gvsv(*a) s ->12
159EONT_EONT
160
161checkOptree ( name => "restore -base36 default",
162 bcopts => [qw/ -basic -base36 /],
163 code => sub{$a},
164 crossfail => 1,
165 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1663 <1> leavesub[1 ref] K/REFC,1 ->(end)
167- <@> lineseq KP ->3
1681 <;> nextstate(main 27 optree_concise.t:161) v ->2
169- <1> ex-rv2sv sK/1 ->-
1702 <#> gvsv[*a] s ->3
171EOT_EOT
172# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
173# - <@> lineseq KP ->3
174# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2
175# - <1> ex-rv2sv sK/1 ->-
176# 2 <$> gvsv(*a) s ->3
177EONT_EONT
178
179checkOptree ( name => "terse basic",
180 bcopts => [qw/ -basic -terse /],
181 code => sub{$a},
182 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
183UNOP (0x82b0918) leavesub [1]
184 LISTOP (0x82b08d8) lineseq
185 COP (0x82b0880) nextstate
186 UNOP (0x82b0860) null [15]
187 PADOP (0x82b0840) gvsv GV (0x82a818c) *a
188EOT_EOT
189# UNOP (0x8282310) leavesub [1]
190# LISTOP (0x82822f0) lineseq
191# COP (0x82822b8) nextstate
192# UNOP (0x812fc20) null [15]
193# SVOP (0x812fc00) gvsv GV (0x814692c) *a
194EONT_EONT
195
196checkOptree ( name => "sticky-terse exec",
197 bcopts => [qw/ -exec /],
198 code => sub{$a},
199 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 200COP (0x82b0d70) nextstate
201PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
202UNOP (0x82b0e08) leavesub [1]
203EOT_EOT
724aa791
JC		 204# COP (0x82828e0) nextstate
205# SVOP (0x82828a0) gvsv GV (0x814692c) *a
206# UNOP (0x8282938) leavesub [1]
207EONT_EONT
208
209pass("OPTIONS IN CMDLINE MODE");
210
19e169bf
JC		 211checkOptree ( name => 'cmdline invoke -basic works',
212 prog => 'sort @a',
213 errs => [ 'Useless use of sort in void context at -e line 1.',
214 'Name "main::a" used only once: possible typo at -e line 1.',
215 ],
724aa791
JC		 216 #bcopts => '-basic', # default
217 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
218# 7 <@> leave[1 ref] vKP/REFC ->(end)
219# 1 <0> enter ->2
220# 2 <;> nextstate(main 1 -e:1) v ->3
221# 6 <@> sort vK ->7
222# 3 <0> pushmark s ->4
223# 5 <1> rv2av[t2] lK/1 ->6
224# 4 <#> gv[*a] s ->5
225EOT_EOT
226# 7 <@> leave[1 ref] vKP/REFC ->(end)
227# 1 <0> enter ->2
228# 2 <;> nextstate(main 1 -e:1) v ->3
229# 6 <@> sort vK ->7
230# 3 <0> pushmark s ->4
231# 5 <1> rv2av[t1] lK/1 ->6
232# 4 <$> gv(*a) s ->5
233EONT_EONT
234
19e169bf
JC		 235checkOptree ( name => 'cmdline invoke -exec works',
236 prog => 'sort @a',
237 errs => [ 'Useless use of sort in void context at -e line 1.',
238 'Name "main::a" used only once: possible typo at -e line 1.',
239 ],
240 bcopts => '-exec',
241 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 2421 <0> enter
2432 <;> nextstate(main 1 -e:1) v
2443 <0> pushmark s
2454 <#> gv[*a] s
2465 <1> rv2av[t2] lK/1
2476 <@> sort vK
2487 <@> leave[1 ref] vKP/REFC
249EOT_EOT
250# 1 <0> enter
251# 2 <;> nextstate(main 1 -e:1) v
252# 3 <0> pushmark s
253# 4 <$> gv(*a) s
254# 5 <1> rv2av[t1] lK/1
255# 6 <@> sort vK
256# 7 <@> leave[1 ref] vKP/REFC
257EONT_EONT
258
5e251bf1 259;
19e169bf 260
5e251bf1
JC		 261checkOptree
262 ( name => 'cmdline self-strict compile err using prog',
263 prog => 'use strict; sort @a',
264 bcopts => [qw/ -basic -concise -exec /],
19e169bf
JC		 265 errs => 'Global symbol "@a" requires explicit package name at -e line 1.',
266 expect => 'nextstate',
267 expect_nt => 'nextstate',
268 noanchors => 1, # allow simple expectations to work
5e251bf1 269 );
724aa791 270
5e251bf1
JC		 271checkOptree
272 ( name => 'cmdline self-strict compile err using code',
273 code => 'use strict; sort @a',
274 bcopts => [qw/ -basic -concise -exec /],
5e251bf1 275 errs => 'Global symbol "@a" requires explicit package name at .*? line 1.',
19e169bf
JC		 276 note => 'this test relys on a kludge which copies $@ to rendering when empty',
277 expect => 'Global symbol',
278 expect_nt => 'Global symbol',
279 noanchors => 1, # allow simple expectations to work
5e251bf1
JC		 280 );
281
282checkOptree
283 ( name => 'cmdline -basic -concise -exec works',
284 prog => 'our @a; sort @a',
285 bcopts => [qw/ -basic -concise -exec /],
19e169bf 286 errs => ['Useless use of sort in void context at -e line 1.'],
5e251bf1 287 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 288# 1 <0> enter
289# 2 <;> nextstate(main 1 -e:1) v
290# 3 <#> gv[*a] s
291# 4 <1> rv2av[t3] vK/OURINTR,1
292# 5 <;> nextstate(main 2 -e:1) v
293# 6 <0> pushmark s
294# 7 <#> gv[*a] s
295# 8 <1> rv2av[t5] lK/1
296# 9 <@> sort vK
297# a <@> leave[1 ref] vKP/REFC
298EOT_EOT
299# 1 <0> enter
300# 2 <;> nextstate(main 1 -e:1) v
301# 3 <$> gv(*a) s
302# 4 <1> rv2av[t2] vK/OURINTR,1
303# 5 <;> nextstate(main 2 -e:1) v
304# 6 <0> pushmark s
305# 7 <$> gv(*a) s
306# 8 <1> rv2av[t3] lK/1
307# 9 <@> sort vK
308# a <@> leave[1 ref] vKP/REFC
309EONT_EONT
310
311
312#################################
313pass("B::Concise STYLE/CALLBACK TESTS");
314
315use B::Concise qw( walk_output add_style set_style_standard add_callback );
316
317# new relative style, added by set_up_relative_test()
318@stylespec =
319 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
320 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
321 . "(x(;~=> #extra)x)\n" # new 'variable' used here
322
323 , " (*( )*) goto #seq\n"
cc02ea56 324 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791
JC		 325 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
326 );
327
328sub set_up_relative_test {
329 # add a new style, and a callback which adds an 'extra' property
330
331 add_style ( "relative" => @stylespec );
332 #set_style_standard ( "relative" );
333
334 add_callback
335 ( sub {
336 my ($h, $op, $format, $level, $style) = @_;
337
338 # callback marks up const ops
339 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
340 $h->{extra} = '';
341
cc02ea56
JC		 342 if ($lastnext and $$lastnext != $$op) {
343 $h->{goto} = ($h->{seq} eq '-')
344 ? 'unresolved' : $h->{seq};
345 }
346
724aa791
JC		 347 # 2 style specific behaviors
348 if ($style eq 'relative') {
349 $h->{extra} = 'RELATIVE';
350 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
351 }
352 elsif ($style eq 'scope') {
353 # supress printout entirely
354 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
355 }
356 });
357}
358
359#################################
360set_up_relative_test();
361pass("set_up_relative_test, new callback installed");
362
363checkOptree ( name => 'callback used, independent of style',
364 bcopts => [qw/ -concise -exec /],
365 code => sub{$a=$b+42},
366 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 3671 <;> nextstate(main 76 optree_concise.t:337) v
3682 <#> gvsv[*b] s
3693 <$> const[IV 42] CALLBACK s
3704 <2> add[t3] sK/2
3715 <#> gvsv[*a] s
3726 <2> sassign sKS/2
3737 <1> leavesub[1 ref] K/REFC,1
374EOT_EOT
375# 1 <;> nextstate(main 455 optree_concise.t:328) v
376# 2 <$> gvsv(*b) s
377# 3 <$> const(IV 42) CALLBACK s
378# 4 <2> add[t1] sK/2
379# 5 <$> gvsv(*a) s
380# 6 <2> sassign sKS/2
381# 7 <1> leavesub[1 ref] K/REFC,1
382EONT_EONT
383
384checkOptree ( name => "new 'relative' style, -exec mode",
385 bcopts => [qw/ -basic -relative /],
386 code => sub{$a=$b+42},
387 crossfail => 1,
388 #retry => 1,
389 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56
JC		 3907 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
391- <@> lineseq KP ->7 => RELATIVE
3921 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
3936 <2> sassign sKS ->7 => RELATIVE
3944 <2> add[t3] sK ->5 => RELATIVE
395- <1> ex-rv2sv sK ->3 => RELATIVE
3962 <#> gvsv[*b] s ->3 => RELATIVE
3973 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
398- <1> ex-rv2sv sKRM* ->6 => RELATIVE
3995 <#> gvsv[*a] s ->6 => RELATIVE
724aa791 400EOT_EOT
cc02ea56
JC		 401# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
402# - <@> lineseq KP ->7 => RELATIVE
403# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
404# 6 <2> sassign sKS ->7 => RELATIVE
405# 4 <2> add[t1] sK ->5 => RELATIVE
406# - <1> ex-rv2sv sK ->3 => RELATIVE
407# 2 <$> gvsv(*b) s ->3 => RELATIVE
408# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
409# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
410# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791
JC		 411EONT_EONT
412
413checkOptree ( name => "both -exec -relative",
414 bcopts => [qw/ -exec -relative /],
415 code => sub{$a=$b+42},
416 crossfail => 1,
417 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 4181 <;> nextstate(main 50 optree_concise.t:326) v
4192 <#> gvsv[*b] s
4203 <$> const[IV 42] CALLBACK s
4214 <2> add[t3] sK
4225 <#> gvsv[*a] s
4236 <2> sassign sKS
4247 <1> leavesub RELATIVE[1 ref] K
425EOT_EOT
426# 1 <;> nextstate(main 78 optree_concise.t:371) v
427# 2 <$> gvsv(*b) s
428# 3 <$> const(IV 42) CALLBACK s
429# 4 <2> add[t1] sK
430# 5 <$> gvsv(*a) s
431# 6 <2> sassign sKS
432# 7 <1> leavesub RELATIVE[1 ref] K
433EONT_EONT
434
435#################################
436
437@scopeops = qw( leavesub enter leave nextstate );
438add_style
439 ( 'scope' # concise copy
440 , "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
441 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
442 , " (*( )*) goto #seq\n"
443 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
444 );
445
446checkOptree ( name => "both -exec -scope",
447 bcopts => [qw/ -exec -scope /],
448 code => sub{$a=$b+42},
449 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 4501 <;> nextstate(main 50 optree_concise.t:337) v
4517 <1> leavesub[1 ref] K/REFC,1
452EOT_EOT
724aa791
JC		 4531 <;> nextstate(main 75 optree_concise.t:396) v
4547 <1> leavesub[1 ref] K/REFC,1
455EONT_EONT
456
457
458checkOptree ( name => "both -basic -scope",
459 bcopts => [qw/ -basic -scope /],
460 code => sub{$a=$b+42},
461 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4627 <1> leavesub[1 ref] K/REFC,1 ->(end)
4631 <;> nextstate(main 51 optree_concise.t:347) v ->2
464EOT_EOT
4657 <1> leavesub[1 ref] K/REFC,1 ->(end)
4661 <;> nextstate(main 76 optree_concise.t:407) v ->2
467EONT_EONT
468
2ce64696 469} #skip
724aa791 470
Unnamed repository; edit this file 'description' to name the repository.