X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2Ft%2Foptree_constants.t;h=c05138b6337b28feeaaf3ed798502f51ff7cca56;hb=4df7f6afd80e96d28fd18bba9dda8b38b6ed6700;hp=1abe759d1493f32715a9aab985bf4c5711370e57;hpb=d51cf0c98f3998b8619964692ede02a78dd26923;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index 1abe759..c05138b 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -19,7 +19,7 @@ BEGIN { use OptreeCheck; # ALSO DOES @ARGV HANDLING !!!!!! use Config; -my $tests = 18; +my $tests = 30; plan tests => $tests; SKIP: { skip "no perlio in this build", $tests unless $Config::Config{useperlio}; @@ -27,20 +27,53 @@ skip "no perlio in this build", $tests unless $Config::Config{useperlio}; ################################# use constant { # see also t/op/gv.t line 282 - myint => 42, - mystr => 'hithere', - myfl => 3.14159, - myrex => qr/foo/, - myglob => \*STDIN, - myaref => [ 1,2,3 ], - myhref => { a => 1 }, + myaref => [ 1,2,3 ], + myfl => 1.414213, + myglob => \*STDIN, + myhref => { a => 1 }, + myint => 42, + myrex => qr/foo/, + mystr => 'hithere', + mysub => \&ok, + myundef => undef, + myunsub => \&nosuch, +}; + +sub myyes() { 1==1 } +sub myno () { return 1!=1 } +sub pi () { 3.14159 }; + +my $RV_class = $] >= 5.011 ? 'IV' : 'RV'; + +my $want = { # expected types, how value renders in-line, todos (maybe) + mystr => [ 'PV', '"'.mystr.'"' ], + myhref => [ $RV_class, '\\\\HASH'], + pi => [ 'NV', pi ], + myglob => [ $RV_class, '\\\\' ], + mysub => [ $RV_class, '\\\\' ], + myunsub => [ $RV_class, '\\\\' ], + # these are not inlined, at least not per BC::Concise + #myyes => [ $RV_class, ], + #myno => [ $RV_class, ], + $] > 5.009 ? ( + myaref => [ $RV_class, '\\\\' ], + myfl => [ 'NV', myfl ], + myint => [ 'IV', myint ], + myrex => [ $RV_class, '\\\\' ], + myundef => [ 'NULL', ], + ) : ( + myaref => [ 'PVIV', '' ], + myfl => [ 'PVNV', myfl ], + myint => [ 'PVIV', myint ], + myrex => [ 'PVNV', '' ], + myundef => [ 'PVIV', ], + ) }; use constant WEEKDAYS => qw ( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); -sub pi () { 3.14159 }; $::{napier} = \2.71828; # counter-example (doesn't get optimized). eval "sub napier ();"; @@ -52,260 +85,165 @@ INIT { }; ################################# -pass("CONSTANT SUBS RETURNING SCALARS"); - -checkOptree ( name => 'myint() as coderef', - code => \&myint, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a IV -EOT_EOT - is a constant sub, optimized to a IV -EONT_EONT - - -checkOptree ( name => 'mystr() as coderef', - code => \&mystr, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a PV -EOT_EOT - is a constant sub, optimized to a PV -EONT_EONT - - -checkOptree ( name => 'myfl() as coderef', - code => \&myfl, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a NV -EOT_EOT - is a constant sub, optimized to a NV -EONT_EONT - - -checkOptree ( name => 'myrex() as coderef', - code => \&myrex, - todo => '- currently renders as XS code', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is XS code -EOT_EOT - is XS code -EONT_EONT - - -checkOptree ( name => 'myglob() as coderef', - code => \&myglob, - todo => '- currently renders as XS code', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is XS code -EOT_EOT - is XS code -EONT_EONT - - -checkOptree ( name => 'myaref() as coderef', - code => \&myaref, - todo => '- currently renders as XS code', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is XS code -EOT_EOT - is XS code -EONT_EONT - - -checkOptree ( name => 'myhref() as coderef', - code => \&myhref, - todo => '- currently renders as XS code', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is XS code -EOT_EOT - is XS code -EONT_EONT - - -############## - -checkOptree ( name => 'call myint', - code => 'myint', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[IV 42] s ->3 +pass("RENDER CONSTANT SUBS RETURNING SCALARS"); + +for $func (sort keys %$want) { + # no strict 'refs'; # why not needed ? + checkOptree ( name => "$func() as a coderef", + code => \&{$func}, + noanchors => 1, + expect => < <{$func}[0] EOT_EOT -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(IV 42) s ->3 + is a constant sub, optimized to a $want->{$func}[0] EONT_EONT +} -checkOptree ( name => 'call mystr', - code => 'mystr', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[PV "hithere"] s ->3 -EOT_EOT -3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(PV "hithere") s ->3 -EONT_EONT - +pass("RENDER CALLS TO THOSE CONSTANT SUBS"); -checkOptree ( name => 'call myfl', - code => 'myfl', - bc_opts => '-nobanner', - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +for $func (sort keys %$want) { + # print "# doing $func\n"; + checkOptree ( name => "call $func", + code => "$func", + ($want->{$func}[2]) ? ( todo => $want->{$func}[2]) : (), + bc_opts => '-nobanner', + expect => < < leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const[NV 3.14159] s ->3 +- <\@> lineseq KP ->3 +1 <;> dbstate(main 833 (eval 44):1) v ->2 +2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s ->3 EOT_EOT 3 <1> leavesub[2 refs] K/REFC,1 ->(end) -- <@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 -2 <$> const(NV 3.14159) s ->3 +- <\@> lineseq KP ->3 +1 <;> dbstate(main 833 (eval 44):1) v ->2 +2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3 EONT_EONT +} -checkOptree ( name => 'call myrex', - code => 'myrex', - todo => '- RV value is bare backslash', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const[RV \\] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const(RV \\) s ->3 -EONT_EONT - - -checkOptree ( name => 'call myglob', - code => 'myglob', - todo => '- RV value is bare backslash', - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const[RV \\] s ->3 -EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 753 (eval 27):1) v ->2 -# 2 <$> const(RV \\) s ->3 -EONT_EONT - +############## +pass("MORE TESTS"); -checkOptree ( name => 'call myaref', - code => 'myaref', - todo => '- RV value is bare backslash', +checkOptree ( name => 'myyes() as coderef', + code => sub () { 1==1 }, noanchors => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 758 (eval 29):1) v ->2 -# 2 <$> const[RV \\] s ->3 + is a constant sub, optimized to a SPECIAL EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 758 (eval 29):1) v ->2 -# 2 <$> const(RV \\) s ->3 + is a constant sub, optimized to a SPECIAL EONT_EONT -checkOptree ( name => 'call myhref', - code => 'myhref', +checkOptree ( name => 'myyes() as coderef', + prog => 'sub a() { 1==1 }; print a', noanchors => 1, + strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 763 (eval 31):1) v ->2 -# 2 <$> const[RV \\HASH] s ->3 +# 6 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 +# 5 <@> print vK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const[SPECIAL sv_yes] s ->5 EOT_EOT -# 3 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->3 -# 1 <;> nextstate(main 763 (eval 31):1) v ->2 -# 2 <$> const(RV \\HASH) s ->3 +# 6 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 +# 5 <@> print vK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const(SPECIAL sv_yes) s ->5 EONT_EONT -################## - -# test constant sub defined w/o 'use constant' - -checkOptree ( name => "pi(), defined w/o 'use constant'", - code => \&pi, +# Need to do this as a prog, not code, as only the first constant to use +# PL_sv_no actually gets to use the real thing - every one following is +# copied. +checkOptree ( name => 'myno() as coderef', + prog => 'sub a() { 1!=1 }; print a', noanchors => 1, + strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); - is a constant sub, optimized to a NV +# 6 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 +# 5 <@> print vK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const[SPECIAL sv_no] s ->5 EOT_EOT - is a constant sub, optimized to a NV +# 6 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 +# 5 <@> print vK ->6 +# 3 <0> pushmark s ->4 +# 4 <$> const(SPECIAL sv_no) s ->5 EONT_EONT -checkOptree ( name => 'constant subs returning lists are not optimized', - code => \&WEEKDAYS, - noanchors => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # 3 <1> leavesub[2 refs] K/REFC,1 ->(end) # - <@> lineseq K ->3 -# 1 <;> nextstate(constant 685 constant.pm:121) v ->2 -# 2 <0> padav[@list:FAKE:m:102] ->3 +# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2 +# 2 <0> padav[@list:FAKE:m:96] ->3 EOT_EOT # 3 <1> leavesub[2 refs] K/REFC,1 ->(end) # - <@> lineseq K ->3 -# 1 <;> nextstate(constant 685 constant.pm:121) v ->2 -# 2 <0> padav[@list:FAKE:m:76] ->3 +# 1 <;> nextstate(constant 61 constant.pm:118) v:*,& ->2 +# 2 <0> padav[@list:FAKE:m:71] ->3 EONT_EONT +if($] < 5.009) { + # 5.8.x doesn't add the m flag to padav + s/FAKE:m:\d+/FAKE/ foreach ($expect, $expect_nt); +} + +checkOptree ( name => 'constant sub returning list', + code => \&WEEKDAYS, + noanchors => 1, + expect => $expect, expect_nt => $expect_nt); + sub printem { printf "myint %d mystr %s myfl %f pi %f\n" , myint, mystr, myfl, pi; } -checkOptree ( name => 'call em all in a print statement', - code => \&printem, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); +my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # 9 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->9 -# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2 +# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 # 2 <0> pushmark s ->3 # 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] s ->4 # 4 <$> const[IV 42] s ->5 # 5 <$> const[PV "hithere"] s ->6 -# 6 <$> const[NV 3.14159] s ->7 +# 6 <$> const[NV 1.414213] s ->7 # 7 <$> const[NV 3.14159] s ->8 EOT_EOT # 9 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->9 -# 1 <;> nextstate(main 635 optree_constants.t:163) v ->2 +# 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 # 2 <0> pushmark s ->3 # 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") s ->4 # 4 <$> const(IV 42) s ->5 # 5 <$> const(PV "hithere") s ->6 -# 6 <$> const(NV 3.14159) s ->7 +# 6 <$> const(NV 1.414213) s ->7 # 7 <$> const(NV 3.14159) s ->8 EONT_EONT +if($] < 5.009) { + # 5.8.x's use constant has larger types + foreach ($expect, $expect_nt) { + s/IV 42/PV$&/; + s/NV 1.41/PV$&/; + } +} + +checkOptree ( name => 'call many in a print statement', + code => \&printem, + strip_open_hints => 1, + expect => $expect, expect_nt => $expect_nt); } #skip