public
Last active

  • Download Gist
Unify.pm
Perl
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
package Test::TAP::Unify;
 
use strict;
use warnings;
use Carp;
our $VERSION = '0.01';
 
1;
__END__
 
=head1 NAME
 
Test::TAP::Unify - Create a minimal set of TODO code for a set of test results
 
=head1 SYNOPSIS
 
rm log.test-*
os=`uname -o`
for p in 5.10.1 5.10.1-nt 5.12.1 5.12.1d 5.12.1d-nt 5.13.3 5.13.3d 5.13.3-nt
do
perl$p Makefile.PL
make test >log.test-$os-$p
done
 
use Test::TAP::Unify;
# take features from test filenames
my $features = {debugging => qr/\dd/,
threads => qr/-nt/,
os => qr/log.test-(\w+)-/,
version => qr/(5\.[\d\.]+/)};
my $t = Test::TAP::Unify->new(filename => $features);
my $u = $t->parse(<log.test-*>);
 
# prints the complete test matrix
print $u->matrix;
 
# prints @TODO lists as test.pl code snippet
print $u->todo->code('PUSH', 'index'); # as PUSH'ed lists of test indices
 
# take features from test filenames and test comments also (the module name)
my $m = Test::TAP::Unify->new
( filenames => {debugging => qr/\dd/,
threads => qr/-nt/,
os => qr/log.modules-(\w+)-/,
version => qr/(5\.[\d\.]+/)},
comment => {module => qr/(pass|fail) (\S+)/})
->parse(<log.modules*>);
print $m->matrix; # all results
print $m->todo->code('IF', 'module'); # as IF checked lists for module lists
 
=head1 DESCRIPTION
 
You hate failing tests, you get a set of test results per perl version
by yourself, and also gathered by cpantesters. So you can mark all failing
tests as TODO check tickets, and release a new version, where all tests pass.
Great! Error free software.
 
Really, for more complicated XS modules with some randomly failing tests
you need to keep TODO lists uptodate. Just to see regressions.
 
This modules was written to unify test results of the perl compiler L<B::C>, you
will get tired to mark TODO tests manually after each feature change or added
platform or perl version you are testing against. It will give you insights
which feature might cause the damage. You can e.g. mark tests with any feature name
and check them with this module.
 
Test::TAP::Unify reads the output of make test (TAP results), detects features
by various methods, e.g. the filename where make test is logged to, or the test comments
and tries to find the minmal set of failing tests per feature. The shortest set of
feature-fail combination. Since you have an arbitrary long list of features -
typically: version, threads, os, debugging, cc - producing this set is not
trivial.
 
The sets can be printed as matrix, or as code, lists of @TODO with added feature logic.
Each test is indexed by number 1..plan.
 
Sample output for todo->code('PUSH', 'index')
 
sub is_todo {
my @TODO;
@TODO = (15,39,44);
@TODO = (39) if !$ITHREADS;
@TODO = (15,41..45) if $version < 5.007;
@TODO = (39,41,44) if $version >= 5.010;
@TODO = (15,29,39,44) if $version >= 5.010 and !$ITHREADS;
push @TODO, (27) if $version >= 5.012 and $ITHREADS;
push @TODO, (6,8..10,16,21,23,24,26,30,31,35) if $version >= 5.013002;
push @TODO, (15,25,42..43) if $version >= 5.013 and $ITHREADS;
return @TODO;
}
 
Sample output for todo->code('IF', 'module')
 
sub is_todo {
my ($module, $version, $name, $threads) = @_;
foreach (qw(ExtUtils::MakeMaker LWP Attribute::Handlers MooseX::Types)) {
return 'generally' if $_ eq $module;
}
if ($] < 5.007) {
foreach(qw( ExtUtils::CBuilder Sub::Name)) {
return '< 5.007' if $_ eq $module;
}
}
if ($] < 5.010) {
foreach(qw(B::Hooks::EndOfScope)) {
return '< 5.010' if $_ eq $module;
}
}
if ($threads) {
foreach(qw(
File::Temp ExtUtils::Install
Test::Tester Attribute::Handlers
Test::Deep FCGI B::Hooks::EndOfScope Digest::SHA1
namespace::clean DateTime::Locale DateTime
Template::Stash
)) {
return 'with threads' if $_ eq $module;
}
if ($] >= 5.010 and $] < 5.012) {
foreach(qw(
Class::Accessor Class::MOP
)) {
return '5.10 with threads' if $_ eq $module;
}
}
} else {
if ($] >= 5.010 and $] < 5.012) {
foreach(qw(
IO ExtUtils::Install Test::Tester Test::Deep Path::Class
Scalar::Util
)) {
return '5.10 without threads' if $_ eq $module;
}
}
}
}
 
=head1 SEE ALSO
 
L<TAP::Harness>
 
L<Test::Harness::Straps>
 
L<B::C>
 
=head1 AUTHOR
 
Reini Urban E<lt>rurban@cpan.atE<gt>
 
=head1 COPYRIGHT AND LICENSE
 
Copyright (C) 2010 by Reini Urban
 
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.
 
 
=cut

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.