r21813 - in /trunk/libtest-tap-model-perl: ./ debian/ lib/Test/TAP/ lib/Test/TAP/Model/ lib/Test/TAP/Model/File/ t/ t/lib/
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Tue Jun 17 16:22:05 UTC 2008
Author: gregoa
Date: Tue Jun 17 16:22:04 2008
New Revision: 21813
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=21813
Log:
New upstream release.
Added:
trunk/libtest-tap-model-perl/Changes
- copied unchanged from r21812, branches/upstream/libtest-tap-model-perl/current/Changes
trunk/libtest-tap-model-perl/Makefile
- copied unchanged from r21812, branches/upstream/libtest-tap-model-perl/current/Makefile
trunk/libtest-tap-model-perl/example.pl
- copied unchanged from r21812, branches/upstream/libtest-tap-model-perl/current/example.pl
trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Consolidated.pm
- copied unchanged from r21812, branches/upstream/libtest-tap-model-perl/current/lib/Test/TAP/Model/Consolidated.pm
trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File/
- copied from r21812, branches/upstream/libtest-tap-model-perl/current/lib/Test/TAP/Model/File/
trunk/libtest-tap-model-perl/t/consolidate.t
- copied unchanged from r21812, branches/upstream/libtest-tap-model-perl/current/t/consolidate.t
trunk/libtest-tap-model-perl/t/lib/
- copied from r21812, branches/upstream/libtest-tap-model-perl/current/t/lib/
Removed:
trunk/libtest-tap-model-perl/Build.PL
trunk/libtest-tap-model-perl/t/00_dist.t
Modified:
trunk/libtest-tap-model-perl/MANIFEST
trunk/libtest-tap-model-perl/META.yml
trunk/libtest-tap-model-perl/Makefile.PL
trunk/libtest-tap-model-perl/SIGNATURE
trunk/libtest-tap-model-perl/debian/changelog
trunk/libtest-tap-model-perl/lib/Test/TAP/Model.pm
trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File.pm
trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Subtest.pm
trunk/libtest-tap-model-perl/t/basic.t
trunk/libtest-tap-model-perl/t/comprehensive.t
trunk/libtest-tap-model-perl/t/oop_file.t
trunk/libtest-tap-model-perl/t/pos_guessing.t
Modified: trunk/libtest-tap-model-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/MANIFEST?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/MANIFEST (original)
+++ trunk/libtest-tap-model-perl/MANIFEST Tue Jun 17 16:22:04 2008
@@ -1,15 +1,20 @@
-Build.PL
+Changes
+example.pl
lib/Test/TAP/Model.pm
+lib/Test/TAP/Model/Consolidated.pm
lib/Test/TAP/Model/File.pm
+lib/Test/TAP/Model/File/Consolidated.pm
lib/Test/TAP/Model/Subtest.pm
+Makefile
+Makefile.PL
MANIFEST This list of files
META.yml
-t/00_dist.t
t/basic.t
t/comprehensive.t
+t/consolidate.t
+t/lib/StringHarness.pm
t/oop_file.t
t/oop_subtest.t
t/pos_guessing.t
t/serializable.t
-Makefile.PL
-SIGNATURE Added here by Module::Build
+SIGNATURE Public-key signature (added by MakeMaker)
Modified: trunk/libtest-tap-model-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/META.yml?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/META.yml (original)
+++ trunk/libtest-tap-model-perl/META.yml Tue Jun 17 16:22:04 2008
@@ -1,21 +1,14 @@
----
-name: Test-TAP-Model
-version: 0.04
-author: ~
-abstract: |-
- Accessible (queryable, serializable object) result collector
- for L<Test::Harness::Straps> runs.
-license: perl
-requires:
- perl: >= 5.008
-build_requires:
- Test::More: 0.53
-provides:
- Test::TAP::Model:
- file: lib/Test/TAP/Model.pm
- version: 0.04
- Test::TAP::Model::File:
- file: lib/Test/TAP/Model/File.pm
- Test::TAP::Model::Subtest:
- file: lib/Test/TAP/Model/Subtest.pm
-generated_by: Module::Build version 0.261
+--- #YAML:1.0
+name: Test-TAP-Model
+version: 0.09
+abstract: ~
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.31
+distribution_type: module
+requires:
+ Method::Alias: 0
+ Test::Harness: 2.64
+ Test::More: 0.53
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Modified: trunk/libtest-tap-model-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/Makefile.PL?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/Makefile.PL (original)
+++ trunk/libtest-tap-model-perl/Makefile.PL Tue Jun 17 16:22:04 2008
@@ -1,13 +1,14 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.03
use ExtUtils::MakeMaker;
-WriteMakefile
-(
- 'PL_FILES' => {},
- 'INSTALLDIRS' => 'site',
- 'NAME' => 'Test::TAP::Model',
- 'VERSION_FROM' => 'lib/Test/TAP/Model.pm',
- 'PREREQ_PM' => {
- 'Test::More' => '0.53'
- }
- )
-;
+WriteMakefile(
+ PL_FILES => {},
+ INSTALLDIRS => 'site',
+ NAME => 'Test::TAP::Model',
+ EXE_FILES => [],
+ VERSION_FROM => 'lib/Test/TAP/Model.pm',
+ SIGN => 1,
+ PREREQ_PM => {
+ 'Test::Harness' => '2.64',
+ 'Test::More' => '0.53',
+ 'Method::Alias' => 0
+ },
+);
Modified: trunk/libtest-tap-model-perl/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/SIGNATURE?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/SIGNATURE (original)
+++ trunk/libtest-tap-model-perl/SIGNATURE Tue Jun 17 16:22:04 2008
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.44.
+signed via the Module::Signature module, version 0.55.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -14,24 +14,29 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 7feca414e773a658888f29f55b96d0a50dd5565a Build.PL
-SHA1 1e30f5b45a74daadca016609e509565a58e9a2f2 MANIFEST
-SHA1 1568ac3da62cf86a1df7814b5a064f1e59752a3a META.yml
-SHA1 29345d0f77506af9c517669e9de86975ad62f855 Makefile.PL
-SHA1 70279d6e3472f9e20b62d036863979648906c412 lib/Test/TAP/Model.pm
-SHA1 9050eb2cf46ccb2b4107d37af1447b13ecc10585 lib/Test/TAP/Model/File.pm
-SHA1 7a94fe5b4ed16ebf6ee3e49b20eb3ff26426d810 lib/Test/TAP/Model/Subtest.pm
-SHA1 acbd2a8d9b17e5c3db037b0c1ad46367428a8ba5 t/00_dist.t
-SHA1 ef8d4cb8e9085b90c6c5b3437e6df73e8d5e0f91 t/basic.t
-SHA1 c6e53bd7ab3a2112225a93c8c0d0044a112cc8ca t/comprehensive.t
-SHA1 dd3f2a8b23b4a04c2da45e1363e240d906c6fc98 t/oop_file.t
+SHA1 aeea9018cc0304bbb090f08fe9feb93e31f5eb99 Changes
+SHA1 066fc183960dc393680bb88b219e57cd8b42482f MANIFEST
+SHA1 279a1c16e6f41412a2bd9cac1c562cea3895167b META.yml
+SHA1 7a43e022e81d47dd22cd9205024da6b18fa81e53 Makefile
+SHA1 ea996d66545325f03838c68e51664aa5db34dc49 Makefile.PL
+SHA1 71f34d2e8b9d99b59f393814a26372217e961c44 example.pl
+SHA1 ba2a4d174a87ac3046c1cc9d9d2d580ccaaf96bb lib/Test/TAP/Model.pm
+SHA1 442be97cdb5e0dc4f2fcd5abea656fa83a37dd56 lib/Test/TAP/Model/Consolidated.pm
+SHA1 b9a41ae3c9d942a98a5b54c62da41adae96c4efd lib/Test/TAP/Model/File.pm
+SHA1 6b1c7072e575bbfc6087b14c345dbf59ae487cf2 lib/Test/TAP/Model/File/Consolidated.pm
+SHA1 6fab02a357fa700e236449e0fe314845a23b6968 lib/Test/TAP/Model/Subtest.pm
+SHA1 b2de97c6c7e94cfb7288605e14886d6d1797c83c t/basic.t
+SHA1 ae8f1c14b14764483e9bb61c663486ae7349d3e4 t/comprehensive.t
+SHA1 d7ba14c7859bc764ed4469641a4b3db37c7106d1 t/consolidate.t
+SHA1 8ecf24ad548b85970fd5dc7fb4c3712a3af75fa6 t/lib/StringHarness.pm
+SHA1 ae0b778b055f1a8e6ed164839d80e91f3b196839 t/oop_file.t
SHA1 4eb74f2a087f15e1c7f07f93d3c689be55ee740e t/oop_subtest.t
-SHA1 30676ba486ac3f1ea853ac85e5142142c2cf9899 t/pos_guessing.t
+SHA1 ce77d86a7165627e8b9dec182f3a7f8cc65fc06b t/pos_guessing.t
SHA1 2120d63b75de8443f81b01d737daaed32db882ea t/serializable.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.2.5 (Darwin)
+Version: GnuPG v1.4.5 (Darwin)
-iD8DBQFCnaE6VCwRwOvSdBgRAjAeAJ9D7GKN3VI0/bR6sMdNxzY3nSACywCfaVZT
-08rTspPuvbBZpkeB7cFcRtQ=
-=BBV7
+iD8DBQFGCDj4VCwRwOvSdBgRAml7AJ43vgm5cRAVVPNahEkW+K1ildqV1wCfR3rg
+2dEQxuSLSf5CLK48rINAokw=
+=PqCR
-----END PGP SIGNATURE-----
Modified: trunk/libtest-tap-model-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/debian/changelog?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/debian/changelog (original)
+++ trunk/libtest-tap-model-perl/debian/changelog Tue Jun 17 16:22:04 2008
@@ -1,4 +1,4 @@
-libtest-tap-model-perl (0.04-2) UNRELEASED; urgency=low
+libtest-tap-model-perl (0.09-1) UNRELEASED; urgency=low
* Take over for the Debian Perl Group with maintainer's permission
(http://lists.debian.org/debian-perl/2008/06/msg00039.html)
@@ -10,6 +10,8 @@
to Uploaders.
* Add debian/watch.
+ * New upstream release.
+
-- gregor herrmann <gregoa at debian.org> Sun, 15 Jun 2008 17:44:16 +0200
libtest-tap-model-perl (0.04-1) unstable; urgency=low
Modified: trunk/libtest-tap-model-perl/lib/Test/TAP/Model.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/lib/Test/TAP/Model.pm?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/lib/Test/TAP/Model.pm (original)
+++ trunk/libtest-tap-model-perl/lib/Test/TAP/Model.pm Tue Jun 17 16:22:04 2008
@@ -10,7 +10,7 @@
use List::Util qw/sum/;
-our $VERSION = "0.04";
+our $VERSION = "0.09";
# callback handlers
sub _handle_bailout {
@@ -31,7 +31,7 @@
sub _handle_test {
my($self, $line, $type, $totals) = @_;
- my $curr = $totals->{seen}||0;
+ my $curr = $totals->seen || 0;
# this is used by pugs' Test.pm, it's rather useful
my $pos;
@@ -40,7 +40,7 @@
$pos = $2;
}
- my %details = %{ $totals->{details}[-1] };
+ my %details = %{ $totals->details->[-1] };
$self->log_event(
type => 'test',
@@ -48,7 +48,7 @@
ok => $details{ok},
actual_ok => $details{actual_ok},
str => $details{ok} # string for people
- ? "ok $curr/$totals->{max}"
+ ? "ok $curr/" . $totals->max
: "NOK $curr",
todo => ($details{type} eq 'todo'),
skip => ($details{type} eq 'skip'),
@@ -86,7 +86,7 @@
my $pkg = shift;
my @tests = @_;
- my $self = $pkg->SUPER::new;
+ my $self = $pkg->new;
$self->run_tests(@tests);
$self;
@@ -96,7 +96,7 @@
my $pkg = shift;
my $meat = shift;
- my $self = $pkg->SUPER::new(@_);
+ my $self = $pkg->new(@_);
$self->{meat} = $meat; # FIXME - the whole Test::Harness::Straps model can be figured out from this
$self;
@@ -117,6 +117,8 @@
my $meth = "_handle_$type";
$self->$meth($line, $type, $totals) if $self->can($meth);
};
+
+ $s->SUPER::_init( @_ );
}
sub log_time {
@@ -169,9 +171,9 @@
my $test_file = $self->start_file($file);
- my %results = eval { $self->analyze_file($file) };
- $test_file->{results} = \%results;
- delete $test_file->{results}{details};
+ my $results = eval { $self->analyze_file($file) } || Test::Harness::Results->new;
+ $test_file->{results} = $results;
+ $test_file->{results}->details(undef); # we don't need that
$test_file;
}
@@ -192,8 +194,12 @@
sub test_files {
my $self = shift;
- $self->{_test_files_cache} ||= [ map { $self->file_class->new($_) } @{ $self->{meat}{test_files} } ];
- @{ $self->{_test_files_cache} }
+ @{$self->{_test_files_cache} ||= [ $self->get_test_files ]};
+}
+
+sub get_test_files {
+ my $self = shift;
+ map { $self->file_class->new($_) } @{ $self->{meat}{test_files} };
}
sub ok { $_->ok or return for $_[0]->test_files; 1 }; *passed = \&ok; *passing = \&ok;
@@ -207,6 +213,15 @@
sub total_failed { sum map { scalar $_->nok_tests } $_[0]->test_files }; *total_nok = \&total_failed;
sub total_unexpectedly_succeeded { sum map { scalar $_->unexpectedly_succeeded_tests } $_[0]->test_files }
+sub summary {
+ my $self = shift;
+ $self->{_summary} ||=
+ sprintf "%d test cases: %d ok, %d failed, %d todo, "
+ ."%d skipped and %d unexpectedly succeeded",
+ map { my $m = "total_$_"; $self->$m }
+ qw/seen passed failed todo skipped unexpectedly_succeeded/;
+}
+
__PACKAGE__
__END__
@@ -220,15 +235,30 @@
=head1 SYNOPSIS
- use Test::TAP::Model
-
- my $t = Test::TAP::Model->new($structure);
-
- my @tests = $t->test_files; # objects interface
-
- YAML::Dump($t->structure); # the same thing we made it with
-
- $t->run_tests(qw{ t/foo.t t/bar.t }); # has a side effect of creating struct
+ use Test::TAP::Model;
+
+ my $t = Test::TAP::Model->new();
+
+ # Test::Harness::Straps methods are available, but they aren't enough.
+ # Extra book keeping is required. See the run_test method
+
+ # here's a convenient wrapper
+ $t = Test::TAP::Model->new_with_tests(glob("t/*.t"));
+
+ # that's shorthand for new->run_tests
+ $t->run_tests(qw{ t/foo.t t/bar.t });
+
+ # every file is an object (Test::TAP::Model::File)
+ my @tests = $t->test_files;
+
+ # this method returns a structure
+ my $structure = $t->structure;
+
+ # which is guaranteed to survive serialization
+ my $other_struct = do { my $VAR; eval Data::Dumper::Dumper($structure) };
+
+ # the same as $t1
+ my $t2 = Test::TAP::Model->new_with_struct($other_struct);
=head1 DESCRIPTION
@@ -484,6 +514,12 @@
events to encapsulate this cleanly (Gaal took care of the handlers way before I
got into the picture), and I'm too lazy to check it out.
+=head1 VERSION CONTROL
+
+This module is maintained using Darcs. You can get the latest version from
+L<http://nothingmuch.woobling.org/Test-TAP-Model/>, and use C<darcs send> to
+commit changes.
+
=head1 AUTHORS
This list was generated from svn log testgraph.pl and testgraph.css in the pugs
@@ -517,7 +553,7 @@
=item *
-Autrijs Tang <autrijus at autrjius.org> AUTRIJUS
+Audrey Tang <cpan at audreyt.org> AUDREYT
=item *
Modified: trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File.pm?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File.pm (original)
+++ trunk/libtest-tap-model-perl/lib/Test/TAP/Model/File.pm Tue Jun 17 16:22:04 2008
@@ -8,38 +8,47 @@
use Test::TAP::Model::Subtest;
use List::Util (); # don't import max, we have our own. We use it fully qualified
-use overload '""' => "name";
+use overload '""' => "name", '==' => "equal";
+
+use Method::Alias (
+ (map { ($_ => 'cases') } qw/seen_tests seen test_cases subtests/),
+ (map { ($_ => 'ok_tests') } qw/passed_tests/),
+ (map { ($_ => 'nok_tests') } qw/failed_tests/),
+ (map { ($_ => 'planned') } qw/max/),
+ (map { ($_ => 'ok') } qw/passed/),
+ (map { ($_ => 'nok') } qw/failed/),
+);
# TODO test this more thoroughly, probably with Devel::Cover
sub new {
my $pkg = shift;
my $struct = shift;
- bless \$struct, $pkg; # don't bless the structure, it's not ours to mess with
+ bless { struct => $struct }, $pkg; # don't bless the structure, it's not ours to mess with
}
# predicates about the test file
-sub ok { ${ $_[0] }->{results}{passing} }; *passed = \&ok;
-sub nok { !$_[0]->ok }; *failed = \&nok;
-sub skipped { exists ${ $_[0] }->{results}{skip_all} };
+sub ok { $_[0]{struct}{results}->passing };
+sub nok { !$_[0]->ok };
+sub skipped { defined($_[0]{struct}{results}->skip_all) };
sub bailed_out {
- my $event = ${ $_[0] }->{events}[-1] or return;
+ my $event = $_[0]{struct}{events}[-1] or return;
return unless exists $event->{type};
return $event->{type} eq "bailout";
}
# member data queries
-sub name { ${ $_[0] }->{file} }
+sub name { $_[0]{struct}{file} }
# utility methods for extracting tests.
sub subtest_class { "Test::TAP::Model::Subtest" }
sub _mk_objs { my $self = shift; wantarray ? map { $self->subtest_class->new($_) } @_ : @_ }
sub _test_structs {
my $self = shift;
- my $max = ${ $self }->{results}{max};
+ my $max = $self->{struct}{results}->max;
# cases is an array of *copies*... that's what the map is about
- my @cases = grep { exists $_->{type} and $_->{type} eq "test" } @{ ${ $self }->{events} };
+ my @cases = grep { exists $_->{type} and $_->{type} eq "test" } @{ $self->{struct}{events} };
if (defined $max){
if ($max > @cases){
@@ -73,18 +82,18 @@
}
# queries about the test cases
-sub planned { ${ $_[0] }->{results}{max} }; *max = \&planned; # only scalar context
+sub planned { $_[0]{struct}{results}->max };
sub cases {
- my @values = @{ ${ $_[0] }->{results} }{qw/seen max/};
+ my @values = map { $_[0]{struct}{results}->$_ } qw/seen max/;
my $scalar = List::Util::max(@values);
$_[0]->_c(sub { 1 }, $scalar)
-}; *seen_tests = *seen = *test_cases = *subtests = \&cases;
-sub actual_cases { $_[0]->_c(sub { $_->{line} ne "stub" }, ${ $_[0] }->{results}{seen}) }
-sub ok_tests { $_[0]->_c(sub { $_->{ok} }, ${ $_[0] }->{results}{ok}) }; *passed_tests = \&ok_tests;
-sub nok_tests { $_[0]->_c(sub { not $_->{ok} }, $_[0]->seen - $_[0]->ok_tests )}; *failed_tests = \&nok_tests;
-sub todo_tests { $_[0]->_c(sub { $_->{todo} }, ${ $_[0] }->{results}{todo}) }
-sub skipped_tests { $_[0]->_c(sub { $_->{skip} }, ${ $_[0] }->{results}{skip}) }
+};
+sub actual_cases { $_[0]->_c(sub { $_->{line} ne "stub" }, $_[0]{struct}{results}->seen) }
+sub ok_tests { $_[0]->_c(sub { $_->{ok} }, $_[0]{struct}{results}->ok) };
+sub nok_tests { $_[0]->_c(sub { not $_->{ok} }, $_[0]->seen - $_[0]->ok_tests )};
+sub todo_tests { $_[0]->_c(sub { $_->{todo} }, $_[0]{struct}{results}->todo) }
+sub skipped_tests { $_[0]->_c(sub { $_->{skip} }, $_[0]{struct}{results}->skip) }
sub unexpectedly_succeeded_tests { $_[0]->_c(sub { $_->{todo} and $_->{actual_ok} }) }
sub ratio {
@@ -97,7 +106,25 @@
sprintf("%.2f%%", 100 * $self->ratio);
}
-sub pre_diag { ${ $_[0] }->{pre_diag} || ""}
+sub pre_diag { $_[0]{struct}{pre_diag} || ""}
+
+sub equal {
+ my $self = shift;
+ my $other = shift;
+
+ # number of sub-tests
+ return unless $self->seen == $other->seen;
+
+ # values of subtests
+ my @self = $self->cases;
+ my @other = $other->cases;
+
+ while (@self) {
+ return unless (pop @self) == (pop @other);
+ }
+
+ 1;
+}
__PACKAGE__
Modified: trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Subtest.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Subtest.pm?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Subtest.pm (original)
+++ trunk/libtest-tap-model-perl/lib/Test/TAP/Model/Subtest.pm Tue Jun 17 16:22:04 2008
@@ -5,7 +5,7 @@
use strict;
use warnings;
-use overload '""' => "str";
+use overload '""' => "str", '==' => "equal";
use Carp qw/croak/;
@@ -45,6 +45,17 @@
sub test_file { $_[0]->pos =~ /(?:file\s+|^)?(\S+?)[\s[:punct:]]*(?:\s+|$)/ ? $1 : "" };
sub test_line { $_[0]->pos =~ /line\s+(\d+)/i ? $1 : ""}
sub test_column { $_[0]->pos =~ /column?\s+(\d+)/ ? $1 : ""}
+
+sub equal {
+ my $self = shift;
+ my $other = shift;
+
+ ($self->actual_ok xor $other->actual_nok)
+ and
+ ($self->skipped xor !$other->skipped)
+ and
+ ($self->todo xor !$other->todo)
+}
__PACKAGE__
Modified: trunk/libtest-tap-model-perl/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/t/basic.t?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/t/basic.t (original)
+++ trunk/libtest-tap-model-perl/t/basic.t Tue Jun 17 16:22:04 2008
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 30;
+use Test::More tests => 35;
my $m;
@@ -15,7 +15,7 @@
can_ok($t, "start_file");
my $e = $t->start_file("example");
-$e->{results} = { $t->analyze_fh("example", \*DATA) };
+$e->{results} = $t->analyze_fh("example", \*DATA);
isa_ok(my $s = $t->structure, "HASH");
@@ -36,9 +36,19 @@
is($e[1]{type}, "test", "second event is a test");
ok(!$e[1]->{ok}, "it failed");
+like($e[1]->{diag}, qr/expected/, "it has diagnosis");
is($e[2]{type}, "test", "third event is a test");
ok($e[2]{todo}, "it's a todo test");
+like($e[1]->{diag}, qr/expected/, "it has diagnosis");
+
+
+is( scalar($t->test_files), 1, "one test file" );
+my $f_obj = ($t->test_files)[0];
+
+is( ( $f_obj->subtests )[0]->diag, "", "first subtest has no diag" );
+like( ( $f_obj->subtests )[1]->diag, qr/expected/, "second subtest does have diag" );
+
# this is the return from analyze_foo
@@ -52,6 +62,7 @@
ok($@, "Test::TAP::Model dies when calling get_tests()");
eval '$t->run()';
ok($@, "Test::TAP::Model dies when calling run()");
+
# Try new_with_struct
$s = $t->structure;
Modified: trunk/libtest-tap-model-perl/t/comprehensive.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/t/comprehensive.t?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/t/comprehensive.t (original)
+++ trunk/libtest-tap-model-perl/t/comprehensive.t Tue Jun 17 16:22:04 2008
@@ -1,11 +1,14 @@
#!/usr/bin/perl
-use Test::More tests => 113;
+use Test::More tests => 122;
use strict;
use warnings;
use List::Util qw/sum/;
+
+use lib "t/lib";
+use StringHarness;
my $m;
BEGIN { use_ok($m = "Test::TAP::Model") };
@@ -23,7 +26,7 @@
}
{
- my $s = strap_this(skip_some => <<TAP);
+ my $s = strap_this($m, skip_some => <<TAP);
1..2
ok 1 foo # skip cause i said so
ok 2 bar
@@ -48,7 +51,7 @@
}
{
- my $s = strap_this(bail_out => <<TAP);
+ my $s = strap_this($m, bail_out => <<TAP);
1..2
ok 1 foo
Bail out!
@@ -70,7 +73,7 @@
}
{
- my $s = strap_this(todo_tests => <<TAP);
+ my $s = strap_this($m, todo_tests => <<TAP);
1..4
ok 1 foo
not ok 2 bar
@@ -107,7 +110,7 @@
}
{
- my $s = strap_this(skip_all => <<TAP);
+ my $s = strap_this($m, skip_all => <<TAP);
1..0 # skipped: dancing beavers
TAP
@@ -124,7 +127,7 @@
}
{
- my $s = strap_this(totals_1 => <<TAP1, totals_2 => <<TAP2);
+ my $s = strap_this($m, totals_1 => <<TAP1, totals_2 => <<TAP2);
1..2
ok 1 foo
not ok 2 bar
@@ -173,7 +176,7 @@
{
- my $s = strap_this(no_plan => <<TAP);
+ my $s = strap_this($m, no_plan => <<TAP);
ok 1
ok 2
ok 3
@@ -186,7 +189,7 @@
}
{
- my $s = strap_this(plan_at_end => <<TAP);
+ my $s = strap_this($m, plan_at_end => <<TAP);
ok 1
ok 2
ok 3
@@ -202,7 +205,7 @@
}
{
- my $s = strap_this(bad_plan => <<TAP);
+ my $s = strap_this($m, bad_plan => <<TAP);
1..2
ok 1
ok 2
@@ -218,7 +221,7 @@
}
{
- my $s = strap_this(bail_no_tests => <<TAP);
+ my $s = strap_this($m, bail_no_tests => <<TAP);
1..10
Bail out!
TAP
@@ -232,7 +235,7 @@
}
{
- my $s = strap_this(diag => <<TAP);
+ my $s = strap_this($m, diag => <<TAP);
1..1
# before
# one
@@ -250,17 +253,19 @@
is($c->diag, "# after\n# two\n", "diagnosis belonging to case 1");
}
-sub strap_this {
- my $s = $m->new;
-
- while (@_){
- my $name = shift;
- my $output = shift;
- $output = [split /\n/,$output];
-
- my $r = $s->start_file($name);
- eval { $r->{results} = { $s->analyze($name, $output) } };
- }
-
- return $s;
-}
+
+{
+ my $s = strap_this($m, empty => <<TAP);
+TAP
+
+ ok($s->nok, "suite is not OK");
+ is($s->ratio, 0, "ratio is 0");
+ is($s->total_percentage, "0.00%", "zero percent");
+ is($s->test_files, 1, "one file");
+ my $f = ($s->test_files)[0];
+ ok($f->nok, "file is not OK");
+ is($f->cases, 0, "no cases");
+ is($f->planned, 0, "no plan either");
+ is($f->ratio, 0, "ratio is 0");
+ is($f->percentage, "0.00%", "zero percent");
+}
Modified: trunk/libtest-tap-model-perl/t/oop_file.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/t/oop_file.t?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/t/oop_file.t (original)
+++ trunk/libtest-tap-model-perl/t/oop_file.t Tue Jun 17 16:22:04 2008
@@ -10,6 +10,20 @@
my $m;
BEGIN { use_ok($m = "Test::TAP::Model::File") }
+{
+ package MockRes;
+ sub new {
+ my ( $pkg, %fields ) = @_;
+ bless \%fields, $pkg;
+ }
+
+ sub AUTOLOAD {
+ my $self = shift;
+ my ( $field ) = ( our $AUTOLOAD =~ /([^:]+)$/ );
+ $self->{ $field };
+ }
+}
+
isa_ok(my $f = $m->new(my $file = {
events => [
my $ok_case = {
@@ -21,14 +35,14 @@
ok => 0,
},
],
- results => my $r = {
+ results => my $r = MockRes->new(
passing => 0,
ok => 10,
todo => 11,
max => 3,
seen => 12,
skip => 13,
- }
+ ),
}), $m);
ok(!$f->ok, "failed");
Modified: trunk/libtest-tap-model-perl/t/pos_guessing.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-tap-model-perl/t/pos_guessing.t?rev=21813&op=diff
==============================================================================
--- trunk/libtest-tap-model-perl/t/pos_guessing.t (original)
+++ trunk/libtest-tap-model-perl/t/pos_guessing.t Tue Jun 17 16:22:04 2008
@@ -11,7 +11,7 @@
isa_ok(my $s = $m->new, $m);
my $f = $s->start_file("foo");
-eval { $f->{results} = { $s->analyze("foo", [split /\n/, <<TAP]) } };
+eval { $f->{results} = $s->analyze("foo", [split /\n/, <<TAP]) };
1..3
ok 1 foo <pos:foo.t at line 2, column 1>
ok 2 foo <pos:file "gorch" line 4>
More information about the Pkg-perl-cvs-commits
mailing list