1#!perl -w 2 3# Before `make install' is performed this script should be runnable with 4# `make test'. After `make install' it should work as `perl Linux-xattr.t' 5 6######################### 7 8# change 'tests => 2' to 'tests => last_test_to_print'; 9 10use strict; 11use Test::More; 12 13BEGIN { 14 my $tlib = $0; 15 $tlib =~ s|/[^/]*$|/lib|; 16 push(@INC, $tlib); 17} 18use t::Support; 19 20if (t::Support::should_skip()) { 21 plan skip_all => 'Tests unsupported on this OS/filesystem'; 22} else { 23 plan tests => 8; 24} 25 26use File::Temp qw(tempfile); 27use File::Path; 28use File::ExtAttr qw(setfattr getfattr delfattr); 29 30my $TESTDIR = ($ENV{ATTR_TEST_DIR} || '.'); 31my ($fh, $filename) = tempfile( DIR => $TESTDIR ); 32close $fh or die "can't close $filename $!"; 33 34# Create a directory. 35my $dirname = "$filename.dir"; 36eval { mkpath($dirname); }; 37if ($@) { 38 warn "Couldn't create $dirname: $@"; 39} 40 41#todo: try wierd characters in here? 42# try unicode? 43my $key = "alskdfjadf2340zsdflksjdfa09eralsdkfjaldkjsldkfj"; 44my $val = "ZZZadlf03948alsdjfaslfjaoweir12l34kealfkjalskdfas90d8fajdlfkj./.,f"; 45 46foreach ( $filename, $dirname ) { 47 print "# using $_\n"; 48 49#for (1..30000) { #checking memory leaks 50 51 #will die if xattr stuff doesn't work at all 52 setfattr($_, "$key", $val) or die "setfattr failed on $_: $!"; 53 54 #set it 55 is (setfattr($_, "$key", $val), 1); 56 57 #read it back 58 is (getfattr($_, "$key"), $val); 59 60 #delete it 61 ok (delfattr($_, "$key")); 62 63 #check that it's gone 64 is (getfattr($_, "$key"), undef); 65#} 66} 67 68END { 69 unlink $filename if $filename; 70 rmdir $dirname if $dirname; 71}; 72