[perl5.git] / cpan / Test-Simple / t / Test2 / modules / API / Instance.t

use strict;
use warnings;

use Test2::IPC;
BEGIN { require "t/tools.pl" };
use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK USE_THREADS get_tid/;

skip_all("Leaks shm blocks");

my $CLASS = 'Test2::API::Instance';

my $one = $CLASS->new;
is_deeply(
    $one,
    {
        contexts => {},

        finalized => undef,
        ipc       => undef,
        formatter => undef,

        ipc_polling => undef,
        ipc_drivers => [],

        formatters => [],

        no_wait => 0,
        loaded  => 0,

        exit_callbacks            => [],
        post_load_callbacks       => [],
        context_acquire_callbacks => [],
        context_init_callbacks    => [],
        context_release_callbacks => [],

        stack => [],
    },
    "Got initial settings"
);

%$one = ();
is_deeply($one, {}, "wiped object");

$one->reset;
is_deeply(
    $one,
    {
        contexts => {},

        ipc_polling => undef,
        ipc_drivers => [],

        formatters => [],

        finalized => undef,
        ipc       => undef,
        formatter => undef,

        no_wait => 0,
        loaded  => 0,

        exit_callbacks            => [],
        post_load_callbacks       => [],
        context_acquire_callbacks => [],
        context_init_callbacks    => [],
        context_release_callbacks => [],

        stack => [],
    },
    "Reset Object"
);

ok(!$one->formatter_set, "no formatter set");
$one->set_formatter('Foo');
ok($one->formatter_set, "formatter set");
$one->reset;

my $ran = 0;
my $callback = sub { $ran++ };
$one->add_post_load_callback($callback);
ok(!$ran, "did not run yet");
is_deeply($one->post_load_callbacks, [$callback], "stored callback for later");

ok(!$one->loaded, "not loaded");
$one->load;
ok($one->loaded, "loaded");
is($ran, 1, "ran the callback");

$one->load;
is($ran, 1, "Did not run the callback again");

$one->add_post_load_callback($callback);
is($ran, 2, "ran the new callback");
is_deeply($one->post_load_callbacks, [$callback, $callback], "stored callback for the record");

like(
    exception { $one->add_post_load_callback({}) },
    qr/Post-load callbacks must be coderefs/,
    "Post-load callbacks must be coderefs"
);

$one->reset;
ok($one->ipc, 'got ipc');
ok($one->finalized, "calling ipc finalized the object");

$one->reset;
ok($one->stack, 'got stack');
ok(!$one->finalized, "calling stack did not finaliz the object");

$one->reset;
ok($one->formatter, 'Got formatter');
ok($one->finalized, "calling format finalized the object");

$one->reset;
$one->set_formatter('Foo');
is($one->formatter, 'Foo', "got specified formatter");
ok($one->finalized, "calling format finalized the object");

{
    local $ENV{T2_FORMATTER} = 'TAP';
    $one->reset;
    is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
    ok($one->finalized, "calling format finalized the object");

    local $ENV{T2_FORMATTER} = '+Test2::Formatter::TAP';
    $one->reset;
    is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
    ok($one->finalized, "calling format finalized the object");

    local $ENV{T2_FORMATTER} = '+Fake';
    $one->reset;
    like(
        exception { $one->formatter },
        qr/COULD NOT LOAD FORMATTER 'Fake' \(set by the 'T2_FORMATTER' environment variable\)/,
        "Bad formatter"
    );
}

$ran = 0;
$one->reset;
$one->add_exit_callback($callback);
is(@{$one->exit_callbacks}, 1, "added an exit callback");
$one->add_exit_callback($callback);
is(@{$one->exit_callbacks}, 2, "added another exit callback");

like(
    exception { $one->add_exit_callback({}) },
    qr/End callbacks must be coderefs/,
    "Exit callbacks must be coderefs"
);

if (CAN_REALLY_FORK) {
    $one->reset;
    my $pid = fork;
    die "Failed to fork!" unless defined $pid;
    unless($pid) { exit 0 }

    is($one->_ipc_wait, 0, "No errors");

    $pid = fork;
    die "Failed to fork!" unless defined $pid;
    unless($pid) { exit 255 }
    my @warnings;
    {
        local $SIG{__WARN__} = sub { push @warnings => @_ };
        is($one->_ipc_wait, 255, "Process exited badly");
    }
    like($warnings[0], qr/Process .* did not exit cleanly \(status: 255\)/, "Warn about exit");
}

if (CAN_THREAD && $] ge '5.010') {
    require threads;
    $one->reset;

    threads->new(sub { 1 });
    is($one->_ipc_wait, 0, "No errors");

    if (threads->can('error')) {
        threads->new(sub {
            close(STDERR);
            close(STDOUT);
            die "xxx"
        });
        my @warnings;
        {
            local $SIG{__WARN__} = sub { push @warnings => @_ };
            is($one->_ipc_wait, 255, "Thread exited badly");
        }
        like($warnings[0], qr/Thread .* did not end cleanly: xxx/, "Warn about exit");
    }
}

{
    $one->reset();
    local $? = 0;
    $one->set_exit;
    is($?, 0, "no errors on exit");
}

{
    $one->reset();
    $one->set__tid(1);
    local $? = 0;
    $one->set_exit;
    is($?, 0, "no errors on exit");
}

{
    $one->reset();
    $one->stack->top;
    $one->no_wait(1);
    local $? = 0;
    $one->set_exit;
    is($?, 0, "no errors on exit");
}

{
    $one->reset();
    $one->stack->top->set_no_ending(1);
    local $? = 0;
    $one->set_exit;
    is($?, 0, "no errors on exit");
}

{
    $one->reset();
    $one->load();
    $one->stack->top->set_failed(2);
    local $? = 0;
    $one->set_exit;
    is($?, 2, "number of failures");
}

{
    $one->reset();
    $one->load();
    local $? = 500;
    $one->set_exit;
    is($?, 255, "set exit code to a sane number");
}

{
    local %INC = %INC;
    delete $INC{'Test2/IPC.pm'};
    $one->reset();
    $one->load();
    my @events;
    $one->stack->top->filter(sub { push @events => $_[1]; undef});
    $one->stack->new_hub;
    local $? = 0;
    $one->set_exit;
    is($?, 255, "errors on exit");
    like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
}

{
    $one->reset;
    my $stderr = "";
    {
        local $INC{'Test/Builder.pm'} = __FILE__;
        local $Test2::API::VERSION    = '0.002';
        local $Test::Builder::VERSION = '0.001';
        local *STDERR;
        open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";

        $one->set_exit;
    }

    is($stderr, <<'    EOT', "Got warning about version mismatch");

********************************************************************************
*                                                                              *
*            Test::Builder -- Test2::API version mismatch detected             *
*                                                                              *
********************************************************************************
   Test2::API Version: 0.002
Test::Builder Version: 0.001

This is not a supported configuration, you will have problems.

    EOT
}

{
    require Test2::API::Breakage;
    no warnings qw/redefine once/;
    my $ran = 0;
    local *Test2::API::Breakage::report = sub { $ran++; return "foo" };
    use warnings qw/redefine once/;
    $one->reset();
    $one->load();

    my $stderr = "";
    {
        local *STDERR;
        open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";
        local $? = 255;
        $one->set_exit;
    }

    is($stderr, <<"    EOT", "Reported bad modules");

You have loaded versions of test modules known to have problems with Test2.
This could explain some test failures.
foo

    EOT
}


{
    $one->reset();
    $one->load();
    my @events;
    $one->stack->top->filter(sub { push @events => $_[1]; undef});
    $one->stack->new_hub;
    ok($one->stack->top->ipc, "Have IPC");
    $one->stack->new_hub;
    ok($one->stack->top->ipc, "Have IPC");
    $one->stack->top->set_ipc(undef);
    ok(!$one->stack->top->ipc, "no IPC");
    $one->stack->new_hub;
    local $? = 0;
    $one->set_exit;
    is($?, 255, "errors on exit");
    like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
}

if (CAN_REALLY_FORK) {
    local $SIG{__WARN__} = sub { };
    $one->reset();
    my $pid = fork;
    die "Failed to fork!" unless defined $pid;
    unless ($pid) { exit 255 }
    $one->_finalize;
    $one->stack->top;

    local $? = 0;
    $one->set_exit;
    is($?, 255, "errors on exit");

    $one->reset();
    $pid = fork;
    die "Failed to fork!" unless defined $pid;
    unless ($pid) { exit 255 }
    $one->_finalize;
    $one->stack->top;

    local $? = 122;
    $one->set_exit;
    is($?, 122, "kept original exit");
}

{
    my $ctx = bless {
        trace => Test2::Util::Trace->new(frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'xxx']),
        hub => Test2::Hub->new(),
    }, 'Test2::API::Context';
    $one->contexts->{1234} = $ctx;

    local $? = 500;
    my $warnings = warnings { $one->set_exit };
    is($?, 255, "set exit code to a sane number");

    is_deeply(
        $warnings,
        [
            "context object was never released! This means a testing tool is behaving very badly at Foo/Bar.pm line 42.\n"
        ],
        "Warned about unfreed context"
    );
}

{
    local %INC = %INC;
    delete $INC{'Test2/IPC.pm'};
    delete $INC{'threads.pm'};
    ok(!USE_THREADS, "Sanity Check");

    $one->reset;
    ok(!$one->ipc, 'IPC not loaded, no IPC object');
    ok($one->finalized, "calling ipc finalized the object");
    is($one->ipc_polling, undef, "no polling defined");
    ok(!@{$one->ipc_drivers}, "no driver");

    if (CAN_THREAD) {
        local $INC{'threads.pm'} = 1;
        no warnings 'once';
        local *threads::tid = sub { 0 } unless threads->can('tid');
        $one->reset;
        ok($one->ipc, 'IPC loaded if threads are');
        ok($one->finalized, "calling ipc finalized the object");
        ok($one->ipc_polling, "polling on by default");
        is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
    }

    {
        local $INC{'Test2/IPC.pm'} = 1;
        $one->reset;
        ok($one->ipc, 'IPC loaded if Test2::IPC is');
        ok($one->finalized, "calling ipc finalized the object");
        ok($one->ipc_polling, "polling on by default");
        is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
    }

    require Test2::IPC::Driver::Files;
    $one->reset;
    $one->add_ipc_driver('Test2::IPC::Driver::Files');
    ok($one->ipc, 'IPC loaded if drivers have been added');
    ok($one->finalized, "calling ipc finalized the object");
    ok($one->ipc_polling, "polling on by default");

    my $file = __FILE__;
    my $line = __LINE__ + 1;
    my $warnings = warnings { $one->add_ipc_driver('Test2::IPC::Driver::Files') };
    like(
        $warnings->[0],
        qr{^IPC driver Test2::IPC::Driver::Files loaded too late to be used as the global ipc driver at \Q$file\E line $line},
        "Got warning at correct frame"
    );

    $one->reset;
    $one->add_ipc_driver('Fake::Fake::XXX');
    is(
        exception { $one->ipc },
        "IPC has been requested, but no viable drivers were found. Aborting...\n",
        "Failed without viable IPC driver"
    );
}

{
    $one->reset;
    ok(!@{$one->context_init_callbacks}, "no callbacks");
    is($one->ipc_polling, undef, "no polling, undef");

    $one->disable_ipc_polling;
    ok(!@{$one->context_init_callbacks}, "no callbacks");
    is($one->ipc_polling, undef, "no polling, still undef");

    my $cull = 0;
    no warnings 'once';
    local *Fake::Hub::cull = sub { $cull++ };
    use warnings;

    $one->enable_ipc_polling;
    is(@{$one->context_init_callbacks}, 1, "added the callback");
    is($one->ipc_polling, 1, "polling on");
    $one->set_ipc_shm_last('abc1');
    $one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
    is($cull, 1, "called cull once");
    $cull = 0;

    $one->disable_ipc_polling;
    is(@{$one->context_init_callbacks}, 1, "kept the callback");
    is($one->ipc_polling, 0, "no polling, set to 0");
    $one->set_ipc_shm_last('abc3');
    $one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
    is($cull, 0, "did not call cull");
    $cull = 0;

    $one->enable_ipc_polling;
    is(@{$one->context_init_callbacks}, 1, "did not add the callback");
    is($one->ipc_polling, 1, "polling on");
    $one->set_ipc_shm_last('abc3');
    $one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
    is($cull, 1, "called cull once");
}

done_testing;
Commit	Line	Data
b4514920 CG	1	use strict;
	2	use warnings;
	3
	4	use Test2::IPC;
	5	BEGIN { require "t/tools.pl" };
	6	use Test2::Util qw/CAN_THREAD CAN_REALLY_FORK USE_THREADS get_tid/;
	7
33d95a65 TC	8	skip_all("Leaks shm blocks");
33d95a65 TC	9
b4514920 CG	10	my $CLASS = 'Test2::API::Instance';
	11
	12	my $one = $CLASS->new;
	13	is_deeply(
	14	$one,
	15	{
b4514920 CG	16	contexts => {},
	17
	18	finalized => undef,
	19	ipc => undef,
	20	formatter => undef,
	21
	22	ipc_polling => undef,
	23	ipc_drivers => [],
	24
	25	formatters => [],
	26
	27	no_wait => 0,
	28	loaded => 0,
	29
	30	exit_callbacks => [],
	31	post_load_callbacks => [],
	32	context_acquire_callbacks => [],
	33	context_init_callbacks => [],
	34	context_release_callbacks => [],
	35
	36	stack => [],
	37	},
	38	"Got initial settings"
	39	);
	40
	41	%$one = ();
	42	is_deeply($one, {}, "wiped object");
	43
	44	$one->reset;
	45	is_deeply(
	46	$one,
	47	{
b4514920 CG	48	contexts => {},
	49
	50	ipc_polling => undef,
	51	ipc_drivers => [],
	52
	53	formatters => [],
	54
	55	finalized => undef,
	56	ipc => undef,
	57	formatter => undef,
	58
	59	no_wait => 0,
	60	loaded => 0,
	61
	62	exit_callbacks => [],
	63	post_load_callbacks => [],
	64	context_acquire_callbacks => [],
	65	context_init_callbacks => [],
	66	context_release_callbacks => [],
	67
	68	stack => [],
	69	},
	70	"Reset Object"
	71	);
	72
	73	ok(!$one->formatter_set, "no formatter set");
	74	$one->set_formatter('Foo');
	75	ok($one->formatter_set, "formatter set");
	76	$one->reset;
	77
	78	my $ran = 0;
	79	my $callback = sub { $ran++ };
	80	$one->add_post_load_callback($callback);
	81	ok(!$ran, "did not run yet");
	82	is_deeply($one->post_load_callbacks, [$callback], "stored callback for later");
	83
	84	ok(!$one->loaded, "not loaded");
	85	$one->load;
	86	ok($one->loaded, "loaded");
	87	is($ran, 1, "ran the callback");
	88
	89	$one->load;
	90	is($ran, 1, "Did not run the callback again");
	91
	92	$one->add_post_load_callback($callback);
	93	is($ran, 2, "ran the new callback");
	94	is_deeply($one->post_load_callbacks, [$callback, $callback], "stored callback for the record");
	95
	96	like(
	97	exception { $one->add_post_load_callback({}) },
	98	qr/Post-load callbacks must be coderefs/,
	99	"Post-load callbacks must be coderefs"
	100	);
	101
	102	$one->reset;
	103	ok($one->ipc, 'got ipc');
	104	ok($one->finalized, "calling ipc finalized the object");
	105
	106	$one->reset;
	107	ok($one->stack, 'got stack');
	108	ok(!$one->finalized, "calling stack did not finaliz the object");
	109
	110	$one->reset;
	111	ok($one->formatter, 'Got formatter');
112	ok($one->finalized, "calling format finalized the object");
113
114	$one->reset;
115	$one->set_formatter('Foo');
116	is($one->formatter, 'Foo', "got specified formatter");
117	ok($one->finalized, "calling format finalized the object");
118
119	{
120	local $ENV{T2_FORMATTER} = 'TAP';
121	$one->reset;
122	is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
123	ok($one->finalized, "calling format finalized the object");
124
125	local $ENV{T2_FORMATTER} = '+Test2::Formatter::TAP';
126	$one->reset;
127	is($one->formatter, 'Test2::Formatter::TAP', "got specified formatter");
128	ok($one->finalized, "calling format finalized the object");
129
130	local $ENV{T2_FORMATTER} = '+Fake';
131	$one->reset;
132	like(
133	exception { $one->formatter },
134	qr/COULD NOT LOAD FORMATTER 'Fake' \(set by the 'T2_FORMATTER' environment variable\)/,
135	"Bad formatter"
136	);
137	}
138
139	$ran = 0;
140	$one->reset;
141	$one->add_exit_callback($callback);
142	is(@{$one->exit_callbacks}, 1, "added an exit callback");
143	$one->add_exit_callback($callback);
144	is(@{$one->exit_callbacks}, 2, "added another exit callback");
145
146	like(
147	exception { $one->add_exit_callback({}) },
148	qr/End callbacks must be coderefs/,
149	"Exit callbacks must be coderefs"
150	);
151
152	if (CAN_REALLY_FORK) {
153	$one->reset;
154	my $pid = fork;
155	die "Failed to fork!" unless defined $pid;
156	unless($pid) { exit 0 }
157
158	is($one->_ipc_wait, 0, "No errors");
159
160	$pid = fork;
161	die "Failed to fork!" unless defined $pid;
162	unless($pid) { exit 255 }
163	my @warnings;
164	{
165	local $SIG{__WARN__} = sub { push @warnings => @_ };
166	is($one->_ipc_wait, 255, "Process exited badly");
167	}
168	like($warnings[0], qr/Process .* did not exit cleanly \(status: 255\)/, "Warn about exit");
169	}
170
171	if (CAN_THREAD && $] ge '5.010') {
172	require threads;
173	$one->reset;
174
175	threads->new(sub { 1 });
176	is($one->_ipc_wait, 0, "No errors");
177
178	if (threads->can('error')) {
179	threads->new(sub {
180	close(STDERR);
181	close(STDOUT);
182	die "xxx"
183	});
184	my @warnings;
185	{
186	local $SIG{__WARN__} = sub { push @warnings => @_ };
187	is($one->_ipc_wait, 255, "Thread exited badly");
188	}
189	like($warnings[0], qr/Thread .* did not end cleanly: xxx/, "Warn about exit");
190	}
191	}
192
193	{
194	$one->reset();
195	local $? = 0;
196	$one->set_exit;
197	is($?, 0, "no errors on exit");
198	}
199
200	{
201	$one->reset();
58818a66	202	$one->set__tid(1);
b4514920 CG	203	local $? = 0;
	204	$one->set_exit;
	205	is($?, 0, "no errors on exit");
	206	}
	207
	208	{
	209	$one->reset();
	210	$one->stack->top;
	211	$one->no_wait(1);
	212	local $? = 0;
	213	$one->set_exit;
	214	is($?, 0, "no errors on exit");
	215	}
	216
	217	{
	218	$one->reset();
	219	$one->stack->top->set_no_ending(1);
	220	local $? = 0;
	221	$one->set_exit;
	222	is($?, 0, "no errors on exit");
	223	}
	224
	225	{
	226	$one->reset();
58818a66	227	$one->load();
b4514920 CG	228	$one->stack->top->set_failed(2);
	229	local $? = 0;
	230	$one->set_exit;
	231	is($?, 2, "number of failures");
	232	}
	233
	234	{
	235	$one->reset();
58818a66	236	$one->load();
b4514920 CG	237	local $? = 500;
	238	$one->set_exit;
	239	is($?, 255, "set exit code to a sane number");
	240	}
	241
	242	{
	243	local %INC = %INC;
	244	delete $INC{'Test2/IPC.pm'};
	245	$one->reset();
58818a66	246	$one->load();
b4514920 CG	247	my @events;
	248	$one->stack->top->filter(sub { push @events => $_[1]; undef});
	249	$one->stack->new_hub;
	250	local $? = 0;
	251	$one->set_exit;
	252	is($?, 255, "errors on exit");
	253	like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
	254	}
	255
	256	{
	257	$one->reset;
	258	my $stderr = "";
	259	{
	260	local $INC{'Test/Builder.pm'} = __FILE__;
	261	local $Test2::API::VERSION = '0.002';
	262	local $Test::Builder::VERSION = '0.001';
	263	local *STDERR;
	264	open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";
	265
	266	$one->set_exit;
	267	}
	268
	269	is($stderr, <<' EOT', "Got warning about version mismatch");
	270
	271	********************************************************************************
	272	* *
	273	* Test::Builder -- Test2::API version mismatch detected *
	274	* *
	275	********************************************************************************
	276	Test2::API Version: 0.002
	277	Test::Builder Version: 0.001
	278
	279	This is not a supported configuration, you will have problems.
	280
	281	EOT
	282	}
	283
	284	{
	285	require Test2::API::Breakage;
	286	no warnings qw/redefine once/;
	287	my $ran = 0;
	288	local *Test2::API::Breakage::report = sub { $ran++; return "foo" };
	289	use warnings qw/redefine once/;
	290	$one->reset();
58818a66	291	$one->load();
b4514920 CG	292
	293	my $stderr = "";
	294	{
	295	local *STDERR;
	296	open(STDERR, '>', \$stderr) or print "Failed to open new STDERR";
	297	local $? = 255;
	298	$one->set_exit;
	299	}
	300
	301	is($stderr, <<" EOT", "Reported bad modules");
	302
	303	You have loaded versions of test modules known to have problems with Test2.
	304	This could explain some test failures.
	305	foo
	306
	307	EOT
	308	}
	309
	310
	311	{
	312	$one->reset();
58818a66	313	$one->load();
b4514920 CG	314	my @events;
	315	$one->stack->top->filter(sub { push @events => $_[1]; undef});
	316	$one->stack->new_hub;
	317	ok($one->stack->top->ipc, "Have IPC");
	318	$one->stack->new_hub;
	319	ok($one->stack->top->ipc, "Have IPC");
	320	$one->stack->top->set_ipc(undef);
	321	ok(!$one->stack->top->ipc, "no IPC");
	322	$one->stack->new_hub;
	323	local $? = 0;
	324	$one->set_exit;
	325	is($?, 255, "errors on exit");
	326	like($events[0]->message, qr/Test ended with extra hubs on the stack!/, "got diag");
	327	}
	328
	329	if (CAN_REALLY_FORK) {
	330	local $SIG{__WARN__} = sub { };
	331	$one->reset();
	332	my $pid = fork;
	333	die "Failed to fork!" unless defined $pid;
	334	unless ($pid) { exit 255 }
	335	$one->_finalize;
	336	$one->stack->top;
	337
	338	local $? = 0;
	339	$one->set_exit;
	340	is($?, 255, "errors on exit");
	341
	342	$one->reset();
	343	$pid = fork;
	344	die "Failed to fork!" unless defined $pid;
	345	unless ($pid) { exit 255 }
	346	$one->_finalize;
	347	$one->stack->top;
	348
	349	local $? = 122;
	350	$one->set_exit;
	351	is($?, 122, "kept original exit");
	352	}
	353
	354	{
	355	my $ctx = bless {
	356	trace => Test2::Util::Trace->new(frame => ['Foo::Bar', 'Foo/Bar.pm', 42, 'xxx']),
	357	hub => Test2::Hub->new(),
	358	}, 'Test2::API::Context';
	359	$one->contexts->{1234} = $ctx;
	360
	361	local $? = 500;
	362	my $warnings = warnings { $one->set_exit };
	363	is($?, 255, "set exit code to a sane number");
	364
	365	is_deeply(
	366	$warnings,
	367	[
	368	"context object was never released! This means a testing tool is behaving very badly at Foo/Bar.pm line 42.\n"
	369	],
	370	"Warned about unfreed context"
	371	);
	372	}
	373
	374	{
	375	local %INC = %INC;
	376	delete $INC{'Test2/IPC.pm'};
	377	delete $INC{'threads.pm'};
378	ok(!USE_THREADS, "Sanity Check");
379
380	$one->reset;
381	ok(!$one->ipc, 'IPC not loaded, no IPC object');
382	ok($one->finalized, "calling ipc finalized the object");
383	is($one->ipc_polling, undef, "no polling defined");
384	ok(!@{$one->ipc_drivers}, "no driver");
385
386	if (CAN_THREAD) {
387	local $INC{'threads.pm'} = 1;
388	no warnings 'once';
389	local *threads::tid = sub { 0 } unless threads->can('tid');
390	$one->reset;
391	ok($one->ipc, 'IPC loaded if threads are');
392	ok($one->finalized, "calling ipc finalized the object");
393	ok($one->ipc_polling, "polling on by default");
394	is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
395	}
396
397	{
398	local $INC{'Test2/IPC.pm'} = 1;
399	$one->reset;
400	ok($one->ipc, 'IPC loaded if Test2::IPC is');
401	ok($one->finalized, "calling ipc finalized the object");
402	ok($one->ipc_polling, "polling on by default");
403	is($one->ipc_drivers->[0], 'Test2::IPC::Driver::Files', "default driver");
404	}
405
406	require Test2::IPC::Driver::Files;
407	$one->reset;
408	$one->add_ipc_driver('Test2::IPC::Driver::Files');
409	ok($one->ipc, 'IPC loaded if drivers have been added');
410	ok($one->finalized, "calling ipc finalized the object");
411	ok($one->ipc_polling, "polling on by default");
412
413	my $file = __FILE__;
414	my $line = __LINE__ + 1;
415	my $warnings = warnings { $one->add_ipc_driver('Test2::IPC::Driver::Files') };
416	like(
417	$warnings->[0],
418	qr{^IPC driver Test2::IPC::Driver::Files loaded too late to be used as the global ipc driver at \Q$file\E line $line},
419	"Got warning at correct frame"
420	);
421
422	$one->reset;
423	$one->add_ipc_driver('Fake::Fake::XXX');
424	is(
425	exception { $one->ipc },
426	"IPC has been requested, but no viable drivers were found. Aborting...\n",
427	"Failed without viable IPC driver"
428	);
429	}
430
431	{
432	$one->reset;
433	ok(!@{$one->context_init_callbacks}, "no callbacks");
434	is($one->ipc_polling, undef, "no polling, undef");
435
436	$one->disable_ipc_polling;
437	ok(!@{$one->context_init_callbacks}, "no callbacks");
438	is($one->ipc_polling, undef, "no polling, still undef");
439
440	my $cull = 0;
441	no warnings 'once';
442	local *Fake::Hub::cull = sub { $cull++ };
443	use warnings;
444
445	$one->enable_ipc_polling;
446	is(@{$one->context_init_callbacks}, 1, "added the callback");
447	is($one->ipc_polling, 1, "polling on");
448	$one->set_ipc_shm_last('abc1');
449	$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
450	is($cull, 1, "called cull once");
451	$cull = 0;
452
453	$one->disable_ipc_polling;
454	is(@{$one->context_init_callbacks}, 1, "kept the callback");
455	is($one->ipc_polling, 0, "no polling, set to 0");
456	$one->set_ipc_shm_last('abc3');
457	$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
458	is($cull, 0, "did not call cull");
459	$cull = 0;
460
461	$one->enable_ipc_polling;
462	is(@{$one->context_init_callbacks}, 1, "did not add the callback");
463	is($one->ipc_polling, 1, "polling on");
464	$one->set_ipc_shm_last('abc3');
465	$one->context_init_callbacks->[0]->({'hub' => 'Fake::Hub'});
466	is($cull, 1, "called cull once");
467	}
468
469	done_testing;