[perl #85104] TODO test for preserving $^E across signal handlers

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index e97e0a1..b65e9eb 100644 (file)
--- 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.
@@ -1474,7 +1474,7 @@ PP(pp_sort)
 {
     dVAR; dSP; dMARK; dORIGMARK;
     SV **p1 = ORIGMARK+1, **p2;
-    I32 max, i;
+    SSize_t max, i;
     AV* av = NULL;
     HV *stash;
     GV *gv;
@@ -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);