ext/XS-APItest/t/my_exit.t

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require "test.pl";
   7
   8 plan(4);
   9
  10 use XS::APItest;
  11
  12 my ($prog, $expect) = (<<'PROG', <<'EXPECT');
  13 use XS::APItest;
  14 print "ok\n";
  15 my_exit(1);
  16 print "not\n";
  17 PROG
  18 ok
  19 EXPECT
  20 fresh_perl_is($prog, $expect);
  21
  22 # C's EXIT_FAILURE ends up as SS$_ABORT (decimal 44) on VMS, which gets
  23 # shifted to 4.  Perl_my_exit (unlike Perl_my_failure_exit) does not
  24 # have access to the vmsish pragmas to modify that behavior.
  25
  26 my $exit_failure = $^O eq 'VMS' ? 4 : 1;
  27 is($? >> 8, $exit_failure, "exit code plain my_exit");
  28
  29 ($prog, $expect) = (<<'PROG', <<'EXPECT');
  30 use XS::APItest;
  31 print "ok\n";
  32 call_sv( sub { my_exit(1); }, G_EVAL );
  33 print "not\n";
  34 PROG
  35 ok
  36 EXPECT
  37 fresh_perl_is($prog, $expect);
  38 is($? >> 8, $exit_failure, "exit code my_exit inside a call_sv with G_EVAL");
  39