From 197c98292bd838e27da6692ba8e7984f12a66fef Mon Sep 17 00:00:00 2001 From: Jelmer Vernooij Date: Tue, 30 Mar 2010 15:03:41 +0200 Subject: subunit: Also import copies of filters and perl module. --- lib/subunit/perl/Makefile.PL.in | 20 +++++ lib/subunit/perl/lib/Subunit.pm | 162 +++++++++++++++++++++++++++++++++++ lib/subunit/perl/lib/Subunit/Diff.pm | 85 ++++++++++++++++++ lib/subunit/perl/subunit-diff | 31 +++++++ 4 files changed, 298 insertions(+) create mode 100755 lib/subunit/perl/Makefile.PL.in create mode 100644 lib/subunit/perl/lib/Subunit.pm create mode 100644 lib/subunit/perl/lib/Subunit/Diff.pm create mode 100755 lib/subunit/perl/subunit-diff (limited to 'lib/subunit/perl') 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 +# +# 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 +# +# 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 +# +# 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; -- cgit