diff options
author | Dave Mitchell <davem@fdisolutions.com> | 2005-05-21 22:10:19 +0000 |
---|---|---|
committer | Dave Mitchell <davem@fdisolutions.com> | 2005-05-21 22:10:19 +0000 |
commit | 5eff7df71d0d0bb7c87e225c00e2091ae2433cb9 (patch) | |
tree | 0bb0b3bd9078269ebea26f546fa5b74647f739cd /t/op/goto_xs.t | |
parent | 2d43a17f6a49532750d0e6ce2814b523e2f19999 (diff) | |
download | perl-5eff7df71d0d0bb7c87e225c00e2091ae2433cb9.tar.gz |
[perl #35878] goto &xsub that croaks corrupts memory
When an XS sub is called, a CxSUB context shouldn't be pushed. Make
goto &xs_sub mimic this behaviour by first popping the old CxSUB
p4raw-id: //depot/perl@24535
Diffstat (limited to 't/op/goto_xs.t')
-rwxr-xr-x | t/op/goto_xs.t | 19 |
1 files changed, 18 insertions, 1 deletions
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"; +} + |