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 d527d1e..813cd2c 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1765,6 +1765,7 @@ 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;
@@ -1774,11 +1775,14 @@ 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;
+    PL_curcop = cop;
     pad = PL_curpad; PL_curpad = 0;
-    result = SvIV(*PL_stack_sp);
+    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;
@@ -1798,6 +1802,7 @@ 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;
@@ -1827,11 +1832,14 @@ 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;
+    PL_curcop = cop;
     pad = PL_curpad; PL_curpad = 0;
-    result = SvIV(*PL_stack_sp);
+    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;
@@ -1881,7 +1889,7 @@ 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(right) || Perl_isnan(left)) {
+    if (Perl_isnan(nv1) || Perl_isnan(nv2)) {
 #else
     if (nv1 != nv1 || nv2 != nv2) {
 #endif
@@ -1997,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:
  */