+57
-2
lines changedFilter options
+57
-2
lines changed Original file line number Diff line number Diff line change
@@ -4,7 +4,7 @@ use strict;
4 4
use warnings;
5 5
use Carp;
6 6 7 -
our $VERSION = '1.23';
7 +
our $VERSION = '1.24';
8 8 9 9
require XSLoader;
10 10
@@ -7051,6 +7051,16 @@ test_Perl_langinfo(SV * item)
7051 7051
OUTPUT:
7052 7052
RETVAL
7053 7053 7054 +
void
7055 +
gimme()
7056 +
CODE:
7057 +
/* facilitate tests that GIMME_V gives the right result
7058 +
* in XS calls */
7059 +
int gimme = GIMME_V;
7060 +
SV* sv = get_sv("XS::APItest::GIMME_V", GV_ADD);
7061 +
sv_setiv_mg(sv, (IV)gimme);
7062 + 7063 + 7054 7064
MODULE = XS::APItest PACKAGE = XS::APItest::Backrefs
7055 7065 7056 7066
void
@@ -2988,6 +2988,7 @@ PP(pp_goto)
2988 2988
const SSize_t items = arg ? AvFILL(arg) + 1 : 0;
2989 2989
const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0;
2990 2990
SV** mark;
2991 +
UNOP fake_goto_op;
2991 2992 2992 2993
ENTER;
2993 2994
SAVETMPS;
@@ -3024,6 +3025,20 @@ PP(pp_goto)
3024 3025
PL_comppad = cx->blk_sub.prevcomppad;
3025 3026
PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
3026 3027 3028 +
/* Make a temporary a copy of the current GOTO op on the C
3029 +
* stack, but with a modified gimme (we can't modify the
3030 +
* real GOTO op as that's not thread-safe). This allows XS
3031 +
* users of GIMME_V to get the correct calling context,
3032 +
* even though there is no longer a CXt_SUB frame to
3033 +
* provide that information.
3034 +
*/
3035 +
Copy(PL_op, &fake_goto_op, 1, UNOP);
3036 +
fake_goto_op.op_flags =
3037 +
(fake_goto_op.op_flags & ~OPf_WANT)
3038 +
| (cx->blk_gimme & G_WANT);
3039 +
SAVEOP();
3040 +
PL_op = (OP*)&fake_goto_op;
3041 + 3027 3042
/* XS subs don't have a CXt_SUB, so pop it;
3028 3043
* this is a cx_popblock(), less all the stuff we already did
3029 3044
* for cx_topblock() earlier */
@@ -11,7 +11,7 @@ BEGIN {
11 11 12 12
use warnings;
13 13
use strict;
14 -
plan tests => 125;
14 +
plan tests => 131;
15 15
our $TODO;
16 16 17 17
my $deprecated = 0;
@@ -902,3 +902,33 @@ is $@,'', 'goto the first parameter of a binary expression [perl #132854]';
902 902
eval { f198(); };
903 903
is $@, "", "v5.31.3-198-gd2cd363728";
904 904
}
905 + 906 +
# GH #19188
907 +
#
908 +
# 'goto &xs_sub' should provide the correct caller context to an XS sub
909 + 910 +
{
911 +
use XS::APItest ();
912 + 913 +
sub f_19188 { goto &XS::APItest::gimme }
914 +
sub g_19188{ f_19188(); }
915 +
my ($s, @a);
916 + 917 +
f_19188();
918 +
is ($XS::APItest::GIMME_V, 1, 'xs_goto void (#19188)');
919 + 920 +
$s = f_19188();
921 +
is ($XS::APItest::GIMME_V, 2, 'xs_goto scalar (#19188)');
922 + 923 +
@a = f_19188();
924 +
is ($XS::APItest::GIMME_V, 3, 'xs_goto list (#19188)');
925 + 926 +
g_19188();
927 +
is ($XS::APItest::GIMME_V, 1, 'xs_goto indirect void (#19188)');
928 + 929 +
$s = g_19188();
930 +
is ($XS::APItest::GIMME_V, 2, 'xs_goto indirect scalar (#19188)');
931 + 932 +
@a = g_19188();
933 +
is ($XS::APItest::GIMME_V, 3, 'xs_goto indirect list (#19188)');
934 +
}
You can’t perform that action at this time.
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4