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};
#################################
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 ();";
};
#################################
-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 => <<EOT_EOT, expect_nt => <<EONT_EONT);
+ is a constant sub, optimized to a $want->{$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 => <<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[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
projects / p5sagit/p5-mst-13.2.git / blobdiff