|
 |
d35ea2 |
From 390fe0c0d09aadc66f644e9eee4aa1245221188c Mon Sep 17 00:00:00 2001
|
|
|
d35ea2 |
From: David Mitchell <davem@iabyn.com>
|
|
|
d35ea2 |
Date: Tue, 25 Aug 2020 13:15:25 +0100
|
|
|
d35ea2 |
Subject: [PATCH] sort { return foo() } ...
|
|
|
d35ea2 |
MIME-Version: 1.0
|
|
|
d35ea2 |
Content-Type: text/plain; charset=UTF-8
|
|
|
d35ea2 |
Content-Transfer-Encoding: 8bit
|
|
|
d35ea2 |
|
|
|
d35ea2 |
GH #18081
|
|
|
d35ea2 |
|
|
|
d35ea2 |
A sub call via return in a sort block was called in void rather than
|
|
|
d35ea2 |
scalar context, causing the comparison result to be discarded.
|
|
|
d35ea2 |
|
|
|
d35ea2 |
This because when a sort block is called it is not a real function
|
|
|
d35ea2 |
call, even though a sort block can be returned from. Instead, a
|
|
|
d35ea2 |
CXt_NULL is pushed on the context stack. Because this isn't a sub-ish
|
|
|
d35ea2 |
context type (unlike CXt_SUB, CXt_EVAL etc) there is no 'caller sub'
|
|
|
d35ea2 |
on the context stack to be found to retrieve the caller's context
|
|
|
d35ea2 |
(i.e. cx->cx_gimme).
|
|
|
d35ea2 |
|
|
|
d35ea2 |
This commit fixes it by special-casing Perl_gimme_V().
|
|
|
d35ea2 |
|
|
|
d35ea2 |
Ideally at some future point, a new context type, CXt_SORT, should be
|
|
|
d35ea2 |
added. This would be used instead of CXt_NULL when a sort BLOCK is
|
|
|
d35ea2 |
called. Like other sub-ish context types, it would have an old_cxsubix
|
|
|
d35ea2 |
field and PL_curstackinfo->si_cxsubix would point to it. This would
|
|
|
d35ea2 |
eliminate needing special-case handling in places like Perl_gimme_V().
|
|
|
d35ea2 |
|
|
|
d35ea2 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
d35ea2 |
---
|
|
|
d35ea2 |
inline.h | 2 +-
|
|
|
d35ea2 |
t/op/sort.t | 12 +++++++++++-
|
|
|
d35ea2 |
2 files changed, 12 insertions(+), 2 deletions(-)
|
|
|
d35ea2 |
|
|
|
d35ea2 |
diff --git a/inline.h b/inline.h
|
|
|
d35ea2 |
index a8240efb9c..6fbd5abfea 100644
|
|
|
d35ea2 |
--- a/inline.h
|
|
|
d35ea2 |
+++ b/inline.h
|
|
|
d35ea2 |
@@ -2086,7 +2086,7 @@ Perl_gimme_V(pTHX)
|
|
|
d35ea2 |
return gimme;
|
|
|
d35ea2 |
cxix = PL_curstackinfo->si_cxsubix;
|
|
|
d35ea2 |
if (cxix < 0)
|
|
|
d35ea2 |
- return G_VOID;
|
|
|
d35ea2 |
+ return PL_curstackinfo->si_type == PERLSI_SORT ? G_SCALAR: G_VOID;
|
|
|
d35ea2 |
assert(cxstack[cxix].blk_gimme & G_WANT);
|
|
|
d35ea2 |
return (cxstack[cxix].blk_gimme & G_WANT);
|
|
|
d35ea2 |
}
|
|
|
d35ea2 |
diff --git a/t/op/sort.t b/t/op/sort.t
|
|
|
d35ea2 |
index f2e139dff0..8e387fb90d 100644
|
|
|
d35ea2 |
--- a/t/op/sort.t
|
|
|
d35ea2 |
+++ b/t/op/sort.t
|
|
|
d35ea2 |
@@ -7,7 +7,7 @@ BEGIN {
|
|
|
d35ea2 |
set_up_inc('../lib');
|
|
|
d35ea2 |
}
|
|
|
d35ea2 |
use warnings;
|
|
|
d35ea2 |
-plan(tests => 203);
|
|
|
d35ea2 |
+plan(tests => 204);
|
|
|
d35ea2 |
use Tie::Array; # we need to test sorting tied arrays
|
|
|
d35ea2 |
|
|
|
d35ea2 |
# these shouldn't hang
|
|
|
d35ea2 |
@@ -1202,3 +1202,13 @@ SKIP:
|
|
|
d35ea2 |
$fillb = undef;
|
|
|
d35ea2 |
is $act, "01[sortb]2[fillb]";
|
|
|
d35ea2 |
}
|
|
|
d35ea2 |
+
|
|
|
d35ea2 |
+# GH #18081
|
|
|
d35ea2 |
+# sub call via return in sort block was called in void rather than scalar
|
|
|
d35ea2 |
+# context
|
|
|
d35ea2 |
+
|
|
|
d35ea2 |
+{
|
|
|
d35ea2 |
+ sub sort18081 { $a + 1 <=> $b + 1 }
|
|
|
d35ea2 |
+ my @a = sort { return &sort18081 } 6,1,2;
|
|
|
d35ea2 |
+ is "@a", "1 2 6", "GH #18081";
|
|
|
d35ea2 |
+}
|
|
|
d35ea2 |
--
|
|
|
d35ea2 |
2.25.4
|
|
|
d35ea2 |
|