X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/eb578fdb5569b91c28466a4d1939e381ff6ceaf4..b1422d62a2c3dcf265ea32d11c493769631aeaed:/pp_sort.c?ds=sidebyside diff --git a/pp_sort.c b/pp_sort.c index e97e0a1..08aa2d5 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1432,7 +1432,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) Sort an array. Here is an example: - sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); + sortsv(AvARRAY(av), av_top_index(av)+1, Perl_sv_cmp_locale); Currently this always uses mergesort. See sortsv_flags for a more flexible routine. @@ -1483,6 +1483,7 @@ PP(pp_sort) OP* const nextop = PL_op->op_next; I32 overloading = 0; bool hasargs = FALSE; + bool copytmps; I32 is_xsub = 0; I32 sorting_av = 0; const U8 priv = PL_op->op_private; @@ -1586,9 +1587,12 @@ PP(pp_sort) } else { if (SvREADONLY(av)) - Perl_croak_no_modify(aTHX); + Perl_croak_no_modify(); else + { SvREADONLY_on(av); + save_pushptr((void *)av, SAVEt_READONLY_OFF); + } p1 = p2 = AvARRAY(av); sorting_av = 1; } @@ -1601,8 +1605,11 @@ 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; for (i=max; i > 0 ; i--) { if ((*p1 = *p2++)) { /* Weed out nulls. */ + if (copytmps && SvPADTMP(*p1) && !IS_PADGV(*p1)) + *p1 = sv_mortalcopy(*p1); SvTEMP_off(*p1); if (!PL_sortcop) { if (priv & OPpSORT_NUMERIC) { @@ -1648,10 +1655,8 @@ PP(pp_sort) if (!hasargs && !is_xsub) { SAVESPTR(PL_firstgv); SAVESPTR(PL_secondgv); - SAVESPTR(PL_sortstash); PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV); PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV); - PL_sortstash = stash; SAVESPTR(GvSV(PL_firstgv)); SAVESPTR(GvSV(PL_secondgv)); } @@ -1667,7 +1672,7 @@ PP(pp_sort) if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv); PUSHSUB(cx); if (!is_xsub) { - AV* const padlist = CvPADLIST(cv); + PADLIST * const padlist = CvPADLIST(cv); if (++CvDEPTH(cv) >= 2) { PERL_STACK_OVERFLOW_CHECK(); @@ -1763,10 +1768,10 @@ S_sortcv(pTHX_ SV *const a, SV *const b) const I32 oldsaveix = PL_savestack_ix; const I32 oldscopeix = PL_scopestack_ix; I32 result; + SV *resultsv; PMOP * const pm = PL_curpm; OP * const sortop = PL_op; COP * const cop = PL_curcop; - SV **pad; PERL_ARGS_ASSERT_SORTCV; @@ -1777,13 +1782,19 @@ S_sortcv(pTHX_ SV *const a, SV *const b) CALLRUNOPS(aTHX); PL_op = sortop; PL_curcop = cop; - pad = PL_curpad; PL_curpad = 0; if (PL_stack_sp != PL_stack_base + 1) { assert(PL_stack_sp == PL_stack_base); - result = SvIV(&PL_sv_undef); + resultsv = &PL_sv_undef; + } + else resultsv = *PL_stack_sp; + if (SvNIOK_nog(resultsv)) result = SvIV(resultsv); + else { + ENTER; + SAVEVPTR(PL_curpad); + PL_curpad = 0; + result = SvIV(resultsv); + LEAVE; } - else result = SvIV(*PL_stack_sp); - PL_curpad = pad; while (PL_scopestack_ix > oldscopeix) { LEAVE; } @@ -1918,7 +1929,7 @@ S_sv_i_ncmp(pTHX_ SV *const a, SV *const b) #define SORT_NORMAL_RETURN_VALUE(val) (((val) > 0) ? 1 : ((val) ? -1 : 0)) static I32 -S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b) +S_amagic_ncmp(pTHX_ SV *const a, SV *const b) { dVAR; SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg); @@ -1939,7 +1950,7 @@ S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b) } static I32 -S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b) +S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b) { dVAR; SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg); @@ -1960,7 +1971,7 @@ S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b) } static I32 -S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2) +S_amagic_cmp(pTHX_ SV *const str1, SV *const str2) { dVAR; SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg); @@ -1981,7 +1992,7 @@ S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2) } static I32 -S_amagic_cmp_locale(pTHX_ register SV *const str1, register SV *const str2) +S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2) { dVAR; SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);