view release on metacpan or  search on metacpan

t/31methcache.t  view on Meta::CPAN

	$row = $sth->fetch;
	is($row->[0], "local0", "$desc local0");
    }
    $row = $sth->fetch;
    is($row->[0], "row1", "$desc row1");

    {
	# replace GP
	local *DBD::Sponge::st::fetch = *Foo::local1;
	$row = $sth->fetch;
	is($row->[0], "local1", "$desc local1");
    }
    $row = $sth->fetch;
    is($row->[0], "row2", "$desc row2");

    {
	# replace GV
	local $DBD::Sponge::st::{fetch} = *Foo::local2;
	$row = $sth->fetch;
	is($row->[0], "local2", "$desc local2");
    }
    $row = $sth->fetch;
    is($row->[0], "row3", "$desc row3");

    {
	# @ISA = NoSuchPackage
	local $DBD::Sponge::st::{fetch};
	local @DBD::Sponge::st::ISA = qw(NoSuchPackage);
	eval { local $SIG{__WARN__} = sub {}; $row = $sth->fetch };
	like($@, qr/Can't locate DBI object method/, "$desc locate DBI object");
    }
    $row = $sth->fetch;
    is($row->[0], "row4", "$desc row4");

    {
	# @ISA = Bar
	$fetch_hook = \&DBD::Sponge::st::fetch;
	local $DBD::Sponge::st::{fetch};
	local @DBD::Sponge::st::ISA = qw(Bar);
	$row = $sth->fetch;
	is($row->[0], "row5", "$desc row5");
	$fetch_hook = sub { [ "local3" ] };
	$row = $sth->fetch;
	is($row->[0], "local3", "$desc local3");
    }
    $row = $sth->fetch;
    is($row->[0], "row6", "$desc row6");
}

run_tests("plain", new_handle());


if ($has_threads) {
    # only enable this when handles are allowed to be shared across threads
    #{
    #    my @h = new_handle();
    #    threads->new(sub { run_tests("threads", @h) })->join; 
    #}
    threads->new(sub { run_tests("threads-h", new_handle()) })->join; 

    # using weaken attaches magic to the CV; see whether this interferes
    # with the cache magic
}

use Scalar::Util qw(weaken);
my $fetch_ref = \&DBI::st::fetch;
weaken $fetch_ref;
run_tests("magic", new_handle());

if ($has_threads) {
    # only enable this when handles are allowed to be shared across threads
    #{
    #    my @h = new_handle();
    #    threads->new(sub { run_tests("threads", @h) })->join; 
    #}
    threads->new(sub { run_tests("magic threads-h", new_handle()) })->join; 
}

done_testing;

1;