[perl5.git] / ext / XS-APItest / t / my_exit.t

#!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);

# C's EXIT_FAILURE ends up as SS$_ABORT (decimal 44) on VMS, which gets
# shifted to 4.  Perl_my_exit (unlike Perl_my_failure_exit) does not 
# have access to the vmsish pragmas to modify that behavior.
 
my $exit_failure = $^O eq 'VMS' ? 4 : 1;
is($? >> 8, $exit_failure, "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, $exit_failure, "exit code my_exit inside a call_sv with G_EVAL");
Commit	Line	Data
6bd7445c GG	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);
81693ff9 CB	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");
6bd7445c GG	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);
81693ff9	38	is($? >> 8, $exit_failure, "exit code my_exit inside a call_sv with G_EVAL");
6bd7445c	39