Re: [perl #36130] chr(-1) should probably return undef
[p5sagit/p5-mst-13.2.git] / pp_sort.c
index 69814ae..203b55d 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, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 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.
@@ -147,17 +147,17 @@ typedef SV * gptr;                /* pointers in our lists */
 **
 ** Unless otherwise specified, pair pointers address the first of two elements.
 **
-** b and b+1 are a pair that compare with sense ``sense''.
-** b is the ``bottom'' of adjacent pairs that might form a longer run.
+** b and b+1 are a pair that compare with sense "sense".
+** b is the "bottom" of adjacent pairs that might form a longer run.
 **
 ** p2 parallels b in the list2 array, where runs are defined by
 ** a pointer chain.
 **
-** t represents the ``top'' of the adjacent pairs that might extend
+** t represents the "top" of the adjacent pairs that might extend
 ** the run beginning at b.  Usually, t addresses a pair
 ** that compares with opposite sense from (b,b+1).
 ** However, it may also address a singleton element at the end of list1,
-** or it may be equal to ``last'', the first element beyond list1.
+** or it may be equal to "last", the first element beyond list1.
 **
 ** r addresses the Nth pair following b.  If this would be beyond t,
 ** we back it off to t.  Only when r is less than t do we consider the
@@ -412,7 +412,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
                    ** which head to merge) the item to merge
                    ** (at pointer q) is the first operand of
                    ** the comparison.  When we want to know
-                   ** if ``q is strictly less than the other'',
+                   ** if "q is strictly less than the other",
                    ** we can't just do
                    **    cmp(q, other) < 0
                    ** because stability demands that we treat equality
@@ -1463,7 +1463,7 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 }
 
 
-void
+static void
 S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 {
     void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
@@ -1490,7 +1490,7 @@ S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 
 PP(pp_sort)
 {
-    dSP; dMARK; dORIGMARK;
+    dVAR; dSP; dMARK; dORIGMARK;
     register SV **p1 = ORIGMARK+1, **p2;
     register I32 max, i;
     AV* av = Nullav;
@@ -1503,7 +1503,7 @@ PP(pp_sort)
     bool hasargs = FALSE;
     I32 is_xsub = 0;
     I32 sorting_av = 0;
-    U8 private = PL_op->op_private;
+    U8 priv = PL_op->op_private;
     U8 flags = PL_op->op_flags;
     void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
       = Perl_sortsv;
@@ -1566,7 +1566,7 @@ PP(pp_sort)
     /* optimiser converts "@a = sort @a" to "sort \@a";
      * in case of tied @a, pessimise: push (@a) onto stack, then assign
      * result back to @a at the end of this function */
-    if (private & OPpSORT_INPLACE) {
+    if (priv & OPpSORT_INPLACE) {
        assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
        (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
        av = (AV*)(*SP);
@@ -1574,7 +1574,7 @@ PP(pp_sort)
        if (SvMAGICAL(av)) {
            MEXTEND(SP, max);
            p2 = SP;
-           for (i=0; i < (U32)max; i++) {
+           for (i=0; i < max; i++) {
                SV **svp = av_fetch(av, i, FALSE);
                *SP++ = (svp) ? *svp : Nullsv;
            }
@@ -1589,21 +1589,44 @@ PP(pp_sort)
        max = SP - MARK;
    }
 
-    if (private & OPpSORT_DESCEND) {
+    if (priv & OPpSORT_DESCEND) {
        sortsvp = S_sortsv_desc;
     }
 
-    /* shuffle stack down, removing optional initial cv (p1!=p2), plus any
-     * nulls; also stringify any args */
+    /* shuffle stack down, removing optional initial cv (p1!=p2), plus
+     * any nulls; also stringify or converting to integer or number as
+     * required any args */
     for (i=max; i > 0 ; i--) {
        if ((*p1 = *p2++)) {                    /* Weed out nulls. */
            SvTEMP_off(*p1);
-           if (!PL_sortcop && !SvPOK(*p1)) {
-               STRLEN n_a;
-               if (SvAMAGIC(*p1))
-                   overloading = 1;
-               else
-                   (void)sv_2pv(*p1, &n_a);
+           if (!PL_sortcop) {
+               if (priv & OPpSORT_NUMERIC) {
+                   if (priv & OPpSORT_INTEGER) {
+                       if (!SvIOK(*p1)) {
+                           if (SvAMAGIC(*p1))
+                               overloading = 1;
+                           else
+                               (void)sv_2iv(*p1);
+                       }
+                   }
+                   else {
+                       if (!SvNOK(*p1)) {
+                           if (SvAMAGIC(*p1))
+                               overloading = 1;
+                           else
+                               (void)sv_2nv(*p1);
+                       }
+                   }
+               }
+               else {
+                   if (!SvPOK(*p1)) {
+                       STRLEN n_a;
+                       if (SvAMAGIC(*p1))
+                           overloading = 1;
+                       else
+                           (void)sv_2pv(*p1, &n_a);
+                   }
+               }
            }
            p1++;
        }
@@ -1668,8 +1691,8 @@ PP(pp_sort)
            MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
            start = sorting_av ? AvARRAY(av) : ORIGMARK+1;
            sortsvp(aTHX_ start, max,
-                   (private & OPpSORT_NUMERIC)
-                       ? ( (private & OPpSORT_INTEGER)
+                   (priv & OPpSORT_NUMERIC)
+                       ? ( (priv & OPpSORT_INTEGER)
                            ? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
                            : ( overloading ? amagic_ncmp : sv_ncmp))
                        : ( IN_LOCALE_RUNTIME
@@ -1678,7 +1701,7 @@ PP(pp_sort)
                                : sv_cmp_locale_static)
                            : ( overloading ? amagic_cmp : sv_cmp_static)));
        }
-       if (private & OPpSORT_REVERSE) {
+       if (priv & OPpSORT_REVERSE) {
            SV **q = start+max-1;
            while (start < q) {
                SV *tmp = *start;
@@ -1692,8 +1715,7 @@ PP(pp_sort)
        SV *sv;
        SV** base, **didstore;
        for (base = ORIGMARK+1, i=0; i < max; i++) {
-           sv = NEWSV(28,0);
-           sv_setsv(sv, base[i]);
+           sv = newSVsv(base[i]);
            base[i] = sv;
        }
        av_clear(av);
@@ -1715,6 +1737,7 @@ PP(pp_sort)
 static I32
 sortcv(pTHX_ SV *a, SV *b)
 {
+    dVAR;
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -1738,6 +1761,7 @@ sortcv(pTHX_ SV *a, SV *b)
 static I32
 sortcv_stacked(pTHX_ SV *a, SV *b)
 {
+    dVAR;
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -1749,12 +1773,12 @@ sortcv_stacked(pTHX_ SV *a, SV *b)
        SV** ary = AvALLOC(av);
        if (AvARRAY(av) != ary) {
            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
-           SvPVX(av) = (char*)ary;
+           SvPV_set(av, (char*)ary);
        }
        if (AvMAX(av) < 1) {
            AvMAX(av) = 1;
            Renew(ary,2,SV*);
-           SvPVX(av) = (char*)ary;
+           SvPV_set(av, (char*)ary);
        }
     }
     AvFILLp(av) = 1;
@@ -1779,7 +1803,7 @@ sortcv_stacked(pTHX_ SV *a, SV *b)
 static I32
 sortcv_xsub(pTHX_ SV *a, SV *b)
 {
-    dSP;
+    dVAR; dSP;
     I32 oldsaveix = PL_savestack_ix;
     I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -1918,3 +1942,13 @@ amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
     }
     return sv_cmp_locale(str1, str2);
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */