Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

89 lines (66 sloc) 2.351 kB
#!/usr/bin/perl
# Test whether the client and server classes correctly detect the presence
# or absence of compression support.
use strict;
use warnings;
use vars qw($compression_available %TEST_PKGS);
use Symbol 'delete_package';
use Test::More;
# First, determine if we actually *do* have Compress::Zlib available:
eval { require Compress::Zlib; };
$compression_available = ($@) ? 0 : 1;
# These are the modules that need to correctly detect compression:
%TEST_PKGS = ( 'RPC::XML::Client' => 'RPC/XML/Client.pm',
'RPC::XML::Server' => 'RPC/XML/Server.pm' );
plan tests => (2 * (scalar keys %TEST_PKGS));
# Clear out Compress::Zlib so it'll try to load again:
clear('Compress::Zlib', 'Compress/Zlib.pm');
# If compression is truly not available, just test that the modules correctly
# detect this. Otherwise, get crafty.
# Start by testing failure-to-detect
unshift(@INC, sub {
die "Force-failing Compress::Zlib" if ($_[1] eq 'Compress/Zlib.pm');
return undef;
}) if ($compression_available);
for my $pkg (sort keys %TEST_PKGS)
{
no strict 'refs';
eval "require $pkg;";
is(${"${pkg}::COMPRESSION_AVAILABLE"}, '',
"$pkg correctly saw no Compress::Zlib");
# Remove from %INC so later tests still run
clear($pkg, $TEST_PKGS{$pkg});
}
SKIP: {
# Test successful detection, but only if we actually have Compress::Zlib
skip 'Compress::Zlib truly not available', (scalar keys %TEST_PKGS)
unless $compression_available;
shift(@INC); # Drop the force-failure sub from above
for my $pkg (sort keys %TEST_PKGS)
{
no strict 'refs';
clear('Compress::Zlib', 'Compress/Zlib.pm');
for (qw(deflate flush inflate))
{
clear('Compress::Zlib', 'Compress/Zlib.pm', $_);
}
eval "require $pkg;";
# I am not explicitly testing for "deflate" here, because that might
# change in the future. What matters is that it is not null.
isnt(${"${pkg}::COMPRESSION_AVAILABLE"}, '',
"$pkg correctly detected Compress::Zlib");
}
}
exit;
sub clear
{
no strict 'refs';
my ($pkg, $file, $name) = @_;
delete $INC{$file};
delete_package($pkg);
if ($pkg eq 'Compress::Zlib')
{
delete_package 'Zlib::OldDeflate';
delete_package 'Zlib::OldInflate';
}
}
Jump to Line
Something went wrong with that request. Please try again.