cassandane: support multiple output formats per run

cassandane/Cassandane/Unit/RunnerPretty.pm → cassandane/Cassandane/Unit/FormatPretty.pm

@@ -37,12 +37,12 @@
 #  OF THIS SOFTWARE.
 #
 
-package Cassandane::Unit::RunnerPretty;
+package Cassandane::Unit::FormatPretty;
 use strict;
 use warnings;
 
 use lib '.';
-use base qw(Cassandane::Unit::Runner);
+use base qw(Cassandane::Unit::Formatter);
 
 sub new
 {
@@ -66,7 +66,7 @@ sub new
 sub ansi
 {
     my ($self, $codes, @args) = @_;
-    my $isatty = -t $self->print_stream;
+    my $isatty = -t $self->{fh};
 
     my $ansi;
 
@@ -77,13 +77,6 @@ sub ansi
     return $ansi;
 }
 
-sub start_test
-{
-    my $self = shift;
-    my $test = shift;
-    # prevent the default action which is to print "."
-}
-
 sub add_pass
 {
     my $self = shift;
@@ -100,8 +93,6 @@ sub add_error
     my $self = shift;
     my $test = shift;
 
-    $self->record_failed($test);
-
     my $line = sprintf "%s %s\n",
                        $self->ansi([31], '[ERROR ]'),
                        _getname($test);
@@ -113,7 +104,6 @@ sub add_failure
     my $self = shift;
     my $test = shift;
 
-    $self->record_failed($test);
     my $line = sprintf "%s %s\n",
                        $self->ansi([33], '[FAILED]'),
                        _getname($test);
@@ -149,8 +139,8 @@ sub print_errors
     my $saved_output_stream;
     if ($self->{_quiet}) {
         if ($self->{_quiet_report_fh}) {
-            $saved_output_stream = $self->{_Print_stream};
-            $self->{_Print_stream} = $self->{_quiet_report_fh};
+            $saved_output_stream = $self->{fh};
+            $self->{fh} = $self->{_quiet_report_fh};
         }
         else {
             return;
@@ -178,7 +168,7 @@ sub print_errors
     }
 
     if ($saved_output_stream) {
-        $self->{_Print_stream} = $saved_output_stream;
+        $self->{fh} = $saved_output_stream;
     }
 }
 
@@ -189,8 +179,8 @@ sub print_failures
     my $saved_output_stream;
     if ($self->{_quiet}) {
         if ($self->{_quiet_report_fh}) {
-            $saved_output_stream = $self->{_Print_stream};
-            $self->{_Print_stream} = $self->{_quiet_report_fh};
+            $saved_output_stream = $self->{fh};
+            $self->{fh} = $self->{_quiet_report_fh};
         }
         else {
             return;
@@ -218,7 +208,7 @@ sub print_failures
     }
 
     if ($saved_output_stream) {
-        $self->{_Print_stream} = $saved_output_stream;
+        $self->{fh} = $saved_output_stream;
     }
 }
 

cassandane/Cassandane/Unit/FormatTAP.pm

@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+#
+#  Copyright (c) 2011-2017 FastMail Pty Ltd. All rights reserved.
+#
+#  Redistribution and use in source and binary forms, with or without
+#  modification, are permitted provided that the following conditions
+#  are met:
+#
+#  1. Redistributions of source code must retain the above copyright
+#     notice, this list of conditions and the following disclaimer.
+#
+#  2. Redistributions in binary form must reproduce the above copyright
+#     notice, this list of conditions and the following disclaimer in
+#     the documentation and/or other materials provided with the
+#     distribution.
+#
+#  3. The name "Fastmail Pty Ltd" must not be used to
+#     endorse or promote products derived from this software without
+#     prior written permission. For permission or any legal
+#     details, please contact
+#      FastMail Pty Ltd
+#      PO Box 234
+#      Collins St West 8007
+#      Victoria
+#      Australia
+#
+#  4. Redistributions of any form whatsoever must retain the following
+#     acknowledgment:
+#     "This product includes software developed by Fastmail Pty. Ltd."
+#
+#  FASTMAIL PTY LTD DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
+#  INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY  AND FITNESS, IN NO
+#  EVENT SHALL OPERA SOFTWARE AUSTRALIA BE LIABLE FOR ANY SPECIAL, INDIRECT
+#  OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
+#  USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+#  TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
+#  OF THIS SOFTWARE.
+#
+
+package Cassandane::Unit::FormatTAP;
+use strict;
+use warnings;
+use Data::Dumper;
+use IO::File;
+
+use lib '.';
+use base qw(Cassandane::Unit::Formatter);
+
+sub new
+{
+    my ($class, $fh) = @_;
+    return $class->SUPER::new($fh);
+}
+
+sub start_test
+{
+    my ($self, $test) = @_;
+    $self->_print('.');
+}
+
+sub add_error
+{
+    my ($self, $test, $exception) = @_;
+    $self->_print('E');
+}
+
+sub add_failure
+{
+    my ($self, $test, $exception) = @_;
+    $self->_print('F');
+}
+
+1;

cassandane/Cassandane/Unit/RunnerXML.pm → cassandane/Cassandane/Unit/FormatXML.pm

@@ -37,47 +37,34 @@
 #  OF THIS SOFTWARE.
 #
 
-package Cassandane::Unit::RunnerXML;
+package Cassandane::Unit::FormatXML;
+use strict;
+use warnings;
+use vars qw($VERSION);
 
 use XML::Generator;
 use Time::HiRes qw(time);
 use Sys::Hostname;
 use POSIX qw(strftime);
 
-use strict;
-use warnings;
-use vars qw($VERSION);
-# XXX should this inherit from our own Cassandane::Unit::Runner?
-use base qw(Test::Unit::Runner);
+use lib '.';
+use base qw(Cassandane::Unit::Formatter);
 
-# $Id: XML.pm 27 2004-08-24 11:22:24Z andrew $
 $VERSION = '0.1';
 
 sub new {
-    my ($class, $directory, $generator) = @_;
+    my ($class, $params, @args) = @_;
 
-    $generator ||= XML::Generator->new(escape => 'always', pretty => 2);
+    my $self = $class->SUPER::new(@args);
 
-    return bless({directory => $directory, gen => $generator,
-                  all_tests_passed => 1,
-                  classrecs => {}},
-                 $class);
-}
+    $params->{generator} ||= XML::Generator->new(escape => 'always',
+                                                 pretty => 2);
 
-sub all_tests_passed {
-    my ($self) = @_;
-
-    return $self->{all_tests_passed};
-}
+    $self->{directory} = $params->{directory};
+    $self->{gen} = $params->{generator};
+    $self->{classrecs} = {};
 
-sub start {
-    my ($self, $suite) = @_;
-
-    my $result = $self->create_test_result();
-    $result->add_listener($self);
-    my $start_time = time();
-    $suite->run($result, $self);
-    $self->_emit_xml();
+    return $self;
 }
 
 sub _classrec {
@@ -98,8 +85,6 @@ sub _testrec {
                 { start_time => 0, node => undef, child_nodes => [] };
 }
 
-sub add_pass {}
-
 sub _extype
 {
     my ($exception) = @_;
@@ -115,7 +100,6 @@ sub add_failure {
     my $cr = $self->_classrec($test);
     my $tr = $self->_testrec($test);
     $cr->{failures}++;
-    $self->{all_tests_passed} = 0;
     push(@{$tr->{child_nodes}},
          $self->{gen}->failure({type => _extype($exception),
                                 message => $exception->get_message()},
@@ -128,7 +112,6 @@ sub add_error {
     my $cr = $self->_classrec($test);
     my $tr = $self->_testrec($test);
     $cr->{errors}++;
-    $self->{all_tests_passed} = 0;
     push(@{$tr->{child_nodes}},
          $self->{gen}->error({type => _extype($exception),
                               message => $exception->get_message()},
@@ -197,6 +180,16 @@ sub _emit_xml {
     }
 }
 
+sub finished
+{
+    my ($self, $result, $start_time, $end_time) = @_;
+
+    # XXX This class does all its own accounting, which is probably
+    # XXX redundant since it doesn't report anything that it couldn't
+    # XXX just get from the usual $result/$start_time/$end_time args.
+    $self->_emit_xml();
+}
+
 sub _xml_filename {
     my ($self, $class) = @_;
 
@@ -205,72 +198,3 @@ sub _xml_filename {
 }
 
 1;
-
-__END__
-
-
-=head1 NAME
-
-Test::Unit::Runner::XML - Generate XML reports from unit test results
-
-=head1 SYNOPSIS
-
-    use Test::Unit::Runner::XML;
-
-    mkdir("test_reports");
-    my $runner = Test::Unit::Runner::XML->new("test-reports");
-    $runner->start($test);
-    exit(!$runner->all_tests_passed());
-
-=head1 DESCRIPTION
-
-Test::Unit::Runner::XML generates XML reports from unit test results. The
-reports are in the same format as those produced by Ant's JUnit task,
-allowing them to be used with Java continuous integration and reporting tools.
-
-=head1 CONSTRUCTOR
-
-    Test::Unit::Runner::XML->new($directory)
-
-Construct a new runner that will write XML reports into $directory
-
-=head1 METHODS
-
-=head2 start
-
-    $runner->start($test);
-
-Run the L<Test::Unit::Test> $test and generate XML reports from the results.
-
-=head2 all_tests_passed
-
-    exit(!$runner->all_tests_passed());
-
-Return true if all tests executed by $runner since it was constructed passed.
-
-=head1 AUTHOR
-
-Copyright (c) 2004 Andrew Eland, E<lt>[email protected]<gt>.
-
-All rights reserved. This program is free software; you can
-redistribute it and/or modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-=over 4
-
-=item *
-
-L<Test::Unit>
-
-=item *
-
-L<Test::Unit::TestRunner>
-
-=item *
-
-The Ant JUnit task, http://ant.apache.org/
-
-=cut
-
-