utf8.c: Fix potential bug

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index fafa00a..eae2098 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -185,8 +185,8 @@ static IV
 dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
 {
     I32 sense;
-    register gptr *b, *p, *q, *t, *p2;
-    register gptr *last, *r;
+    gptr *b, *p, *q, *t, *p2;
+    gptr *last, *r;
     IV runs = 0;
 
     b = list1;
@@ -354,7 +354,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     dVAR;
     IV i, run, offset;
     I32 sense, level;
-    register gptr *f1, *f2, *t, *b, *p;
+    gptr *f1, *f2, *t, *b, *p;
     int iwhich;
     gptr *aux;
     gptr *p1;
@@ -392,7 +392,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
            list1 = which[iwhich];              /* area where runs are now */
            list2 = which[++iwhich];            /* area for merged runs */
            do {
-               register gptr *l1, *l2, *tp2;
+               gptr *l1, *l2, *tp2;
                offset = stackp->offset;
                f1 = p1 = list1 + offset;               /* start of first run */
                p = tp2 = list2 + offset;       /* where merged run will go */
@@ -422,7 +422,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
                    ** and -1 when equality should look high.
                    */
 
-                   register gptr *q;
+                   gptr *q;
                    if (cmp(aTHX_ *f1, *f2) <= 0) {
                        q = f2; b = f1; t = l1;
                        sense = -1;
@@ -763,7 +763,7 @@ doqsort_all_asserts(
 STATIC void /* the standard unstable (u) quicksort (qsort) */
 S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 {
-   register SV * temp;
+   SV * temp;
    struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
    int next_stack_entry = 0;
    int part_left;
@@ -783,10 +783,10 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 
    /* Inoculate large partitions against quadratic behavior */
    if (num_elts > QSORT_PLAY_SAFE) {
-      register size_t n;
-      register SV ** const q = array;
+      size_t n;
+      SV ** const q = array;
       for (n = num_elts; n > 1; ) {
-         register const size_t j = (size_t)(n-- * Drand01());
+         const size_t j = (size_t)(n-- * Drand01());
          temp = q[j];
          q[j] = q[n];
          q[n] = temp;
@@ -1350,8 +1350,8 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 {
     dVAR;
     if ((flags & SORTf_STABLE) != 0) {
-        register gptr **pp, *q;
-        register size_t n, j, i;
+        gptr **pp, *q;
+        size_t n, j, i;
         gptr *small[SMALLSORT], **indir, tmp;
         SVCOMPARE_t savecmp;
         if (nmemb <= 1) return;     /* sorted trivially */
@@ -1473,8 +1473,8 @@ Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 PP(pp_sort)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    register SV **p1 = ORIGMARK+1, **p2;
-    register I32 max, i;
+    SV **p1 = ORIGMARK+1, **p2;
+    I32 max, i;
     AV* av = NULL;
     HV *stash;
     GV *gv;
@@ -1525,11 +1525,11 @@ PP(pp_sort)
                    hasargs = TRUE;
                }
            }
-           if (!(cv && CvROOT(cv))) {
-               if (cv && CvISXSUB(cv)) {
-                   is_xsub = 1;
-               }
-               else if (gv) {
+           if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
+               is_xsub = 1;
+           }
+           else if (!(cv && CvROOT(cv))) {
+               if (gv) {
                    goto autoload;
                }
                else if (!CvANON(cv) && (gv = CvGV(cv))) {
@@ -1586,7 +1586,7 @@ PP(pp_sort)
        }
        else {
            if (SvREADONLY(av))
-               Perl_croak_no_modify(aTHX);
+               Perl_croak_no_modify();
            else
                SvREADONLY_on(av);
            p1 = p2 = AvARRAY(av);
@@ -1667,7 +1667,7 @@ PP(pp_sort)
                if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
                PUSHSUB(cx);
                if (!is_xsub) {
-                   AV* const padlist = CvPADLIST(cv);
+                   PADLIST * const padlist = CvPADLIST(cv);
 
                    if (++CvDEPTH(cv) >= 2) {
                        PERL_STACK_OVERFLOW_CHECK();
@@ -1765,6 +1765,8 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     I32 result;
     PMOP * const pm = PL_curpm;
     OP * const sortop = PL_op;
+    COP * const cop = PL_curcop;
+    SV **pad;
  
     PERL_ARGS_ASSERT_SORTCV;
 
@@ -1773,10 +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");
     PL_op = sortop;
-    result = SvIV(*PL_stack_sp);
+    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;
     }
@@ -1795,6 +1802,8 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     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;
 
@@ -1823,10 +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");
     PL_op = sortop;
-    result = SvIV(*PL_stack_sp);
+    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;
     }
@@ -1874,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;
 }
 
@@ -1983,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:
  */