Re: [PATCH] sort/multicall patch

Message-ID: <20051104152029.GA17169@rpc142.cs.man.ac.uk>

p4raw-id: //depot/perl@25992

diff --git a/pp_ctl.c b/pp_ctl.c
index d5bb802..cfefefd 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1949,6 +1949,8 @@ PP(pp_return)
                                     * 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;
            return 0;
        }
        else
@@ -1957,8 +1959,16 @@ PP(pp_return)
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
-    if (CxMULTICALL(&cxstack[cxix]))
+    if (CxMULTICALL(&cxstack[cxix])) {
+       gimme = cxstack[cxix].blk_gimme;
+       if (gimme == G_VOID)
+           PL_stack_sp = PL_stack_base;
+       else if (gimme == G_SCALAR) {
+           PL_stack_base[1] = *PL_stack_sp;
+           PL_stack_sp = PL_stack_base + 1;
+       }
        return 0;
+    }
 
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {

diff --git a/t/op/sort.t b/t/op/sort.t
index 1624b58..42ef5f3 100755 (executable)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 use warnings;
-print "1..141\n";
+print "1..143\n";
 
 # these shouldn't hang
 {
@@ -790,3 +790,13 @@ print(($@ =~ /^Modification of a read-only value attempted/ ?
 # Using return() should be okay even in a deeper context
 @b = sort {while (1) {return ($a <=> $b)} } 1..10;
 ok("@b", "1 2 3 4 5 6 7 8 9 10", "return within loop");
+
+# Using return() should be okay even if there are other items
+# on the stack at the time.
+@b = sort {$_ = ($a<=>$b) + do{return $b<=> $a}} 1..10;
+ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");
+
+# As above, but with a sort sub rather than a sort block.
+sub ret_with_stacked { $_ = ($a<=>$b) + do {return $b <=> $a} }
+@b = sort ret_with_stacked 1..10;
+ok("@b", "10 9 8 7 6 5 4 3 2 1", "return with SVs on stack");