Put sort arguments in lvalue context

Since $a and $b are aliased to the actual scalars being sorted, and
since they can be modified, the list of items needs to be in lvalue
context, like the arguments to grep.  Otherwise implementation
details leak through, in that sort{$a=1} $_,... will modify $_, but
sort{$a=1} $#_,... will fail to modify $#_.

The way I have written the loop and if() condition (the if inside the
loop) may seem odd and inefficient, but the next commit will take
advantage of that.

diff --git a/op.c b/op.c
index 2d6793e..c8bce83 100644 (file)
--- a/op.c
+++ b/op.c
@@ -9657,8 +9657,10 @@ Perl_ck_sort(pTHX_ OP *o)
 {
     dVAR;
     OP *firstkid;
+    OP *kid;
     HV * const hinthv =
        PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;
+    U8 stacked;
 
     PERL_ARGS_ASSERT_CK_SORT;
 
@@ -9676,7 +9678,7 @@ Perl_ck_sort(pTHX_ OP *o)
     if (o->op_flags & OPf_STACKED)
        simplify_sort(o);
     firstkid = cLISTOPo->op_first->op_sibling;         /* get past pushmark */
-    if (o->op_flags & OPf_STACKED) {                   /* may have been cleared */
+    if ((stacked = o->op_flags & OPf_STACKED)) {       /* may have been cleared */
        OP *kid = cUNOPx(firstkid)->op_first;           /* get past null */
 
        if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
@@ -9697,6 +9699,10 @@ Perl_ck_sort(pTHX_ OP *o)
 
     /* provide list context for arguments */
     list(firstkid);
+    for (kid = firstkid; kid; kid = kid->op_sibling) {
+       if (stacked)
+           op_lvalue(kid, OP_GREPSTART);
+    }
 
     return o;
 }

diff --git a/t/op/sort.t b/t/op/sort.t
index 452a66b..e483766 100644 (file)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 178 );
+plan( tests => 179 );
 
 # these shouldn't hang
 {
@@ -1001,3 +1001,7 @@ sub yarn($$) { "no thinking aloud" }
 eval { eval { use warnings FATAL => 'all'; () = sort yarn 1,2 } };
 is $@, "",
   'no panic/crash with fatal warnings when sort sub($$) returns string';
+
+$#a = -1;
+() = [sort { $a = 10; $b = 10; 0 } $#a, $#a];
+is $#a, 10, 'sort block modifying $a and $b';