simplify sort sub return arg processing

This commit:

1) makes the  gimme of sort blocks, as specified by the pushed cx_gimme,
be G_SCALAR. Formerly it was likely to be G_ARRAY, as it inherited
whatever sort() was called as, and sort doesn't bother calling a sort
block unless sort was called in list context.

This change is largely cosmetic, as
    a) the sort block is already compiled in scalar context; and
    b) the code in S_sortcv() etc does its own return arg context
       processing anyway, and assumes scalar context.
But it makes it consistent with sort SUB, which *does* set gimme to
G_SCALAR.

2) Makes use of the fact that a sort sub or block will always be
called as the first context in a new stackinfo, and such stackinfos always
have PL_stack_base[0] set to &PL_sv_undef as a guard.
So handling scalar context return (where zero args returned needs to be
converted into 1 PL_sv_undef arg) can be simplified by just always
accessing the last arg, *PL_stack_sp, regardless of whether 0,1,2+ args
were returned.
Note that some code making use of MULTICALL (e.g. List::Util) has already
been (possibly inadvertently) relying on this fact.

3) Remove the "Sort subroutine didn't return single value" fatal error.
This croak was removed from the sort BLOCK and sort NON-XS-SUB variants
in v5.15.5-82-g1715fa6, but the croak was left for XS sort subs.
That commit incorrectly asserted that for "sort BLOCK" and "sort
NON-XS-SUB", more than 1 arg could never be returned, but:

    $ perl -e'sub f { return (1,2) } @a = sort f 1,2,3'
    perl: pp_sort.c:1789: S_sortcv: Assertion `PL_stack_sp ==
        PL_stack_base' failed.

That has been fixed by (2) above. By removing the croak from the XS branch
too, we make things consistent. This means that an XS sub which returns
more than 1 arg will just gets its return args be evaluated in scalar
context (so @return_args[-1] will be used), rather than being handled
specially.

1 files changed, 13 insertions, 15 deletions

diff --git a/pp_sort.c b/pp_sort.c
index 3203f4c566..be7922f96c 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1661,10 +1661,10 @@ PP(pp_sort)
 		SAVESPTR(GvSV(PL_secondgv));
 	    }
 
+            gimme = G_SCALAR;
 	    PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
 	    if (!(flags & OPf_SPECIAL)) {
 		cx->cx_type = CXt_SUB;
-		cx->blk_gimme = G_SCALAR;
 		/* If our comparison routine is already active (CvDEPTH is
 		 * is not 0),  then PUSHSUB does not increase the refcount,
 		 * so we have to do it ourselves, because the LEAVESUB fur-
@@ -1782,12 +1782,10 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
     PL_curcop = cop;
-    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);
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+    result = SvIV(*PL_stack_sp);
 
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
@@ -1835,12 +1833,10 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
     PL_curcop = cop;
-    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);
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+    result = SvIV(*PL_stack_sp);
 
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
@@ -1869,9 +1865,11 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     *++SP = b;
     PUTBACK;
     (void)(*CvXSUB(cv))(aTHX_ cv);
-    if (PL_stack_sp != PL_stack_base + 1)
-	Perl_croak(aTHX_ "Sort subroutine didn't return single value");
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
     result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
 	LEAVE;
     }