Commit | Line | Data |
---|---|---|
724aa791 JC |
1 | #!perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't'; | |
5 | @INC = ('../lib', '../ext/B/t'); | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | # import checkOptree(), and %gOpts (containing test state) | |
10 | use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! | |
11 | ||
12 | plan tests => 24; # need to set based on testing state | |
13 | ||
14 | $SIG{__WARN__} = sub { | |
15 | my $err = shift; | |
16 | $err =~ m/Subroutine re::(un)?install redefined/ and return; | |
17 | }; | |
18 | ################################# | |
19 | pass("CANONICAL B::Concise EXAMPLE"); | |
20 | ||
21 | checkOptree ( name => 'canonical example w -basic', | |
22 | bcopts => '-basic', | |
23 | code => sub{$a=$b+42}, | |
24 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
25 | # 7 <1> leavesub[\d+ refs?] K/REFC,1 ->(end) | |
26 | # - <@> lineseq KP ->7 | |
27 | # 1 <;> nextstate(foo bar) v ->2 | |
28 | # 6 <2> sassign sKS/2 ->7 | |
29 | # 4 <2> add[t\d+] sK/2 ->5 | |
30 | # - <1> ex-rv2sv sK/1 ->3 | |
31 | # 2 <#> gvsv[*b] s ->3 | |
32 | # 3 <$> const[IV 42] s ->4 | |
33 | # - <1> ex-rv2sv sKRM*/1 ->6 | |
34 | # 5 <#> gvsv[*a] s ->6 | |
35 | EOT_EOT | |
36 | # 7 <1> leavesub[1 ref] K/REFC,1 ->(end) | |
37 | # - <@> lineseq KP ->7 | |
38 | # 1 <;> nextstate(main 60 optree_concise.t:122) v ->2 | |
39 | # 6 <2> sassign sKS/2 ->7 | |
40 | # 4 <2> add[t1] sK/2 ->5 | |
41 | # - <1> ex-rv2sv sK/1 ->3 | |
42 | # 2 <$> gvsv(*b) s ->3 | |
43 | # 3 <$> const(IV 42) s ->4 | |
44 | # - <1> ex-rv2sv sKRM*/1 ->6 | |
45 | # 5 <$> gvsv(*a) s ->6 | |
46 | EONT_EONT | |
47 | ||
48 | checkOptree ( name => 'canonical example w -exec', | |
49 | bcopts => '-exec', | |
50 | code => sub{$a=$b+42}, | |
51 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
52 | # goto - | |
53 | # 1 <;> nextstate(main 61 optree_concise.t:139) v | |
54 | # 2 <#> gvsv[*b] s | |
55 | # 3 <$> const[IV 42] s | |
56 | # 4 <2> add[t3] sK/2 | |
57 | # 5 <#> gvsv[*a] s | |
58 | # 6 <2> sassign sKS/2 | |
59 | # 7 <1> leavesub[1 ref] K/REFC,1 | |
60 | EOT_EOT | |
61 | # goto - | |
62 | # 1 <;> nextstate(main 61 optree_concise.t:139) v | |
63 | # 2 <$> gvsv(*b) s | |
64 | # 3 <$> const(IV 42) s | |
65 | # 4 <2> add[t1] sK/2 | |
66 | # 5 <$> gvsv(*a) s | |
67 | # 6 <2> sassign sKS/2 | |
68 | # 7 <1> leavesub[1 ref] K/REFC,1 | |
69 | EONT_EONT | |
70 | ||
71 | checkOptree ( name => 'tree reftext is messy cut-paste', | |
72 | skip => 1); | |
73 | ||
74 | ||
75 | ################################# | |
76 | pass("B::Concise OPTION TESTS"); | |
77 | ||
78 | checkOptree ( name => '-base3 sticky-exec', | |
79 | bcopts => '-base3', | |
80 | code => sub{$a=$b+42}, | |
81 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
82 | goto - | |
83 | 1 <;> dbstate(main 24 optree_concise.t:132) v | |
84 | 2 <#> gvsv[*b] s | |
85 | 10 <$> const[IV 42] s | |
86 | 11 <2> add[t3] sK/2 | |
87 | 12 <#> gvsv[*a] s | |
88 | 20 <2> sassign sKS/2 | |
89 | 21 <1> leavesub[2 refs] K/REFC,1 | |
90 | EOT_EOT | |
91 | # goto - | |
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 | |
99 | EONT_EONT | |
100 | ||
101 | checkOptree ( name => 'sticky-base3, -basic over sticky-exec', | |
102 | bcopts => '-basic', | |
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 | |
115 | EOT_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 | |
126 | EONT_EONT | |
127 | ||
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 | |
138 | 2 <#> gvsv[*b] s ->3 | |
139 | 3 <$> const[IV 42] s ->10 | |
140 | - <1> ex-rv2sv sKRM*/1 ->12 | |
141 | 11 <#> gvsv[*a] s ->12 | |
142 | EOT_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 | |
153 | EONT_EONT | |
154 | ||
155 | checkOptree ( name => "restore -base36 default", | |
156 | bcopts => [qw/ -basic -base36 /], | |
157 | code => sub{$a}, | |
158 | crossfail => 1, | |
159 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
160 | 3 <1> leavesub[1 ref] K/REFC,1 ->(end) | |
161 | - <@> lineseq KP ->3 | |
162 | 1 <;> nextstate(main 27 optree_concise.t:161) v ->2 | |
163 | - <1> ex-rv2sv sK/1 ->- | |
164 | 2 <#> gvsv[*a] s ->3 | |
165 | EOT_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 | |
171 | EONT_EONT | |
172 | ||
173 | checkOptree ( name => "terse basic", | |
174 | bcopts => [qw/ -basic -terse /], | |
175 | code => sub{$a}, | |
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 | |
182 | EOT_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 | |
188 | EONT_EONT | |
189 | ||
190 | checkOptree ( name => "sticky-terse exec", | |
191 | bcopts => [qw/ -exec /], | |
192 | code => sub{$a}, | |
193 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
194 | goto UNOP (0x82b0918) | |
195 | COP (0x82b0d70) nextstate | |
196 | PADOP (0x82b0d30) gvsv GV (0x82a818c) *a | |
197 | UNOP (0x82b0e08) leavesub [1] | |
198 | EOT_EOT | |
199 | # goto UNOP (0x8282310) | |
200 | # COP (0x82828e0) nextstate | |
201 | # SVOP (0x82828a0) gvsv GV (0x814692c) *a | |
202 | # UNOP (0x8282938) leavesub [1] | |
203 | EONT_EONT | |
204 | ||
205 | pass("OPTIONS IN CMDLINE MODE"); | |
206 | ||
207 | checkOptree ( name => 'cmdline invoke -basic works', | |
208 | prog => 'sort @a', | |
209 | #bcopts => '-basic', # default | |
210 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
211 | # 7 <@> leave[1 ref] vKP/REFC ->(end) | |
212 | # 1 <0> enter ->2 | |
213 | # 2 <;> nextstate(main 1 -e:1) v ->3 | |
214 | # 6 <@> sort vK ->7 | |
215 | # 3 <0> pushmark s ->4 | |
216 | # 5 <1> rv2av[t2] lK/1 ->6 | |
217 | # 4 <#> gv[*a] s ->5 | |
218 | EOT_EOT | |
219 | # 7 <@> leave[1 ref] vKP/REFC ->(end) | |
220 | # 1 <0> enter ->2 | |
221 | # 2 <;> nextstate(main 1 -e:1) v ->3 | |
222 | # 6 <@> sort vK ->7 | |
223 | # 3 <0> pushmark s ->4 | |
224 | # 5 <1> rv2av[t1] lK/1 ->6 | |
225 | # 4 <$> gv(*a) s ->5 | |
226 | EONT_EONT | |
227 | ||
228 | checkOptree ( name => 'cmdline invoke -exec works', | |
229 | prog => 'sort @a', | |
230 | bcopts => '-exec', | |
231 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
232 | 1 <0> enter | |
233 | 2 <;> nextstate(main 1 -e:1) v | |
234 | 3 <0> pushmark s | |
235 | 4 <#> gv[*a] s | |
236 | 5 <1> rv2av[t2] lK/1 | |
237 | 6 <@> sort vK | |
238 | 7 <@> leave[1 ref] vKP/REFC | |
239 | EOT_EOT | |
240 | # 1 <0> enter | |
241 | # 2 <;> nextstate(main 1 -e:1) v | |
242 | # 3 <0> pushmark s | |
243 | # 4 <$> gv(*a) s | |
244 | # 5 <1> rv2av[t1] lK/1 | |
245 | # 6 <@> sort vK | |
246 | # 7 <@> leave[1 ref] vKP/REFC | |
247 | EONT_EONT | |
248 | ||
249 | checkOptree ( name => 'cmdline self-strict compile err', | |
250 | prog => 'use strict; sort @a', | |
251 | bcopts => [qw/ -basic -concise -exec /], | |
252 | expect => 'compilation errors', | |
253 | expect_nt => 'compilation errors'); | |
254 | ||
255 | checkOptree ( name => 'error at -e line 1', | |
256 | prog => 'our @a; sort @a', | |
257 | bcopts => [qw/ -basic -concise -exec /], | |
258 | expect => 'at -e line 1', | |
259 | expect_nt => 'at -e line 1'); | |
260 | ||
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'); | |
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 | |
275 | EOT_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 | |
286 | EONT_EONT | |
287 | ||
288 | ||
289 | ################################# | |
290 | pass("B::Concise STYLE/CALLBACK TESTS"); | |
291 | ||
292 | use 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" | |
301 | , "(?(<#speq>)?)#exname#arg(?([#targarglife])?)" | |
302 | #. "(x(;~=> #extra)x)\n" # new 'variable' used here | |
303 | ); | |
304 | ||
305 | sub 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 | ||
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 | ################################# | |
332 | set_up_relative_test(); | |
333 | pass("set_up_relative_test, new callback installed"); | |
334 | ||
335 | checkOptree ( 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'); | |
339 | goto - | |
340 | 1 <;> nextstate(main 76 optree_concise.t:337) v | |
341 | 2 <#> gvsv[*b] s | |
342 | 3 <$> const[IV 42] CALLBACK s | |
343 | 4 <2> add[t3] sK/2 | |
344 | 5 <#> gvsv[*a] s | |
345 | 6 <2> sassign sKS/2 | |
346 | 7 <1> leavesub[1 ref] K/REFC,1 | |
347 | EOT_EOT | |
348 | # 1 <;> nextstate(main 455 optree_concise.t:328) v | |
349 | # 2 <$> gvsv(*b) s | |
350 | # 3 <$> const(IV 42) CALLBACK s | |
351 | # 4 <2> add[t1] sK/2 | |
352 | # 5 <$> gvsv(*a) s | |
353 | # 6 <2> sassign sKS/2 | |
354 | # 7 <1> leavesub[1 ref] K/REFC,1 | |
355 | EONT_EONT | |
356 | ||
357 | checkOptree ( name => "new 'relative' style, -exec mode", | |
358 | bcopts => [qw/ -basic -relative /], | |
359 | code => sub{$a=$b+42}, | |
360 | crossfail => 1, | |
361 | #retry => 1, | |
362 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
363 | 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE | |
364 | - <@> lineseq KP ->7 => RELATIVE | |
365 | 1 <;> nextstate(main 49 optree_concise.t:309) v ->2 => RELATIVE | |
366 | 6 <2> sassign sKS ->7 => RELATIVE | |
367 | 4 <2> add[t3] sK ->5 => RELATIVE | |
368 | - <1> ex-rv2sv sK ->3 => RELATIVE | |
369 | 2 <#> gvsv[*b] s ->3 => RELATIVE | |
370 | 3 <$> const[IV 42] CALLBACK s ->4 => RELATIVE | |
371 | - <1> ex-rv2sv sKRM* ->6 => RELATIVE | |
372 | 5 <#> gvsv[*a] s ->6 => RELATIVE | |
373 | EOT_EOT | |
374 | # 7 <1> leavesub RELATIVE[1 ref] K ->(end) => RELATIVE | |
375 | # - <@> lineseq KP ->7 => RELATIVE | |
376 | # 1 <;> nextstate(main 77 optree_concise.t:353) v ->2 => RELATIVE | |
377 | # 6 <2> sassign sKS ->7 => RELATIVE | |
378 | # 4 <2> add[t1] sK ->5 => RELATIVE | |
379 | # - <1> ex-rv2sv sK ->3 => RELATIVE | |
380 | # 2 <$> gvsv(*b) s ->3 => RELATIVE | |
381 | # 3 <$> const(IV 42) CALLBACK s ->4 => RELATIVE | |
382 | # - <1> ex-rv2sv sKRM* ->6 => RELATIVE | |
383 | # 5 <$> gvsv(*a) s ->6 => RELATIVE | |
384 | EONT_EONT | |
385 | ||
386 | checkOptree ( name => "both -exec -relative", | |
387 | bcopts => [qw/ -exec -relative /], | |
388 | code => sub{$a=$b+42}, | |
389 | crossfail => 1, | |
390 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
391 | goto - | |
392 | 1 <;> nextstate(main 50 optree_concise.t:326) v | |
393 | 2 <#> gvsv[*b] s | |
394 | 3 <$> const[IV 42] CALLBACK s | |
395 | 4 <2> add[t3] sK | |
396 | 5 <#> gvsv[*a] s | |
397 | 6 <2> sassign sKS | |
398 | 7 <1> leavesub RELATIVE[1 ref] K | |
399 | EOT_EOT | |
400 | # 1 <;> nextstate(main 78 optree_concise.t:371) v | |
401 | # 2 <$> gvsv(*b) s | |
402 | # 3 <$> const(IV 42) CALLBACK s | |
403 | # 4 <2> add[t1] sK | |
404 | # 5 <$> gvsv(*a) s | |
405 | # 6 <2> sassign sKS | |
406 | # 7 <1> leavesub RELATIVE[1 ref] K | |
407 | EONT_EONT | |
408 | ||
409 | ################################# | |
410 | ||
411 | @scopeops = qw( leavesub enter leave nextstate ); | |
412 | add_style | |
413 | ( 'scope' # concise copy | |
414 | , "#hyphseq2 (*( (x( ;)x))*)<#classsym> " | |
415 | . "#exname#arg(?([#targarglife])?)~#flags(?(/#private)?)(x(;~->#next)x) " | |
416 | , " (*( )*) goto #seq\n" | |
417 | , "(?(<#seq>)?)#exname#arg(?([#targarglife])?)" | |
418 | ); | |
419 | ||
420 | checkOptree ( name => "both -exec -scope", | |
421 | bcopts => [qw/ -exec -scope /], | |
422 | code => sub{$a=$b+42}, | |
423 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
424 | goto - | |
425 | 1 <;> nextstate(main 50 optree_concise.t:337) v | |
426 | 7 <1> leavesub[1 ref] K/REFC,1 | |
427 | EOT_EOT | |
428 | goto - | |
429 | 1 <;> nextstate(main 75 optree_concise.t:396) v | |
430 | 7 <1> leavesub[1 ref] K/REFC,1 | |
431 | EONT_EONT | |
432 | ||
433 | ||
434 | checkOptree ( name => "both -basic -scope", | |
435 | bcopts => [qw/ -basic -scope /], | |
436 | code => sub{$a=$b+42}, | |
437 | expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); | |
438 | 7 <1> leavesub[1 ref] K/REFC,1 ->(end) | |
439 | 1 <;> nextstate(main 51 optree_concise.t:347) v ->2 | |
440 | EOT_EOT | |
441 | 7 <1> leavesub[1 ref] K/REFC,1 ->(end) | |
442 | 1 <;> nextstate(main 76 optree_concise.t:407) v ->2 | |
443 | EONT_EONT | |
444 | ||
445 | ||
446 | __END__ | |
447 |