projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Re: more B::Concise stuff (PATCH - updated)
[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');
6 require './test.pl';
7}
8
9# import checkOptree(), and %gOpts (containing test state)
10use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!!
2ce64696 11use Config;
724aa791 12
cc02ea56 13plan tests => 23;
2ce64696 14SKIP: {
15skip "no perlio in this build", 24 unless $Config::Config{useperlio};
724aa791 16
17$SIG{__WARN__} = sub {
18 my $err = shift;
19 $err =~ m/Subroutine re::(un)?install redefined/ and return;
20};
21#################################
22pass("CANONICAL B::Concise EXAMPLE");
23
24checkOptree ( name => 'canonical example w -basic',
25 bcopts => '-basic',
26 code => sub{$a=$b+42},
27 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
28# 7 <1> leavesub[\d+ refs?] K/REFC,1 ->(end)
29# - <@> lineseq KP ->7
30# 1 <;> nextstate(foo bar) v ->2
31# 6 <2> sassign sKS/2 ->7
32# 4 <2> add[t\d+] sK/2 ->5
33# - <1> ex-rv2sv sK/1 ->3
34# 2 <#> gvsv[*b] s ->3
35# 3 <$> const[IV 42] s ->4
36# - <1> ex-rv2sv sKRM*/1 ->6
37# 5 <#> gvsv[*a] s ->6
38EOT_EOT
39# 7 <1> leavesub[1 ref] K/REFC,1 ->(end)
40# - <@> lineseq KP ->7
41# 1 <;> nextstate(main 60 optree_concise.t:122) v ->2
42# 6 <2> sassign sKS/2 ->7
43# 4 <2> add[t1] sK/2 ->5
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
49EONT_EONT
50
51checkOptree ( name => 'canonical example w -exec',
52 bcopts => '-exec',
53 code => sub{$a=$b+42},
54 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 55# 1 <;> nextstate(main 61 optree_concise.t:139) v
56# 2 <#> gvsv[*b] s
57# 3 <$> const[IV 42] s
58# 4 <2> add[t3] sK/2
59# 5 <#> gvsv[*a] s
60# 6 <2> sassign sKS/2
61# 7 <1> leavesub[1 ref] K/REFC,1
62EOT_EOT
724aa791 63# 1 <;> nextstate(main 61 optree_concise.t:139) v
64# 2 <$> gvsv(*b) s
65# 3 <$> const(IV 42) s
66# 4 <2> add[t1] sK/2
67# 5 <$> gvsv(*a) s
68# 6 <2> sassign sKS/2
69# 7 <1> leavesub[1 ref] K/REFC,1
70EONT_EONT
71
724aa791 72#################################
73pass("B::Concise OPTION TESTS");
74
75checkOptree ( name => '-base3 sticky-exec',
76 bcopts => '-base3',
77 code => sub{$a=$b+42},
78 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 791 <;> dbstate(main 24 optree_concise.t:132) v
802 <#> gvsv[*b] s
8110 <$> const[IV 42] s
8211 <2> add[t3] sK/2
8312 <#> gvsv[*a] s
8420 <2> sassign sKS/2
cc02ea56 8521 <1> leavesub[1 ref] K/REFC,1
724aa791 86EOT_EOT
724aa791 87# 1 <;> nextstate(main 62 optree_concise.t:161) v
88# 2 <$> gvsv(*b) s
89# 10 <$> const(IV 42) s
90# 11 <2> add[t1] sK/2
91# 12 <$> gvsv(*a) s
92# 20 <2> sassign sKS/2
93# 21 <1> leavesub[1 ref] K/REFC,1
94EONT_EONT
95
96checkOptree ( name => 'sticky-base3, -basic over sticky-exec',
97 bcopts => '-basic',
98 code => sub{$a=$b+42},
99 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
10021 <1> leavesub[1 ref] K/REFC,1 ->(end)
101- <@> lineseq KP ->21
1021 <;> nextstate(main 32 optree_concise.t:164) v ->2
10320 <2> sassign sKS/2 ->21
10411 <2> add[t3] sK/2 ->12
105- <1> ex-rv2sv sK/1 ->10
1062 <#> gvsv[*b] s ->10
10710 <$> const[IV 42] s ->11
108- <1> ex-rv2sv sKRM*/1 ->20
10912 <#> gvsv[*a] s ->20
110EOT_EOT
111# 21 <1> leavesub[1 ref] K/REFC,1 ->(end)
112# - <@> lineseq KP ->21
113# 1 <;> nextstate(main 63 optree_concise.t:186) v ->2
114# 20 <2> sassign sKS/2 ->21
115# 11 <2> add[t1] sK/2 ->12
116# - <1> ex-rv2sv sK/1 ->10
117# 2 <$> gvsv(*b) s ->10
118# 10 <$> const(IV 42) s ->11
119# - <1> ex-rv2sv sKRM*/1 ->20
120# 12 <$> gvsv(*a) s ->20
121EONT_EONT
122
123checkOptree ( name => '-base4',
124 bcopts => [qw/ -basic -base4 /],
125 code => sub{$a=$b+42},
126 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
12713 <1> leavesub[1 ref] K/REFC,1 ->(end)
128- <@> lineseq KP ->13
1291 <;> nextstate(main 26 optree_concise.t:145) v ->2
13012 <2> sassign sKS/2 ->13
13110 <2> add[t3] sK/2 ->11
132- <1> ex-rv2sv sK/1 ->3
1332 <#> gvsv[*b] s ->3
1343 <$> const[IV 42] s ->10
135- <1> ex-rv2sv sKRM*/1 ->12
13611 <#> gvsv[*a] s ->12
137EOT_EOT
138# 13 <1> leavesub[1 ref] K/REFC,1 ->(end)
139# - <@> lineseq KP ->13
140# 1 <;> nextstate(main 64 optree_concise.t:193) v ->2
141# 12 <2> sassign sKS/2 ->13
142# 10 <2> add[t1] sK/2 ->11
143# - <1> ex-rv2sv sK/1 ->3
144# 2 <$> gvsv(*b) s ->3
145# 3 <$> const(IV 42) s ->10
146# - <1> ex-rv2sv sKRM*/1 ->12
147# 11 <$> gvsv(*a) s ->12
148EONT_EONT
149
150checkOptree ( name => "restore -base36 default",
151 bcopts => [qw/ -basic -base36 /],
152 code => sub{$a},
153 crossfail => 1,
154 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
1553 <1> leavesub[1 ref] K/REFC,1 ->(end)
156- <@> lineseq KP ->3
1571 <;> nextstate(main 27 optree_concise.t:161) v ->2
158- <1> ex-rv2sv sK/1 ->-
1592 <#> gvsv[*a] s ->3
160EOT_EOT
161# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
162# - <@> lineseq KP ->3
163# 1 <;> nextstate(main 65 optree_concise.t:210) v ->2
164# - <1> ex-rv2sv sK/1 ->-
165# 2 <$> gvsv(*a) s ->3
166EONT_EONT
167
168checkOptree ( name => "terse basic",
169 bcopts => [qw/ -basic -terse /],
170 code => sub{$a},
171 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
172UNOP (0x82b0918) leavesub [1]
173 LISTOP (0x82b08d8) lineseq
174 COP (0x82b0880) nextstate
175 UNOP (0x82b0860) null [15]
176 PADOP (0x82b0840) gvsv GV (0x82a818c) *a
177EOT_EOT
178# UNOP (0x8282310) leavesub [1]
179# LISTOP (0x82822f0) lineseq
180# COP (0x82822b8) nextstate
181# UNOP (0x812fc20) null [15]
182# SVOP (0x812fc00) gvsv GV (0x814692c) *a
183EONT_EONT
184
185checkOptree ( name => "sticky-terse exec",
186 bcopts => [qw/ -exec /],
187 code => sub{$a},
188 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 189COP (0x82b0d70) nextstate
190PADOP (0x82b0d30) gvsv GV (0x82a818c) *a
191UNOP (0x82b0e08) leavesub [1]
192EOT_EOT
724aa791 193# COP (0x82828e0) nextstate
194# SVOP (0x82828a0) gvsv GV (0x814692c) *a
195# UNOP (0x8282938) leavesub [1]
196EONT_EONT
197
198pass("OPTIONS IN CMDLINE MODE");
199
200checkOptree ( name => 'cmdline invoke -basic works',
201 prog => 'sort @a',
202 #bcopts => '-basic', # default
203 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
204# 7 <@> leave[1 ref] vKP/REFC ->(end)
205# 1 <0> enter ->2
206# 2 <;> nextstate(main 1 -e:1) v ->3
207# 6 <@> sort vK ->7
208# 3 <0> pushmark s ->4
209# 5 <1> rv2av[t2] lK/1 ->6
210# 4 <#> gv[*a] s ->5
211EOT_EOT
212# 7 <@> leave[1 ref] vKP/REFC ->(end)
213# 1 <0> enter ->2
214# 2 <;> nextstate(main 1 -e:1) v ->3
215# 6 <@> sort vK ->7
216# 3 <0> pushmark s ->4
217# 5 <1> rv2av[t1] lK/1 ->6
218# 4 <$> gv(*a) s ->5
219EONT_EONT
220
221checkOptree ( name => 'cmdline invoke -exec works',
222 prog => 'sort @a',
223 bcopts => '-exec',
224 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
2251 <0> enter
2262 <;> nextstate(main 1 -e:1) v
2273 <0> pushmark s
2284 <#> gv[*a] s
2295 <1> rv2av[t2] lK/1
2306 <@> sort vK
2317 <@> leave[1 ref] vKP/REFC
232EOT_EOT
233# 1 <0> enter
234# 2 <;> nextstate(main 1 -e:1) v
235# 3 <0> pushmark s
236# 4 <$> gv(*a) s
237# 5 <1> rv2av[t1] lK/1
238# 6 <@> sort vK
239# 7 <@> leave[1 ref] vKP/REFC
240EONT_EONT
241
242checkOptree ( name => 'cmdline self-strict compile err',
243 prog => 'use strict; sort @a',
244 bcopts => [qw/ -basic -concise -exec /],
cc02ea56 245 noanchors => 1,
724aa791 246 expect => 'compilation errors',
247 expect_nt => 'compilation errors');
248
249checkOptree ( name => 'error at -e line 1',
250 prog => 'our @a; sort @a',
251 bcopts => [qw/ -basic -concise -exec /],
cc02ea56 252 noanchors => 1,
724aa791 253 expect => 'at -e line 1',
254 expect_nt => 'at -e line 1');
255
256checkOptree ( name => 'cmdline -basic -concise -exec works',
257 prog => 'our @a; sort @a',
258 bcopts => [qw/ -basic -concise -exec /],
259 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
260# 1 <0> enter
261# 2 <;> nextstate(main 1 -e:1) v
262# 3 <#> gv[*a] s
263# 4 <1> rv2av[t3] vK/OURINTR,1
264# 5 <;> nextstate(main 2 -e:1) v
265# 6 <0> pushmark s
266# 7 <#> gv[*a] s
267# 8 <1> rv2av[t5] lK/1
268# 9 <@> sort vK
269# a <@> leave[1 ref] vKP/REFC
270EOT_EOT
271# 1 <0> enter
272# 2 <;> nextstate(main 1 -e:1) v
273# 3 <$> gv(*a) s
274# 4 <1> rv2av[t2] vK/OURINTR,1
275# 5 <;> nextstate(main 2 -e:1) v
276# 6 <0> pushmark s
277# 7 <$> gv(*a) s
278# 8 <1> rv2av[t3] lK/1
279# 9 <@> sort vK
280# a <@> leave[1 ref] vKP/REFC
281EONT_EONT
282
283
284#################################
285pass("B::Concise STYLE/CALLBACK TESTS");
286
287use B::Concise qw( walk_output add_style set_style_standard add_callback );
288
289# new relative style, added by set_up_relative_test()
290@stylespec =
291 ( "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
292 . "#exname#arg(?([#targarglife])?)~#flags(?(/#privateb)?)(x(;~->#next)x) "
293 . "(x(;~=> #extra)x)\n" # new 'variable' used here
294
295 , " (*( )*) goto #seq\n"
cc02ea56 296 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
724aa791 297 #. "(x(;~=> #extra)x)\n" # new 'variable' used here
298 );
299
300sub set_up_relative_test {
301 # add a new style, and a callback which adds an 'extra' property
302
303 add_style ( "relative" => @stylespec );
304 #set_style_standard ( "relative" );
305
306 add_callback
307 ( sub {
308 my ($h, $op, $format, $level, $style) = @_;
309
310 # callback marks up const ops
311 $h->{arg} .= ' CALLBACK' if $h->{name} eq 'const';
312 $h->{extra} = '';
313
cc02ea56 314 if ($lastnext and $$lastnext != $$op) {
315 $h->{goto} = ($h->{seq} eq '-')
316 ? 'unresolved' : $h->{seq};
317 }
318
724aa791 319 # 2 style specific behaviors
320 if ($style eq 'relative') {
321 $h->{extra} = 'RELATIVE';
322 $h->{arg} .= ' RELATIVE' if $h->{name} eq 'leavesub';
323 }
324 elsif ($style eq 'scope') {
325 # supress printout entirely
326 $$format="" unless grep { $h->{name} eq $_ } @scopeops;
327 }
328 });
329}
330
331#################################
332set_up_relative_test();
333pass("set_up_relative_test, new callback installed");
334
335checkOptree ( name => 'callback used, independent of style',
336 bcopts => [qw/ -concise -exec /],
337 code => sub{$a=$b+42},
338 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 3391 <;> nextstate(main 76 optree_concise.t:337) v
3402 <#> gvsv[*b] s
3413 <$> const[IV 42] CALLBACK s
3424 <2> add[t3] sK/2
3435 <#> gvsv[*a] s
3446 <2> sassign sKS/2
3457 <1> leavesub[1 ref] K/REFC,1
346EOT_EOT
347# 1 <;> nextstate(main 455 optree_concise.t:328) v
348# 2 <$> gvsv(*b) s
349# 3 <$> const(IV 42) CALLBACK s
350# 4 <2> add[t1] sK/2
351# 5 <$> gvsv(*a) s
352# 6 <2> sassign sKS/2
353# 7 <1> leavesub[1 ref] K/REFC,1
354EONT_EONT
355
356checkOptree ( name => "new 'relative' style, -exec mode",
357 bcopts => [qw/ -basic -relative /],
358 code => sub{$a=$b+42},
359 crossfail => 1,
360 #retry => 1,
361 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
cc02ea56 3627 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
363- <@> lineseq KP ->7 => RELATIVE
3641 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE
3656 <2> sassign sKS ->7 => RELATIVE
3664 <2> add[t3] sK ->5 => RELATIVE
367- <1> ex-rv2sv sK ->3 => RELATIVE
3682 <#> gvsv[*b] s ->3 => RELATIVE
3693 <$> const[IV 42] CALLBACK s ->4 => RELATIVE
370- <1> ex-rv2sv sKRM* ->6 => RELATIVE
3715 <#> gvsv[*a] s ->6 => RELATIVE
724aa791 372EOT_EOT
cc02ea56 373# 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE
374# - <@> lineseq KP ->7 => RELATIVE
375# 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE
376# 6 <2> sassign sKS ->7 => RELATIVE
377# 4 <2> add[t1] sK ->5 => RELATIVE
378# - <1> ex-rv2sv sK ->3 => RELATIVE
379# 2 <$> gvsv(*b) s ->3 => RELATIVE
380# 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE
381# - <1> ex-rv2sv sKRM* ->6 => RELATIVE
382# 5 <$> gvsv(*a) s ->6 => RELATIVE
724aa791 383EONT_EONT
384
385checkOptree ( name => "both -exec -relative",
386 bcopts => [qw/ -exec -relative /],
387 code => sub{$a=$b+42},
388 crossfail => 1,
389 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 3901 <;> nextstate(main 50 optree_concise.t:326) v
3912 <#> gvsv[*b] s
3923 <$> const[IV 42] CALLBACK s
3934 <2> add[t3] sK
3945 <#> gvsv[*a] s
3956 <2> sassign sKS
3967 <1> leavesub RELATIVE[1 ref] K
397EOT_EOT
398# 1 <;> nextstate(main 78 optree_concise.t:371) v
399# 2 <$> gvsv(*b) s
400# 3 <$> const(IV 42) CALLBACK s
401# 4 <2> add[t1] sK
402# 5 <$> gvsv(*a) s
403# 6 <2> sassign sKS
404# 7 <1> leavesub RELATIVE[1 ref] K
405EONT_EONT
406
407#################################
408
409@scopeops = qw( leavesub enter leave nextstate );
410add_style
411 ( 'scope' # concise copy
412 , "#hyphseq2 (*( (x( ;)x))*)<#classsym> "
413 . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) "
414 , " (*( )*) goto #seq\n"
415 , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)"
416 );
417
418checkOptree ( name => "both -exec -scope",
419 bcopts => [qw/ -exec -scope /],
420 code => sub{$a=$b+42},
421 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
724aa791 4221 <;> nextstate(main 50 optree_concise.t:337) v
4237 <1> leavesub[1 ref] K/REFC,1
424EOT_EOT
724aa791 4251 <;> nextstate(main 75 optree_concise.t:396) v
4267 <1> leavesub[1 ref] K/REFC,1
427EONT_EONT
428
429
430checkOptree ( name => "both -basic -scope",
431 bcopts => [qw/ -basic -scope /],
432 code => sub{$a=$b+42},
433 expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
4347 <1> leavesub[1 ref] K/REFC,1 ->(end)
4351 <;> nextstate(main 51 optree_concise.t:347) v ->2
436EOT_EOT
4377 <1> leavesub[1 ref] K/REFC,1 ->(end)
4381 <;> nextstate(main 76 optree_concise.t:407) v ->2
439EONT_EONT
440
2ce64696 441} #skip
724aa791 442
Unnamed repository; edit this file to name it for gitweb.