#!perl
BEGIN {
- chdir q(t);
- @INC = qw(../lib ../ext/B/t);
+ unshift @INC, 't';
require Config;
if (($Config::Config{'extensions'} !~ /\bB\b/) ){
print "1..0 # Skip -- Perl configured without B module\n";
print "1..0 # Skip -- need perlio to walk the optree\n";
exit 0;
}
- if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
- print
- "1..0 # Skip: Data::Dumper was not built, needed by OptreeCheck\n";
- exit 0;
-
- }
- if ($] < 5.009) {
- print "1..0 # Skip -- TODO - provide golden result regexps for 5.8\n";
- exit 0;
- }
- require q(./test.pl);
}
use OptreeCheck;
-plan tests => 20;
+plan tests => 40;
+
+=head1 f_sort.t
+
+Code test snippets here are adapted from `perldoc -f map`
+Due to a bleadperl optimization (Dave Mitchell, circa apr 04), the
+(map|grep)(start|while) opcodes have different flags in 5.9, their
+private flags /1, /2 are gone in blead (for the cases covered)
+
+When the optree stuff was integrated into 5.8.6, these tests failed,
+and were todo'd. They're now done, by version-specific tweaking in
+mkCheckRex(), therefore the skip is removed too.
=head1 Test Notes
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t5] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 545 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t3] KS
+# a <2> aassign[t3] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t3] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t10] KS
+# a <2> aassign[t10] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t3] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t3] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t5] KS
+# a <2> aassign[t3] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t2] KS
+# a <2> aassign[t2] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*eldest] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t11] KS
+# b <2> aassign[t11] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*eldest) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*sortedclass] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*sortedclass) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# k <#> gv[*george] s
# l <1> rv2av[t5] lKRM*/1
# m <2> aassign[t6] vKS
-# n <;> nextstate(main 602 (eval 32):4) v
+# n <;> nextstate(main 602 (eval 32):4) v:{
# o <0> pushmark s
# p <0> pushmark s
# q <#> gv[*harry] s
# r <1> rv2av[t8] lK/1
# s <@> sort lK
# t <@> print vK
-# u <;> nextstate(main 602 (eval 32):4) v
+# u <;> nextstate(main 602 (eval 32):4) v:{
# v <0> pushmark s
# w <0> pushmark s
# x <$> const[PV "backwards"] s/BARE
# z <1> rv2av[t10] lK/1
# 10 <@> sort lKS
# 11 <@> print vK
-# 12 <;> nextstate(main 602 (eval 32):5) v
+# 12 <;> nextstate(main 602 (eval 32):5) v:{
# 13 <0> pushmark s
# 14 <0> pushmark s
# 15 <#> gv[*george] s
# k <$> gv(*george) s
# l <1> rv2av[t3] lKRM*/1
# m <2> aassign[t4] vKS
-# n <;> nextstate(main 602 (eval 32):4) v
+# n <;> nextstate(main 602 (eval 32):4) v:{
# o <0> pushmark s
# p <0> pushmark s
# q <$> gv(*harry) s
# r <1> rv2av[t5] lK/1
# s <@> sort lK
# t <@> print vK
-# u <;> nextstate(main 602 (eval 32):4) v
+# u <;> nextstate(main 602 (eval 32):4) v:{
# v <0> pushmark s
# w <0> pushmark s
# x <$> const(PV "backwards") s/BARE
# z <1> rv2av[t6] lK/1
# 10 <@> sort lKS
# 11 <@> print vK
-# 12 <;> nextstate(main 602 (eval 32):5) v
+# 12 <;> nextstate(main 602 (eval 32):5) v:{
# 13 <0> pushmark s
# 14 <0> pushmark s
# 15 <$> gv(*george) s
sort { $b->[1] <=> $a->[1] || $a->[2] cmp $b->[2] }
map { [$_, /=(\d+)/, uc($_)] } @old; },
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 609 (eval 34):3) v
+# 1 <;> nextstate(main 609 (eval 34):3) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <0> pushmark s
# 5 <0> pushmark s
# 6 <#> gv[*old] s
# 7 <1> rv2av[t19] lKM/1
-# 8 <@> mapstart lK*
+# 8 <@> mapstart lK
# 9 <|> mapwhile(other->a)[t20] lK
# a <0> enter l
-# b <;> nextstate(main 608 (eval 34):2) v
+# b <;> nextstate(main 608 (eval 34):2) v:{
# c <0> pushmark s
# d <#> gvsv[*_] s
# e </> match(/"=(\\d+)"/) l/RTIME
# f <#> gvsv[*_] s
# g <1> uc[t17] sK/1
-# h <@> anonlist sKRM/1
-# i <1> srefgen sK/1
-# j <@> leave lKP
+# h <@> anonlist sK*/1
+# i <@> leave lKP
# goto 9
-# k <@> sort lKMS*
-# l <@> mapstart lK*
-# m <|> mapwhile(other->n)[t26] lK
-# n <#> gv[*_] s
-# o <1> rv2sv sKM/DREFAV,1
-# p <1> rv2av[t4] sKR/1
-# q <$> const[IV 0] s
-# r <2> aelem sK/2
-# - <@> scope lK
-# goto m
-# s <0> pushmark s
-# t <#> gv[*new] s
-# u <1> rv2av[t2] lKRM*/1
-# v <2> aassign[t27] KS/COMMON
-# w <1> leavesub[1 ref] K/REFC,1
+# j <@> sort lKMS*
+# k <@> mapstart lK
+# 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
+# goto l
+# r <0> pushmark s
+# s <#> gv[*new] s
+# t <1> rv2av[t2] lKRM*/1
+# u <2> aassign[t27] KS/COMMON
+# v <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 609 (eval 34):3) v
+# 1 <;> nextstate(main 609 (eval 34):3) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <0> pushmark s
# 5 <0> pushmark s
# 6 <$> gv(*old) s
# 7 <1> rv2av[t10] lKM/1
-# 8 <@> mapstart lK*
+# 8 <@> mapstart lK
# 9 <|> mapwhile(other->a)[t11] lK
# a <0> enter l
-# b <;> nextstate(main 608 (eval 34):2) v
+# b <;> nextstate(main 608 (eval 34):2) v:{
# c <0> pushmark s
# d <$> gvsv(*_) s
# e </> match(/"=(\\d+)"/) l/RTIME
# f <$> gvsv(*_) s
# g <1> uc[t9] sK/1
-# h <@> anonlist sKRM/1
-# i <1> srefgen sK/1
-# j <@> leave lKP
+# h <@> anonlist sK*/1
+# i <@> leave lKP
# goto 9
-# k <@> sort lKMS*
-# l <@> mapstart lK*
-# m <|> mapwhile(other->n)[t12] lK
-# n <$> gv(*_) s
-# o <1> rv2sv sKM/DREFAV,1
-# p <1> rv2av[t2] sKR/1
-# q <$> const(IV 0) s
-# r <2> aelem sK/2
-# - <@> scope lK
-# goto m
-# s <0> pushmark s
-# t <$> gv(*new) s
-# u <1> rv2av[t1] lKRM*/1
-# v <2> aassign[t13] KS/COMMON
-# w <1> leavesub[1 ref] K/REFC,1
+# j <@> sort lKMS*
+# k <@> mapstart lK
+# 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
+# goto l
+# r <0> pushmark s
+# s <$> gv(*new) s
+# t <1> rv2av[t1] lKRM*/1
+# u <2> aassign[t13] KS/COMMON
+# v <1> leavesub[1 ref] K/REFC,1
EONT_EONT
code => q{package other; sub backwards ($$) { $_[1] cmp $_[0]; }
package main; @new = sort other::backwards @old; },
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 614 (eval 36):2) v
+# 1 <;> nextstate(main 614 (eval 36):2) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <$> const[PV "other::backwards"] s/BARE
# 8 <0> pushmark s
# 9 <#> gv[*new] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 614 (eval 36):2) v
+# 1 <;> nextstate(main 614 (eval 36):2) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <$> const(PV "other::backwards") s/BARE
# 8 <0> pushmark s
# 9 <$> gv(*new) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 8 <0> pushmark s
# 9 <#> gv[*new] s
# a <1> rv2av[t2] lKRM*/1
-# b <2> aassign[t5] KS
+# b <2> aassign[t5] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 8 <0> pushmark s
# 9 <$> gv(*new) s
# a <1> rv2av[t1] lKRM*/1
-# b <2> aassign[t3] KS
+# b <2> aassign[t3] KS/COMMON
# c <1> leavesub[1 ref] K/REFC,1
EONT_EONT
=cut
-checkOptree(note => q{},
- bcopts => q{-exec},
- code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
- expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 656 (eval 40):1) v
+my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
+# 1 <;> nextstate(main 656 (eval 40):1) v:%,{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <#> gv[*old] s
# 5 <1> rv2av[t9] lK/1
-# 6 <@> sort lKS*
+# 6 <@> sort lKS*/STABLE
# 7 <0> pushmark s
# 8 <#> gv[*new] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t14] KS
+# a <2> aassign[t14] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 578 (eval 15):1) v
+# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <$> gv(*old) s
# 5 <1> rv2av[t5] lK/1
-# 6 <@> sort lKS*
+# 6 <@> sort lKS*/STABLE
# 7 <0> pushmark s
# 8 <$> gv(*new) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
-
+
+if($] < 5.009) {
+ # 5.8.x doesn't show the /STABLE flag, so massage the golden results.
+ s!/STABLE!!s foreach ($expect, $expect_nt);
+}
+
+checkOptree(note => q{},
+ bcopts => q{-exec},
+ code => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
+ expect => $expect, expect_nt => $expect_nt);
=for gentest
bcopts => q{-exec},
code => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 662 (eval 42):1) v
+# 1 <;> nextstate(main 662 (eval 42):1) v:%,{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <#> gv[*old] s
# 7 <0> pushmark s
# 8 <#> gv[*new] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t14] KS
+# a <2> aassign[t14] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 578 (eval 15):1) v
+# 1 <;> nextstate(main 578 (eval 15):1) v:%,{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <$> gv(*old) s
# 7 <0> pushmark s
# 8 <$> gv(*new) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t6] KS
+# a <2> aassign[t6] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 7 <0> pushmark s
# 8 <#> gv[*articles] s
# 9 <1> rv2av[t2] lKRM*/1
-# a <2> aassign[t8] KS
+# a <2> aassign[t8] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 546 (eval 15):1) v
# 7 <0> pushmark s
# 8 <$> gv(*articles) s
# 9 <1> rv2av[t1] lKRM*/1
-# a <2> aassign[t4] KS
+# a <2> aassign[t4] KS/COMMON
# b <1> leavesub[1 ref] K/REFC,1
EONT_EONT
# 4 <0> pushmark s
# 5 <#> gv[*input] s
# 6 <1> rv2av[t9] lKM/1
-# 7 <@> grepstart lK*
+# 7 <@> grepstart lK
# 8 <|> grepwhile(other->9)[t10] lK
# 9 <#> gvsv[*_] s
# a <#> gvsv[*_] s
# b <2> eq sK/2
-# - <@> scope sK
# goto 8
# c <@> sort lK/NUM
# d <0> pushmark s
# e <#> gv[*result] s
# f <1> rv2av[t2] lKRM*/1
-# g <2> aassign[t5] KS/COMMON
+# g <2> aassign[t3] KS/COMMON
# h <1> leavesub[1 ref] K/REFC,1
EOT_EOT
# 1 <;> nextstate(main 547 (eval 15):1) v
# 4 <0> pushmark s
# 5 <$> gv(*input) s
# 6 <1> rv2av[t3] lKM/1
-# 7 <@> grepstart lK*
+# 7 <@> grepstart lK
# 8 <|> grepwhile(other->9)[t4] lK
# 9 <$> gvsv(*_) s
# a <$> gvsv(*_) s
# b <2> eq sK/2
-# - <@> scope sK
# goto 8
# c <@> sort lK/NUM
# d <0> pushmark s
# 3 <0> pushmark s
# 4 <#> gv[*input] s
# 5 <1> rv2av[t7] lKM/1
-# 6 <@> grepstart lK*
+# 6 <@> grepstart lK
# 7 <|> grepwhile(other->8)[t8] lK
# 8 <#> gvsv[*_] s
# 9 <#> gvsv[*_] s
# a <2> eq sK/2
-# - <@> scope sK
# goto 7
# b <@> sort K/NUM
# c <1> leavesub[1 ref] K/REFC,1
# 3 <0> pushmark s
# 4 <$> gv(*input) s
# 5 <1> rv2av[t2] lKM/1
-# 6 <@> grepstart lK*
+# 6 <@> grepstart lK
# 7 <|> grepwhile(other->8)[t3] lK
# 8 <$> gvsv(*_) s
# 9 <$> gvsv(*_) s
# a <2> eq sK/2
-# - <@> scope sK
# goto 7
# b <@> sort K/NUM
# c <1> leavesub[1 ref] K/REFC,1
bcopts => q{-exec},
code => q{$s = sort { $a <=> $b } @input; },
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 689 (eval 52):1) v
+# 1 <;> nextstate(main 689 (eval 52):1) v:{
# 2 <0> pushmark s
# 3 <#> gv[*input] s
# 4 <1> rv2av[t6] lK/1
# 7 <2> sassign sKS/2
# 8 <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 546 (eval 15):1) v
+# 1 <;> nextstate(main 546 (eval 15):1) v:{
# 2 <0> pushmark s
# 3 <$> gv(*input) s
# 4 <1> rv2av[t2] lK/1
bcopts => q{-exec},
code => q{$s = sort { $a <=> $b } grep { $_ == $_ } @input; },
expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1 <;> nextstate(main 695 (eval 54):1) v
+# 1 <;> nextstate(main 695 (eval 54):1) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <#> gv[*input] s
# 5 <1> rv2av[t8] lKM/1
-# 6 <@> grepstart lK*
+# 6 <@> grepstart lK
# 7 <|> grepwhile(other->8)[t9] lK
# 8 <#> gvsv[*_] s
# 9 <#> gvsv[*_] s
# a <2> eq sK/2
-# - <@> scope sK
# goto 7
# b <@> sort sK/NUM
# c <#> gvsv[*s] s
# d <2> sassign sKS/2
# e <1> leavesub[1 ref] K/REFC,1
EOT_EOT
-# 1 <;> nextstate(main 547 (eval 15):1) v
+# 1 <;> nextstate(main 547 (eval 15):1) v:{
# 2 <0> pushmark s
# 3 <0> pushmark s
# 4 <$> gv(*input) s
# 5 <1> rv2av[t2] lKM/1
-# 6 <@> grepstart lK*
+# 6 <@> grepstart lK
# 7 <|> grepwhile(other->8)[t3] lK
# 8 <$> gvsv(*_) s
# 9 <$> gvsv(*_) s
# a <2> eq sK/2
-# - <@> scope sK
# goto 7
# b <@> sort sK/NUM
# c <$> gvsv(*s) s
https://perl5.git.perl.org / perl5.git / blobdiff