Update of /cvsroot/file-extattr/File-ExtAttr/t
In directory sc8-pr-cvs17:/tmp/cvs-serv13974/t
Added Files:
80memleakget.t
Log Message:
Bugfix: Fix a memory leak in getfattr()
--- NEW FILE: 80memleakget.t ---
#!perl -w
use strict;
use Test::More;
# DEBUG: When debugging with valgrind or top, uncomment this stub for is().
# Otherwise the test results will be stored by Test::More, "distorting"
# the picture of memory usage -- it will include the memory usage
# of both File::ExtAttr and Test::More.
#
# sub is {}
BEGIN {
my $tlib = $0;
$tlib =~ s|/[^/]*$|/lib|;
push(@INC, $tlib);
}
use t::Support;
if (t::Support::should_skip()) {
plan skip_all => 'Tests unsupported on this OS/filesystem';
} else {
plan tests => 60000;
}
use File::Temp qw(tempfile);
use File::Path;
use File::ExtAttr qw(setfattr getfattr);
use IO::File;
my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.');
my ($fh, $filename) = tempfile( DIR => $TESTDIR );
close $fh || die "can't close $filename $!";
# Create a directory.
my $dirname = "$filename.dir";
eval { mkpath($dirname); };
if ($@) {
die "Couldn't create $dirname: $@";
}
#todo: try wierd characters in here?
# try unicode?
my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj";
my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f";
my $key2 = $key.'2';
##########################
# Filename-based tests #
##########################
foreach ( $filename, $dirname ) {
print "# using $_\n";
setfattr($_, $key, $val) || die "setfattr failed on filename $_: $!";
for (my $i = 0; $i < 1000; $i++) {
# Check for the existing attribute.
is(getfattr($_, $key), $val);
# Check for the non-existing attribute.
is(getfattr($_, $key2), undef);
}
# DEBUG: Uncomment when debugging.
#sleep(5);
}
##########################
# IO::Handle-based tests #
##########################
$fh = new IO::File("<$filename") || die "Unable to open $filename";
print "# using file descriptor ".$fh->fileno()."\n";
setfattr($fh, $key, $val)
|| die "setfattr failed on file descriptor ".$fh->fileno().": $!";
for (my $i = 0; $i < 10000; $i++) {
# Check for the existing attribute.
is(getfattr($fh, $key), $val);
# Check for the non-existing attribute.
is(getfattr($fh, $key2), undef);
}
# DEBUG: Uncomment when debugging.
#sleep(5);
END {
unlink $filename if $filename;
rmdir $dirname if $dirname;
};
|