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