diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 6 | ||||
| -rw-r--r-- | ext/B/t/concise-xs.t | 2 | ||||
| -rw-r--r-- | ext/B/t/f_sort.t | 4 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | lib/feature.pm | 6 | ||||
| -rw-r--r-- | lib/sort.pm | 97 | ||||
| -rw-r--r-- | lib/sort.t | 73 | ||||
| -rw-r--r-- | op.c | 15 | ||||
| -rw-r--r-- | op.h | 3 | ||||
| -rw-r--r-- | pod/perlapi.pod | 13 | ||||
| -rw-r--r-- | pp_sort.c | 81 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | toke.c | 5 |
15 files changed, 167 insertions, 145 deletions
@@ -453,6 +453,7 @@ Afp |SV* |mess |NN const char* pat|... Ap |SV* |vmess |NN const char* pat|NULLOK va_list* args p |void |qerror |NN SV* err Apd |void |sortsv |NN SV** array|size_t num_elts|SVCOMPARE_t cmp +Apd |void |sortsv_flags |NN SV** array|size_t num_elts|SVCOMPARE_t cmp|U32 flags Apd |int |mg_clear |NN SV* sv Apd |int |mg_copy |NN SV* sv|NN SV* nsv|NULLOK const char* key|I32 klen pd |void |mg_localize |NN SV* sv|NN SV* nsv @@ -457,6 +457,7 @@ #define qerror Perl_qerror #endif #define sortsv Perl_sortsv +#define sortsv_flags Perl_sortsv_flags #define mg_clear Perl_mg_clear #define mg_copy Perl_mg_copy #ifdef PERL_CORE @@ -2502,6 +2503,7 @@ #define qerror(a) Perl_qerror(aTHX_ a) #endif #define sortsv(a,b,c) Perl_sortsv(aTHX_ a,b,c) +#define sortsv_flags(a,b,c,d) Perl_sortsv_flags(aTHX_ a,b,c,d) #define mg_clear(a) Perl_mg_clear(aTHX_ a) #define mg_copy(a,b,c,d) Perl_mg_copy(aTHX_ a,b,c,d) #ifdef PERL_CORE diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index c84578e44c..9b44b05dff 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -590,16 +590,14 @@ $priv{"flip"}{64} = $priv{"flop"}{64} = "LINENUM"; $priv{"list"}{64} = "GUESSED"; $priv{"delete"}{64} = "SLICE"; $priv{"exists"}{64} = "SUB"; -$priv{$_}{64} = "LOCALE" - for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge", - "scmp", "lc", "uc", "lcfirst", "ucfirst"); -@{$priv{"sort"}}{1,2,4,8,16} = ("NUM", "INT", "REV", "INPLACE","DESC"); +@{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE"); $priv{"threadsv"}{64} = "SVREFd"; @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR") for ("open", "backtick"); $priv{"exit"}{128} = "VMS"; $priv{$_}{2} = "FTACCESS" for ("ftrread", "ftrwrite", "ftrexec", "fteread", "ftewrite", "fteexec"); +$priv{"entereval"}{2} = "HAS_HH"; if ($] >= 5.009) { # Stacked filetests are post 5.8.x $priv{$_}{4} = "FTSTACKED" diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t index fe45773e03..0ac1aea172 100644 --- a/ext/B/t/concise-xs.t +++ b/ext/B/t/concise-xs.t @@ -94,7 +94,7 @@ use Getopt::Std; use Carp; use Test::More tests => ( 1 * !!$Config::Config{useithreads} + 3 * ($] > 5.009) - + 12 * ($] >= 5.009003) + + 14 * ($] >= 5.009003) + 777 ); require_ok("B::Concise"); diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index ccd7d8d8d1..513c2e215e 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -675,7 +675,7 @@ checkOptree(note => q{}, # 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 @@ -687,7 +687,7 @@ EOT_EOT # 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 diff --git a/global.sym b/global.sym index eb734052a4..376f23e36d 100644 --- a/global.sym +++ b/global.sym @@ -242,6 +242,7 @@ Perl_markstack_grow Perl_mess Perl_vmess Perl_sortsv +Perl_sortsv_flags Perl_mg_clear Perl_mg_copy Perl_mg_find diff --git a/lib/feature.pm b/lib/feature.pm index e0981d08a9..fe549944bc 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -5,9 +5,9 @@ $feature::hint_bits = 0x04020000; # HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL # (feature name) => (internal name, used in %^H) my %feature = ( - switch => 'switch', - "~~" => "~~", - say => "say", + switch => 'feature_switch', + "~~" => "feature_~~", + say => "feature_say", ); diff --git a/lib/sort.pm b/lib/sort.pm index e785003f4f..e8d6446ba4 100644 --- a/lib/sort.pm +++ b/lib/sort.pm @@ -2,12 +2,10 @@ package sort; our $VERSION = '1.02'; -# Currently the hints for pp_sort are stored in the global variable -# $sort::hints. An improvement would be to store them in $^H{SORT} and have -# this information available somewhere in the listop OP_SORT, to allow lexical -# scoping of this pragma. -- rgs 2002-04-30 +# The hints for pp_sort are now stored in $^H{sort}; older versions +# of perl used the global variable $sort::hints. -- rjh 2005-12-19 -our $hints = 0; +$sort::hint_bits = 0x04020000; # HINT_LOCALIZE_HH | HINT_HH_FOR_EVAL $sort::quicksort_bit = 0x00000001; $sort::mergesort_bit = 0x00000002; @@ -24,22 +22,24 @@ sub import { } local $_; no warnings 'uninitialized'; # bitops would warn + $^H{sort} //= 0; while ($_ = shift(@_)) { if (/^_q(?:uick)?sort$/) { - $hints &= ~$sort::sort_bits; - $hints |= $sort::quicksort_bit; + $^H{sort} &= ~$sort::sort_bits; + $^H{sort} |= $sort::quicksort_bit; } elsif ($_ eq '_mergesort') { - $hints &= ~$sort::sort_bits; - $hints |= $sort::mergesort_bit; + $^H{sort} &= ~$sort::sort_bits; + $^H{sort} |= $sort::mergesort_bit; } elsif ($_ eq 'stable') { - $hints |= $sort::stable_bit; + $^H{sort} |= $sort::stable_bit; } elsif ($_ eq 'defaults') { - $hints = 0; + $^H{sort} = 0; } else { require Carp; Carp::croak("sort: unknown subpragma '$_'"); } } + $^H |= $sort::hint_bits; } sub unimport { @@ -52,11 +52,11 @@ sub unimport { no warnings 'uninitialized'; # bitops would warn while ($_ = shift(@_)) { if (/^_q(?:uick)?sort$/) { - $hints &= ~$sort::sort_bits; + $^H{sort} &= ~$sort::sort_bits; } elsif ($_ eq '_mergesort') { - $hints &= ~$sort::sort_bits; + $^H{sort} &= ~$sort::sort_bits; } elsif ($_ eq 'stable') { - $hints &= ~$sort::stable_bit; + $^H{sort} &= ~$sort::stable_bit; } else { require Carp; Carp::croak("sort: unknown subpragma '$_'"); @@ -66,10 +66,10 @@ sub unimport { sub current { my @sort; - if ($hints) { - push @sort, 'quicksort' if $hints & $sort::quicksort_bit; - push @sort, 'mergesort' if $hints & $sort::mergesort_bit; - push @sort, 'stable' if $hints & $sort::stable_bit; + if ($^H{sort}) { + push @sort, 'quicksort' if $^H{sort} & $sort::quicksort_bit; + push @sort, 'mergesort' if $^H{sort} & $sort::mergesort_bit; + push @sort, 'stable' if $^H{sort} & $sort::stable_bit; } push @sort, 'mergesort' unless @sort; join(' ', @sort); @@ -92,7 +92,10 @@ sort - perl pragma to control sort() behaviour use sort '_qsort'; # alias for quicksort - my $current = sort::current(); # identify prevailing algorithm + my $current; + BEGIN { + $current = sort::current(); # identify prevailing algorithm + } =head1 DESCRIPTION @@ -152,50 +155,46 @@ have exactly the same effect, leaving the choice of sort algorithm open. =head1 CAVEATS -This pragma is not lexically scoped: its effect is global to the program -it appears in. That means the following will probably not do what you -expect, because I<both> pragmas take effect at compile time, before -I<either> C<sort()> happens. +As of Perl 5.10, this pragma is lexically scoped and takes effect +at compile time. In earlier versions its effect was global and took +effect at run-time; the documentation suggested using C<eval()> to +change the behaviour: - { use sort "_quicksort"; + { eval 'use sort qw(defaults _quicksort)'; # force quicksort + eval 'no sort "stable"'; # stability not wanted print sort::current . "\n"; @a = sort @b; + eval 'use sort "defaults"'; # clean up, for others } - { use sort "stable"; + { eval 'use sort qw(defaults stable)'; # force stability print sort::current . "\n"; @c = sort @d; + eval 'use sort "defaults"'; # clean up, for others } - # prints: - # quicksort stable - # quicksort stable -You can achieve the effect you probably wanted by using C<eval()> -to defer the pragmas until run time. Use the quoted argument -form of C<eval()>, I<not> the BLOCK form, as in +Such code no longer has the desired effect, for two reasons. +Firstly, the use of C<eval()> means that the sorting algorithm +is not changed until runtime, by which time it's too late to +have any effect. Secondly, C<sort::current> is also called at +run-time, when in fact the compile-time value of C<sort::current> +is the one that matters. - eval { use sort "_quicksort" }; # WRONG +So now this code would be written: -or the effect will still be at compile time. -Reset to default options before selecting other subpragmas -(in case somebody carelessly left them on) and after sorting, -as a courtesy to others. - - { eval 'use sort qw(defaults _quicksort)'; # force quicksort - eval 'no sort "stable"'; # stability not wanted - print sort::current . "\n"; + { use sort qw(defaults _quicksort); # force quicksort + no sort "stable"; # stability not wanted + my $current; + BEGIN { $current = print sort::current; } + print "$current\n"; @a = sort @b; - eval 'use sort "defaults"'; # clean up, for others + # Pragmas go out of scope at the end of the block } - { eval 'use sort qw(defaults stable)'; # force stability - print sort::current . "\n"; + { use sort qw(defaults stable); # force stability + my $current; + BEGIN { $current = print sort::current; } + print "$current\n"; @c = sort @d; - eval 'use sort "defaults"'; # clean up, for others } - # prints: - # quicksort - # stable - -Scoping for this pragma may change in future versions. =cut diff --git a/lib/sort.t b/lib/sort.t index 8828083066..62c5529c21 100644 --- a/lib/sort.t +++ b/lib/sort.t @@ -99,7 +99,7 @@ sub checkequal { # Test sort on arrays of various sizes (set up in @TestSizes) sub main { - my ($expect_unstable) = @_; + my ($dothesort, $expect_unstable) = @_; my ($ts, $unsorted, @sorted, $status); my $unstable_num = 0; @@ -108,9 +108,9 @@ sub main { # Sort only on item portion of each element. # There will typically be many repeated items, # and their order had better be preserved. - @sorted = sort { substr($a, 0, $RootWidth) + @sorted = $dothesort->(sub { substr($a, 0, $RootWidth) cmp - substr($b, 0, $RootWidth) } @$unsorted; + substr($b, 0, $RootWidth) }, $unsorted); $status = checkorder(\@sorted); # Put the items back into the original order. # The contents of the arrays had better be identical. @@ -119,9 +119,9 @@ sub main { ++$unstable_num; } is($status, '', "order ok for size $ts"); - @sorted = sort { substr($a, $RootWidth) + @sorted = $dothesort->(sub { substr($a, $RootWidth) cmp - substr($b, $RootWidth) } @sorted; + substr($b, $RootWidth) }, \@sorted); $status = checkequal(\@sorted, $unsorted); is($status, '', "contents ok for size $ts"); } @@ -133,51 +133,46 @@ sub main { } # Test with no pragma still loaded -- stability expected (this is a mergesort) -main(0); +main(sub { sort {&{$_[0]}} @{$_[1]} }, 0); -# XXX We're using this eval "..." trick to force recompilation, -# to ensure that the correct pragma is enabled when main() is run. -# Currently 'use sort' modifies $sort::hints at compile-time, but -# pp_sort() fetches its value at run-time. -# The order of those evals is important. - -eval q{ +{ use sort qw(_qsort); - is(sort::current(), 'quicksort', 'sort::current for _qsort'); - main(1); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'quicksort', 'sort::current for _qsort'); + main(sub { sort {&{$_[0]}} @{$_[1]} }, 1); +} -eval q{ +{ use sort qw(_mergesort); - is(sort::current(), 'mergesort', 'sort::current for _mergesort'); - main(0); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'mergesort', 'sort::current for _mergesort'); + main(sub { sort {&{$_[0]}} @{$_[1]} }, 0); +} -eval q{ +{ use sort qw(_qsort stable); - is(sort::current(), 'quicksort stable', 'sort::current for _qsort stable'); - main(0); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'quicksort stable', 'sort::current for _qsort stable'); + main(sub { sort {&{$_[0]}} @{$_[1]} }, 0); +} # Tests added to check "defaults" subpragma, and "no sort" -eval q{ +{ + use sort qw(_qsort stable); no sort qw(_qsort); - is(sort::current(), 'stable', 'sort::current after no _qsort'); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'stable', 'sort::current after no _qsort'); +} -eval q{ +{ use sort qw(defaults _qsort); - is(sort::current(), 'quicksort', 'sort::current after defaults _qsort'); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'quicksort', 'sort::current after defaults _qsort'); +} -eval q{ +{ use sort qw(defaults stable); - is(sort::current(), 'stable', 'sort::current after defaults stable'); -}; -die $@ if $@; + my $sort_current; BEGIN { $sort_current = sort::current(); } + is($sort_current, 'stable', 'sort::current after defaults stable'); +} @@ -6231,6 +6231,21 @@ Perl_ck_sort(pTHX_ OP *o) { OP *firstkid; + if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0) + { + HV *hinthv = GvHV(PL_hintgv); + if (hinthv) { + SV **svp = hv_fetch(hinthv, "sort", 4, 0); + if (svp) { + I32 sorthints = (I32)SvIV(*svp); + if ((sorthints & HINT_SORT_QUICKSORT) != 0) + o->op_private |= OPpSORT_QSORT; + if ((sorthints & HINT_SORT_STABLE) != 0) + o->op_private |= OPpSORT_STABLE; + } + } + } + if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED) simplify_sort(o); firstkid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ @@ -215,6 +215,9 @@ Deprecated. Use C<GIMME_V> instead. #define OPpSORT_REVERSE 4 /* Reversed sort */ #define OPpSORT_INPLACE 8 /* sort in-place; eg @a = sort @a */ #define OPpSORT_DESCEND 16 /* Descending sort */ +#define OPpSORT_QSORT 32 /* Use quicksort (not mergesort) */ +#define OPpSORT_STABLE 64 /* Use a stable algorithm */ + /* Private for OP_THREADSV */ #define OPpDONE_SVREF 64 /* Been through newSVREF once */ diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 2f701e5972..2931da4c5b 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -317,13 +317,24 @@ Sort an array. Here is an example: sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); -See lib/sort.pm for details about controlling the sorting algorithm. +Currently this always uses mergesort. See sortsv_flags for a more +flexible routine. void sortsv(SV** array, size_t num_elts, SVCOMPARE_t cmp) =for hackers Found in file pp_sort.c +=item sortsv_flags +X<sortsv_flags> + +Sort an array, with various options. + + void sortsv_flags(SV** array, size_t num_elts, SVCOMPARE_t cmp, U32 flags) + +=for hackers +Found in file pp_sort.c + =back @@ -36,13 +36,15 @@ #define sv_cmp_static Perl_sv_cmp #define sv_cmp_locale_static Perl_sv_cmp_locale -#define dSORTHINTS SV *hintsv = GvSV(gv_fetchpv("sort::hints", GV_ADDMULTI, SVt_IV)) -#define SORTHINTS (SvIOK(hintsv) ? ((I32)SvIV(hintsv)) : 0) - #ifndef SMALLSORT #define SMALLSORT (200) #endif +/* Flags for qsortsv and mergesortsv */ +#define SORTf_DESC 1 +#define SORTf_STABLE 2 +#define SORTf_QSORT 4 + /* * The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>. * @@ -1339,10 +1341,7 @@ cmpindir_desc(pTHX_ gptr a, gptr b) STATIC void S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { - - dSORTHINTS; - - if (SORTHINTS & HINT_SORT_STABLE) { + if ((flags & SORTf_STABLE) != 0) { register gptr **pp, *q; register size_t n, j, i; gptr *small[SMALLSORT], **indir, tmp; @@ -1361,7 +1360,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) /* sort, with indirection */ S_qsortsvu(aTHX_ (gptr *)indir, nmemb, - flags ? cmpindir_desc : cmpindir); + ((flags & SORTf_DESC) != 0 ? cmpindir_desc : cmpindir)); pp = indir; q = list1; @@ -1404,7 +1403,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) if (indir != small) { Safefree(indir); } /* restore prevailing comparison routine */ PL_sort_RealCmp = savecmp; - } else if (flags) { + } else if ((flags & SORTf_DESC) != 0) { SVCOMPARE_t savecmp = PL_sort_RealCmp; /* Save current comparison routine, if any */ PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */ cmp = cmp_desc; @@ -1425,7 +1424,8 @@ Sort an array. Here is an example: sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); -See lib/sort.pm for details about controlling the sorting algorithm. +Currently this always uses mergesort. See sortsv_flags for a more +flexible routine. =cut */ @@ -1433,38 +1433,23 @@ See lib/sort.pm for details about controlling the sorting algorithm. void Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) { - void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) - = S_mergesortsv; - dSORTHINTS; - const I32 hints = SORTHINTS; - if (hints & HINT_SORT_QUICKSORT) { - sortsvp = S_qsortsv; - } - else { - /* The default as of 5.8.0 is mergesort */ - sortsvp = S_mergesortsv; - } - - sortsvp(aTHX_ array, nmemb, cmp, 0); + sortsv_flags(array, nmemb, cmp, 0); } +/* +=for apidoc sortsv_flags -static void -S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) +Sort an array, with various options. + +=cut +*/ +void +Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) - = S_mergesortsv; - dSORTHINTS; - const I32 hints = SORTHINTS; - if (hints & HINT_SORT_QUICKSORT) { - sortsvp = S_qsortsv; - } - else { - /* The default as of 5.8.0 is mergesort */ - sortsvp = S_mergesortsv; - } + = ((flags & SORTf_QSORT) != 0 ? S_qsortsv : S_mergesortsv); - sortsvp(aTHX_ array, nmemb, cmp, 1); + sortsvp(aTHX_ array, nmemb, cmp, flags); } #define SvNSIOK(sv) ((SvFLAGS(sv) & SVf_NOK) || ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK)) @@ -1488,10 +1473,18 @@ PP(pp_sort) I32 sorting_av = 0; const U8 priv = PL_op->op_private; const U8 flags = PL_op->op_flags; - void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) - = Perl_sortsv; + U32 sort_flags = 0; + void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) + = Perl_sortsv_flags; I32 all_SIVs = 1; + if ((priv & OPpSORT_DESCEND) != 0) + sort_flags |= SORTf_DESC; + if ((priv & OPpSORT_QSORT) != 0) + sort_flags |= SORTf_QSORT; + if ((priv & OPpSORT_STABLE) != 0) + sort_flags |= SORTf_STABLE; + if (gimme != G_ARRAY) { SP = MARK; EXTEND(SP,1); @@ -1572,10 +1565,6 @@ PP(pp_sort) max = SP - MARK; } - if (priv & OPpSORT_DESCEND) { - sortsvp = S_sortsv_desc; - } - /* shuffle stack down, removing optional initial cv (p1!=p2), plus * any nulls; also stringify or converting to integer or number as * required any args */ @@ -1675,7 +1664,8 @@ PP(pp_sort) start = p1 - max; sortsvp(aTHX_ start, max, - is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv); + (is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv), + sort_flags); if (!(flags & OPf_SPECIAL)) { LEAVESUB(cv); @@ -1699,9 +1689,10 @@ PP(pp_sort) ? ( overloading ? S_amagic_cmp_locale : sv_cmp_locale_static) - : ( overloading ? S_amagic_cmp : sv_cmp_static))); + : ( overloading ? S_amagic_cmp : sv_cmp_static)), + sort_flags); } - if (priv & OPpSORT_REVERSE) { + if ((priv & OPpSORT_REVERSE) != 0) { SV **q = start+max-1; while (start < q) { SV * const tmp = *start; @@ -1246,6 +1246,9 @@ PERL_CALLCONV void Perl_qerror(pTHX_ SV* err) PERL_CALLCONV void Perl_sortsv(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp) __attribute__nonnull__(pTHX_1); +PERL_CALLCONV void Perl_sortsv_flags(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t cmp, U32 flags) + __attribute__nonnull__(pTHX_1); + PERL_CALLCONV int Perl_mg_clear(pTHX_ SV* sv) __attribute__nonnull__(pTHX_1); @@ -468,7 +468,10 @@ STATIC bool S_feature_is_enabled(pTHX_ char *name, STRLEN namelen) { HV * const hinthv = GvHV(PL_hintgv); - return (hinthv && hv_exists(hinthv, name, namelen)); + char he_name[32] = "feature_"; + (void) strncpy(&he_name[8], name, 24); + + return (hinthv && hv_exists(hinthv, he_name, 8 + namelen)); } /* |