Lost arguments to simplified sort

To: perl5-porters@perl.org
Message-ID: <14276.56616.879390.562685@metonymy.hip.berkeley.edu>

p4raw-id: //depot/cfgperl@4048

diff --git a/op.c b/op.c
index 8ff0353..a371d79 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5553,9 +5553,10 @@ S_simplify_sort(pTHX_ OP *o)
        o->op_private |= OPpSORT_NUMERIC;
     if (k->op_type == OP_I_NCMP)
        o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
-    op_free(cLISTOPo->op_first->op_sibling);   /* delete comparison block */
-    cLISTOPo->op_first->op_sibling = cLISTOPo->op_last;
-    cLISTOPo->op_children = 1;
+    kid = cLISTOPo->op_first->op_sibling;
+    cLISTOPo->op_first->op_sibling = kid->op_sibling; /* bypass old block */
+    op_free(kid);                                    /* then delete it */
+    cLISTOPo->op_children--;
 }
 
 OP *

diff --git a/t/op/sort.t b/t/op/sort.t
index 27c77a4..f7bba3d 100755 (executable)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -4,7 +4,7 @@ BEGIN {
     chdir 't' if -d 't';
     unshift @INC, '../lib';
 }
-print "1..37\n";
+print "1..38\n";
 
 # XXX known to leak scalars
 $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
@@ -191,9 +191,15 @@ print "# x = '$x'; expected = '$expected'\n";
     print ($x eq $expected ? "ok 36\n" : "not ok 36\n");
     print "# x = '$x'; expected = '$expected'\n";
 }
+
+# test that an optimized-away comparison block doesn't take any other
+# arguments away with it
+$x = join('', sort { $a <=> $b } 3, 1, 2);
+print $x eq "123" ? "ok 37\n" : "not ok 37\n";
+
 # test sorting in non-main package
 package Foo;
 @a = ( 5, 19, 1996, 255, 90 );
 @b = sort { $b <=> $a } @a;
-print ("@b" eq '1996 255 90 19 5' ? "ok 37\n" : "not ok 37\n");
+print ("@b" eq '1996 255 90 19 5' ? "ok 38\n" : "not ok 38\n");
 print "# x = '@b'\n";