X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/45c198c1bc981a507ab719edbd292922a896a397..70250a0bc924bd7e738cf4f0014883dfc35d80a8:/pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index b68e80c..9d31bda 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -46,6 +46,7 @@
 #define SORTf_DESC   1
 #define SORTf_STABLE 2
 #define SORTf_QSORT  4
+#define SORTf_UNSTABLE 8
 
 /*
  * The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>.
@@ -557,7 +558,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     }
   done:
     if (aux != small) Safefree(aux);	/* free iff allocated */
-    if (flags) {
+    if (savecmp != NULL) {
 	 PL_sort_RealCmp = savecmp;	/* Restore current comparison routine, if any */
     }
     return;
@@ -787,7 +788,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
       size_t n;
       SV ** const q = array;
       for (n = num_elts; n > 1; ) {
-         const size_t j = (size_t)(n-- * Drand01());
+         const size_t j = (size_t)(n-- * Perl_internal_drand48());
          temp = q[j];
          q[j] = q[n];
          q[n] = temp;
@@ -1428,9 +1429,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 
 =for apidoc sortsv
 
-Sort an array.  Here is an example:
-
-    sortsv(AvARRAY(av), av_top_index(av)+1, Perl_sv_cmp_locale);
+In-place sort an array of SV pointers with the given comparison routine.
 
 Currently this always uses mergesort.  See C<L</sortsv_flags>> for a more
 flexible routine.
@@ -1449,7 +1448,8 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 /*
 =for apidoc sortsv_flags
 
-Sort an array, with various options.
+In-place sort an array of SV pointers with the given comparison routine,
+with various SORTf_* flag options.
 
 =cut
 */
@@ -1495,6 +1495,8 @@ PP(pp_sort)
 	sort_flags |= SORTf_QSORT;
     if ((priv & OPpSORT_STABLE) != 0)
 	sort_flags |= SORTf_STABLE;
+    if ((priv & OPpSORT_UNSTABLE) != 0)
+	sort_flags |= SORTf_UNSTABLE;
 
     if (gimme != G_ARRAY) {
 	SP = MARK;
@@ -1543,7 +1545,7 @@ PP(pp_sort)
 		  else {
 		    SV *tmpstr = sv_newmortal();
 		    gv_efullname3(tmpstr, gv, NULL);
-		    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
+		    DIE(aTHX_ "Undefined sort subroutine \"%" SVf "\" called",
 			SVfARG(tmpstr));
 		  }
 		}
@@ -1596,7 +1598,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 = PL_sortcop;
+    copytmps = cBOOL(PL_sortcop);
     for (i=max; i > 0 ; i--) {
 	if ((*p1 = *p2++)) {			/* Weed out nulls. */
 	    if (copytmps && SvPADTMP(*p1)) {
@@ -1767,6 +1769,9 @@ PP(pp_sort)
                     base[i] = newSVsv(sv);
                 else
                     SvREFCNT_inc_simple_void_NN(sv);
+
+                if (SvWEAKREF(sv))
+                    sv_rvunweaken(sv);
             }
             av_clear(av);
             if (max > 0) {
@@ -1832,8 +1837,8 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 	    AvARRAY(av) = ary;
 	}
 	if (AvMAX(av) < 1) {
-	    AvMAX(av) = 1;
 	    Renew(ary,2,SV*);
+	    AvMAX(av) = 1;
 	    AvARRAY(av) = ary;
 	    AvALLOC(av) = ary;
 	}
@@ -1888,20 +1893,16 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
 static I32
 S_sv_ncmp(pTHX_ SV *const a, SV *const b)
 {
-    const NV nv1 = SvNSIV(a);
-    const NV nv2 = SvNSIV(b);
+    I32 cmp = do_ncmp(a, b);
 
     PERL_ARGS_ASSERT_SV_NCMP;
 
-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-    if (Perl_isnan(nv1) || Perl_isnan(nv2)) {
-#else
-    if (nv1 != nv1 || nv2 != nv2) {
-#endif
+    if (cmp == 2) {
 	if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
 	return 0;
     }
-    return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
+
+    return cmp;
 }
 
 static I32