diff options
| -rw-r--r-- | pp_sort.c | 93 | ||||
| -rw-r--r-- | t/op/sort.t | 20 | ||||
| -rw-r--r-- | t/perf/benchmarks | 67 |
3 files changed, 128 insertions, 52 deletions
@@ -1482,7 +1482,6 @@ PP(pp_sort) bool hasargs = FALSE; bool copytmps; I32 is_xsub = 0; - I32 sorting_av = 0; const U8 priv = PL_op->op_private; const U8 flags = PL_op->op_flags; U32 sort_flags = 0; @@ -1563,34 +1562,31 @@ PP(pp_sort) PL_sortcop = NULL; } - /* optimiser converts "@a = sort @a" to "sort \@a"; - * in case of tied @a, pessimise: push (@a) onto stack, then assign - * result back to @a at the end of this function */ + /* optimiser converts "@a = sort @a" to "sort \@a". In this case, + * push (@a) onto stack, then assign result back to @a at the end of + * this function */ if (priv & OPpSORT_INPLACE) { assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV); (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */ av = MUTABLE_AV((*SP)); + if (SvREADONLY(av)) + Perl_croak_no_modify(); max = AvFILL(av) + 1; + MEXTEND(SP, max); if (SvMAGICAL(av)) { - MEXTEND(SP, max); for (i=0; i < max; i++) { SV **svp = av_fetch(av, i, FALSE); *SP++ = (svp) ? *svp : NULL; } - SP--; - p1 = p2 = SP - (max-1); } - else { - if (SvREADONLY(av)) - Perl_croak_no_modify(); - else - { - SvREADONLY_on(av); - save_pushptr((void *)av, SAVEt_READONLY_OFF); - } - p1 = p2 = AvARRAY(av); - sorting_av = 1; + else { + SV **svp = AvARRAY(av); + assert(svp || max == 0); + for (i = 0; i < max; i++) + *SP++ = *svp++; } + SP--; + p1 = p2 = SP - (max-1); } else { p2 = MARK+1; @@ -1600,7 +1596,7 @@ PP(pp_sort) /* shuffle stack down, removing optional initial cv (p1!=p2), plus * any nulls; also stringify or converting to integer or number as * required any args */ - copytmps = !sorting_av && PL_sortcop; + copytmps = PL_sortcop; for (i=max; i > 0 ; i--) { if ((*p1 = *p2++)) { /* Weed out nulls. */ if (copytmps && SvPADTMP(*p1)) { @@ -1633,9 +1629,6 @@ PP(pp_sort) else max--; } - if (sorting_av) - AvFILLp(av) = max-1; - if (max > 1) { SV **start; if (PL_sortcop) { @@ -1716,7 +1709,7 @@ PP(pp_sort) } else { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ - start = sorting_av ? AvARRAY(av) : ORIGMARK+1; + start = ORIGMARK+1; sortsvp(aTHX_ start, max, (priv & OPpSORT_NUMERIC) ? ( ( ( priv & OPpSORT_INTEGER) || all_SIVs) @@ -1742,27 +1735,45 @@ PP(pp_sort) } } } - if (sorting_av) - SvREADONLY_off(av); - else if (av && !sorting_av) { - /* simulate pp_aassign of tied AV */ - SV** const base = MARK+1; - for (i=0; i < max; i++) { - base[i] = newSVsv(base[i]); - } - av_clear(av); - av_extend(av, max); - for (i=0; i < max; i++) { - SV * const sv = base[i]; - SV ** const didstore = av_store(av, i, sv); - if (SvSMAGICAL(sv)) - mg_set(sv); - if (!didstore) - sv_2mortal(sv); - } + + if (av) { + /* copy back result to the array */ + SV** const base = MARK+1; + if (SvMAGICAL(av)) { + for (i = 0; i < max; i++) + base[i] = newSVsv(base[i]); + av_clear(av); + av_extend(av, max); + for (i=0; i < max; i++) { + SV * const sv = base[i]; + SV ** const didstore = av_store(av, i, sv); + if (SvSMAGICAL(sv)) + mg_set(sv); + if (!didstore) + sv_2mortal(sv); + } + } + else { + /* the elements of av are likely to be the same as the + * (non-refcounted) elements on the stack, just in a different + * order. However, its possible that someone's messed with av + * in the meantime. So bump and unbump the relevant refcounts + * first. + */ + for (i = 0; i < max; i++) + SvREFCNT_inc_void(base[i]); + av_clear(av); + if (max > 0) { + av_extend(av, max); + Copy(base, AvARRAY(av), max, SV*); + } + AvFILLp(av) = max - 1; + AvREIFY_off(av); + AvREAL_on(av); + } } LEAVE; - PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max); + PL_stack_sp = ORIGMARK + max; return nextop; } diff --git a/t/op/sort.t b/t/op/sort.t index badd684ab0..7a07b36010 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -474,6 +474,16 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar no warnings 'void'; my @m; push @m, 0 for 1 .. 1024; $#m; @m = sort @m; ::pass("in-place sorting segfault"); + + # RT #39358 - array should be preserved during sort + + { + my @aa = qw(b c a); + my @copy; + @aa = sort { @copy = @aa; $a cmp $b } @aa; + is "@aa", "a b c", "RT 39358 - aa"; + is "@copy", "b c a", "RT 39358 - copy"; + } } # Test optimisations of reversed sorts. As we now guarantee stability by @@ -846,16 +856,6 @@ cmp_ok($answer,'eq','good','sort subr called from other package'); } -# Bug 7567 - an array shouldn't be modifiable while it's being -# sorted in-place. -{ - eval { @a=(1..8); @a = sort { @a = (0) } @a; }; - - $fail_msg = q(Modification of a read-only value attempted); - cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567'); - eval { @a=1..3 }; - is $@, "", 'abrupt scope exit turns off readonliness'; -} # I commented out this TODO test because messing with FREEd scalars on the # stack can have all sorts of strange side-effects, not made safe by eval diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 88b20deb94..6ea1ce882b 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -33,6 +33,7 @@ # # call:: subroutine and method handling # expr:: expressions: e.g. $x=1, $foo{bar}[0] +# func:: perl functions, e.g. func::sort::... # loop:: structural code like for, while(), etc # regex:: regular expressions # string:: string handling @@ -895,9 +896,73 @@ code => '$y = $x--', # scalar context so not optimised to --$x }, + + 'func::sort::num' => { + desc => 'plain numeric sort', + setup => 'my (@a, @b); @a = reverse 1..10;', + code => '@b = sort { $a <=> $b } @a', + }, + 'func::sort::num_block' => { + desc => 'codeblock numeric sort', + setup => 'my (@a, @b); @a = reverse 1..10;', + code => '@b = sort { $a + 1 <=> $b + 1 } @a', + }, + 'func::sort::num_fn' => { + desc => 'function numeric sort', + setup => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;', + code => '@b = sort f @a', + }, + 'func::sort::str' => { + desc => 'plain string sort', + setup => 'my (@a, @b); @a = reverse "a".."j";', + code => '@b = sort { $a cmp $b } @a', + }, + 'func::sort::str_block' => { + desc => 'codeblock string sort', + setup => 'my (@a, @b); @a = reverse "a".."j";', + code => '@b = sort { ($a . "") cmp ($b . "") } @a', + }, + 'func::sort::str_fn' => { + desc => 'function string sort', + setup => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse "a".."j";', + code => '@b = sort f @a', + }, + + 'func::sort::num_inplace' => { + desc => 'plain numeric sort in-place', + setup => 'my @a = reverse 1..10;', + code => '@a = sort { $a <=> $b } @a', + }, + 'func::sort::num_block_inplace' => { + desc => 'codeblock numeric sort in-place', + setup => 'my @a = reverse 1..10;', + code => '@a = sort { $a + 1 <=> $b + 1 } @a', + }, + 'func::sort::num_fn_inplace' => { + desc => 'function numeric sort in-place', + setup => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;', + code => '@a = sort f @a', + }, + 'func::sort::str_inplace' => { + desc => 'plain string sort in-place', + setup => 'my @a = reverse "a".."j";', + code => '@a = sort { $a cmp $b } @a', + }, + 'func::sort::str_block_inplace' => { + desc => 'codeblock string sort in-place', + setup => 'my @a = reverse "a".."j";', + code => '@a = sort { ($a . "") cmp ($b . "") } @a', + }, + 'func::sort::str_fn_inplace' => { + desc => 'function string sort in-place', + setup => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse "a".."j";', + code => '@a = sort f @a', + }, + + 'loop::block' => { desc => 'empty basic loop', - setup => ';', + setup => '', code => '{1;}', }, |