Make sort {} and sort {()} equivalent

sub {} and sub{()} are equivalent.  In list context they both return
the empty list.  In scalar context they both return undef.  But sort
doesn’t seem to think so.  It croaks on sub{}.  This commit fixes that
and makes it consistent.

I left XSUBs alone, since I’m not sure how they are supposed
to behave.

diff --git a/pp_sort.c b/pp_sort.c
index 6c2e301..364a6a0 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1775,12 +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;
@@ -1830,12 +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;

diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit
index e0c7320..7d73f01 100644 (file)
--- a/t/lib/warnings/9uninit
+++ b/t/lib/warnings/9uninit
@@ -640,6 +640,11 @@ sub frobnicate($$) { undef }
 no warnings;
 sub pyfg { undef }
 sub pyfgc($$) { undef }
+use warnings;
+sub dog {}
+sub dogwood($$) {}
+@sort = sort dog     1,2;
+@sort = sort dogwood 1,2;
 EXPECT
 Use of uninitialized value $m1 in sort at - line 6.
 Use of uninitialized value $g1 in sort at - line 6.
@@ -661,6 +666,8 @@ Use of uninitialized value in sort at - line 10.
 Use of uninitialized value in sort at - line 12.
 Use of uninitialized value in sort at - line 13.
 Use of uninitialized value in sort at - line 14.
+Use of uninitialized value in sort at - line 21.
+Use of uninitialized value in sort at - line 22.
 ########
 my $nan = sin 9**9**9;
 if ($nan == $nan) {