Merge branch 'blead' of ssh://perl5.git.perl.org/perl into blead

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index 3d0e4b5..813cd2c 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -105,7 +105,7 @@ typedef SV * gptr;          /* pointers in our lists */
 #define FROMTOUPTO(src, dst, lim) do *dst++ = *src++; while(src<lim)
 
 
-/* Runs are identified by a pointer in the auxilliary list.
+/* Runs are identified by a pointer in the auxiliary list.
 ** The pointer is at the start of the list,
 ** and it points to the start of the next list.
 ** NEXT is used as an lvalue, too.
@@ -372,7 +372,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     }
 
     if (nmemb <= SMALLSORT) aux = small;       /* use stack for aux array */
-    else { Newx(aux,nmemb,gptr); }             /* allocate auxilliary array */
+    else { Newx(aux,nmemb,gptr); }             /* allocate auxiliary array */
     level = 0;
     stackp = stack;
     stackp->runs = dynprep(aTHX_ base, aux, nmemb, cmp);
@@ -549,7 +549,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
                t = NEXT(t);                    /* where second run will end */
                t = PINDEX(base, PNELEM(aux, t)); /* where it now ends */
                FROMTOUPTO(f1, f2, t);          /* copy both runs */
-               NEXT(b) = p;                    /* paralled pointer for 1st */
+               NEXT(b) = p;                    /* paralleled pointer for 1st */
                NEXT(p) = t;                    /* ... and for second */
            }
        }
@@ -781,7 +781,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
       return;
    }
 
-   /* Innoculate large partitions against quadratic behavior */
+   /* Inoculate large partitions against quadratic behavior */
    if (num_elts > QSORT_PLAY_SAFE) {
       register size_t n;
       register SV ** const q = array;
@@ -1376,7 +1376,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
         q = list1;
         for (n = nmemb; n--; ) {
              /* Assert A: all elements of q with index > n are already
-              * in place.  This is vacuosly true at the start, and we
+              * in place.  This is vacuously true at the start, and we
               * put element n where it belongs below (if it wasn't
               * already where it belonged). Assert B: we only move
               * elements that aren't where they belong,
@@ -1516,22 +1516,40 @@ PP(pp_sort)
            stash = CopSTASH(PL_curcop);
        }
        else {
-           cv = sv_2cv(*++MARK, &stash, &gv, 0);
+           GV *autogv = NULL;
+           cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
+         check_cv:
            if (cv && SvPOK(cv)) {
                const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
                if (proto && strEQ(proto, "$$")) {
                    hasargs = TRUE;
                }
            }
-           if (!(cv && CvROOT(cv))) {
-               if (cv && CvISXSUB(cv)) {
-                   is_xsub = 1;
+           if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
+               is_xsub = 1;
+           }
+           else if (!(cv && CvROOT(cv))) {
+               if (gv) {
+                   goto autoload;
                }
-               else if (gv) {
+               else if (!CvANON(cv) && (gv = CvGV(cv))) {
+                 if (cv != GvCV(gv)) cv = GvCV(gv);
+                autoload:
+                 if (!autogv && (
+                       autogv = gv_autoload_pvn(
+                           GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+                           GvNAMEUTF8(gv) ? SVf_UTF8 : 0
+                       )
+                    )) {
+                   cv = GvCVu(autogv);
+                   goto check_cv;
+                 }
+                 else {
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
                    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
                        SVfARG(tmpstr));
+                 }
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");
@@ -1746,6 +1764,9 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
     PMOP * const pm = PL_curpm;
+    OP * const sortop = PL_op;
+    COP * const cop = PL_curcop;
+    SV **pad;
  
     PERL_ARGS_ASSERT_SORTCV;
 
@@ -1754,9 +1775,15 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    if (PL_stack_sp != PL_stack_base + 1)
-       Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    result = SvIV(*PL_stack_sp);
+    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);
+    }
+    else result = SvIV(*PL_stack_sp);
+    PL_curpad = pad;
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -1774,6 +1801,9 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     I32 result;
     AV * const av = GvAV(PL_defgv);
     PMOP * const pm = PL_curpm;
+    OP * const sortop = PL_op;
+    COP * const cop = PL_curcop;
+    SV **pad;
 
     PERL_ARGS_ASSERT_SORTCV_STACKED;
 
@@ -1802,9 +1832,15 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    if (PL_stack_sp != PL_stack_base + 1)
-       Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    result = SvIV(*PL_stack_sp);
+    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);
+    }
+    else result = SvIV(*PL_stack_sp);
+    PL_curpad = pad;
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -1852,6 +1888,14 @@ S_sv_ncmp(pTHX_ SV *const a, SV *const 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 (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
+       return 0;
+    }
     return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
 }
 
@@ -1961,8 +2005,8 @@ S_amagic_cmp_locale(pTHX_ register SV *const str1, register SV *const str2)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */