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
[perl #46947] Parse method-BLOCK arguments as a term
[perl5.git] / ext / B / t / optree_concise.t
CommitLineData
724aa791
JC		 1#!perl
2
3BEGIN {
74517a3a 4 unshift @INC, 't';
9cd8f857
NC		 5 require Config;
6 if (($Config::Config{'extensions'} !~ /\bB\b/) ){
7 print "1..0 # Skip -- Perl configured without B module\n";
8 exit 0;
9 }
27e11f68
NC		 10 if (!$Config::Config{useperlio}) {
11 print "1..0 # Skip -- need perlio to walk the optree\n";
12 exit 0;
13 }
724aa791
JC		 14}
15
16# import checkOptree(), and %gOpts (containing test state)
17use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696 18use Config;
724aa791 19
3857d07c 20plan tests => 41;
724aa791
JC		 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},
be2b1c74 32 strip_open_hints => 1,
724aa791 33 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
19e169bf 34# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
724aa791 35# - <@> lineseq KP ->7
be2b1c74 36# 1 <;> nextstate(foo bar) v:>,<,%,{ ->2
724aa791 37# 6 <2> sassign sKS/2 ->7
19e169bf 38# 4 <2> add[t3] sK/2 ->5
724aa791
JC		 39# - <1> ex-rv2sv sK/1 ->3
40# 2 <#> gvsv[*b] s ->3
41# 3 <$> const[IV 42] s ->4
42# - <1> ex-rv2sv sKRM*/1 ->6
43# 5 <#> gvsv[*a] s ->6
44EOT_EOT
45# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
46# - <@> lineseq KP ->7
be2b1c74 47# 1 <;> nextstate(main 60 optree_concise.t:122) v:>,<,%,{ ->2
724aa791
JC		 48# 6 <2> sassign sKS/2 ->7
49# 4 <2> add[t1] sK/2 ->5
50# - <1> ex-rv2sv sK/1 ->3
51# 2 <$> gvsv(*b) s ->3
52# 3 <$> const(IV 42) s ->4
53# - <1> ex-rv2sv sKRM*/1 ->6
54# 5 <$> gvsv(*a) s ->6
55EONT_EONT
56
57checkOptree ( name => 'canonical example w -exec',
58 bcopts => '-exec',
59 code => sub{$a=$b+42},
be2b1c74 60 strip_open_hints => 1,
724aa791 61 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
be2b1c74 62# 1 <;> nextstate(main 61 optree_concise.t:139) v:>,<,%,{
724aa791
JC		 63# 2 <#> gvsv[*b] s
64# 3 <$> const[IV 42] s
65# 4 <2> add[t3] sK/2
66# 5 <#> gvsv[*a] s
67# 6 <2> sassign sKS/2
68# 7 <1> leavesub[1 ref] K/REFC,1
69EOT_EOT
be2b1c74 70# 1 <;> nextstate(main 61 optree_concise.t:139) v:>,<,%,{
724aa791
JC		 71# 2 <$> gvsv(*b) s
72# 3 <$> const(IV 42) s
73# 4 <2> add[t1] sK/2
74# 5 <$> gvsv(*a) s
75# 6 <2> sassign sKS/2
76# 7 <1> leavesub[1 ref] K/REFC,1
77EONT_EONT
78
724aa791
JC		 79#################################
80pass("B::Concise OPTION TESTS");
81
82checkOptree ( name => '-base3 sticky-exec',
83 bcopts => '-base3',
84 code => sub{$a=$b+42},
be2b1c74 85 strip_open_hints => 1,
724aa791 86 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
be2b1c74 871 <;> dbstate(main 24 optree_concise.t:132) v:>,<,%,{
724aa791
JC		 882 <#> gvsv[*b] s
8910 <$> const[IV 42] s
9011 <2> add[t3] sK/2
9112 <#> gvsv[*a] s
9220 <2> sassign sKS/2
cc02ea56 9321 <1> leavesub[1 ref] K/REFC,1
724aa791 94EOT_EOT
be2b1c74 95# 1 <;> nextstate(main 62 optree_concise.t:161) v:>,<,%,{
724aa791
JC		 96# 2 <$> gvsv(*b) s
97# 10 <$> const(IV 42) s
98# 11 <2> add[t1] sK/2
99# 12 <$> gvsv(*a) s
100# 20 <2> sassign sKS/2
101# 21 <1> leavesub[1 ref] K/REFC,1
102EONT_EONT
103
104checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
105 bcopts => '-basic',
106 code => sub{$a=$b+42},
be2b1c74 107 strip_open_hints => 1,
724aa791
JC		 108 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
10921 <1> leavesub[1 ref] K/REFC,1 ->(end)
110- <@> lineseq KP ->21
be2b1c74 1111 <;> nextstate(main 32 optree_concise.t:164) v:>,<,%,{ ->2
724aa791
JC		 11220 <2> sassign sKS/2 ->21
11311 <2> add[t3] sK/2 ->12
114- <1> ex-rv2sv sK/1 ->10
1152 <#> gvsv[*b] s ->10
11610 <$> const[IV 42] s ->11
117- <1> ex-rv2sv sKRM*/1 ->20
11812 <#> gvsv[*a] s ->20
119EOT_EOT
120# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
121# - <@> lineseq KP ->21
be2b1c74 122# 1 <;> nextstate(main 63 optree_concise.t:186) v:>,<,%,{ ->2
724aa791
JC		 123# 20 <2> sassign sKS/2 ->21
124# 11 <2> add[t1] sK/2 ->12
125# - <1> ex-rv2sv sK/1 ->10
126# 2 <$> gvsv(*b) s ->10
127# 10 <$> const(IV 42) s ->11
128# - <1> ex-rv2sv sKRM*/1 ->20
129# 12 <$> gvsv(*a) s ->20
130EONT_EONT
131
132checkOptree ( name => '-base4',
133 bcopts => [qw/ -basic -base4 /],
134 code => sub{$a=$b+42},
be2b1c74 135 strip_open_hints => 1,
724aa791
JC		 136 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
13713 <1> leavesub[1 ref] K/REFC,1 ->(end)
138- <@> lineseq KP ->13
be2b1c74 1391 <;> nextstate(main 26 optree_concise.t:145) v:>,<,%,{ ->2
724aa791
JC		 14012 <2> sassign sKS/2 ->13
14110 <2> add[t3] sK/2 ->11
142- <1> ex-rv2sv sK/1 ->3
1432 <#> gvsv[*b] s ->3
1443 <$> const[IV 42] s ->10
145- <1> ex-rv2sv sKRM*/1 ->12
14611 <#> gvsv[*a] s ->12
147EOT_EOT
148# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
149# - <@> lineseq KP ->13
be2b1c74 150# 1 <;> nextstate(main 64 optree_concise.t:193) v:>,<,%,{ ->2
724aa791
JC		 151# 12 <2> sassign sKS/2 ->13
152# 10 <2> add[t1] sK/2 ->11
153# - <1> ex-rv2sv sK/1 ->3
154# 2 <$> gvsv(*b) s ->3
155# 3 <$> const(IV 42) s ->10
156# - <1> ex-rv2sv sKRM*/1 ->12
157# 11 <$> gvsv(*a) s ->12
158EONT_EONT
159
160checkOptree ( name => "restore -base36 default",
161 bcopts => [qw/ -basic -base36 /],
162 code => sub{$a},
163 crossfail => 1,
be2b1c74 164 strip_open_hints => 1,
724aa791
JC		 165 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1663 <1> leavesub[1 ref] K/REFC,1 ->(end)
167- <@> lineseq KP ->3
be2b1c74 1681 <;> nextstate(main 27 optree_concise.t:161) v:>,<,% ->2
724aa791
JC		 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
be2b1c74 174# 1 <;> nextstate(main 65 optree_concise.t:210) v:>,<,% ->2
724aa791
JC		 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 216 #bcopts => '-basic', # default
be2b1c74 217 strip_open_hints => 1,
724aa791
JC		 218 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
219# 7 <@> leave[1 ref] vKP/REFC ->(end)
220# 1 <0> enter ->2
be2b1c74 221# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
724aa791
JC		 222# 6 <@> sort vK ->7
223# 3 <0> pushmark s ->4
224# 5 <1> rv2av[t2] lK/1 ->6
225# 4 <#> gv[*a] s ->5
226EOT_EOT
227# 7 <@> leave[1 ref] vKP/REFC ->(end)
228# 1 <0> enter ->2
be2b1c74 229# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->3
724aa791
JC		 230# 6 <@> sort vK ->7
231# 3 <0> pushmark s ->4
232# 5 <1> rv2av[t1] lK/1 ->6
233# 4 <$> gv(*a) s ->5
234EONT_EONT
235
19e169bf
JC		 236checkOptree ( name => 'cmdline invoke -exec works',
237 prog => 'sort @a',
238 errs => [ 'Useless use of sort in void context at -e line 1.',
239 'Name "main::a" used only once: possible typo at -e line 1.',
240 ],
241 bcopts => '-exec',
be2b1c74 242 strip_open_hints => 1,
19e169bf 243 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 2441 <0> enter
be2b1c74 2452 <;> nextstate(main 1 -e:1) v:>,<,%,{
724aa791
JC		 2463 <0> pushmark s
2474 <#> gv[*a] s
2485 <1> rv2av[t2] lK/1
2496 <@> sort vK
2507 <@> leave[1 ref] vKP/REFC
251EOT_EOT
252# 1 <0> enter
be2b1c74 253# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{
724aa791
JC		 254# 3 <0> pushmark s
255# 4 <$> gv(*a) s
256# 5 <1> rv2av[t1] lK/1
257# 6 <@> sort vK
258# 7 <@> leave[1 ref] vKP/REFC
259EONT_EONT
260
5e251bf1 261;
19e169bf 262
5e251bf1
JC		 263checkOptree
264 ( name => 'cmdline self-strict compile err using prog',
265 prog => 'use strict; sort @a',
266 bcopts => [qw/ -basic -concise -exec /],
19e169bf
JC		 267 errs => 'Global symbol "@a" requires explicit package name at -e line 1.',
268 expect => 'nextstate',
269 expect_nt => 'nextstate',
270 noanchors => 1, # allow simple expectations to work
5e251bf1 271 );
724aa791 272
5e251bf1
JC		 273checkOptree
274 ( name => 'cmdline self-strict compile err using code',
275 code => 'use strict; sort @a',
276 bcopts => [qw/ -basic -concise -exec /],
3f472914 277 errs => qr/Global symbol "\@a" requires explicit package name at .*? line 1\./,
19e169bf
JC		 278 note => 'this test relys on a kludge which copies $@ to rendering when empty',
279 expect => 'Global symbol',
280 expect_nt => 'Global symbol',
281 noanchors => 1, # allow simple expectations to work
5e251bf1
JC		 282 );
283
284checkOptree
285 ( name => 'cmdline -basic -concise -exec works',
286 prog => 'our @a; sort @a',
287 bcopts => [qw/ -basic -concise -exec /],
19e169bf 288 errs => ['Useless use of sort in void context at -e line 1.'],
be2b1c74 289 strip_open_hints => 1,
5e251bf1 290 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 291# 1 <0> enter
be2b1c74 292# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{
724aa791
JC		 293# 3 <#> gv[*a] s
294# 4 <1> rv2av[t3] vK/OURINTR,1
be2b1c74 295# 5 <;> nextstate(main 2 -e:1) v:>,<,%,{
724aa791
JC		 296# 6 <0> pushmark s
297# 7 <#> gv[*a] s
298# 8 <1> rv2av[t5] lK/1
299# 9 <@> sort vK
300# a <@> leave[1 ref] vKP/REFC
301EOT_EOT
302# 1 <0> enter
be2b1c74 303# 2 <;> nextstate(main 1 -e:1) v:>,<,%,{
724aa791
JC		 304# 3 <$> gv(*a) s
305# 4 <1> rv2av[t2] vK/OURINTR,1
be2b1c74 306# 5 <;> nextstate(main 2 -e:1) v:>,<,%,{
724aa791
JC		 307# 6 <0> pushmark s
308# 7 <$> gv(*a) s
309# 8 <1> rv2av[t3] lK/1
310# 9 <@> sort vK
311# a <@> leave[1 ref] vKP/REFC
312EONT_EONT
313
314
315#################################
316pass("B::Concise STYLE/CALLBACK TESTS");
317
318use B::Concise qw( walk_output add_style set_style_standard add_callback );
319
320# new relative style, added by set_up_relative_test()
321@stylespec =
322 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
323 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
324 . "(x(;~=> #extra)x)\n" # new 'variable' used here
325
326 , " (*( )*) goto #seq\n"
cc02ea56 327 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791
JC		 328 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
329 );
330
331sub set_up_relative_test {
332 # add a new style, and a callback which adds an 'extra' property
333
334 add_style ( "relative" => @stylespec );
335 #set_style_standard ( "relative" );
336
337 add_callback
338 ( sub {
339 my ($h, $op, $format, $level, $style) = @_;
340
341 # callback marks up const ops
342 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
343 $h->{extra} = '';
344
cc02ea56
JC		 345 if ($lastnext and $$lastnext != $$op) {
346 $h->{goto} = ($h->{seq} eq '-')
347 ? 'unresolved' : $h->{seq};
348 }
349
724aa791
JC		 350 # 2 style specific behaviors
351 if ($style eq 'relative') {
352 $h->{extra} = 'RELATIVE';
353 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
354 }
355 elsif ($style eq 'scope') {
b7b1e41b 356 # suppress printout entirely
724aa791
JC		 357 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
358 }
359 });
360}
361
362#################################
363set_up_relative_test();
364pass("set_up_relative_test, new callback installed");
365
366checkOptree ( name => 'callback used, independent of style',
367 bcopts => [qw/ -concise -exec /],
368 code => sub{$a=$b+42},
be2b1c74 369 strip_open_hints => 1,
724aa791 370 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
be2b1c74 3711 <;> nextstate(main 76 optree_concise.t:337) v:>,<,%,{
724aa791
JC		 3722 <#> gvsv[*b] s
3733 <$> const[IV 42] CALLBACK s
3744 <2> add[t3] sK/2
3755 <#> gvsv[*a] s
3766 <2> sassign sKS/2
3777 <1> leavesub[1 ref] K/REFC,1
378EOT_EOT
be2b1c74 379# 1 <;> nextstate(main 455 optree_concise.t:328) v:>,<,%,{
724aa791
JC		 380# 2 <$> gvsv(*b) s
381# 3 <$> const(IV 42) CALLBACK s
382# 4 <2> add[t1] sK/2
383# 5 <$> gvsv(*a) s
384# 6 <2> sassign sKS/2
385# 7 <1> leavesub[1 ref] K/REFC,1
386EONT_EONT
387
388checkOptree ( name => "new 'relative' style, -exec mode",
389 bcopts => [qw/ -basic -relative /],
390 code => sub{$a=$b+42},
391 crossfail => 1,
392 #retry => 1,
393 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56
JC		 3947 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
395- <@> lineseq KP ->7 => RELATIVE
3961 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
3976 <2> sassign sKS ->7 => RELATIVE
3984 <2> add[t3] sK ->5 => RELATIVE
399- <1> ex-rv2sv sK ->3 => RELATIVE
4002 <#> gvsv[*b] s ->3 => RELATIVE
4013 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
402- <1> ex-rv2sv sKRM* ->6 => RELATIVE
4035 <#> gvsv[*a] s ->6 => RELATIVE
724aa791 404EOT_EOT
cc02ea56
JC		 405# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
406# - <@> lineseq KP ->7 => RELATIVE
407# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
408# 6 <2> sassign sKS ->7 => RELATIVE
409# 4 <2> add[t1] sK ->5 => RELATIVE
410# - <1> ex-rv2sv sK ->3 => RELATIVE
411# 2 <$> gvsv(*b) s ->3 => RELATIVE
412# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
413# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
414# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791
JC		 415EONT_EONT
416
417checkOptree ( name => "both -exec -relative",
418 bcopts => [qw/ -exec -relative /],
419 code => sub{$a=$b+42},
420 crossfail => 1,
421 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 4221 <;> nextstate(main 50 optree_concise.t:326) v
4232 <#> gvsv[*b] s
4243 <$> const[IV 42] CALLBACK s
4254 <2> add[t3] sK
4265 <#> gvsv[*a] s
4276 <2> sassign sKS
4287 <1> leavesub RELATIVE[1 ref] K
429EOT_EOT
430# 1 <;> nextstate(main 78 optree_concise.t:371) v
431# 2 <$> gvsv(*b) s
432# 3 <$> const(IV 42) CALLBACK s
433# 4 <2> add[t1] sK
434# 5 <$> gvsv(*a) s
435# 6 <2> sassign sKS
436# 7 <1> leavesub RELATIVE[1 ref] K
437EONT_EONT
438
439#################################
440
441@scopeops = qw( leavesub enter leave nextstate );
442add_style
443 ( 'scope' # concise copy
444 , "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
445 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
446 , " (*( )*) goto #seq\n"
447 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
448 );
449
450checkOptree ( name => "both -exec -scope",
451 bcopts => [qw/ -exec -scope /],
452 code => sub{$a=$b+42},
453 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791
JC		 4541 <;> nextstate(main 50 optree_concise.t:337) v
4557 <1> leavesub[1 ref] K/REFC,1
456EOT_EOT
724aa791
JC		 4571 <;> nextstate(main 75 optree_concise.t:396) v
4587 <1> leavesub[1 ref] K/REFC,1
459EONT_EONT
460
461
462checkOptree ( name => "both -basic -scope",
463 bcopts => [qw/ -basic -scope /],
464 code => sub{$a=$b+42},
465 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4667 <1> leavesub[1 ref] K/REFC,1 ->(end)
4671 <;> nextstate(main 51 optree_concise.t:347) v ->2
468EOT_EOT
4697 <1> leavesub[1 ref] K/REFC,1 ->(end)
4701 <;> nextstate(main 76 optree_concise.t:407) v ->2
471EONT_EONT
Unnamed repository; edit this file 'description' to name the repository.