Windows issues with select() are already documented in perlport.
[p5sagit/p5-mst-13.2.git] / ext / B / t / optree_concise.t
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