File: 80memleakget.t

package info (click to toggle)
libfile-extattr-perl 1.09-7
  • links: PTS
  • area: main
  • in suites: forky, sid
  • size: 364 kB
  • sloc: ansic: 1,864; perl: 1,221; makefile: 42
file content (95 lines) | stat: -rwxr-xr-x 2,241 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
#!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 => 6000;
}

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 or 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) or 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") or die "Unable to open $filename";

print "# using file descriptor ".$fh->fileno()."\n";

setfattr($fh, $key, $val)
    or die "setfattr failed on file descriptor ".$fh->fileno().": $!"; 

for (my $i = 0; $i < 1000; $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;
};