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=b8ea287661a55d76992932c00f428e9e86109ca9;hpb=dbeafbd11804a1f3337ac72205001f934fa9e9af;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index b8ea287..c05138b 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -24,14 +24,6 @@ plan tests => $tests; SKIP: { skip "no perlio in this build", $tests unless $Config::Config{useperlio}; -my @open_todo; -sub open_todo { - if (((caller 0)[10]||{})->{open}) { - @open_todo = (skip => "\$^OPEN is set"); - } -} -open_todo; - ################################# use constant { # see also t/op/gv.t line 282 @@ -51,21 +43,31 @@ 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) - myfl => [ 'NV', myfl ], - myint => [ 'IV', myint ], mystr => [ 'PV', '"'.mystr.'"' ], - myhref => [ 'RV', '\\\\HASH'], - myundef => [ 'NULL', ], + myhref => [ $RV_class, '\\\\HASH'], pi => [ 'NV', pi ], - myaref => [ 'RV', '\\\\' ], - myglob => [ 'RV', '\\\\' ], - myrex => [ 'RV', '\\\\' ], - mysub => [ 'RV', '\\\\' ], - myunsub => [ 'RV', '\\\\' ], + myglob => [ $RV_class, '\\\\' ], + mysub => [ $RV_class, '\\\\' ], + myunsub => [ $RV_class, '\\\\' ], # these are not inlined, at least not per BC::Concise - #myyes => [ 'RV', ], - #myno => [ 'RV', ], + #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 @@ -109,12 +111,12 @@ for $func (sort keys %$want) { expect => < < leavesub[2 refs] K/REFC,1 ->(end) - <\@> lineseq KP ->3 -1 <;> dbstate(main 1163 OptreeCheck.pm:511]:1) v ->2 +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 +1 <;> dbstate(main 833 (eval 44):1) v ->2 2 <\$> const($want->{$func}[0] $want->{$func}[1]) s ->3 EONT_EONT @@ -134,50 +136,51 @@ EONT_EONT checkOptree ( name => 'myyes() as coderef', - code => 'sub a() { 1==1 }; print a', + prog => 'sub a() { 1==1 }; print a', noanchors => 1, + strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->5 -# 1 <;> nextstate(main 810 (eval 47):1) v ->2 -# 4 <@> print sK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const[SPECIAL sv_yes] s ->4 +# 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 -# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->5 -# 1 <;> nextstate(main 810 (eval 47):1) v ->2 -# 4 <@> print sK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const(SPECIAL sv_yes) s ->4 +# 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 +# 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', - code => 'sub a() { 1!=1 }; print a', + prog => 'sub a() { 1!=1 }; print a', noanchors => 1, - todo => '- SPECIAL sv_no renders as PVNV 0', + strip_open_hints => 1, expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); -# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->5 -# 1 <;> nextstate(main 810 (eval 47):1) v ->2 -# 4 <@> print sK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const[PVNV 0] s ->4 +# 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 -# 5 <1> leavesub[1 ref] K/REFC,1 ->(end) -# - <@> lineseq KP ->5 -# 1 <;> nextstate(main 810 (eval 47):1) v ->2 -# 4 <@> print sK ->5 -# 2 <0> pushmark s ->3 -# 3 <$> const(PVNV 0) s ->4 +# 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 sub returning list', - 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 61 constant.pm:118) v:*,& ->2 @@ -189,19 +192,26 @@ EOT_EOT # 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 many in a print statement', - code => \&printem, - @open_todo, - 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 @@ -212,7 +222,7 @@ checkOptree ( name => 'call many in a print statement', 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 @@ -222,6 +232,18 @@ EOT_EOT # 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