X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/dcae3e365f028d9009bb2a2707ea4f42a56f9f69..3366dfc64be644770fc494fbe1514173c88fca77:/pp_sort.c diff --git a/pp_sort.c b/pp_sort.c index a657fa7..f96d568 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1568,7 +1568,7 @@ PP(pp_sort) } else { if (SvREADONLY(av)) - Perl_croak(aTHX_ "%s", PL_no_modify); + Perl_croak_no_modify(aTHX); else SvREADONLY_on(av); p1 = p2 = AvARRAY(av); @@ -1589,33 +1589,23 @@ PP(pp_sort) if (!PL_sortcop) { if (priv & OPpSORT_NUMERIC) { if (priv & OPpSORT_INTEGER) { - if (!SvIOK(*p1)) { - if (SvAMAGIC(*p1)) - overloading = 1; - else - (void)sv_2iv(*p1); - } + if (!SvIOK(*p1)) + (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD); } else { - if (!SvNSIOK(*p1)) { - if (SvAMAGIC(*p1)) - overloading = 1; - else - (void)sv_2nv(*p1); - } + if (!SvNSIOK(*p1)) + (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD); if (all_SIVs && !SvSIOK(*p1)) all_SIVs = 0; } } else { - if (!SvPOK(*p1)) { - if (SvAMAGIC(*p1)) - overloading = 1; - else - (void)sv_2pv_flags(*p1, 0, - SV_GMAGIC|SV_CONST_RETURN); - } + if (!SvPOK(*p1)) + (void)sv_2pv_flags(*p1, 0, + SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD); } + if (SvAMAGIC(*p1)) + overloading = 1; } p1++; } @@ -1652,6 +1642,11 @@ PP(pp_sort) if (!(flags & OPf_SPECIAL)) { cx->cx_type = CXt_SUB; cx->blk_gimme = G_SCALAR; + /* If our comparison routine is already active (CvDEPTH is + * is not 0), then PUSHSUB does not increase the refcount, + * so we have to do it ourselves, because the LEAVESUB fur- + * ther down lowers it. */ + if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv); PUSHSUB(cx); if (!is_xsub) { AV* const padlist = CvPADLIST(cv); @@ -1683,9 +1678,12 @@ PP(pp_sort) sort_flags); if (!(flags & OPf_SPECIAL)) { - LEAVESUB(cv); - if (!is_xsub) - CvDEPTH(cv)--; + SV *sv; + /* Reset cx, in case the context stack has been + reallocated. */ + cx = &cxstack[cxstack_ix]; + POPSUB(cx, sv); + LEAVESUB(sv); } POPBLOCK(cx,PL_curpm); PL_stack_sp = newsp; @@ -1776,8 +1774,13 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b) PERL_ARGS_ASSERT_SORTCV_STACKED; + if (AvREAL(av)) { + av_clear(av); + AvREAL_off(av); + AvREIFY_on(av); + } if (AvMAX(av) < 1) { - SV** ary = AvALLOC(av); + SV **ary = AvALLOC(av); if (AvARRAY(av) != ary) { AvMAX(av) += AvARRAY(av) - AvALLOC(av); AvARRAY(av) = ary; @@ -1786,6 +1789,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b) AvMAX(av) = 1; Renew(ary,2,SV*); AvARRAY(av) = ary; + AvALLOC(av) = ary; } } AvFILLp(av) = 1; @@ -1857,7 +1861,7 @@ S_sv_i_ncmp(pTHX_ SV *const a, SV *const b) } #define tryCALL_AMAGICbin(left,right,meth) \ - (PL_amagic_generation && (SvAMAGIC(left)||SvAMAGIC(right))) \ + (SvAMAGIC(left)||SvAMAGIC(right)) \ ? amagic_call(left, right, CAT2(meth,_amg), 0) \ : NULL;