diff options
author | David Mitchell <davem@iabyn.com> | 2012-10-24 15:50:25 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2012-10-26 16:51:55 +0100 |
commit | 82aeefe162adb05e9fab0d665d4df0c56f2252ec (patch) | |
tree | 0347bdf31c0dab910f8f5130edf708b191a1629d /ext/B | |
parent | a5e62da03c2cb46e070067467ac3b29dd44b96bd (diff) | |
download | perl-82aeefe162adb05e9fab0d665d4df0c56f2252ec.tar.gz |
make ext/B work with 5.16.x
The modules and tests under ext/B are notionally supposed to be
portable to older perl versions; in practice, extensive bit-rot
has occurred; often attempts have been made to add version-specific
code, which haven't actually been tested against older perl versions.
This commit does the minimum necessary to get the tests under ext/B
working with 5.16.0 and 5.16.1, threaded and unthreaded. It makes no
assertions as to whether it will work with the rest of the 5.16.x test
suite.
The side effects of this fix-up are:
* a facility has been added to OptreeCheck.pm (the test module that
checks the Concise output of various constructs) that allows
version-specific matching, e.g.:
# 4 <$> const(PV "junk") s* < 5.017002
# 4 <$> const(PV "junk") s*/FOLD >=5.017002
* OptreeCheck.pm's skip mechanism was found to be broken: checkOptree()
allows you to specify skipping, but only skipped one test, even though
a single call to checkOptree() could generate multiple lines of test
output.
Diffstat (limited to 'ext/B')
-rw-r--r-- | ext/B/B.pm | 2 | ||||
-rw-r--r-- | ext/B/B.xs | 15 | ||||
-rw-r--r-- | ext/B/t/OptreeCheck.pm | 33 | ||||
-rw-r--r-- | ext/B/t/b.t | 10 | ||||
-rw-r--r-- | ext/B/t/concise-xs.t | 3 | ||||
-rw-r--r-- | ext/B/t/f_map.t | 30 | ||||
-rw-r--r-- | ext/B/t/f_sort.t | 38 | ||||
-rw-r--r-- | ext/B/t/optree_check.t | 7 | ||||
-rw-r--r-- | ext/B/t/optree_constants.t | 78 | ||||
-rw-r--r-- | ext/B/t/optree_misc.t | 26 | ||||
-rw-r--r-- | ext/B/t/optree_samples.t | 12 | ||||
-rw-r--r-- | ext/B/typemap | 3 |
12 files changed, 196 insertions, 61 deletions
diff --git a/ext/B/B.pm b/ext/B/B.pm index 7229d5351a..680256869f 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -15,7 +15,7 @@ require Exporter; # walkoptree comes from B.xs BEGIN { - $B::VERSION = '1.39'; + $B::VERSION = '1.40'; @B::EXPORT_OK = (); # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK. diff --git a/ext/B/B.xs b/ext/B/B.xs index 435b0cc995..53023cdcb2 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -880,7 +880,11 @@ threadsv_names() #define OP_private_ix U8p | offsetof(struct op, op_private) #define PMOP_pmflags_ix U32p | offsetof(struct pmop, op_pmflags) -#define PMOP_code_list_ix OPp | offsetof(struct pmop, op_code_list) +#if PERL_VERSION >= 17 +# define PMOP_code_list_ix OPp | offsetof(struct pmop, op_code_list) +#else +# define PMOP_code_list_ix -1 +#endif #ifdef USE_ITHREADS #define PMOP_pmoffset_ix IVp | offsetof(struct pmop, op_pmoffset) @@ -1182,7 +1186,7 @@ BOOT: #ifdef USE_ITHREADS cv = newXS("B::PMOP::pmoffset", XS_B__OP_next, __FILE__); XSANY.any_i32 = PMOP_pmoffset_ix; -# if PERL_VERSION < 17 || defined(CopSTASH_len) +# if PERL_VERSION < 17 cv = newXS("B::COP::stashpv", XS_B__OP_next, __FILE__); XSANY.any_i32 = COP_stashpv_ix; # else @@ -1286,7 +1290,7 @@ COP_file(o) #endif -#if PERL_VERSION >= 10 +#if PERL_VERSION >= 17 SV * COP_stashpv(o) @@ -1299,6 +1303,7 @@ COP_stashpv(o) RETVAL #else +# ifndef USE_ITHREADS char * COP_stashpv(o) @@ -1308,6 +1313,7 @@ COP_stashpv(o) OUTPUT: RETVAL +# endif #endif I32 @@ -2015,6 +2021,9 @@ CvPADLIST(cv) B::AV CvPADLIST(cv) B::CV cv + PPCODE: + PUSHs(make_sv_object(aTHX_ (SV *)CvPADLIST(cv))); + #endif diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm index 9bb7088876..8983d1c6be 100644 --- a/ext/B/t/OptreeCheck.pm +++ b/ext/B/t/OptreeCheck.pm @@ -5,7 +5,7 @@ use warnings; use vars qw($TODO $Level $using_open); require "test.pl"; -our $VERSION = '0.08'; +our $VERSION = '0.09'; # now export checkOptree, and those test.pl functions used by tests our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike @@ -212,6 +212,10 @@ sampled from known-ok threaded and un-threaded bleadperl (5.9.1) builds. They're both required, and the correct one is selected for the platform being tested, and saved into the synthesized property B<wanted>. +Individual sample lines may be suffixed with whitespace followed +by (<|<=|==|>=|>)5.nnnn to select that line only for the listed perl +version; the whitespace and conditional are stripped. + =head2 bcopts => $bcopts || [ @bcopts ] When getRendering() runs, it passes bcopts into B::Concise::compile(). @@ -409,7 +413,14 @@ sub checkOptree { print "checkOptree args: ",mydumper($tc) if $tc->{dump}; SKIP: { - skip("$tc->{skip} $tc->{name}", 1) if $tc->{skip}; + if ($tc->{skip}) { + skip("$tc->{skip} $tc->{name}", + ($gOpts{selftest} + ? 1 + : 1 + @{$modes{$gOpts{testmode}}} + ) + ); + } return runSelftest($tc) if $gOpts{selftest}; @@ -628,6 +639,24 @@ sub mkCheckRex { $str =~ s/^\# //mg; # ease cut-paste testcase authoring + # strip out conditional lines + + $str =~ s{^(.*?)\s+(<|<=|==|>=|>)\s*(5\.\d+)\ *\n} + { + my ($line, $cmp, $version) = ($1,$2,$3); + my $repl = ""; + if ( $cmp eq '<' ? $] < $version + : $cmp eq '<=' ? $] <= $version + : $cmp eq '==' ? $] == $version + : $cmp eq '>=' ? $] >= $version + : $cmp eq '>' ? $] > $version + : die("bad comparision '$cmp' in string [$str]\n") + ) { + $repl = "$line\n"; + } + $repl; + }gem; + if ($] < 5.009) { # add 5.8 private flags, which bleadperl (5.9.1) doesn't have/use/render # works because it adds no wildcards, which are butchered below.. diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 02353f936e..aad7f05ad8 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -306,8 +306,14 @@ my $cop = B::svref_2object($sub1)->ROOT->first->first; my $bobby = B::svref_2object($sub2)->ROOT->first->first; is $cop->stash->object_2svref, \%main::, 'COP->stash'; is $cop->stashpv, 'main', 'COP->stashpv'; -is $bobby->stashpv, "Pe\0e\x{142}", 'COP->stashpv with utf8 and nulls'; -if ($Config::Config{useithreads}) { + +SKIP: { + skip "no nulls in packages before 5.17", 1 if $] < 5.017; + is $bobby->stashpv, "Pe\0e\x{142}", 'COP->stashpv with utf8 and nulls'; +} + +SKIP: { + skip "no stashoff", 2 if $] < 5.017 || !$Config::Config{useithreads}; like $cop->stashoff, qr/^[1-9]\d*\z/a, 'COP->stashoff'; isnt $cop->stashoff, $bobby->stashoff, 'different COP->stashoff for different stashes'; diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index efd0cf7788..eeb9f730e0 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -251,6 +251,7 @@ EODIE if (%opts) { require Data::Dumper; Data::Dumper->import('Dumper'); + { my $x = \*Data::Dumper::Sortkeys } # shut up 'used once' warning $Data::Dumper::Sortkeys = 1; } my @argpkgs = @ARGV; @@ -353,6 +354,7 @@ sub corecheck { warn "Module::CoreList not available on $]\n"; return; } + { my $x = \*Module::CoreList::version } # shut up 'used once' warning my $mods = $Module::CoreList::version{'5.009002'}; $mods = [ sort keys %$mods ]; print Dumper($mods); @@ -364,6 +366,7 @@ sub corecheck { END { if ($opts{c}) { + { my $x = \*Data::Dumper::Indent } # shut up 'used once' warning $Data::Dumper::Indent = 1; print "Corrections: ", Dumper(\%report); diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t index 014861a412..b09f3be8bd 100644 --- a/ext/B/t/f_map.t +++ b/ext/B/t/f_map.t @@ -95,7 +95,8 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> enter l # 9 <;> nextstate(main 475 (eval 10):1) v:{ @@ -119,7 +120,8 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> enter l # 9 <;> nextstate(main 559 (eval 15):1) v:{ @@ -239,7 +241,8 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s @@ -247,6 +250,7 @@ checkOptree(note => q{}, # b <@> stringify[t5] sK/1 # c <$> const[IV 1] s # d <@> list lK +# - <@> scope lK < 5.017002 # goto 7 # e <0> pushmark s # f <#> gv[*hash] s @@ -259,7 +263,8 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t4] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t5] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s @@ -267,6 +272,7 @@ EOT_EOT # b <@> stringify[t3] sK/1 # c <$> const(IV 1) s # d <@> list lK +# - <@> scope lK < 5.017002 # goto 7 # e <0> pushmark s # f <$> gv(*hash) s @@ -291,7 +297,8 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s @@ -299,6 +306,7 @@ checkOptree(note => q{}, # b <@> stringify[t5] sK/1 # c <$> const[IV 1] s # d <@> list lKP +# - <@> scope lK < 5.017002 # goto 7 # e <0> pushmark s # f <#> gv[*hash] s @@ -311,7 +319,8 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t4] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t5] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s @@ -319,6 +328,7 @@ EOT_EOT # b <@> stringify[t3] sK/1 # c <$> const(IV 1) s # d <@> list lKP +# - <@> scope lK < 5.017002 # goto 7 # e <0> pushmark s # f <$> gv(*hash) s @@ -343,13 +353,15 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*array] s # 5 <1> rv2av[t6] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t8] lK # 8 <0> pushmark s # 9 <#> gvsv[*_] s # a <1> lc[t4] sK/1 # b <$> const[IV 1] s # c <@> list lK +# - <@> scope lK < 5.017002 # goto 7 # d <0> pushmark s # e <#> gv[*hash] s @@ -362,13 +374,15 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*array) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> pushmark s # 9 <$> gvsv(*_) s # a <1> lc[t2] sK/1 # b <$> const(IV 1) s # c <@> list lK +# - <@> scope lK < 5.017002 # goto 7 # d <0> pushmark s # e <$> gv(*hash) s diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index fc4a009207..4e03bebdc4 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -500,7 +500,8 @@ checkOptree(name => q{Compound sort/map Expression }, # 5 <0> pushmark s # 6 <#> gv[*old] s # 7 <1> rv2av[t19] lKM/1 -# 8 <@> mapstart lK +# 8 <@> mapstart lK* < 5.017002 +# 8 <@> mapstart lK >=5.017002 # 9 <|> mapwhile(other->a)[t20] lK # a <0> enter l # b <;> nextstate(main 608 (eval 34):2) v:{ @@ -513,13 +514,15 @@ checkOptree(name => q{Compound sort/map Expression }, # i <@> leave lKP # goto 9 # j <@> sort lKMS* -# k <@> mapstart lK +# k <@> mapstart lK* < 5.017002 +# k <@> mapstart lK >=5.017002 # l <|> mapwhile(other->m)[t26] lK # m <#> gv[*_] s # n <1> rv2sv sKM/DREFAV,1 # o <1> rv2av[t4] sKR/1 # p <$> const[IV 0] s # q <2> aelem sK/2 +# - <@> scope lK < 5.017002 # goto l # r <0> pushmark s # s <#> gv[*new] s @@ -534,7 +537,8 @@ EOT_EOT # 5 <0> pushmark s # 6 <$> gv(*old) s # 7 <1> rv2av[t10] lKM/1 -# 8 <@> mapstart lK +# 8 <@> mapstart lK* < 5.017002 +# 8 <@> mapstart lK >=5.017002 # 9 <|> mapwhile(other->a)[t11] lK # a <0> enter l # b <;> nextstate(main 608 (eval 34):2) v:{ @@ -547,13 +551,15 @@ EOT_EOT # i <@> leave lKP # goto 9 # j <@> sort lKMS* -# k <@> mapstart lK +# k <@> mapstart lK* < 5.017002 +# k <@> mapstart lK >=5.017002 # l <|> mapwhile(other->m)[t12] lK # m <$> gv(*_) s # n <1> rv2sv sKM/DREFAV,1 # o <1> rv2av[t2] sKR/1 # p <$> const(IV 0) s # q <2> aelem sK/2 +# - <@> scope lK < 5.017002 # goto l # r <0> pushmark s # s <$> gv(*new) s @@ -783,11 +789,13 @@ checkOptree(note => q{}, # 4 <0> pushmark s # 5 <#> gv[*input] s # 6 <1> rv2av[t9] lKM/1 -# 7 <@> grepstart lK +# 7 <@> grepstart lK* < 5.017002 +# 7 <@> grepstart lK >=5.017002 # 8 <|> grepwhile(other->9)[t10] lK # 9 <#> gvsv[*_] s # a <#> gvsv[*_] s # b <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 8 # c <@> sort lK/NUM # d <0> pushmark s @@ -802,11 +810,13 @@ EOT_EOT # 4 <0> pushmark s # 5 <$> gv(*input) s # 6 <1> rv2av[t3] lKM/1 -# 7 <@> grepstart lK +# 7 <@> grepstart lK* < 5.017002 +# 7 <@> grepstart lK >=5.017002 # 8 <|> grepwhile(other->9)[t4] lK # 9 <$> gvsv(*_) s # a <$> gvsv(*_) s # b <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 8 # c <@> sort lK/NUM # d <0> pushmark s @@ -860,11 +870,13 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*input] s # 5 <1> rv2av[t7] lKM/1 -# 6 <@> grepstart lK +# 6 <@> grepstart lK* < 5.017002 +# 6 <@> grepstart lK >=5.017002 # 7 <|> grepwhile(other->8)[t8] lK # 8 <#> gvsv[*_] s # 9 <#> gvsv[*_] s # a <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 7 # b <@> sort K/NUM # c <1> leavesub[1 ref] K/REFC,1 @@ -874,11 +886,13 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*input) s # 5 <1> rv2av[t2] lKM/1 -# 6 <@> grepstart lK +# 6 <@> grepstart lK* < 5.017002 +# 6 <@> grepstart lK >=5.017002 # 7 <|> grepwhile(other->8)[t3] lK # 8 <$> gvsv(*_) s # 9 <$> gvsv(*_) s # a <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 7 # b <@> sort K/NUM # c <1> leavesub[1 ref] K/REFC,1 @@ -931,11 +945,13 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*input] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> grepstart lK +# 6 <@> grepstart lK* < 5.017002 +# 6 <@> grepstart lK >=5.017002 # 7 <|> grepwhile(other->8)[t9] lK # 8 <#> gvsv[*_] s # 9 <#> gvsv[*_] s # a <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 7 # b <@> sort sK/NUM # c <#> gvsv[*s] s @@ -947,11 +963,13 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*input) s # 5 <1> rv2av[t2] lKM/1 -# 6 <@> grepstart lK +# 6 <@> grepstart lK* < 5.017002 +# 6 <@> grepstart lK >=5.017002 # 7 <|> grepwhile(other->8)[t3] lK # 8 <$> gvsv(*_) s # 9 <$> gvsv(*_) s # a <2> eq sK/2 +# - <@> scope sK < 5.017002 # goto 7 # b <@> sort sK/NUM # c <$> gvsv(*s) s diff --git a/ext/B/t/optree_check.t b/ext/B/t/optree_check.t index bcbb5549ec..38ff88b64e 100644 --- a/ext/B/t/optree_check.t +++ b/ext/B/t/optree_check.t @@ -26,7 +26,12 @@ cmdline args in 'standard' way across all clients of OptreeCheck. =cut -plan tests => 5 + 15 + 12 + 16 * $gOpts{selftest}; # pass()s + $#tests +plan tests => 11 # REGEX TEST HARNESS SELFTEST + + 3 # TEST FATAL ERRS + + 11 # TEST -e \$srcCode + + 5 # REFTEXT FIXUP TESTS + + 5 # CANONICAL B::Concise EXAMPLE + + 16 * $gOpts{selftest}; # XXX I don't understand this - DAPM pass("REGEX TEST HARNESS SELFTEST"); diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t index a986193950..b04b290440 100644 --- a/ext/B/t/optree_constants.t +++ b/ext/B/t/optree_constants.t @@ -110,12 +110,14 @@ for $func (sort keys %$want) { 3 <1> leavesub[2 refs] K/REFC,1 ->(end) - <\@> lineseq KP ->3 1 <;> dbstate(main 833 (eval 44):1) v ->2 -2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3 +2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s* ->3 < 5.017002 +2 <\$> const[$want->{$func}[0] $want->{$func}[1]] s*/FOLD ->3 >=5.017002 EOT_EOT 3 <1> leavesub[2 refs] K/REFC,1 ->(end) - <\@> lineseq KP ->3 1 <;> dbstate(main 833 (eval 44):1) v ->2 -2 <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3 +2 <\$> const($want->{$func}[0] $want->{$func}[1]) s* ->3 < 5.017002 +2 <\$> const($want->{$func}[0] $want->{$func}[1]) s*/FOLD ->3 >=5.017002 EONT_EONT } @@ -143,14 +145,16 @@ checkOptree ( name => 'myyes() as coderef', # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 # 5 <@> print vK ->6 # 3 <0> pushmark s ->4 -# 4 <$> const[SPECIAL sv_yes] s*/FOLD ->5 +# 4 <$> const[SPECIAL sv_yes] s* ->5 < 5.017002 +# 4 <$> const[SPECIAL sv_yes] s*/FOLD ->5 >=5.017002 EOT_EOT # 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*/FOLD ->5 +# 4 <$> const(SPECIAL sv_yes) s* ->5 < 5.017002 +# 4 <$> const(SPECIAL sv_yes) s*/FOLD ->5 >=5.017002 EONT_EONT @@ -167,14 +171,16 @@ checkOptree ( name => 'myno() as coderef', # 2 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->3 # 5 <@> print vK ->6 # 3 <0> pushmark s ->4 -# 4 <$> const[SPECIAL sv_no] s*/FOLD ->5 +# 4 <$> const[SPECIAL sv_no] s* ->5 < 5.017002 +# 4 <$> const[SPECIAL sv_no] s*/FOLD ->5 >=5.017002 EOT_EOT # 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*/FOLD ->5 +# 4 <$> const(SPECIAL sv_no) s* ->5 < 5.017002 +# 4 <$> const(SPECIAL sv_no) s*/FOLD ->5 >=5.017002 EONT_EONT @@ -212,22 +218,32 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 # 2 <0> pushmark sM ->3 -# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4 -# 4 <$> const[IV 42] sM*/FOLD ->5 -# 5 <$> const[PV "hithere"] sM*/FOLD ->6 -# 6 <$> const[NV 1.414213] sM*/FOLD ->7 -# 7 <$> const[NV 3.14159] sM*/FOLD ->8 +# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM ->4 < 5.017002 +# 4 <$> const[IV 42] sM* ->5 < 5.017002 +# 5 <$> const[PV "hithere"] sM* ->6 < 5.017002 +# 6 <$> const[NV 1.414213] sM* ->7 < 5.017002 +# 7 <$> const[NV 3.14159] sM* ->8 < 5.017002 +# 3 <$> const[PV "myint %d mystr %s myfl %f pi %f\n"] sM/FOLD ->4 >= 5.017002 +# 4 <$> const[IV 42] sM*/FOLD ->5 >=5.017002 +# 5 <$> const[PV "hithere"] sM*/FOLD ->6 >=5.017002 +# 6 <$> const[NV 1.414213] sM*/FOLD ->7 >=5.017002 +# 7 <$> const[NV 3.14159] sM*/FOLD ->8 >=5.017002 EOT_EOT # 9 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->9 # 1 <;> nextstate(main 635 optree_constants.t:163) v:>,<,% ->2 # 8 <@> prtf sK ->9 # 2 <0> pushmark sM ->3 -# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4 -# 4 <$> const(IV 42) sM*/FOLD ->5 -# 5 <$> const(PV "hithere") sM*/FOLD ->6 -# 6 <$> const(NV 1.414213) sM*/FOLD ->7 -# 7 <$> const(NV 3.14159) sM*/FOLD ->8 +# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM ->4 < 5.017002 +# 4 <$> const(IV 42) sM* ->5 < 5.017002 +# 5 <$> const(PV "hithere") sM* ->6 < 5.017002 +# 6 <$> const(NV 1.414213) sM* ->7 < 5.017002 +# 7 <$> const(NV 3.14159) sM* ->8 < 5.017002 +# 3 <$> const(PV "myint %d mystr %s myfl %f pi %f\n") sM/FOLD ->4 >= 5.017002 +# 4 <$> const(IV 42) sM*/FOLD ->5 >=5.017002 +# 5 <$> const(PV "hithere") sM*/FOLD ->6 >=5.017002 +# 6 <$> const(NV 1.414213) sM*/FOLD ->7 >=5.017002 +# 7 <$> const(NV 3.14159) sM*/FOLD ->8 >=5.017002 EONT_EONT if($] < 5.015) { @@ -257,14 +273,16 @@ checkOptree ( name => 'arithmetic constant folding in print', # 1 <;> nextstate(main 937 (eval 53):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const[IV 6] s/FOLD ->4 +# 3 <$> const[IV 6] s ->4 < 5.017002 +# 3 <$> const[IV 6] s/FOLD ->4 >=5.017002 EOT_EOT # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 # 1 <;> nextstate(main 937 (eval 53):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const(IV 6) s/FOLD ->4 +# 3 <$> const(IV 6) s ->4 < 5.017002 +# 3 <$> const(IV 6) s/FOLD ->4 >=5.017002 EONT_EONT checkOptree ( name => 'string constant folding in print', @@ -276,14 +294,16 @@ checkOptree ( name => 'string constant folding in print', # 1 <;> nextstate(main 942 (eval 55):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const[PV "foobar"] s/FOLD ->4 +# 3 <$> const[PV "foobar"] s ->4 < 5.017002 +# 3 <$> const[PV "foobar"] s/FOLD ->4 >=5.017002 EOT_EOT # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 # 1 <;> nextstate(main 942 (eval 55):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const(PV "foobar") s/FOLD ->4 +# 3 <$> const(PV "foobar") s ->4 < 5.017002 +# 3 <$> const(PV "foobar") s/FOLD ->4 >=5.017002 EONT_EONT checkOptree ( name => 'boolean or folding', @@ -321,7 +341,8 @@ checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp', # - <@> lineseq KP ->r # 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2 # 4 <2> sassign vKS/2 ->5 -# 2 <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3 +# 2 <$> const[PV "FOO.Bar.low.lOW"] s ->3 < 5.017002 +# 2 <$> const[PV "FOO.Bar.low.lOW"] s/FOLD ->3 >=5.017002 # - <1> ex-rv2sv sKRM*/1 ->4 # 3 <#> gvsv[*s] s ->4 # 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6 @@ -345,13 +366,15 @@ checkOptree ( name => 'lc*,uc*,gt,lt,ge,le,cmp', # m <0> pushmark s ->n # n <$> const[PV "b-cmp-a"] s ->o # p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q -# q <$> const[PVNV 0] s/FOLD,SHORT ->r +# q <$> const[PVNV 0] s/SHORT ->r < 5.017002 +# q <$> const[PVNV 0] s/FOLD,SHORT ->r >=5.017002 EOT_EOT # r <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->r # 1 <;> nextstate(main 916 optree_constants.t:307) v:>,<,%,{ ->2 # 4 <2> sassign vKS/2 ->5 -# 2 <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3 +# 2 <$> const(PV "FOO.Bar.low.lOW") s ->3 < 5.017002 +# 2 <$> const(PV "FOO.Bar.low.lOW") s/FOLD ->3 >=5.017002 # - <1> ex-rv2sv sKRM*/1 ->4 # 3 <$> gvsv(*s) s ->4 # 5 <;> nextstate(main 916 optree_constants.t:308) v:>,<,%,{ ->6 @@ -375,7 +398,8 @@ EOT_EOT # m <0> pushmark s ->n # n <$> const(PV "b-cmp-a") s ->o # p <;> nextstate(main 916 optree_constants.t:313) v:>,<,%,{ ->q -# q <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r +# q <$> const(SPECIAL sv_no) s/SHORT ->r < 5.017002 +# q <$> const(SPECIAL sv_no) s/FOLD,SHORT ->r >=5.017002 EONT_EONT checkOptree ( name => 'mixed constant folding, with explicit braces', @@ -387,14 +411,16 @@ checkOptree ( name => 'mixed constant folding, with explicit braces', # 1 <;> nextstate(main 977 (eval 28):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const[PV "foobar5"] s/FOLD ->4 +# 3 <$> const[PV "foobar5"] s ->4 < 5.017002 +# 3 <$> const[PV "foobar5"] s/FOLD ->4 >=5.017002 EOT_EOT # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 # 1 <;> nextstate(main 977 (eval 28):1) v ->2 # 4 <@> print sK ->5 # 2 <0> pushmark s ->3 -# 3 <$> const(PV "foobar5") s/FOLD ->4 +# 3 <$> const(PV "foobar5") s ->4 < 5.017002 +# 3 <$> const(PV "foobar5") s/FOLD ->4 >=5.017002 EONT_EONT __END__ diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t index 5b623f5978..747a1ed941 100644 --- a/ext/B/t/optree_misc.t +++ b/ext/B/t/optree_misc.t @@ -65,7 +65,30 @@ EONT_EONT checkOptree ( name => 'PMOP children', code => sub { $foo =~ s/(a)/$1/ }, strip_open_hints => 1, - expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); + ( $] < 5.017002 + ? (expect => <<'EOT_EOT16', expect_nt => <<'EONT_EONT16') +# 6 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->6 +# 1 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2 +# 3 </> subst(/"(a)"/ replstart->4) KS ->6 +# - <1> ex-rv2sv sKRM/1 ->3 +# 2 <#> gvsv[*foo] s ->3 +# 5 <|> substcont(other->3) sK/1 ->(end) +# - <1> ex-rv2sv sK/1 ->5 +# 4 <#> gvsv[*1] s ->5 +EOT_EOT16 +# 6 <1> leavesub[1 ref] K/REFC,1 ->(end) +# - <@> lineseq KP ->6 +# 1 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2 +# 3 </> subst(/"(a)"/ replstart->4) KS ->6 +# - <1> ex-rv2sv sKRM/1 ->3 +# 2 <$> gvsv(*foo) s ->3 +# 5 <|> substcont(other->3) sK/1 ->(end) +# - <1> ex-rv2sv sK/1 ->5 +# 4 <$> gvsv(*1) s ->5 +EONT_EONT16 + + : (expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'))); # 5 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->5 # 1 <;> nextstate(main 1 -e:1) v:>,<,%,{ ->2 @@ -131,6 +154,7 @@ checkOptree ( name => 'formats', bcopts => 'STDOUT', progfile => $tmpfile, strip_open_hints => 1, + skip => ($] < 5.017003), expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT'); # main::STDOUT (FORMAT): # c <1> leavewrite[1 ref] K/REFC,1 ->(end) diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index f4a6e3c74e..5cc4e2589a 100644 --- a/ext/B/t/optree_samples.t +++ b/ext/B/t/optree_samples.t @@ -469,7 +469,8 @@ checkOptree ( name => '%h = map { getkey($_) => $_ } @a', # 3 <0> pushmark s # 4 <#> gv[*a] s # 5 <1> rv2av[t8] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t9] lK # 8 <0> enter l # 9 <;> nextstate(main 500 (eval 22):1) v:{ @@ -493,7 +494,8 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*a) s # 5 <1> rv2av[t3] lKM/1 -# 6 <@> mapstart lK +# 6 <@> mapstart lK* < 5.017002 +# 6 <@> mapstart lK >=5.017002 # 7 <|> mapwhile(other->8)[t4] lK # 8 <0> enter l # 9 <;> nextstate(main 500 (eval 22):1) v:{ @@ -617,14 +619,16 @@ checkOptree ( name => '-e use constant j => qq{junk}; print j', # 1 <0> enter # 2 <;> nextstate(main 71 -e:1) v:>,<,%,{ # 3 <0> pushmark s -# 4 <$> const[PV "junk"] s*/FOLD +# 4 <$> const[PV "junk"] s* < 5.017002 +# 4 <$> const[PV "junk"] s*/FOLD >=5.017002 # 5 <@> print vK # 6 <@> leave[1 ref] vKP/REFC EOT_EOT # 1 <0> enter # 2 <;> nextstate(main 71 -e:1) v:>,<,%,{ # 3 <0> pushmark s -# 4 <$> const(PV "junk") s*/FOLD +# 4 <$> const(PV "junk") s* < 5.017002 +# 4 <$> const(PV "junk") s*/FOLD >=5.017002 # 5 <@> print vK # 6 <@> leave[1 ref] vKP/REFC EONT_EONT diff --git a/ext/B/typemap b/ext/B/typemap index f3e253b97d..e97fb76d94 100644 --- a/ext/B/typemap +++ b/ext/B/typemap @@ -88,9 +88,6 @@ T_PL_OBJ croak(\"$var is not a reference\") OUTPUT -T_SV_OBJ - make_sv_object(aTHX_ ($arg), (SV*)($var)); - T_MG_OBJ sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var)); |