diff options
| -rw-r--r-- | ext/B/t/f_sort.t | 16 | ||||
| -rw-r--r-- | op.c | 17 | ||||
| -rw-r--r-- | op.h | 3 | ||||
| -rwxr-xr-x | t/op/sort.t | 133 |
4 files changed, 153 insertions, 16 deletions
diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index 7d66c2d901..f3eec358e6 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -154,11 +154,11 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*files] s # 5 <1> rv2av[t7] lK/1 -# 6 <@> sort lK/REV +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t5] KS +# a <2> aassign[t8] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -166,11 +166,11 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*files) s # 5 <1> rv2av[t3] lK/1 -# 6 <@> sort lK/REV +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t4] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -228,11 +228,11 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*files] s # 5 <1> rv2av[t7] lK/1 -# 6 <@> sort lK/REV,NUM +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t5] KS +# a <2> aassign[t8] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -240,11 +240,11 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*files) s # 5 <1> rv2av[t3] lK/1 -# 6 <@> sort lK/REV,NUM +# 6 <@> sort lKS* # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t4] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -5913,7 +5913,7 @@ S_simplify_sort(pTHX_ OP *o) { register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; - int reversed; + int descending; GV *gv; if (!(o->op_flags & OPf_STACKED)) return; @@ -5942,11 +5942,16 @@ S_simplify_sort(pTHX_ OP *o) if (GvSTASH(gv) != PL_curstash) return; if (strEQ(GvNAME(gv), "a")) - reversed = 0; + descending = 0; else if (strEQ(GvNAME(gv), "b")) - reversed = 1; + descending = 1; else return; + + /* FIXME once we have proper descending support in pp_sort */ + if (descending) + return; + kid = k; /* back to cmp */ if (kBINOP->op_last->op_type != OP_RV2SV) return; @@ -5956,13 +5961,13 @@ S_simplify_sort(pTHX_ OP *o) kid = kUNOP->op_first; /* get past rv2sv */ gv = kGVOP_gv; if (GvSTASH(gv) != PL_curstash - || ( reversed + || ( descending ? strNE(GvNAME(gv), "a") : strNE(GvNAME(gv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); - if (reversed) - o->op_private |= OPpSORT_REVERSE; + if (descending) + o->op_private |= OPpSORT_DESCEND; if (k->op_type == OP_NCMP) o->op_private |= OPpSORT_NUMERIC; if (k->op_type == OP_I_NCMP) @@ -203,8 +203,9 @@ Deprecated. Use C<GIMME_V> instead. /* Private for OP_SORT */ #define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */ #define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */ -#define OPpSORT_REVERSE 4 /* Descending sort */ +#define OPpSORT_REVERSE 4 /* Reversed sort */ #define OPpSORT_INPLACE 8 /* sort in-place; eg @a = sort @a */ +#define OPpSORT_DESCEND 16 /* Descending sort */ /* Private for OP_THREADSV */ #define OPpDONE_SVREF 64 /* Been through newSVREF once */ diff --git a/t/op/sort.t b/t/op/sort.t index c1129c2422..63b3bbb25e 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } use warnings; -print "1..75\n"; +print "1..99\n"; # these shouldn't hang { @@ -391,6 +391,137 @@ sub ok { ok "@a", "c b a x", "un-inplace sort with function of lexical 2"; } +# Test optimisations of reversed sorts. As we now guarantee stability by +# default, # optimisations which do not provide this are bogus. +{ + package Oscalar; + use overload (qw("" stringify 0+ numify fallback 1)); + + sub new { + bless [$_[1], $_[2]], $_[0]; + } + + sub stringify { $_[0]->[0] } + + sub numify { $_[0]->[1] } +} + +sub generate { + my $count = 0; + map {new Oscalar $_, $count++} qw(A A A B B B C C C); +} + +my @input = &generate; +my @output = sort @input; +ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", "Simple stable sort"; + +@input = &generate; +@input = sort @input; +ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8", + "Simple stable in place sort"; + +# This won't be very interesting +@input = &generate; +@output = sort {$a <=> $b} @input; +ok "@output", "A A A B B B C C C", 'stable $a <=> $b sort'; + +@input = &generate; +@output = sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @output), "0 1 2 3 4 5 6 7 8", 'stable $a cmp $b sort'; + +@input = &generate; +@input = sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @input), "0 1 2 3 4 5 6 7 8", + 'stable $a cmp $b in place sort'; + +@input = &generate; +@output = sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @output), "6 7 8 3 4 5 0 1 2", 'stable $b cmp $a sort'; + +@input = &generate; +@input = sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @input), "6 7 8 3 4 5 0 1 2", + 'stable $b cmp $a in place sort'; + +@output = reverse sort @input; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", "Reversed stable sort"; + +@input = &generate; +@input = reverse sort @input; +ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0", + "Reversed stable in place sort"; + + +@input = &generate; +@output = reverse sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @output), "8 7 6 5 4 3 2 1 0", + 'reversed stable $a cmp $b sort'; + +@input = &generate; +@input = reverse sort {$a cmp $b} @input; +ok join(" ", map {0+$_} @input), "8 7 6 5 4 3 2 1 0", + 'revesed stable $a cmp $b in place sort'; + +@input = &generate; +@output = reverse sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @output), "2 1 0 5 4 3 8 7 6", + 'reversed stable $b cmp $a sort'; + +@input = &generate; +@input = reverse sort {$b cmp $a} @input; +ok join(" ", map {0+$_} @input), "2 1 0 5 4 3 8 7 6", + 'revesed stable $b cmp $a in place sort'; + + +# And now with numbers + +sub generate1 { + my $count = 'A'; + map {new Oscalar $count++, $_} 0, 0, 0, 1, 1, 1, 2, 2, 2; +} + +# This won't be very interesting +@input = &generate1; +@output = sort {$a cmp $b} @input; +ok "@output", "A B C D E F G H I", 'stable $a cmp $b sort'; + +@input = &generate1; +@output = sort {$a <=> $b} @input; +ok "@output", "A B C D E F G H I", 'stable $a <=> $b sort'; + +@input = &generate1; +@input = sort {$a <=> $b} @input; +ok "@input", "A B C D E F G H I", 'stable $a <=> $b in place sort'; + +@input = &generate1; +@output = sort {$b <=> $a} @input; +ok "@output", "G H I D E F A B C", 'stable $b <=> $a sort'; + +@input = &generate1; +@input = sort {$b <=> $a} @input; +ok "@input", "G H I D E F A B C", 'stable $b <=> $a in place sort'; + +# These two are actually doing string cmp on 0 1 and 2 +@output = reverse sort @input; +ok "@output", "I H G F E D C B A", "Reversed stable sort"; + +@input = &generate1; +@input = reverse sort @input; +ok "@input", "I H G F E D C B A", "Reversed stable in place sort"; + +@input = &generate1; +@output = reverse sort {$a <=> $b} @input; +ok "@output", "I H G F E D C B A", 'reversed stable $a <=> $b sort'; + +@input = &generate1; +@input = reverse sort {$a <=> $b} @input; +ok "@input", "I H G F E D C B A", 'revesed stable $a <=> $b in place sort'; +@input = &generate1; +@output = reverse sort {$b <=> $a} @input; +ok "@output", "C B A F E D I H G", 'reversed stable $b <=> $a sort'; +@input = &generate1; +@input = reverse sort {$b <=> $a} @input; +ok "@input", "C B A F E D I H G", 'revesed stable $b <=> $a in place sort'; |