| Subject: | [PATCH] implement verbose level 2 |
This patch implements verbose level 2, at which there is a diag output
line for each test within the test group, including nested groups.
| Subject: | test-group-verbose.patch |
diff -Nurd Test-Group-0.14.orig/lib/Test/Group.pm Test-Group-0.14/lib/Test/Group.pm
--- Test-Group-0.14.orig/lib/Test/Group.pm 2008-09-12 18:05:23.000000000 +0200
+++ Test-Group-0.14/lib/Test/Group.pm 2009-10-18 18:02:44.000000000 +0200
@@ -491,8 +491,9 @@
=head2 verbose ($level)
-Sets verbosity level to $level, where 0 means quietest. For now only 0
-and 1 are implemented.
+Sets verbosity level to $level, where 0 means quietest. At level 1
+there is a diag line for each test group, at level 2 there is diag
+output for each test run within the groups.
=cut
@@ -736,6 +737,13 @@
$result->{todo} = $todo if defined($todo);
push @{$self->{subtests}}, $result;
+ if ($classstate_verbose and $classstate_verbose >= 2) {
+ my $line = ($status ? '' : 'not ') . 'ok ';
+ $line .= $self->_fully_qualified_test_number;
+ $line .= " $testname" if defined $testname;
+ $T->diag($line);
+ }
+
# Report failures only, as Test::Builder would
if( ! $status && ! $self->mute ) {
my $msg = $todo ? "Failed (TODO)" : "Failed";
@@ -1007,6 +1015,27 @@
1;
}
+=head3 _fully_qualified_test_number ()
+
+Returns the compound number of the current test, fully qualified
+from the outer L<Test::Builder> test down into the current test
+group, with numbers joined with dots.
+
+=cut
+
+sub _fully_qualified_test_number {
+ my $self = shift;
+
+ my @nums;
+ my $runner = $self->current;
+ while ($runner) {
+ unshift @nums, 1+scalar $runner->subtests;
+ $runner = $runner->{parent};
+ }
+ --$nums[-1] if @nums;
+ return join '.', 1+Test::Builder->new->current_test, @nums;
+}
+
=head3 _run_with_local_TODO ($callerpackage, $sub)
Invokes the test sub $sub while temporarily setting the variable
diff -Nurd Test-Group-0.14.orig/t/60-verbose2.t Test-Group-0.14/t/60-verbose2.t
--- Test-Group-0.14.orig/t/60-verbose2.t 1970-01-01 02:00:00.000000000 +0200
+++ Test-Group-0.14/t/60-verbose2.t 2009-10-18 17:58:46.000000000 +0200
@@ -0,0 +1,166 @@
+#!/usr/bin/perl -w
+# -*- coding: utf-8; -*-
+
+=head1 NAME
+
+60-verbose2.t - Testing Test::Group with C<verbose> set to 2.
+
+=cut
+
+use Test::More tests => 7;
+use lib "t/lib";
+use testlib;
+
+use strict;
+use warnings;
+
+ok(my $perl = perl_cmd);
+
+is $perl->run(stdin => <<'EOSCRIPT') >> 8, 0, "passing verbose";
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Group;
+
+Test::Group->verbose(2);
+
+ok 1, "pre";
+
+test foo => sub {
+ ok 1, "foo one";
+ ok 1, "foo two";
+};
+
+test bar => sub {
+ ok 1, "bar one";
+ ok 1, "bar two";
+ ok_foobarbaz("foobarbaz", "woo woo");
+};
+
+ok 1, "post";
+
+sub ok_foobarbaz {
+ my ($thing, $name) = @_;
+ $name ||= 'ok_foobarbaz';
+
+ test $name => sub {
+ like $thing, qr/foo/, "$name like foo";
+ ok_bar($thing, "$name like bar");
+ like $thing, qr/baz/, "$name like baz";
+ };
+}
+
+sub ok_bar {
+ my ($thing, $name) = @_;
+ $name ||= 'ok_bar';
+
+ test $name => sub {
+ like $thing, qr/b/, "$name like b";
+ like $thing, qr/a/, "$name like a";
+ like $thing, qr/r/, "$name like r";
+ };
+}
+EOSCRIPT
+is scalar($perl->stdout()), <<EOOUT, "passing out";
+1..4
+ok 1 - pre
+ok 2 - foo
+ok 3 - bar
+ok 4 - post
+EOOUT
+is scalar($perl->stderr()), <<EOERR, "passing err";
+# Running group of tests - foo
+# ok 2.1 foo one
+# ok 2.2 foo two
+# Running group of tests - bar
+# ok 3.1 bar one
+# ok 3.2 bar two
+# Running group of tests - woo woo
+# ok 3.3.1 woo woo like foo
+# Running group of tests - woo woo like bar
+# ok 3.3.2.1 woo woo like bar like b
+# ok 3.3.2.2 woo woo like bar like a
+# ok 3.3.2.3 woo woo like bar like r
+# ok 3.3.2 woo woo like bar
+# ok 3.3.3 woo woo like baz
+# ok 3.3 woo woo
+EOERR
+
+
+ok $perl->run(stdin => <<'EOSCRIPT') >> 8, "failing verbose";
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Group;
+
+Test::Group->verbose(2);
+
+ok 1, "pre";
+
+test foo => sub {
+ ok 1, "foo one";
+ ok 1, "foo two";
+};
+
+test bar => sub {
+ ok 1, "bar one";
+ ok 1, "bar two";
+ ok_foobarbaz("foobarbaz", "woo woo");
+};
+
+ok 1, "post";
+
+sub ok_foobarbaz {
+ my ($thing, $name) = @_;
+ $name ||= 'ok_foobarbaz';
+
+ test $name => sub {
+ like $thing, qr/foo/, "$name like foo";
+ ok_bar($thing, "$name like bar");
+ like $thing, qr/baz/, "$name like baz";
+ };
+}
+
+sub ok_bar {
+ my ($thing, $name) = @_;
+ $name ||= 'ok_bar';
+
+ test $name => sub {
+ like $thing, qr/b/, "$name like b";
+ like $thing, qr/A/, "$name like A";
+ like $thing, qr/r/, "$name like r";
+ };
+}
+EOSCRIPT
+is scalar($perl->stdout()), <<EOOUT, "failing out";
+1..4
+ok 1 - pre
+ok 2 - foo
+not ok 3 - bar
+ok 4 - post
+EOOUT
+my $err = $perl->stderr();
+$err =~ s/^\s*\n//mg;
+$err =~ s/^\s*\# {2,}.*\n//mg;
+is $err, <<EOERR, "failing err";
+# Running group of tests - foo
+# ok 2.1 foo one
+# ok 2.2 foo two
+# Running group of tests - bar
+# ok 3.1 bar one
+# ok 3.2 bar two
+# Running group of tests - woo woo
+# ok 3.3.1 woo woo like foo
+# Running group of tests - woo woo like bar
+# ok 3.3.2.1 woo woo like bar like b
+# not ok 3.3.2.2 woo woo like bar like A
+# ok 3.3.2.3 woo woo like bar like r
+# not ok 3.3.2 woo woo like bar
+# ok 3.3.3 woo woo like baz
+# not ok 3.3 woo woo
+# Looks like you failed 1 test of 4.
+EOERR
+
+1;