[p5sagit/p5-mst-13.2.git] / ext / XS-APItest / t / xs_special_subs_require.t

#!perl -w
BEGIN {
    push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
    require Config; import Config;
    if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
        print "1..0 # Skip: XS::APItest was not built\n";
        exit 0;
    }
    # Hush the used only once warning.
    $XS::APItest::WARNINGS_ON_BOOTSTRAP = $MacPerl::Architecture;
    $XS::APItest::WARNINGS_ON_BOOTSTRAP = 1;
}

use strict;
use warnings;
my $uc;
BEGIN {
    $uc = $] > 5.009;
}
use Test::More tests => $uc ? 103 : 83;

# Doing this longhand cut&paste makes it clear
# BEGIN and INIT are FIFO, CHECK and END are LIFO
BEGIN {
    print "# First BEGIN\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
       if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
       if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
    is($XS::APItest::INIT_called, undef, "INIT not called");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

CHECK {
    print "# First CHECK\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
       if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
       if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
    is($XS::APItest::INIT_called, undef, "INIT not called");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

INIT {
    print "# First INIT\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
       if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
       if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
    is($XS::APItest::INIT_called, undef, "INIT not called");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

END {
    print "# First END\n";
    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
    is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
    is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
    is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
    is($XS::APItest::END_called, 1, "END called");
    is($XS::APItest::END_called_PP, 1, "END called");
}

print "# First body\n";
is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called") if $uc;
is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
is($XS::APItest::END_called, undef, "END not yet called");
is($XS::APItest::END_called_PP, undef, "END not yet called");

{
    my @trap;
    local $SIG{__WARN__} = sub { push @trap, join "!", @_ };
    require XS::APItest;

    @trap = sort @trap;
    is(scalar @trap, 2, "There were 2 warnings");
    is($trap[0], "Too late to run CHECK block.\n");
    is($trap[1], "Too late to run INIT block.\n");
}

print "# Second body\n";
is($XS::APItest::BEGIN_called, 1, "BEGIN called");
is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
is($XS::APItest::END_called, undef, "END not yet called");
is($XS::APItest::END_called_PP, undef, "END not yet called");

BEGIN {
    print "# Second BEGIN\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
	if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
    is($XS::APItest::INIT_called, undef, "INIT not called");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

CHECK {
    print "# Second CHECK\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
	if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
    is($XS::APItest::INIT_called, undef, "INIT not called");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

INIT {
    print "# Second INIT\n";
    is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
    is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
    is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	if $uc;
    is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
	if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
    is($XS::APItest::END_called, undef, "END not yet called");
    is($XS::APItest::END_called_PP, undef, "END not yet called");
}

END {
    print "# Second END\n";
    is($XS::APItest::BEGIN_called, 1, "BEGIN called");
    is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
    is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
    is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
    is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
    is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
    is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
    is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
    is($XS::APItest::END_called, 1, "END called");
    is($XS::APItest::END_called_PP, 1, "END called");
}
Commit	Line	Data
a6ea7cf3	1	#!perl -w
a6ea7cf3	2	BEGIN {
a6ea7cf3	3	push @INC, "::lib:$MacPerl::Architecture:" if $^O eq 'MacOS';
	4	require Config; import Config;
	5	if ($Config{'extensions'} !~ /\bXS\/APItest\b/) {
	6	print "1..0 # Skip: XS::APItest was not built\n";
	7	exit 0;
	8	}
	9	# Hush the used only once warning.
	10	$XS::APItest::WARNINGS_ON_BOOTSTRAP = $MacPerl::Architecture;
	11	$XS::APItest::WARNINGS_ON_BOOTSTRAP = 1;
	12	}
	13
	14	use strict;
	15	use warnings;
9568a123	16	my $uc;
	17	BEGIN {
	18	$uc = $] > 5.009;
	19	}
	20	use Test::More tests => $uc ? 103 : 83;
a6ea7cf3	21
	22	# Doing this longhand cut&paste makes it clear
	23	# BEGIN and INIT are FIFO, CHECK and END are LIFO
	24	BEGIN {
	25	print "# First BEGIN\n";
	26	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	27	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	28	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	29	if $uc;
	30	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
	31	if $uc;
a6ea7cf3	32	is($XS::APItest::CHECK_called, undef, "CHECK not called");
	33	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
	34	is($XS::APItest::INIT_called, undef, "INIT not called");
	35	is($XS::APItest::INIT_called_PP, undef, "INIT not called");
	36	is($XS::APItest::END_called, undef, "END not yet called");
	37	is($XS::APItest::END_called_PP, undef, "END not yet called");
	38	}
	39
	40	CHECK {
	41	print "# First CHECK\n";
	42	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	43	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	44	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	45	if $uc;
	46	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
	47	if $uc;
a6ea7cf3	48	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	49	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	50	is($XS::APItest::INIT_called, undef, "INIT not called");
	51	is($XS::APItest::INIT_called_PP, undef, "INIT not called");
	52	is($XS::APItest::END_called, undef, "END not yet called");
	53	is($XS::APItest::END_called_PP, undef, "END not yet called");
	54	}
	55
	56	INIT {
	57	print "# First INIT\n";
	58	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	59	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	60	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	61	if $uc;
	62	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
	63	if $uc;
a6ea7cf3	64	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	65	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	66	is($XS::APItest::INIT_called, undef, "INIT not called");
	67	is($XS::APItest::INIT_called_PP, undef, "INIT not called");
	68	is($XS::APItest::END_called, undef, "END not yet called");
	69	is($XS::APItest::END_called_PP, undef, "END not yet called");
	70	}
	71
	72	END {
	73	print "# First END\n";
	74	is($XS::APItest::BEGIN_called, 1, "BEGIN called");
	75	is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
9568a123	76	is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
9568a123	77	is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
a6ea7cf3	78	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	79	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	80	is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
	81	is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
	82	is($XS::APItest::END_called, 1, "END called");
	83	is($XS::APItest::END_called_PP, 1, "END called");
	84	}
	85
	86	print "# First body\n";
	87	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	88	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	89	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called") if $uc;
9568a123	90	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called") if $uc;
a6ea7cf3	91	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	92	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	93	is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
	94	is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
	95	is($XS::APItest::END_called, undef, "END not yet called");
	96	is($XS::APItest::END_called_PP, undef, "END not yet called");
	97
	98	{
	99	my @trap;
	100	local $SIG{__WARN__} = sub { push @trap, join "!", @_ };
	101	require XS::APItest;
	102
	103	@trap = sort @trap;
	104	is(scalar @trap, 2, "There were 2 warnings");
	105	is($trap[0], "Too late to run CHECK block.\n");
	106	is($trap[1], "Too late to run INIT block.\n");
	107	}
	108
	109	print "# Second body\n";
	110	is($XS::APItest::BEGIN_called, 1, "BEGIN called");
	111	is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
9568a123	112	is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
9568a123	113	is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
a6ea7cf3	114	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	115	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	116	is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
	117	is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
	118	is($XS::APItest::END_called, undef, "END not yet called");
	119	is($XS::APItest::END_called_PP, undef, "END not yet called");
	120
	121	BEGIN {
	122	print "# Second BEGIN\n";
	123	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	124	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	125	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	126	if $uc;
	127	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not called")
	128	if $uc;
a6ea7cf3	129	is($XS::APItest::CHECK_called, undef, "CHECK not called");
	130	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
	131	is($XS::APItest::INIT_called, undef, "INIT not called");
	132	is($XS::APItest::INIT_called_PP, undef, "INIT not called");
	133	is($XS::APItest::END_called, undef, "END not yet called");
	134	is($XS::APItest::END_called_PP, undef, "END not yet called");
	135	}
	136
	137	CHECK {
	138	print "# Second CHECK\n";
	139	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	140	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	141	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	142	if $uc;
	143	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
	144	if $uc;
a6ea7cf3	145	is($XS::APItest::CHECK_called, undef, "CHECK not called");
	146	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called");
	147	is($XS::APItest::INIT_called, undef, "INIT not called");
	148	is($XS::APItest::INIT_called_PP, undef, "INIT not called");
	149	is($XS::APItest::END_called, undef, "END not yet called");
	150	is($XS::APItest::END_called_PP, undef, "END not yet called");
	151	}
	152
	153	INIT {
	154	print "# Second INIT\n";
	155	is($XS::APItest::BEGIN_called, undef, "BEGIN not yet called");
	156	is($XS::APItest::BEGIN_called_PP, undef, "BEGIN not yet called");
9568a123	157	is($XS::APItest::UNITCHECK_called, undef, "UNITCHECK not yet called")
	158	if $uc;
	159	is($XS::APItest::UNITCHECK_called_PP, undef, "UNITCHECK not yet called")
	160	if $uc;
a6ea7cf3	161	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	162	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	163	is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
	164	is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
	165	is($XS::APItest::END_called, undef, "END not yet called");
	166	is($XS::APItest::END_called_PP, undef, "END not yet called");
	167	}
	168
	169	END {
	170	print "# Second END\n";
	171	is($XS::APItest::BEGIN_called, 1, "BEGIN called");
	172	is($XS::APItest::BEGIN_called_PP, 1, "BEGIN called");
9568a123	173	is($XS::APItest::UNITCHECK_called, 1, "UNITCHECK called") if $uc;
9568a123	174	is($XS::APItest::UNITCHECK_called_PP, 1, "UNITCHECK called") if $uc;
a6ea7cf3	175	is($XS::APItest::CHECK_called, undef, "CHECK not called (too late)");
	176	is($XS::APItest::CHECK_called_PP, undef, "CHECK not called (too late)");
	177	is($XS::APItest::INIT_called, undef, "INIT not called (too late)");
	178	is($XS::APItest::INIT_called_PP, undef, "INIT not called (too late)");
	179	is($XS::APItest::END_called, 1, "END called");
	180	is($XS::APItest::END_called_PP, 1, "END called");
	181	}