From: Mark Glines <mark@glines.org>
Date: Mon, 22 Apr 2002 02:24:28 +0000 (+0000)
Subject: added a test framework
X-Git-Tag: debian_version_1_0-1~38
X-Git-Url: http://git.maquefel.me/?a=commitdiff_plain;h=8811161f67657253d11214ede54857f810662a91;p=qemu-gpiodev%2Flibfuse.git

added a test framework
updated README
fixed a couple of bugs in loopback.pl
---

diff --git a/perl/README b/perl/README
index 01a0d8a..87d5a7d 100644
--- a/perl/README
+++ b/perl/README
@@ -1,4 +1,4 @@
-Fuse version 0.01
+Fuse version 0.02
 =================
 
 This is a test release.  It seems to work thus far, but still has a few
@@ -27,32 +27,16 @@ more information.
 
 BUGS
 
-A lot of it works, but I have to do some formal testing on all of it
-still.
-
-Building a Linux kernel actually succeeds.  I haven't tried booting it.
-
-The functions, all of which need to be thoroughally tested:
-getattr
-readlink
-getdir
-mknod
-mkdir
-unlink
-rmdir
-open
-read
-statfs
-symlink
-rename
-link
-chmod
-chown
-truncate
-utime
-write
+I've begun to build a formal testing framework.  Currently it can mount
+and unmount loopback.pl, and all of the base-level functions have test
+scripts.  These need to be fleshed out as problems are noticed.
+
+The current test framework seems to work well, but the underlying mount/
+unmount infrastructure is a crock.  I am not pleased with that code.
 
 While most things work, I do still have a TODO list:
 * while "ln -s" works as expected, "cp -a" kicks out an error on symlinks.
 * "du -sb" reports a couple orders of magnitude too large a size.
-* need a full Test::Harness framework
+* need to sort out cleaner mount semantics for the test framework
+* figure out how to un-linuxcentrify the statfs tests
+* test everything on other architectures and OS's
diff --git a/perl/loopback.pl b/perl/loopback.pl
index 3aaf6be..206eb81 100644
--- a/perl/loopback.pl
+++ b/perl/loopback.pl
@@ -7,7 +7,7 @@ use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
 use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
 require 'syscall.ph'; # for SYS_mknod
 
-sub fixup { return "/tmp/test" . shift }
+sub fixup { return "/tmp/fusetest" . shift }
 
 sub x_getattr {
 	my ($file) = fixup(shift);
@@ -75,7 +75,7 @@ sub x_rename {
 	my ($err) = rename($old,$new) ? 0 : -ENOENT();
 	return $err;
 }
-sub x_link { return err(link(fixup(shift),fixup(shift))   ); }
+sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
 sub x_chown {
 	my ($fn) = fixup(shift);
 	my ($uid,$gid) = @_;
@@ -100,7 +100,7 @@ sub x_mknod {
 	my ($file, $modes, $dev) = @_;
 	$file = fixup($file);
 	$! = 0;
-	syscall(&SYS_mknod,$file,$modes);
+	syscall(&SYS_mknod,$file,$modes,$dev);
 	return -$!;
 }
 
diff --git a/perl/test.pl b/perl/test.pl
index eee3421..e8152fd 100644
--- a/perl/test.pl
+++ b/perl/test.pl
@@ -1,18 +1,8 @@
 #!/usr/bin/perl
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl test.pl'
+BEGIN { $ENV{HARNESS_IGNORE_EXITCODE} = 1; }
 
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use Test;
-BEGIN { plan tests => 1 };
-use Fuse;
-ok(1); # If we made it this far, we're ok.
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
-# haven't written anything, because I don't want to require root
+use Test::Harness qw(&runtests $verbose);
+$verbose=0;
+die "cannot find test directory!" unless -d "test";
+my (@files) = <test/*.t>;
+runtests("test/s/mount.t",sort(@files),"test/s/umount.t");
diff --git a/perl/test/chmod.t b/perl/test/chmod.t
new file mode 100644
index 0000000..366f89b
--- /dev/null
+++ b/perl/test/chmod.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+chdir($_point);
+system("echo frog >file");
+ok(chmod(0644,"file"),"set unexecutable");
+ok(!-x "file","unexecutable");
+ok(chmod(0755,"file"),"set executable");
+ok(-x "file","executable");
+unlink("file");
diff --git a/perl/test/chown.t b/perl/test/chown.t
new file mode 100644
index 0000000..8ccbb88
--- /dev/null
+++ b/perl/test/chown.t
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+my (@stat);
+chdir($_point);
+system("echo frog >file");
+ok(chown(0,0,"file"),"set 0,0");
+@stat = stat("file");
+ok($stat[4] == 0 && $stat[5] == 0,"0,0");
+ok(chown(1,1,"file"),"set 1,1");
+@stat = stat("file");
+ok($stat[4] == 1 && $stat[5] == 1,"1,1");
+unlink("file");
diff --git a/perl/test/getattr.t b/perl/test/getattr.t
new file mode 100644
index 0000000..49eef14
--- /dev/null
+++ b/perl/test/getattr.t
@@ -0,0 +1,42 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+use Data::Dumper;
+plan tests => 28;
+my ($a, $b) = ("$_real/wibble","$_point/wibble");
+`touch $a; sleep 1; cat $a >/dev/null`;
+is(-A "$a", -A "$b", '-A'); # 1
+is(-B "$a", -B "$b", '-B'); # 2
+is(-C "$a", -C "$b", '-C'); # 3
+is(-M "$a", -M "$b", '-M'); # 4
+is(-O "$a", -O "$b", '-O'); # 5
+is(-R "$a", -R "$b", '-R'); # 6
+is(-S "$a", -S "$b", '-S'); # 7
+is(-T "$a", -T "$b", '-T'); # 8
+is(-W "$a", -W "$b", '-W'); # 9
+is(-X "$a", -X "$b", '-X'); # 10
+is(-b "$a", -b "$b", '-b'); # 11
+is(-c "$a", -c "$b", '-c'); # 12
+is(-d "$a", -d "$b", '-d'); # 13
+is(-e "$a", -e "$b", '-e'); # 14
+is(-f "$a", -f "$b", '-f'); # 15
+is(-g "$a", -g "$b", '-g'); # 16
+is(-k "$a", -k "$b", '-k'); # 17
+is(-l "$a", -l "$b", '-l'); # 18
+is(-o "$a", -o "$b", '-o'); # 19
+is(-p "$a", -p "$b", '-p'); # 20
+is(-r "$a", -r "$b", '-r'); # 21
+is(-s "$a", -s "$b", '-s'); # 22
+is(-t "$a", -t "$b", '-t'); # 23
+is(-u "$a", -u "$b", '-u'); # 24
+is(-w "$a", -w "$b", '-w'); # 25
+is(-x "$a", -x "$b", '-x'); # 26
+is(-z "$a", -z "$b", '-z'); # 27
+my (@astat, @bstat);
+@astat = stat("$a");
+@bstat = stat("$b");
+# dev and inode can legally change
+shift(@astat); shift(@astat);
+shift(@bstat); shift(@bstat);
+is(join(" ",@astat),join(" ",@bstat),"stat()");
+`rm -f $a`;
diff --git a/perl/test/getdir.t b/perl/test/getdir.t
new file mode 100644
index 0000000..1d60561
--- /dev/null
+++ b/perl/test/getdir.t
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+my (@names) = qw(abc def ghi jkl mno pqr stu jlk sfdaljk  sdfakjlsdfa kjldsf kjl;sdf akjl;asdf klj;asdf lkjsdflkjsdfkjlsdfakjsdfakjlsadfkjl;asdfklj;asdfkjl;asdfklj;asdfkjl;asdfkjlasdflkj;sadf);
+@names = sort(@names);
+plan tests => 2 * scalar @names;
+chdir($_real);
+
+# create entries
+map { system("touch \"$_\"") } @names;
+
+# make sure they exist in real dir
+opendir(REAL,$_real);
+my (@ents) = readdir(REAL);
+closedir(REAL);
+@ents = sort(@ents);
+map {
+	shift(@ents) while($ents[0] eq '.' || $ents[0] eq '..');
+	is(shift(@ents),$_,"ent $_")
+} @names;
+
+# make sure they exist in fuse dir
+opendir(POINT,$_point);
+@ents = readdir(POINT);
+closedir(POINT);
+@ents = sort(@ents);
+map {
+	shift(@ents) while($ents[0] eq '.' || $ents[0] eq '..');
+	is(shift(@ents),$_,"ent $_")
+} @names;
+
+# remove them
+map { unlink } @names;
diff --git a/perl/test/helper.pm b/perl/test/helper.pm
new file mode 100644
index 0000000..3d980ec
--- /dev/null
+++ b/perl/test/helper.pm
@@ -0,0 +1,23 @@
+#!/usr/bin/perl
+package test::helper;
+use strict;
+use Exporter;
+our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+@ISA = "Exporter";
+@EXPORT_OK = qw($_loop $_point $_pidfile $_real);
+our($_loop, $_point, $_pidfile, $_real) = ("loopback.pl","/mnt","test/s/mounted.pid","/tmp/fusetest");
+if($0 !~ qr|s/u?mount\.t$|) {
+	my ($reject) = 1;
+	if(-f $_pidfile) {
+		unless(system("ps `cat $_pidfile` | grep \"$_loop $_point\" >/dev/null")>>8) {
+			if(`mount | grep "on $_point"`) {
+				$reject = 0;
+			} else {
+				system("kill `cat $_pidfile`");
+			}
+		}
+	}
+	$reject = 0 if (system("ls $_point >&/dev/null") >> 8);
+	die "not properly mounted\n" if $reject;
+}
+1;
diff --git a/perl/test/link.t b/perl/test/link.t
new file mode 100644
index 0000000..391b2f0
--- /dev/null
+++ b/perl/test/link.t
@@ -0,0 +1,16 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 8;
+chdir($_point);
+system("echo hippity >womble");
+ok(-f "womble","exists");
+ok(!-f "rabbit","target file doesn't exist");
+is(-s "womble",8,"right size");
+ok(link("womble","rabbit"),"link");
+ok(-f "womble","old file exists");
+ok(-f "rabbit","target file exists");
+is(-s "womble",8,"right size");
+is(-s "rabbit",8,"right size");
+unlink("womble");
+unlink("rabbit");
diff --git a/perl/test/mkdir.t b/perl/test/mkdir.t
new file mode 100644
index 0000000..90ec6f3
--- /dev/null
+++ b/perl/test/mkdir.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+chdir($_point);
+ok(mkdir("dir"),"mkdir");
+ok(-d "dir","dir exists");
+chdir($_real);
+ok(-d "dir","dir really exists");
+chdir($_point);
+rmdir("dir");
diff --git a/perl/test/mknod.t b/perl/test/mknod.t
new file mode 100644
index 0000000..35c5c82
--- /dev/null
+++ b/perl/test/mknod.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 24;
+my (@stat);
+chdir($_point);
+ok(!(system("touch reg"      )>>8),"create normal file");
+ok(!(system("mknod chr c 2 3")>>8),"create chrdev");
+ok(!(system("mknod blk b 2 3")>>8),"create blkdev");
+ok(!(system("mknod fifo p"   )>>8),"create fifo");
+chdir($_real);
+ok(-e "reg" ,"normal file exists");
+ok(-e "chr" ,"chrdev exists");
+ok(-e "blk" ,"blkdev exists");
+ok(-e "fifo","fifo exists");
+ok(-f "reg" ,"normal file is normal file");
+ok(-c "chr" ,"chrdev is chrdev");
+ok(-b "blk" ,"blkdev is blkdev");
+ok(-p "fifo","fifo is fifo");
+@stat = stat("chr");
+is($stat[6],3+(2<<8),"chrdev has right major,minor");
+@stat = stat("blk");
+is($stat[6],3+(2<<8),"blkdev has right major,minor");
+chdir($_point);
+ok(-e "reg" ,"normal file exists");
+ok(-e "chr" ,"chrdev exists");
+ok(-e "blk" ,"blkdev exists");
+ok(-e "fifo","fifo exists");
+ok(-f "reg" ,"normal file is normal file");
+ok(-c "chr" ,"chrdev is chrdev");
+ok(-b "blk" ,"blkdev is blkdev");
+ok(-p "fifo","fifo is fifo");
+@stat = stat("chr");
+is($stat[6],3+(2<<8),"chrdev has right major,minor");
+@stat = stat("blk");
+is($stat[6],3+(2<<8),"blkdev has right major,minor");
+map { unlink } qw(reg chr blk fifo);
diff --git a/perl/test/open.t b/perl/test/open.t
new file mode 100644
index 0000000..030dc1f
--- /dev/null
+++ b/perl/test/open.t
@@ -0,0 +1,10 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 1;
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(open(FILE,"file"),"open");
+close(FILE);
+unlink("file");
diff --git a/perl/test/read.t b/perl/test/read.t
new file mode 100644
index 0000000..5eca920
--- /dev/null
+++ b/perl/test/read.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(open(FILE,"file"),"open");
+my ($data) = <FILE>;
+close(FILE);
+is(length($data),5,"right amount read");
+is($data,"frog\n","right data read");
+unlink("file");
diff --git a/perl/test/readlink.t b/perl/test/readlink.t
new file mode 100644
index 0000000..85b9ffc
--- /dev/null
+++ b/perl/test/readlink.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+use test::helper qw($_point $_real);
+use Test::More;
+plan tests => 4;
+chdir($_real);
+ok(symlink("abc","def"),"OS supports symlinks");
+is(readlink("def"),"abc","OS supports symlinks");
+chdir($_point);
+ok(-l "def","symlink exists");
+is(readlink("def"),"abc","readlink");
+unlink("def");
diff --git a/perl/test/rename.t b/perl/test/rename.t
new file mode 100644
index 0000000..9fbb330
--- /dev/null
+++ b/perl/test/rename.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_point);
+system("echo hippity >frog");
+ok(-f "frog","exists");
+ok(!-f "toad","target file doesn't exist");
+ok(rename("frog","toad"),"rename");
+ok(!-f "frog","old file doesn't exist");
+ok(-f "toad","target file exists");
+unlink("toad");
diff --git a/perl/test/rmdir.t b/perl/test/rmdir.t
new file mode 100644
index 0000000..36f0378
--- /dev/null
+++ b/perl/test/rmdir.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_real);
+ok(mkdir("dir"),"mkdir");
+ok(-d "dir","dir really exists");
+chdir($_point);
+ok(-d "dir","dir exists");
+rmdir("dir");
+ok(! -d "dir","dir removed");
+chdir($_real);
+ok(! -d "dir","dir really removed");
diff --git a/perl/test/s/mount.t b/perl/test/s/mount.t
new file mode 100644
index 0000000..1deb2c4
--- /dev/null
+++ b/perl/test/s/mount.t
@@ -0,0 +1,26 @@
+#!/usr/bin/perl -w
+use test::helper qw($_point $_loop $_real $_pidfile);
+use strict;
+use Test::More tests => 4;
+ok(!(scalar grep(/ on $_point /,`cat /proc/mounts`)),"already mounted");
+ok(-f $_loop,"loopback exists");
+ok(-x $_loop,"loopback executable");
+
+if(!fork()) {
+	#close(STDIN);
+	close(STDOUT);
+	close(STDERR);
+	`echo $$ >test/s/mounted.pid`;
+	exec("perl $_loop $_point");
+	exit(1);
+}
+select(undef, undef, undef, 0.5);
+my ($success) = `cat /proc/mounts` =~ / $_point /;
+ok($success,"mount succeeded");
+system("rm -rf $_real");
+unless($success) {
+	kill('INT',`cat $_pidfile`);
+	unlink($_pidfile);
+} else {
+	mkdir($_real);
+}
diff --git a/perl/test/s/umount.t b/perl/test/s/umount.t
new file mode 100644
index 0000000..da60677
--- /dev/null
+++ b/perl/test/s/umount.t
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+use test::helper qw($_point $_real $_pidfile);
+use strict;
+use Test::More tests => 1;
+system("umount $_point");
+ok(1,"unmount");
+system("rm -rf $_real $_pidfile");
diff --git a/perl/test/statfs.t b/perl/test/statfs.t
new file mode 100644
index 0000000..fb94704
--- /dev/null
+++ b/perl/test/statfs.t
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+require 'syscall.ph'; # for SYS_statfs
+plan tests => 7;
+my ($statfs_data) = "    " x 10;
+my ($tmp) = $_point;
+ok(!syscall(&SYS_statfs,$tmp,$statfs_data),"statfs");
+# FIXME: this is soooooo linux-centric.  perhaps parse the output of /bin/df?
+my @list = unpack("LSSL8",$statfs_data);
+shift(@list);
+is(shift(@list),4096,"block size");
+shift(@list);
+is(shift(@list),1000000,"blocks");
+is(shift(@list),500000,"blocks free");
+shift(@list);
+is(shift(@list),1000000,"files");
+is(shift(@list),500000,"files free");
+shift(@list);
+shift(@list);
+is(shift(@list),255,"namelen");
diff --git a/perl/test/symlink.t b/perl/test/symlink.t
new file mode 100644
index 0000000..faf98e6
--- /dev/null
+++ b/perl/test/symlink.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+use test::helper qw($_point $_real);
+use Test::More;
+plan tests => 5;
+chdir($_point);
+ok(symlink("abc","def"),"symlink created");
+ok(-l "def","symlink exists");
+is(readlink("def"),"abc","it worked");
+chdir($_real);
+ok(-l "def","symlink really exists");
+is(readlink("def"),"abc","really worked");
+unlink("def");
diff --git a/perl/test/test-template b/perl/test/test-template
new file mode 100644
index 0000000..ef57e08
--- /dev/null
+++ b/perl/test/test-template
@@ -0,0 +1,5 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 1;
+ok(1);
diff --git a/perl/test/truncate.t b/perl/test/truncate.t
new file mode 100644
index 0000000..8607421
--- /dev/null
+++ b/perl/test/truncate.t
@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_point);
+system("echo hippity >womble");
+ok(-f "womble","exists");
+is(-s "womble",8,"right size");
+ok(truncate("womble",4),"truncate");
+ok(-f "womble","file exists");
+is(-s "womble",4,"right size");
+unlink("womble");
diff --git a/perl/test/unlink.t b/perl/test/unlink.t
new file mode 100644
index 0000000..eef8c1a
--- /dev/null
+++ b/perl/test/unlink.t
@@ -0,0 +1,14 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+chdir($_point);
+system("touch file");
+ok(-f "file","file exists");
+chdir($_real);
+ok(-f "file","file really exists");
+chdir($_point);
+unlink("file");
+ok(! -f "file","file unlinked");
+chdir($_real);
+ok(! -f "file","file really unlinked");
diff --git a/perl/test/utime.t b/perl/test/utime.t
new file mode 100644
index 0000000..0303907
--- /dev/null
+++ b/perl/test/utime.t
@@ -0,0 +1,13 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+my (@stat);
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(utime(1,2,"file"),"set utime");
+@stat = stat("file");
+is($stat[9],1,"atime");
+is($stat[10],2,"atime");
+unlink("file");
diff --git a/perl/test/write.t b/perl/test/write.t
new file mode 100644
index 0000000..58af2aa
--- /dev/null
+++ b/perl/test/write.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 15;
+my ($data);
+chdir($_point);
+undef $/; # slurp it all
+# create file
+system("echo frogbing >writefile");
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),9,"right amount read");
+is($data,"frogbing\n","right data read");
+
+# overwrite part
+ok(open(FILE,'+<',"writefile"),"open");
+ok(seek(FILE,2,0),"seek");
+ok(print(FILE "ib"),"print");
+close(FILE);
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),9,"right amount read");
+is($data,"fribbing\n","right data read");
+
+# overwrite part, append some
+ok(open(FILE,'+<',"writefile"),"open");
+ok(seek(FILE,7,0),"seek");
+ok(print(FILE "gle"),"print");
+close(FILE);
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),10,"right amount read");
+is($data,"fribbingle","right data read");
+
+# kill file
+unlink("writefile");