subunit: Also import copies of filters and perl module.

4 files changed, 298 insertions, 0 deletions

diff --git a/lib/subunit/perl/Makefile.PL.in b/lib/subunit/perl/Makefile.PL.in
new file mode 100755
index 0000000000..26e1c181f0
--- /dev/null
+++ b/lib/subunit/perl/Makefile.PL.in
@@ -0,0 +1,20 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    'INSTALL_BASE' => '@prefix@',
+    'NAME'	=> 'Subunit',
+    'VERSION' => '@SUBUNIT_VERSION@',
+    'test' => { 'TESTS' => 'tests/*.pl' },
+    'PMLIBDIRS' => [ 'lib' ],
+    'EXE_FILES' => [ '@abs_srcdir@/subunit-diff' ],
+);
+sub MY::postamble {
+<<'EOT';
+check: # test
+
+uninstall_distcheck:
+	rm -fr $(DESTINSTALLARCHLIB)
+
+VPATH = @srcdir@
+.PHONY: uninstall_distcheck
+EOT
+}
diff --git a/lib/subunit/perl/lib/Subunit.pm b/lib/subunit/perl/lib/Subunit.pm
new file mode 100644
index 0000000000..05206748e2
--- /dev/null
+++ b/lib/subunit/perl/lib/Subunit.pm
@@ -0,0 +1,162 @@
+# Perl module for parsing and generating the Subunit protocol
+# Copyright (C) 2008-2009 Jelmer Vernooij <jelmer@samba.org>
+#
+#  Licensed under either the Apache License, Version 2.0 or the BSD 3-clause
+#  license at the users choice. A copy of both licenses are available in the
+#  project source as Apache-2.0 and BSD. You may not use this file except in
+#  compliance with one of these two licences.
+#  
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under these licenses is distributed on an "AS IS" BASIS, WITHOUT
+#  WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.  See the
+#  license you chose for the specific language governing permissions and
+#  limitations under that license.
+
+package Subunit;
+use POSIX;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(parse_results $VERSION);
+
+use vars qw ( $VERSION );
+
+$VERSION = '0.0.2';
+
+use strict;
+
+sub parse_results($$$)
+{
+	my ($msg_ops, $statistics, $fh) = @_;
+	my $expected_fail = 0;
+	my $unexpected_fail = 0;
+	my $unexpected_err = 0;
+	my $open_tests = [];
+
+	while(<$fh>) {
+		if (/^test: (.+)\n/) {
+			$msg_ops->control_msg($_);
+			$msg_ops->start_test($1);
+			push (@$open_tests, $1);
+		} elsif (/^time: (\d+)-(\d+)-(\d+) (\d+):(\d+):(\d+)Z\n/) {
+			$msg_ops->report_time(mktime($6, $5, $4, $3, $2, $1-1900));
+		} elsif (/^(success|successful|failure|fail|skip|knownfail|error|xfail): (.*?)( \[)?([ \t]*)\n/) {
+			$msg_ops->control_msg($_);
+			my $result = $1;
+			my $testname = $2;
+			my $reason = undef;
+			if ($3) {
+				$reason = "";
+				# reason may be specified in next lines
+				my $terminated = 0;
+				while(<$fh>) {
+					$msg_ops->control_msg($_);
+					if ($_ eq "]\n") { $terminated = 1; last; } else { $reason .= $_; }
+				}
+				
+				unless ($terminated) {
+					$statistics->{TESTS_ERROR}++;
+					$msg_ops->end_test($testname, "error", 1, "reason ($result) interrupted");
+					return 1;
+				}
+			}
+			if ($result eq "success" or $result eq "successful") {
+				pop(@$open_tests); #FIXME: Check that popped value == $testname 
+				$statistics->{TESTS_EXPECTED_OK}++;
+				$msg_ops->end_test($testname, $result, 0, $reason);
+			} elsif ($result eq "xfail" or $result eq "knownfail") {
+				pop(@$open_tests); #FIXME: Check that popped value == $testname
+				$statistics->{TESTS_EXPECTED_FAIL}++;
+				$msg_ops->end_test($testname, $result, 0, $reason);
+				$expected_fail++;
+			} elsif ($result eq "failure" or $result eq "fail") {
+				pop(@$open_tests); #FIXME: Check that popped value == $testname
+				$statistics->{TESTS_UNEXPECTED_FAIL}++;
+				$msg_ops->end_test($testname, $result, 1, $reason);
+				$unexpected_fail++;
+			} elsif ($result eq "skip") {
+				$statistics->{TESTS_SKIP}++;
+				my $last = pop(@$open_tests);
+				if (defined($last) and $last ne $testname) {
+					push (@$open_tests, $testname);
+				}
+				$msg_ops->end_test($testname, $result, 0, $reason);
+			} elsif ($result eq "error") {
+				$statistics->{TESTS_ERROR}++;
+				pop(@$open_tests); #FIXME: Check that popped value == $testname
+				$msg_ops->end_test($testname, $result, 1, $reason);
+				$unexpected_err++;
+			} 
+		} else {
+			$msg_ops->output_msg($_);
+		}
+	}
+
+	while ($#$open_tests+1 > 0) {
+		$msg_ops->end_test(pop(@$open_tests), "error", 1,
+				   "was started but never finished!");
+		$statistics->{TESTS_ERROR}++;
+		$unexpected_err++;
+	}
+
+	return 1 if $unexpected_err > 0;
+	return 1 if $unexpected_fail > 0;
+	return 0;
+}
+
+sub start_test($)
+{
+	my ($testname) = @_;
+	print "test: $testname\n";
+}
+
+sub end_test($$;$)
+{
+	my $name = shift;
+	my $result = shift;
+	my $reason = shift;
+	if ($reason) {
+		print "$result: $name [\n";
+		print "$reason";
+		print "]\n";
+	} else {
+		print "$result: $name\n";
+	}
+}
+
+sub skip_test($;$)
+{
+	my $name = shift;
+	my $reason = shift;
+	end_test($name, "skip", $reason);
+}
+
+sub fail_test($;$)
+{
+	my $name = shift;
+	my $reason = shift;
+	end_test($name, "fail", $reason);
+}
+
+sub success_test($;$)
+{
+	my $name = shift;
+	my $reason = shift;
+	end_test($name, "success", $reason);
+}
+
+sub xfail_test($;$)
+{
+	my $name = shift;
+	my $reason = shift;
+	end_test($name, "xfail", $reason);
+}
+
+sub report_time($)
+{
+	my ($time) = @_;
+	my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime($time);
+	printf "time: %04d-%02d-%02d %02d:%02d:%02dZ\n", $year+1900, $mon, $mday, $hour, $min, $sec;
+}
+
+1;
diff --git a/lib/subunit/perl/lib/Subunit/Diff.pm b/lib/subunit/perl/lib/Subunit/Diff.pm
new file mode 100644
index 0000000000..e7841c3b00
--- /dev/null
+++ b/lib/subunit/perl/lib/Subunit/Diff.pm
@@ -0,0 +1,85 @@
+#!/usr/bin/perl
+# Diff two subunit streams
+# Copyright (C) Jelmer Vernooij <jelmer@samba.org>
+#
+#  Licensed under either the Apache License, Version 2.0 or the BSD 3-clause
+#  license at the users choice. A copy of both licenses are available in the
+#  project source as Apache-2.0 and BSD. You may not use this file except in
+#  compliance with one of these two licences.
+#  
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under these licenses is distributed on an "AS IS" BASIS, WITHOUT
+#  WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.  See the
+#  license you chose for the specific language governing permissions and
+#  limitations under that license.
+
+package Subunit::Diff;
+
+use strict;
+
+use Subunit qw(parse_results);
+
+sub control_msg() { }
+sub report_time($$) { }
+
+sub output_msg($$)
+{
+	my ($self, $msg) = @_;
+
+	# No output for now, perhaps later diff this as well ?
+}
+
+sub start_test($$)
+{
+	my ($self, $testname) = @_;
+}
+
+sub end_test($$$$$)
+{
+	my ($self, $testname, $result, $unexpected, $reason) = @_;
+
+	$self->{$testname} = $result;
+}
+
+sub new {
+	my ($class) = @_;
+
+	my $self = { 
+	};
+	bless($self, $class);
+}
+
+sub from_file($)
+{
+	my ($path) = @_;
+	my $statistics = {
+		TESTS_UNEXPECTED_OK => 0,
+		TESTS_EXPECTED_OK => 0,
+		TESTS_UNEXPECTED_FAIL => 0,
+		TESTS_EXPECTED_FAIL => 0,
+		TESTS_ERROR => 0,
+		TESTS_SKIP => 0,
+	};
+
+	my $ret = new Subunit::Diff();
+	open(IN, $path) or return;
+	parse_results($ret, $statistics, *IN);
+	close(IN);
+	return $ret;
+}
+
+sub diff($$)
+{
+	my ($old, $new) = @_;
+	my $ret = {};
+
+	foreach my $testname (keys %$old) {
+		if ($new->{$testname} ne $old->{$testname}) {
+			$ret->{$testname} = [$old->{$testname}, $new->{$testname}];
+		}
+	}
+
+	return $ret;
+}
+
+1;
diff --git a/lib/subunit/perl/subunit-diff b/lib/subunit/perl/subunit-diff
new file mode 100755
index 0000000000..581e832ae3
--- /dev/null
+++ b/lib/subunit/perl/subunit-diff
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+# Diff two subunit streams
+# Copyright (C) Jelmer Vernooij <jelmer@samba.org>
+#
+#  Licensed under either the Apache License, Version 2.0 or the BSD 3-clause
+#  license at the users choice. A copy of both licenses are available in the
+#  project source as Apache-2.0 and BSD. You may not use this file except in
+#  compliance with one of these two licences.
+#  
+#  Unless required by applicable law or agreed to in writing, software
+#  distributed under these licenses is distributed on an "AS IS" BASIS, WITHOUT
+#  WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.  See the
+#  license you chose for the specific language governing permissions and
+#  limitations under that license.
+
+use Getopt::Long;
+use strict;
+use FindBin qw($RealBin $Script);
+use lib "$RealBin/lib";
+use Subunit::Diff;
+
+my $old = Subunit::Diff::from_file($ARGV[0]);
+my $new = Subunit::Diff::from_file($ARGV[1]);
+
+my $ret = Subunit::Diff::diff($old, $new);
+
+foreach my $e (sort(keys %$ret)) {
+	printf "%s: %s -> %s\n", $e, $ret->{$e}[0], $ret->{$e}[1];
+}
+
+0;