This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
consting for .c files in tests
[perl5.git] / pp_sort.c
index ab383c1..1c12014 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1,7 +1,7 @@
 /*    pp_sort.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -762,10 +762,8 @@ STATIC void /* the standard unstable (u) quicksort (qsort) */
 S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 {
    register SV * temp;
-
    struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
    int next_stack_entry = 0;
-
    int part_left;
    int part_right;
 #ifdef QSORT_ORDER_GUESS
@@ -773,6 +771,8 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
    int swapped;
 #endif
 
+    PERL_ARGS_ASSERT_QSORTSVU;
+
    /* Make sure we actually have work to do.
    */
    if (num_elts <= 1) {
@@ -1365,8 +1365,10 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
         PL_sort_RealCmp = cmp; /* Put comparison routine where cmpindir can find it */
 
         /* sort, with indirection */
-        S_qsortsvu(aTHX_ (gptr *)indir, nmemb,
-                   ((flags & SORTf_DESC) != 0 ? cmpindir_desc : cmpindir));
+        if (flags & SORTf_DESC)
+           qsortsvu((gptr *)indir, nmemb, cmpindir_desc);
+       else
+           qsortsvu((gptr *)indir, nmemb, cmpindir);
 
         pp = indir;
         q = list1;
@@ -1413,11 +1415,11 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
         const SVCOMPARE_t savecmp = PL_sort_RealCmp;   /* Save current comparison routine, if any */
         PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */
         cmp = cmp_desc;
-        S_qsortsvu(aTHX_ list1, nmemb, cmp);
+        qsortsvu(list1, nmemb, cmp);
         /* restore prevailing comparison routine */
         PL_sort_RealCmp = savecmp;
     } else {
-        S_qsortsvu(aTHX_ list1, nmemb, cmp);
+        qsortsvu(list1, nmemb, cmp);
     }
 }
 
@@ -1439,6 +1441,8 @@ flexible routine.
 void
 Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 {
+    PERL_ARGS_ASSERT_SORTSV;
+
     sortsv_flags(array, nmemb, cmp, 0);
 }
 
@@ -1452,6 +1456,8 @@ Sort an array, with various options.
 void
 Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 {
+    PERL_ARGS_ASSERT_SORTSV_FLAGS;
+
     if (flags & SORTf_QSORT)
        S_qsortsv(aTHX_ array, nmemb, cmp, flags);
     else
@@ -1523,7 +1529,7 @@ PP(pp_sort)
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
                    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
-                       (void*)tmpstr);
+                       SVfARG(tmpstr));
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");
@@ -1693,9 +1699,9 @@ PP(pp_sort)
                            : ( overloading ? S_amagic_ncmp : S_sv_ncmp ) )
                        : ( IN_LOCALE_RUNTIME
                            ? ( overloading
-                               ? S_amagic_cmp_locale
-                               : sv_cmp_locale_static)
-                           : ( overloading ? S_amagic_cmp : sv_cmp_static)),
+                               ? (SVCOMPARE_t)S_amagic_cmp_locale
+                               : (SVCOMPARE_t)sv_cmp_locale_static)
+                           : ( overloading ? (SVCOMPARE_t)S_amagic_cmp : (SVCOMPARE_t)sv_cmp_static)),
                    sort_flags);
        }
        if ((priv & OPpSORT_REVERSE) != 0) {
@@ -1738,6 +1744,9 @@ S_sortcv(pTHX_ SV *a, SV *b)
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
+    PERL_ARGS_ASSERT_SORTCV;
+
     GvSV(PL_firstgv) = a;
     GvSV(PL_secondgv) = b;
     PL_stack_sp = PL_stack_base;
@@ -1764,16 +1773,18 @@ S_sortcv_stacked(pTHX_ SV *a, SV *b)
     I32 result;
     AV * const av = GvAV(PL_defgv);
 
+    PERL_ARGS_ASSERT_SORTCV_STACKED;
+
     if (AvMAX(av) < 1) {
        SV** ary = AvALLOC(av);
        if (AvARRAY(av) != ary) {
            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
-           SvPV_set(av, (char*)ary);
+           AvARRAY(av) = ary;
        }
        if (AvMAX(av) < 1) {
            AvMAX(av) = 1;
            Renew(ary,2,SV*);
-           SvPV_set(av, (char*)ary);
+           AvARRAY(av) = ary;
        }
     }
     AvFILLp(av) = 1;
@@ -1804,6 +1815,8 @@ S_sortcv_xsub(pTHX_ SV *a, SV *b)
     CV * const cv=(CV*)PL_sortcop;
     I32 result;
 
+    PERL_ARGS_ASSERT_SORTCV_XSUB;
+
     SP = PL_stack_base;
     PUSHMARK(SP);
     EXTEND(SP, 2);
@@ -1829,6 +1842,9 @@ S_sv_ncmp(pTHX_ SV *a, SV *b)
 {
     const NV nv1 = SvNSIV(a);
     const NV nv2 = SvNSIV(b);
+
+    PERL_ARGS_ASSERT_SV_NCMP;
+
     return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
 }
 
@@ -1837,6 +1853,9 @@ S_sv_i_ncmp(pTHX_ SV *a, SV *b)
 {
     const IV iv1 = SvIV(a);
     const IV iv2 = SvIV(b);
+
+    PERL_ARGS_ASSERT_SV_I_NCMP;
+
     return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
 }
 
@@ -1845,23 +1864,24 @@ S_sv_i_ncmp(pTHX_ SV *a, SV *b)
        ? amagic_call(left, right, CAT2(meth,_amg), 0) \
        : NULL;
 
+#define SORT_NORMAL_RETURN_VALUE(val)  (((val) > 0) ? 1 : ((val) ? -1 : 0))
+
 static I32
 S_amagic_ncmp(pTHX_ register SV *a, register SV *b)
 {
     dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+
+    PERL_ARGS_ASSERT_AMAGIC_NCMP;
+
     if (tmpsv) {
         if (SvIOK(tmpsv)) {
             const I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
+            return SORT_NORMAL_RETURN_VALUE(i);
         }
        else {
            const NV d = SvNV(tmpsv);
-           if (d > 0)
-              return 1;
-           return d ? -1 : 0;
+           return SORT_NORMAL_RETURN_VALUE(d);
        }
      }
      return S_sv_ncmp(aTHX_ a, b);
@@ -1872,18 +1892,17 @@ S_amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
 {
     dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+
+    PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
+
     if (tmpsv) {
         if (SvIOK(tmpsv)) {
             const I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
+            return SORT_NORMAL_RETURN_VALUE(i);
         }
        else {
            const NV d = SvNV(tmpsv);
-           if (d > 0)
-              return 1;
-           return d ? -1 : 0;
+           return SORT_NORMAL_RETURN_VALUE(d);
        }
     }
     return S_sv_i_ncmp(aTHX_ a, b);
@@ -1894,18 +1913,17 @@ S_amagic_cmp(pTHX_ register SV *str1, register SV *str2)
 {
     dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+
+    PERL_ARGS_ASSERT_AMAGIC_CMP;
+
     if (tmpsv) {
         if (SvIOK(tmpsv)) {
             const I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
+            return SORT_NORMAL_RETURN_VALUE(i);
         }
        else {
            const NV d = SvNV(tmpsv);
-           if (d > 0)
-              return 1;
-           return d? -1 : 0;
+           return SORT_NORMAL_RETURN_VALUE(d);
        }
     }
     return sv_cmp(str1, str2);
@@ -1916,18 +1934,17 @@ S_amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
 {
     dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+
+    PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
+
     if (tmpsv) {
         if (SvIOK(tmpsv)) {
             const I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
+            return SORT_NORMAL_RETURN_VALUE(i);
         }
        else {
            const NV d = SvNV(tmpsv);
-           if (d > 0)
-              return 1;
-           return d? -1 : 0;
+           return SORT_NORMAL_RETURN_VALUE(d);
        }
     }
     return sv_cmp_locale(str1, str2);