This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest.xs: Omit unused variable
[perl5.git] / pp_sort.c
index b68e80c..9d31bda 100644 (file)
--- 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