diff options
| -rw-r--r-- | pp_ctl.c | 9 | ||||
| -rwxr-xr-x | t/op/goto_xs.t | 19 |
2 files changed, 22 insertions, 6 deletions
@@ -2343,6 +2343,7 @@ PP(pp_goto) SAVETMPS; SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ if (CvXSUB(cv)) { + OP* retop = cx->blk_sub.retop; if (reified) { I32 index; for (index=0; index<items; index++) @@ -2367,17 +2368,15 @@ PP(pp_goto) SV **newsp; I32 gimme; + /* XS subs don't have a CxSUB, so pop it */ + POPBLOCK(cx, PL_curpm); /* Push a mark for the start of arglist */ PUSHMARK(mark); PUTBACK; (void)(*CvXSUB(cv))(aTHX_ cv); - /* Pop the current context like a decent sub should */ - POPBLOCK(cx, PL_curpm); - /* Do _not_ use PUTBACK, keep the XSUB's return stack! */ } LEAVE; - assert(CxTYPE(cx) == CXt_SUB); - return cx->blk_sub.retop; + return retop; } else { AV* padlist = CvPADLIST(cv); diff --git a/t/op/goto_xs.t b/t/op/goto_xs.t index dc8e7d77aa..b775e3d1ba 100755 --- a/t/op/goto_xs.t +++ b/t/op/goto_xs.t @@ -20,7 +20,7 @@ BEGIN { $| = 1; } eval 'require Fcntl' or do { print "1..0\n# Fcntl unavailable, can't test XS goto.\n"; exit 0 }; -print "1..10\n"; +print "1..11\n"; # We don't know what symbols are defined in platform X's system headers. # We don't even want to guess, because some platform out there will @@ -96,3 +96,20 @@ sub call_goto_ref { &goto_ref; } $ret = call_goto_ref($VALID); print(($ret == $value) ? "ok 10\n" : "not ok 10\n# ($ret != $value)\n"); + + +# [perl #35878] croak in XS after goto segfaulted + +use XS::APItest qw(mycroak); + +sub goto_croak { goto &mycroak } + +{ + my $e; + for (1..4) { + eval { goto_croak("boo$_\n") }; + $e .= $@; + } + print $e eq "boo1\nboo2\nboo3\nboo4\n" ? "ok 11\n" : "not ok 11\n"; +} + |