Skip to content

Commit

Permalink
First round of Devel::Cover-inspired improvements.
Browse files Browse the repository at this point in the history 
These are the changes to the test suites to increase coverage of the code.
  • Loading branch information
@rjray
rjray committed Jul 13, 2011
1 parent 6124191 commit 343e66b
Show file tree
Hide file tree
Showing 17 changed files with 1,647 additions and 355 deletions.
180 changes: 134 additions & 46 deletions t/10_data.t
View file

Large diffs are not rendered by default.

305 changes: 193 additions & 112 deletions t/11_base64_fh.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,181 +3,262 @@
# Test the usage of RPC::XML::base64 with filehandles

use strict;
use vars qw($dir $vol $file $tmpfile $value $enc_value $obj $fh $pos $md5_able);
use vars qw($dir $vol $file $b64file $tmpfile $value $enc_value $obj $fh $pos
$md5_able $md5 $size $ofh);

# This is what we're testing
use RPC::XML;

use Test;
use Test::More tests => 35;
use File::Spec;
use IO::File;
use MIME::Base64;

($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
$dir = File::Spec->catpath($vol, $dir, '');
$file = File::Spec->catfile($dir, 'svsm_text.gif');
$b64file = File::Spec->catfile($dir, 'svsm_text.b64');
$tmpfile = File::Spec->catfile($dir, "__tmp__${$}__");

BEGIN
{
eval "use Digest::MD5";
$md5_able = $@ ? 0 : 1;

plan tests => 23;
}

END
{
unlink $tmpfile;
if (-f $tmpfile)
{
unlink $tmpfile;
}
}

$value = 'Short string for easy tests';
$enc_value = encode_base64($value, '');

if (ref($fh = IO::File->new_tmpfile))
if (! (open $fh, '+>', $tmpfile))
{
$fh->autoflush(1);
print $fh $value;
$pos = $fh->tell;

# We now have a ready-to-use FH, and we know the seek-pos on it
$obj = RPC::XML::base64->new($fh);
ok(ref $obj);
ok($fh->tell() == $pos);
ok($obj->value() eq $value);
ok($fh->tell() == $pos);
ok($obj->as_string() eq "<base64>$enc_value</base64>");
ok($fh->tell() == $pos);

# Done with this for now
$fh->close;
}
else
{
skip('Skipped: opening IO::File::new_tmpfile failed', 0) for (1 .. 6);
die "Error opening $tmpfile: $!";
}

select($fh); $| = 1; select STDOUT;

print {$fh} $value;
$pos = tell $fh;

# We now have a ready-to-use FH, and we know the seek-pos on it
$obj = RPC::XML::base64->new($fh);
isa_ok($obj, 'RPC::XML::base64', '$obj');
is(tell $fh, $pos, 'object construction leaves pos() unchanged');
is($obj->value(), $value, 'object value is correct');
is(tell $fh, $pos, 'call to value() leaves pos() unchanged');
is($obj->as_string(), "<base64>$enc_value</base64>",
'object stringification is correct');
is(tell $fh, $pos, 'call to as_string leaves pos() unchanged');

# Done with this for now
close $fh;
unlink $tmpfile;

# Same tests, but init the FH with the encoded data rather than the cleartext
if (ref($fh = IO::File->new_tmpfile))
{
$fh->autoflush(1);
print $fh $enc_value;
$pos = $fh->tell;

# We now have a ready-to-use FH, and we know the seek-pos on it
$obj = RPC::XML::base64->new($fh, 'encoded');
ok(ref $obj);
ok($fh->tell() == $pos);
ok($obj->value() eq $value);
ok($fh->tell() == $pos);
ok($obj->as_string() eq "<base64>$enc_value</base64>");
ok($fh->tell() == $pos);

# Done with this for now
$fh->close;
}
else
if (! (open $fh, '+>', $tmpfile))
{
skip('Skipped: opening IO::File::new_tmpfile failed', 0) for (1 .. 6);
die "Error opening $tmpfile: $!";
}

# Test ordinary filehandles as well
select($fh); $| = 1; select STDOUT;

print $fh $enc_value;
$pos = tell $fh;

# We now have a ready-to-use FH, and we know the seek-pos on it
$obj = RPC::XML::base64->new($fh, 'encoded');
isa_ok($obj, 'RPC::XML::base64', '$obj(encoded)');
is(tell $fh, $pos, 'object(encoded) construction leaves pos() unchanged');
is($obj->value(), $value, 'object(encoded) value is correct');
is(tell $fh, $pos, 'call to value() leaves pos() unchanged');
is($obj->as_string(), "<base64>$enc_value</base64>",
'object(encoded) stringification is correct');
is(tell $fh, $pos, 'call to as_string leaves pos() unchanged');

# Done with this for now
close $fh;
unlink $tmpfile;

# Test old-style glob filehandles
local *F;
if (open(F, "> $tmpfile"))
if (! (open F, '+>', $tmpfile))
{
print F $value;
close(F);
die "Error opening $tmpfile: $!";
}
else

select(F); $| = 1; select STDOUT;

print F $enc_value;
$pos = tell F;

# We now have a ready-to-use FH, and we know the seek-pos on it
$obj = RPC::XML::base64->new(\*F, 'encoded');
isa_ok($obj, 'RPC::XML::base64', '$obj(glob)');
is(tell F, $pos, 'object(glob) construction leaves pos() unchanged');
is($obj->value(), $value, 'object(glob) value is correct');
is(tell F, $pos, 'call to value() leaves pos() unchanged');
is($obj->as_string(), "<base64>$enc_value</base64>",
'object(glob) stringification is correct');
is(tell F, $pos, 'call to as_string leaves pos() unchanged');

# Done with this for now
close F;
unlink $tmpfile;

# Test with a larger file
if (! (open $fh, '<', $file))
{
die "Cannot create local file $tmpfile: $!";
die "Error opening $file: $!";
}

if (open(F, "< $tmpfile"))
$obj = RPC::XML::base64->new($fh);
isa_ok($obj, 'RPC::XML::base64', '$obj');
$enc_value = ''; $value = '';

while (read $fh, $value, 60*57)
{
autoflush F 1;
seek(F, 0, 0);
$pos = tell(F);

$obj = RPC::XML::base64->new(\*F);
ok(ref $obj);
ok(tell(F) == $pos);
ok($obj->value() eq $value);
ok(tell(F) == $pos);
ok($obj->as_string() eq "<base64>$enc_value</base64>");
ok(tell(F) == $pos);

close(F);
$enc_value .= encode_base64($value, '');
}
else
{
skip("Skipped: Opening $tmpfile failed: $!", 0) for (1 .. 6);
is($obj->as_string(), "<base64>$enc_value</base64>",
'from file, stringification');
is(length($obj->as_string), $obj->length, 'from file, length');
seek $fh, 0, 0;

SKIP: {
skip 'Digest::MD5 unavailable', 1 if (! $md5_able);

$md5 = Digest::MD5->new;
$md5->addfile($fh);
$value = $md5->hexdigest;
$md5->new; # Clear the digest
$md5->add($obj->value);
is($value, $md5->hexdigest, 'MD5 checksum matches');
}

# Test with a larger file
if ($fh = IO::File->new("< $file"))
close $fh;

# Test the to_file method
if (! (open $fh, '<', $file))
{
$obj = RPC::XML::base64->new($fh);
$enc_value = ''; $value = '';
die "Error opening $file: $!";
}
$obj = RPC::XML::base64->new($fh);

while (read($fh, $value, 60*57))
# Start by trying to write the new file
$size = $obj->to_file($tmpfile);
is($size, -s $file, 'to_file call returned correct number of bytes');
is(-s $tmpfile, -s $file, 'temp-file size matches file size');

SKIP: {
skip 'Digest::MD5 unavailable', 1 if (! $md5_able);

$md5 = Digest::MD5->new;
$md5->addfile($fh);
$value = $md5->hexdigest;
$md5->new; # Clear the digest

# Now get an MD5 on the new file
if (! (open $ofh, '<', $tmpfile))
{
$enc_value .= encode_base64($value, '');
die "Error opening $tmpfile for reading: $!";
}
ok($obj->as_string(), "<base64>$enc_value</base64>");
ok(length($obj->as_string), $obj->length);
$fh->seek(0, 0);
$md5->addfile($ofh);
is($value, $md5->hexdigest, 'MD5 hexdigest matches');
close $ofh;
unlink $tmpfile;
}
close $fh;

if ($md5_able)
{
my $md5 = Digest::MD5->new;
# Try with in-memory data
$value = 'a simple in-memory string';
$obj = RPC::XML::base64->new($value);
# Try to write it
$size = $obj->to_file($tmpfile);
is($size, length $value, 'to_file call returned correct number of bytes');
is(length $value, -s $tmpfile, 'temp-file size matches string');
unlink $tmpfile;

# Try with a file-handle instead of a file name
if (! (open $ofh, '>', $tmpfile))
{
die "Error opening $tmpfile for writing: $!";
}
select($ofh); $| = 1; select STDOUT;
$size = $obj->to_file($ofh);
is($size, length $value, 'to_file call on file-handle, correct size');
is(length $value, -s $ofh, 'temp-file size matches string');
close $ofh;
unlink $tmpfile;

# Try an unusable reference
$size = $obj->to_file([]);
is($size, -1, 'to_file call failed on unusable reference type');
like($RPC::XML::ERROR, qr/Unusable reference/, 'Correct error message');

$md5->addfile($fh);
$value = $md5->hexdigest;
$md5->new; # Clear the digest
$md5->add($obj->value);
ok($value, $md5->hexdigest);
SKIP: {
# Test the failure to open a file. Cannot run this on Windows because
# it doesn't have the concept of chmod...
skip 'Tests involving directory permissions skipped on Windows', 2
if ($^O eq 'MSWin32' || $^O eq 'cygwin');

my $baddir = File::Spec->catdir(File::Spec->tmpdir(), "baddir_$$");
if (! mkdir $baddir)
{
skip "Skipping, failed to create dir $baddir: $!", 2;
}
else
if (! chmod oct(600), $baddir)
{
skip("Skipped: Digest::MD5 unavailable", 0);
skip "Skipping, failed to chmod dir $baddir: $!", 2;
}
my $badfile = File::Spec->catfile($baddir, 'file');

$fh->close;
}
else
{
skip("Skipped: Opening file $file failed: $!", 0) for (1 .. 2);
$size = $obj->to_file($badfile);
is($size, -1, 'to_file call failed on un-openable file');
like($RPC::XML::ERROR, qr/Error opening/, 'Correct error message');

if (! rmdir $baddir)
{
warn "Failed to remove temp-dir $baddir: $!";
}
}

# Test the to_file method
if ($md5_able and $fh = IO::File->new("< $file"))
# Test to_file() with an encoded file in the file-handle
if (! (open $fh, '<', $b64file))
{
$obj = RPC::XML::base64->new($fh);

my $md5 = Digest::MD5->new;

# Start by trying to write the new file
$obj->to_file($tmpfile);
ok(1); # Whee! It didn't die!
die "Error opening $b64file for reading: $!";
}
$obj = RPC::XML::base64->new($fh, 'encoded');
$size = $obj->to_file($tmpfile);
is($size, -s $file, 'to_file() written size matches decoded file size');
SKIP: {
skip 'Digest::MD5 unavailable', 1 if (! $md5_able);

if (! (open $fh, '<', $file))
{
die "Error opening $file: $!";
}
$md5 = Digest::MD5->new;
$md5->addfile($fh);
$value = $md5->hexdigest;
$md5->new; # Clear the digest

# Now get an MD5 on the new file
my $ofh;
die "Error opening $tmpfile for reading: $!"
unless ($ofh = IO::File->new("< $tmpfile"));
if (! (open $ofh, '<', $tmpfile))
{
die "Error opening $tmpfile for reading: $!";
}
$md5->addfile($ofh);
ok($value, $md5->hexdigest);
$ofh->close;
$fh->close;
}
else
{
skip("Skipped: Digest::MD5 not availabe or open of $file failed", 0)
for (1 .. 2);
is($value, $md5->hexdigest, 'MD5 hexdigest matches');
close $ofh;
unlink $tmpfile;
}
close $fh;

exit;
Loading

0 comments on commit 343e66b

Please sign in to comment.