diff options
| author | Gerard Goossen <gerard@ggoossen.net> | 2009-11-04 12:36:30 +0100 |
|---|---|---|
| committer | Rafael Garcia-Suarez <rgs@consttype.org> | 2009-11-08 14:53:41 +0100 |
| commit | 6bd7445c6d3b53823883c456e32ea27ce24bfc5c (patch) | |
| tree | a970dc6bd10efac39c12c6163c8baf6cc75012ae | |
| parent | 3d22c4f05aed968c6c562e40be30222328d66f6b (diff) | |
| download | perl-6bd7445c6d3b53823883c456e32ea27ce24bfc5c.tar.gz | |
Make my_exit behave the same as the Perl exit. And add tests for it
Rationale: This makes the behaviour of my_exit consistent, so it no
longer depends on whether a subroutine was called using call_sv or as a
normal using an entersub op. Previously, the exit code was sometimes
converted to an exception.
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.pm | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/APItest.xs | 5 | ||||
| -rw-r--r-- | ext/XS-APItest/t/my_exit.t | 33 | ||||
| -rw-r--r-- | perl.c | 14 |
5 files changed, 40 insertions, 15 deletions
@@ -3211,6 +3211,7 @@ ext/XS-APItest/t/call.t XS::APItest extension ext/XS-APItest/t/exception.t XS::APItest extension ext/XS-APItest/t/hash.t XS::APItest: tests for hash related APIs ext/XS-APItest/t/my_cxt.t XS::APItest: test MY_CXT interface +ext/XS-APItest/t/my_exit.t XS::APItest: test my_exit ext/XS-APItest/t/op.t XS::APItest: tests for OP related APIs ext/XS-APItest/t/pmflag.t Test deprecation warning for Perl_pmflag() ext/XS-APItest/t/printf.t XS::APItest extension diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index f80f3ea13e..11766f47ac 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -23,7 +23,7 @@ our @EXPORT = qw( print_double print_int print_long my_cxt_getint my_cxt_getsv my_cxt_setint my_cxt_setsv sv_setsv_cow_hashkey_core sv_setsv_cow_hashkey_notcore rmagical_cast rmagical_flags - DPeek utf16_to_utf8 utf16_to_utf8_reversed pmflag + DPeek utf16_to_utf8 utf16_to_utf8_reversed pmflag my_exit ); our $VERSION = '0.17'; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index e8c36d7961..ede69949a1 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -931,3 +931,8 @@ pmflag (flag, before = 0) RETVAL = before; OUTPUT: RETVAL + +void +my_exit(int exitcode) + PPCODE: + my_exit(exitcode); diff --git a/ext/XS-APItest/t/my_exit.t b/ext/XS-APItest/t/my_exit.t new file mode 100644 index 0000000000..31c0a6b232 --- /dev/null +++ b/ext/XS-APItest/t/my_exit.t @@ -0,0 +1,33 @@ +#!perl + +use strict; +use warnings; + +require "test.pl"; + +plan(4); + +use XS::APItest; + +my ($prog, $expect) = (<<'PROG', <<'EXPECT'); +use XS::APItest; +print "ok\n"; +my_exit(1); +print "not\n"; +PROG +ok +EXPECT +fresh_perl_is($prog, $expect); +is($? >> 8, 1, "exit code plain my_exit"); + +($prog, $expect) = (<<'PROG', <<'EXPECT'); +use XS::APItest; +print "ok\n"; +call_sv( sub { my_exit(1); }, G_EVAL ); +print "not\n"; +PROG +ok +EXPECT +fresh_perl_is($prog, $expect); +is($? >> 8, 1, "exit code my_exit inside a call_sv with G_EVAL"); + @@ -2610,8 +2610,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags) PL_curstash = PL_defstash; FREETMPS; JMPENV_POP; - if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) - Perl_croak(aTHX_ "Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: @@ -2712,8 +2710,6 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) PL_curstash = PL_defstash; FREETMPS; JMPENV_POP; - if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) - Perl_croak(aTHX_ "Callback called exit"); my_exit_jump(); /* NOTREACHED */ case 3: @@ -4585,16 +4581,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) PL_curcop = &PL_compiling; CopLINE_set(PL_curcop, oldline); JMPENV_POP; - if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) { - if (paramList == PL_beginav) - Perl_croak(aTHX_ "BEGIN failed--compilation aborted"); - else - Perl_croak(aTHX_ "%s failed--call queue aborted", - paramList == PL_checkav ? "CHECK" - : paramList == PL_initav ? "INIT" - : paramList == PL_unitcheckav ? "UNITCHECK" - : "END"); - } my_exit_jump(); /* NOTREACHED */ case 3: |