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.

diff --git a/MANIFEST b/MANIFEST
index d0682b4..a18091e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 f80f3ea..11766f4 100644 (file)
--- 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 e8c36d7..ede6994 100644 (file)
--- 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 (file)
index 0000000..31c0a6b
--- /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");
+

diff --git a/perl.c b/perl.c
index dbb2081..64ab731 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -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: