Basic testing framework.

Signed-off-by: Peter Hutterer <peter.hutterer@who-t.net>

4 files changed, 536 insertions, 0 deletions

diff --git a/ILTest/Error.pm b/ILTest/Error.pm
new file mode 100644
index 0000000..38bd6f0
--- /dev/null
+++ b/ILTest/Error.pm
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+# Copyright © 2011 by Red Hat, Inc.
+#                                                                            
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software 
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# 
+# Authors: Peter Hutterer <peter.hutterer@redhat.com>
+
+
+# Generic test error class.
+
+package ILTest::Error;
+
+use warnings;
+use strict;
+
+# Instance methods
+sub new {
+	my $class = shift;
+	my $self = {@_};
+	bless ($self, $class);
+
+	return $self;
+}
+
+sub msg {
+	my $self = shift;
+	my $msg = shift;
+
+	$self->{msg} = $msg if defined $msg;
+	return $self->{msg};
+}
+
+
+1;
+# vim: set noexpandtab shiftwidth=8 tabstop=8:
diff --git a/ILTest/ILTest.pm b/ILTest/ILTest.pm
new file mode 100644
index 0000000..01ff3a9
--- /dev/null
+++ b/ILTest/ILTest.pm
@@ -0,0 +1,297 @@
+#!/usr/bin/perl
+
+# Copyright © 2011 by Red Hat, Inc.
+#                                                                            
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software 
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# 
+# Authors: Peter Hutterer <peter.hutterer@redhat.com>
+
+
+=head1 NAME
+
+ILtest::ILTest - main ILTest controller module
+
+=head1 SYNOPSIS
+
+It is recommended that ILTest runs are executed through the C<iltest>
+command which provides some wrappers for commonly used options.
+
+	use ILTest::ILTest;
+
+	$iltest = ILTest::ILTest->new(testee => "Some::Class",
+				      tester => "Other::Class");
+	$iltest->run();
+
+
+=head1 DESCRIPTION
+
+ILTest stands for InterLeaved Testing. It is designed to provide for testing
+of two different entities against each other. A C<testee> is the primary
+program to be tested, and a C<tester> is run against it.
+
+This module contains various utility functions used by tests.
+
+=cut
+package ILTest::ILTest;
+
+use ILTest::TestCase;
+use ILTest::Error;
+use Module::Load;
+use Data::Dumper;
+use File::Copy;
+use File::Temp;
+use lib "../";
+
+use warnings;
+use strict;
+
+sub new {
+	my $class = shift;
+	my $self = {@_};
+	bless ($self, $class);
+
+	$self->{verbosity} = 0 if (not defined $self->{verbosity});
+	if (not $self->{testee} or not $self->{tester}) {
+		$self->error("Invalid tester/testee\n");
+		return undef;
+	}
+
+	$self->println(10, "Testee: $self->{testee} vs Tester: $self->{tester}");
+
+	return $self;
+}
+
+###########################################
+# 	   UTILITY FUNCTIONS              #
+###########################################
+
+=head2 B<$iltest-E<gt>println($level, $message)>
+
+Print $message, automatically terminated by \n with verbosity $level.
+If $level is below $iltest's verbosity, nothing will be printed.
+
+=cut
+sub println {
+	my $self = shift;
+	my $level = shift;
+	my $msg = shift;
+
+	$self->print($level, $msg . "\n");
+}
+
+=head2 B<$iltest-E<gt>print($level, $message)>
+
+Print $message with verbosity $level.
+If $level is below $iltest's verbosity, nothing will be printed.
+
+=cut
+sub print {
+	my $self = shift;
+	my $level = shift;
+	my $msg = shift;
+
+	print "($level) $msg" if ($level <= $self->{verbosity});
+}
+
+=head2 B<$iltest-E<gt>error($message)>
+
+Print an error $message.
+
+=cut
+sub error {
+	my $self = shift;
+	my $msg = shift;
+
+	$self->print(0, "(EE) ".$msg);
+}
+
+=head2 B<$iltest-E<gt>file_backup($path)>
+
+Back up file $path to some other location so it can be restored later.
+Backing up a file also removes it from the current location, so a simple
+backup call is enough to get rid of unwanted files.
+
+Returns the temporary storage path for this file.
+
+=cut
+sub file_backup {
+	my $self = shift;
+	my $path = shift;
+	my $tmp;
+
+	return undef if (not $path or not -e $path);
+
+	if (not defined $self->{backups}) {
+		my $tmpdir = File::Temp::tempdir("/tmp/.iltest-XXXX", CLEANUP => 1);
+		$self->{backups} = { _tmpdir => $tmpdir };
+		$self->println(10, "Using backup dir $tmpdir");
+	}
+
+	my $template = $path;
+	$template =~ s|/|___|g;
+	(my $fh, $tmp) = File::Temp::tempfile("$template.XXXX",
+					      DIR => $self->{backups}->{_tmpdir});
+
+	File::Copy::move($path, $tmp);
+	$self->{backups}->{$path} = $tmp;
+	return $tmp;
+}
+
+=head2 B<$iltest-E<gt>file_restore([$path])>
+
+If a path is given, restore that file to the previous position. Otherwise,
+restore all previously backed up files to their previous position.
+
+=cut
+
+sub file_restore {
+	my $self = shift;
+	my $path = shift;
+
+	return if (not defined $self->{backups});
+
+
+	if (defined $path and $self->{backups}->{$path}) {
+		File::Copy::move($self->{backups}->{$path}, $path);
+		delete $self->{backups}->{$path};
+		return;
+	} else {
+		for (keys %{$self->{backups}}) {
+			next if $_ eq "_tmpdir";
+			File::Copy::move($self->{backups}->{$_}, $_);
+			delete $self->{backups}->{$_};
+		}
+	}
+
+}
+
+
+###########################################
+# 	END OF UTILITY FUNCTIONS          #
+###########################################
+
+=head2 B<$iltest-E<gt>testee>
+
+Return the ILTest::TestCase Testee for this test.
+
+=cut
+sub testee {
+	my $self = shift;
+
+	if (not $self->{testee_ref}) {
+		load $self->{testee};
+		$self->{testee_ref} = $self->{testee}->new(iltest => $self);
+	}
+
+	return $self->{testee_ref};
+}
+
+=head2 B<$iltest-E<gt>tester>
+
+Return the ILTest::TestCase Tester for this test.
+
+=cut
+sub tester {
+	my $self = shift;
+
+	if (not $self->{tester_ref}) {
+		load $self->{tester};
+		$self->{tester_ref} = $self->{tester}->new(iltest => $self);
+	}
+
+	return $self->{tester_ref};
+}
+
+sub _stage_pre() {
+	my $self = shift;
+	my $testee = $self->testee;
+	my $tester = $self->tester;
+	my $error;
+
+	$self->println(5, "STAGE PRE: $self->{testee}");
+
+	$error = $testee->pre();
+	if ($error) {
+		$self->error($error->msg);
+		return 0;
+	}
+
+	$self->println(5, "STAGE PRE: $self->{tester}");
+
+	$error = $tester->pre();
+	if ($error) {
+		$self->error($error->msg);
+		return 0;
+	}
+	return 1;
+}
+
+sub _stage_run() {
+	my $self = shift;
+	my $testee = $self->testee;
+	my $tester = $self->tester;
+	my $error;
+
+	$self->println(5, "STAGE RUN: $self->{testee}");
+
+	$error = $testee->run();
+	if ($error) {
+		$self->error($error->msg);
+		return 0;
+	}
+
+	$self->println(5, "STAGE RUN: $self->{tester}");
+
+	$error = $tester->run();
+	if ($error) {
+		$self->error($error->msg);
+		return 0;
+	}
+	return 1;
+}
+
+sub _stage_post() {
+	my $self = shift;
+	my $testee = $self->testee;
+	my $tester = $self->tester;
+
+	$self->println(5, "STAGE POST: $self->{testee}");
+	$testee->post();
+	$self->println(5, "STAGE POST: $self->{tester}");
+	$tester->post();
+}
+
+=head2 B<$iltest-E<gt>test>
+
+Run the test.
+
+Returns 0 on failure or 1 on success.
+
+=cut
+sub test {
+	my $self = shift;
+	my $rc;
+
+	if (not $self->_stage_pre) {
+		return 0;
+	}
+
+	$rc = $self->_stage_run;
+	$self->_stage_post;
+	return $rc;
+}
+
+1;
+# vim: set noexpandtab shiftwidth=8 tabstop=8:
diff --git a/ILTest/TestCase.pm b/ILTest/TestCase.pm
new file mode 100644
index 0000000..c8eb212
--- /dev/null
+++ b/ILTest/TestCase.pm
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+
+# Copyright © 2011 by Red Hat, Inc.
+#                                                                            
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software 
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# 
+# Authors: Peter Hutterer <peter.hutterer@redhat.com>
+
+
+=head1 NAME
+
+ILtest::TestCase - ILTest parent test class 
+
+
+=head1 DESCRIPTION
+
+This module is the main interface for test cases.
+
+=cut
+
+package ILTest::TestCase;
+
+use warnings;
+use strict;
+
+sub new {
+	my $class = shift;
+	my $self = {@_};
+	$self->{parameters} = {};
+	bless ($self, $class);
+	return $self;
+}
+
+=head2 B<$test-E<gt>iltest>
+
+Returns the associated ILTest instance.
+
+=cut
+sub iltest {
+	my $self = shift;
+	return $self->{iltest};
+}
+
+=head2 B<$test-E<gt>parameters(\%parameters)>
+
+Returns a refernce to the parameters hash set for this test. The parameters
+are test-specific.
+
+=cut
+sub parameters {
+	my $self = shift;
+	my $pref = shift;
+
+	$self->{parameters} = \%{$pref} if $pref;
+
+	return $self->{parameters};
+}
+
+=head2 B<$test-E<gt>pre>
+
+Pre-testing setup. Override this function set up the environment before
+the test is run.
+
+If this function fails, the test counts as failed and stages C<run> and C<post>
+are not called.
+If this function succeeds, stage C<post> will be called.
+
+Return undef on success or an ILTest::Error on failure.
+=cut
+sub pre {
+	my $self = shift;
+	return undef;
+}
+
+=head2 B<$test-E<gt>run>
+
+Test run. Override this function to test.
+
+If this function fails, the test counts as failed. Stage C<post> will be
+called regardless of the return value.
+
+Return undef on success or an ILTest::Error on failure.
+
+=cut
+sub run {
+	my $self = shift;
+	return undef;
+}
+
+=head2 B<$test-E<gt>post>
+
+Post-test cleanup. Override this function to restore the environment
+before the test is run.
+
+Return undef on success or an ILTest::Error on failure.
+=cut
+sub post {
+	my $self = shift;
+	return undef;
+}
+
+1;
+# vim: set noexpandtab shiftwidth=8 tabstop=8:
diff --git a/iltest b/iltest
new file mode 100755
index 0000000..955fccc
--- /dev/null
+++ b/iltest
@@ -0,0 +1,76 @@
+#!/usr/bin/perl
+
+# Copyright © 2011 by Red Hat, Inc.
+#                                                                            
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software 
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+# 
+# Authors: Peter Hutterer <peter.hutterer@redhat.com>
+
+
+use ILTest::ILTest;
+use Getopt::Long;
+
+use warnings;
+use strict;
+
+=head1 NAME
+
+iltest - interleaved testing tool.
+
+=head1 DESCRIPTION
+
+The C<iltest> command provides simple testing of two different entities
+against each other. A C<testee> is the primary program to be tested, and a
+C<tester> is run against it.
+
+=head1 SYNOPSIS
+
+	# Run a tester C<bar> against a testee C<foo>
+	$ iltest foo bar
+=cut
+
+sub usage () {
+	print "Usage: $0 [options] <testee> <tester>\n";
+	print "Options:\n";
+	print "	--verbose	be verbose, very verbose\n";
+	print "	--quiet		don't print anything but test results\n";
+	exit(1);
+}
+
+my $verbosity = "5";
+my $quiet = "";
+
+GetOptions("verbose=i" => \$verbosity,
+	   "quiet" => \$quiet);
+
+$verbosity = 0 if ($quiet);
+
+my $testee = shift;
+my $tester = shift;
+
+usage() if (not $testee or not $tester);
+
+my $iltest = ILTest::ILTest->new(testee => $testee,
+				 tester => $tester,
+				 verbosity => $verbosity);
+my $rc = $iltest->test();
+if ($rc) {
+	print "Test failed with code $rc\n";
+} else {
+	print "Test succeeded\n";
+}
+exit($rc);
+
+# vim: set noexpandtab shiftwidth=8 tabstop=8: