(F) An ancient error message that almost nobody ever runs into anymore.
But before sort was a keyword, people sometimes used it as a filehandle.
-=item Sort subroutine didn't return single value
-
-(F) A sort comparison subroutine written in XS must return exactly one
-item. See L<perlfunc/sort>.
-
=item Source filters apply only to byte streams
(F) You tried to activate a source filter (usually by loading a
* sort block, which is a CXt_NULL
* not a CXt_SUB */
dounwind(0);
- PL_stack_base[1] = *PL_stack_sp;
- PL_stack_sp = PL_stack_base + 1;
+ /* if we were in list context, we would have to splice out
+ * any junk before the return args, like we do in the general
+ * pp_return case, e.g.
+ * sub f { for (junk1, junk2) { return arg1, arg2 }}
+ */
+ assert(cxstack[0].blk_gimme == G_SCALAR);
return 0;
}
else
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-
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;
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;
*++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;
}
set_up_inc('../lib');
}
use warnings;
-plan( tests => 183 );
+plan(tests => 190);
# these shouldn't hang
{
@_=sort { delete $deletions::{a}; delete $deletions::{b}; 3 } 1..3;
}
pass "no crash when sort block deletes *a and *b";
+
+# make sure return args are always evaluated in scalar context
+
+{
+ package Ret;
+ no warnings 'void';
+ sub f0 { }
+ sub f1 { $b <=> $a, $a <=> $b }
+ sub f2 { return ($b <=> $a, $a <=> $b) }
+ sub f3 { for ($b <=> $a) { return ($b <=> $a, $a <=> $b) } }
+
+ {
+ no warnings 'uninitialized';
+ ::is (join('-', sort { () } 3,1,2,4), '3-1-2-4', "Ret: null blk");
+ }
+ ::is (join('-', sort { $b <=> $a, $a <=> $b } 3,1,2,4), '1-2-3-4', "Ret: blk");
+ ::is (join('-', sort { for($b <=> $a) { return ($b <=> $a, $a <=> $b) } }
+ 3,1,2,4), '1-2-3-4', "Ret: blk ret");
+ {
+ no warnings 'uninitialized';
+ ::is (join('-', sort f0 3,1,2,4), '3-1-2-4', "Ret: f0");
+ }
+ ::is (join('-', sort f1 3,1,2,4), '1-2-3-4', "Ret: f1");
+ ::is (join('-', sort f2 3,1,2,4), '1-2-3-4', "Ret: f2");
+ ::is (join('-', sort f3 3,1,2,4), '1-2-3-4', "Ret: f3");
+}