[tapx-dev] [commit] [109] Tidied TAP::Harness::Compatible documentation
andy at hexten.net
andy at hexten.net
Sun Mar 11 11:45:05 GMT 2007
Revision: 109
Author: andy
Date: 2007-03-11 11:45:04 +0000 (Sun, 11 Mar 2007)
Log Message:
-----------
Tidied TAP::Harness::Compatible documentation
Removed redundant modules below TAP::Harness::Compatible
Removed unused compatibility tests
Modified Paths:
--------------
trunk/Changes
trunk/MANIFEST
trunk/lib/TAP/Harness/Compatible.pm
trunk/lib/TAP/Parser.pm
Removed Paths:
-------------
trunk/lib/TAP/Harness/Compatible/
trunk/t/compat/from_line.t
trunk/t/compat/harness.t
trunk/t/compat/point-parse.t
trunk/t/compat/point.t
trunk/t/compat/prove-globbing.t
trunk/t/compat/prove-switches.t
trunk/t/compat/strap-analyze.t
trunk/t/compat/strap.t
trunk/t/compat/test-harness.t
Modified: trunk/Changes
===================================================================
--- trunk/Changes 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/Changes 2007-03-11 11:45:04 UTC (rev 109)
@@ -10,6 +10,9 @@
simplified remaining logic to suit.
- Removed now-redundant t/140-varsource.t.
- Implemented TAP version syntax.
+ - Tidied TAP::Harness::Compatible documentation
+ - Removed redundant modules below TAP::Harness::Compatible
+ - Removed unused compatibility tests
0.50_07 5 March 2007
- Fixed bug where we erroneously checked the test number instead of number
Modified: trunk/MANIFEST
===================================================================
--- trunk/MANIFEST 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/MANIFEST 2007-03-11 11:45:04 UTC (rev 109)
@@ -15,12 +15,6 @@
lib/TAP/Harness.pm
lib/TAP/Harness/Color.pm
lib/TAP/Harness/Compatible.pm
-lib/TAP/Harness/Compatible/Iterator.pm
-lib/TAP/Harness/Compatible/Point.pm
-lib/TAP/Harness/Compatible/Results.pm
-lib/TAP/Harness/Compatible/Straps.pm
-lib/TAP/Harness/Compatible/TAP.pod
-lib/TAP/Harness/Compatible/Util.pm
lib/TAP/Parser.pm
lib/TAP/Parser/Aggregator.pm
lib/TAP/Parser/Grammar.pm
@@ -37,7 +31,7 @@
lib/TAP/Parser/YAML.pm
Makefile.PL
MANIFEST
-META.yml # Will be created by "make dist"
+META.yml
perltidyrc
README
t/000-load.t
@@ -60,19 +54,10 @@
t/compat/base.t
t/compat/callback.t
t/compat/failure.t
-t/compat/from_line.t
-t/compat/harness.t
t/compat/inc_taint.t
t/compat/nonumbers.t
t/compat/ok.t
-t/compat/point-parse.t
-t/compat/point.t
-t/compat/prove-globbing.t
-t/compat/prove-switches.t
-t/compat/strap-analyze.t
-t/compat/strap.t
t/compat/test-harness-compat.t
-t/compat/test-harness.t
t/compat/version.t
t/data/execrc
t/data/sample.yml
Modified: trunk/lib/TAP/Harness/Compatible.pm
===================================================================
--- trunk/lib/TAP/Harness/Compatible.pm 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/lib/TAP/Harness/Compatible.pm 2007-03-11 11:45:04 UTC (rev 109)
@@ -47,53 +47,15 @@
*switches = *Switches;
*debug = *Debug;
-#
-# $ENV{HARNESS_ACTIVE} = 1;
-# $ENV{HARNESS_VERSION} = $VERSION;
-#
-# END {
-# # For VMS.
-# delete $ENV{HARNESS_ACTIVE};
-# delete $ENV{HARNESS_VERSION};
-# }
-#
-# my $Files_In_Dir = $ENV{HARNESS_FILELEAK_IN_DIR};
-#
-# # Stolen from Params::Util
-# sub _CLASS {
-# (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s) ? $_[0] : undef;
-# }
-#
-# # Strap Overloading
-# if ( $ENV{HARNESS_STRAPS_CLASS} ) {
-# die 'Set HARNESS_STRAP_CLASS, singular, not HARNESS_STRAPS_CLASS';
-# }
-# my $HARNESS_STRAP_CLASS = $ENV{HARNESS_STRAP_CLASS} || 'TAP::Harness::Compatible::Straps';
-# if ( $HARNESS_STRAP_CLASS =~ /\.pm$/ ) {
-# # "Class" is actually a filename, that should return the
-# # class name as its true return value.
-# $HARNESS_STRAP_CLASS = require $HARNESS_STRAP_CLASS;
-# if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
-# die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
-# }
-# }
-# else {
-# # It is a class name within the current @INC
-# if ( !_CLASS($HARNESS_STRAP_CLASS) ) {
-# die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' is not a valid class name";
-# }
-# eval "require $HARNESS_STRAP_CLASS";
-# die $@ if $@;
-# }
-# if ( !$HARNESS_STRAP_CLASS->isa('TAP::Harness::Compatible::Straps') ) {
-# die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' must be a TAP::Harness::Compatible::Straps subclass";
-# }
-#
-# $Strap = $HARNESS_STRAP_CLASS->new;
-#
-# sub strap { return $Strap };
-#
+$ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
+END {
+ # For VMS.
+ delete $ENV{HARNESS_ACTIVE};
+ delete $ENV{HARNESS_VERSION};
+}
+
@ISA = ('Exporter');
@EXPORT = qw(&runtests);
@EXPORT_OK = qw(&execute_tests $verbose $switches);
@@ -113,112 +75,14 @@
=head1 DESCRIPTION
-B<STOP!> If all you want to do is write a test script, consider
-using Test::Simple. TAP::Harness::Compatible is the module that reads the
-output from Test::Simple, Test::More and other modules based on
-Test::Builder. You don't need to know about TAP::Harness::Compatible to use
-those modules.
+This module exists to provide TAP::Harness with an interface that is
+somewhat backwards compatible with L<Test::Harness>. If you're writing new
+code consider using L<TAP::Harness> directly instead.
-TAP::Harness::Compatible runs tests and expects output from the test in a
-certain format. That format is called TAP, the Test Anything
-Protocol. It is defined in L<TAP::Harness::Compatible::TAP>.
+Emulation is provided for C<runtests> and C<execute_tests> but the
+pluggable 'Straps' interface that the real L<Test::Harness> supports is
+not reproduced here.
-C<TAP::Harness::Compatible::runtests(@tests)> runs all the testscripts named
-as arguments and checks standard output for the expected strings
-in TAP format.
-
-The F<prove> utility is a thin wrapper around TAP::Harness::Compatible.
-
-=head2 Taint mode
-
-TAP::Harness::Compatible will honor the C<-T> or C<-t> in the #! line on your
-test files. So if you begin a test with:
-
- #!perl -T
-
-the test will be run with taint mode on.
-
-=head2 Configuration variables.
-
-These variables can be used to configure the behavior of
-TAP::Harness::Compatible. They are exported on request.
-
-=over 4
-
-=item C<$TAP::Harness::Compatible::Verbose>
-
-The package variable C<$TAP::Harness::Compatible::Verbose> is exportable and can be
-used to let C<runtests()> display the standard output of the script
-without altering the behavior otherwise. The F<prove> utility's C<-v>
-flag will set this.
-
-=item C<$TAP::Harness::Compatible::switches>
-
-The package variable C<$TAP::Harness::Compatible::switches> is exportable and can be
-used to set perl command line options used for running the test
-script(s). The default value is C<-w>. It overrides C<HARNESS_PERL_SWITCHES>.
-
-=item C<$TAP::Harness::Compatible::Timer>
-
-If set to true, and C<Time::HiRes> is available, print elapsed seconds
-after each test file.
-
-=back
-
-
-=head2 Failure
-
-When tests fail, analyze the summary report:
-
- t/base..............ok
- t/nonumbers.........ok
- t/ok................ok
- t/test-harness......ok
- t/waterloo..........dubious
- Test returned status 3 (wstat 768, 0x300)
- DIED. FAILED tests 1, 3, 5, 7, 9, 11, 13, 15, 17, 19
- Failed 10/20 tests, 50.00% okay
- Failed Test Stat Wstat Total Fail List of Failed
- ---------------------------------------------------------------
- t/waterloo.t 3 768 20 10 1 3 5 7 9 11 13 15 17 19
- Failed 1/5 test scripts, 80.00% okay. 10/44 subtests failed, 77.27% okay.
-
-Everything passed but F<t/waterloo.t>. It failed 10 of 20 tests and
-exited with non-zero status indicating something dubious happened.
-
-The columns in the summary report mean:
-
-=over 4
-
-=item B<Failed Test>
-
-The test file which failed.
-
-=item B<Stat>
-
-If the test exited with non-zero, this is its exit status.
-
-=item B<Wstat>
-
-The wait status of the test.
-
-=item B<Total>
-
-Total number of tests expected to run.
-
-=item B<Fail>
-
-Number which failed, either from "not ok" or because they never ran.
-
-=item B<List of Failed>
-
-A list of the tests which failed. Successive failures may be
-abbreviated (ie. 15-20 to indicate that tests 15, 16, 17, 18, 19 and
-20 failed).
-
-=back
-
-
=head1 FUNCTIONS
The following functions are available.
@@ -448,7 +312,6 @@
1;
__END__
-
=head1 EXPORT
C<&runtests> is exported by TAP::Harness::Compatible by default.
@@ -456,41 +319,8 @@
C<&execute_tests>, C<$verbose>, C<$switches> and C<$debug> are
exported upon request.
-=head1 DIAGNOSTICS
+=head1 ENVIRONMENT VARIABLES THAT TAP::HARNESS::COMPATIBLE SETS
-=over 4
-
-=item C<All tests successful.\nFiles=%d, Tests=%d, %s>
-
-If all tests are successful some statistics about the performance are
-printed.
-
-=item C<FAILED tests %s\n\tFailed %d/%d tests, %.2f%% okay.>
-
-For any single script that has failing subtests statistics like the
-above are printed.
-
-=item C<Test returned status %d (wstat %d)>
-
-Scripts that return a non-zero exit status, both C<$? E<gt>E<gt> 8>
-and C<$?> are printed in a message similar to the above.
-
-=item C<Failed 1 test, %.2f%% okay. %s>
-
-=item C<Failed %d/%d tests, %.2f%% okay. %s>
-
-If not all tests were successful, the script dies with one of the
-above messages.
-
-=item C<FAILED--Further testing stopped: %s>
-
-If a single subtest decides that further testing will not make sense,
-the script dies with this message.
-
-=back
-
-=head1 ENVIRONMENT VARIABLES THAT TEST::HARNESS SETS
-
TAP::Harness::Compatible sets these before executing the individual tests.
=over 4
@@ -510,61 +340,6 @@
=over 4
-=item C<HARNESS_COLUMNS>
-
-This value will be used for the width of the terminal. If it is not
-set then it will default to C<COLUMNS>. If this is not set, it will
-default to 80. Note that users of Bourne-sh based shells will need to
-C<export COLUMNS> for this module to use that variable.
-
-=item C<HARNESS_COMPILE_TEST>
-
-When true it will make harness attempt to compile the test using
-C<perlcc> before running it.
-
-B<NOTE> This currently only works when sitting in the perl source
-directory!
-
-=item C<HARNESS_DEBUG>
-
-If true, TAP::Harness::Compatible will print debugging information about itself as
-it runs the tests. This is different from C<HARNESS_VERBOSE>, which prints
-the output from the test being run. Setting C<$TAP::Harness::Compatible::Debug> will
-override this, or you can use the C<-d> switch in the F<prove> utility.
-
-=item C<HARNESS_FILELEAK_IN_DIR>
-
-When set to the name of a directory, harness will check after each
-test whether new files appeared in that directory, and report them as
-
- LEAKED FILES: scr.tmp 0 my.db
-
-If relative, directory name is with respect to the current directory at
-the moment runtests() was called. Putting absolute path into
-C<HARNESS_FILELEAK_IN_DIR> may give more predictable results.
-
-=item C<HARNESS_NOTTY>
-
-When set to a true value, forces it to behave as though STDOUT were
-not a console. You may need to set this if you don't want harness to
-output more frequent progress messages using carriage returns. Some
-consoles may not handle carriage returns properly (which results in a
-somewhat messy output).
-
-=item C<HARNESS_PERL>
-
-Usually your tests will be run by C<$^X>, the currently-executing Perl.
-However, you may want to have it run by a different executable, such as
-a threading perl, or a different version.
-
-If you're using the F<prove> utility, you can use the C<--perl> switch.
-
-=item C<HARNESS_PERL_SWITCHES>
-
-Its value will be prepended to the switches used to invoke perl on
-each test. For example, setting C<HARNESS_PERL_SWITCHES> to C<-W> will
-run all tests with all warnings enabled.
-
=item C<HARNESS_TIMER>
Setting this to true will make the harness display the number of
@@ -581,179 +356,28 @@
its tests. Setting C<$TAP::Harness::Compatible::verbose> will override this,
or you can use the C<-v> switch in the F<prove> utility.
-=item C<HARNESS_STRAP_CLASS>
-
-Defines the TAP::Harness::Compatible::Straps subclass to use. The value may either
-be a filename or a class name.
-
-If HARNESS_STRAP_CLASS is a class name, the class must be in C<@INC>
-like any other class.
-
-If HARNESS_STRAP_CLASS is a filename, the .pm file must return the name
-of the class, instead of the canonical "1".
-
=back
-=head1 EXAMPLE
-
-Here's how TAP::Harness::Compatible tests itself
-
- $ cd ~/src/devel/Test-Harness
- $ perl -Mblib -e 'use TAP::Harness::Compatible qw(&runtests $verbose);
- $verbose=0; runtests @ARGV;' t/*.t
- Using /home/schwern/src/devel/Test-Harness/blib
- t/base..............ok
- t/nonumbers.........ok
- t/ok................ok
- t/test-harness......ok
- All tests successful.
- Files=4, Tests=24, 2 wallclock secs ( 0.61 cusr + 0.41 csys = 1.02 CPU)
-
=head1 SEE ALSO
-The included F<prove> utility for running test scripts from the command line,
-L<Test> and L<Test::Simple> for writing test scripts, L<Benchmark> for
-the underlying timing routines, and L<Devel::Cover> for test coverage
-analysis.
+L<TAP::Harness>, L<Test::Harness>
-=head1 TODO
-
-Provide a way of running tests quietly (ie. no printing) for automated
-validation of tests. This will probably take the form of a version
-of runtests() which rather than printing its output returns raw data
-on the state of the tests. (Partially done in TAP::Harness::Compatible::Straps)
-
-Document the format.
-
-Fix HARNESS_COMPILE_TEST without breaking its core usage.
-
-Figure a way to report test names in the failure summary.
-
-Rework the test summary so long test names are not truncated as badly.
-(Partially done with new skip test styles)
-
-Add option for coverage analysis.
-
-Trap STDERR.
-
-Implement Straps total_results()
-
-Remember exit code
-
-Completely redo the print summary code.
-
-Straps->analyze_file() not taint clean, don't know if it can be
-
-Fix that damned VMS nit.
-
-Add a test for verbose.
-
-Change internal list of test results to a hash.
-
-Fix stats display when there's an overrun.
-
-Fix so perls with spaces in the filename work.
-
-Keeping whittling away at _run_all_tests()
-
-Clean up how the summary is printed. Get rid of those damned formats.
-
-=head1 BUGS
-
-Please report any bugs or feature requests to
-C<bug-test-harness at rt.cpan.org>, or through the web interface at
-L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
-I will be notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the F<perldoc> command.
-
- perldoc TAP::Harness::Compatible
-
-You can get docs for F<prove> with
-
- prove --man
-
-You can also look for information at:
-
-=over 4
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/Test-Harness>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/Test-Harness>
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-Harness>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/Test-Harness>
-
-=back
-
-=head1 SOURCE CODE
-
-The source code repository for TAP::Harness::Compatible is at
-L<http://svn.perl.org/modules/Test-Harness>.
-
=head1 AUTHORS
-Either Tim Bunce or Andreas Koenig, we don't know. What we know for
-sure is, that it was inspired by Larry Wall's F<TEST> script that came
-with perl distributions for ages. Numerous anonymous contributors
-exist. Andreas Koenig held the torch for many years, and then
-Michael G Schwern.
+Andy Armstrong C<< <andy at hexten.net> >>
-Current maintainer is Andy Lester C<< <andy at petdance.com> >>.
+L<Test::Harness> (on which this module is based) has this attribution:
-=head1 COPYRIGHT
+ Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+ sure is, that it was inspired by Larry Wall's F<TEST> script that came
+ with perl distributions for ages. Numerous anonymous contributors
+ exist. Andreas Koenig held the torch for many years, and then
+ Michael G Schwern.
-Copyright 2002-2006
-by Michael G Schwern C<< <schwern at pobox.com> >>,
-Andy Lester C<< <andy at petdance.com> >>.
+=head1 LICENCE AND COPYRIGHT
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
+Copyright (c) 2007, Andy Armstrong C<< <andy at hexten.net> >>. All rights reserved.
-See L<http://www.perl.com/perl/misc/Artistic.html>.
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
-=head1 TO DOCUMENT
-
-=over
-
-=item bailout_handler
-
-TODO: Document bailout_handler
-
-=item get_results
-
-Not documented in Test::Harness - so assume it's private.
-
-=item header_handler
-
-TODO: Document header_handler
-
-=item strap
-
-TODO: Document strap
-
-=item strap_callback
-
-TODO: Document strap_callback
-
-=item swrite
-
-TODO: Document swrite
-
-=item test_handler
-
-TODO: Document test_handler
-
-=back
Modified: trunk/lib/TAP/Parser.pm
===================================================================
--- trunk/lib/TAP/Parser.pm 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/lib/TAP/Parser.pm 2007-03-11 11:45:04 UTC (rev 109)
@@ -369,8 +369,7 @@
}
$self->_stream($stream);
- $self->_grammar( TAP::Parser::Grammar->new($self) )
- ; # eventually pass a version
+ $self->_grammar( TAP::Parser::Grammar->new($self) );
$self->_spool($spool);
while ( my ( $k, $v ) = each %initialize ) {
Deleted: trunk/t/compat/from_line.t
===================================================================
--- trunk/t/compat/from_line.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/from_line.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,67 +0,0 @@
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = '../lib';
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 23;
-
-BEGIN {
- use_ok('TAP::Harness::Compatible::Point');
-}
-
-BASIC_OK: {
- my $line = "ok 14 - Blah blah";
- my $point = TAP::Harness::Compatible::Point->from_test_line($line);
- isa_ok( $point, 'TAP::Harness::Compatible::Point', 'BASIC_OK' );
- is( $point->number, 14 );
- ok( $point->ok );
- is( $point->description, 'Blah blah' );
-}
-
-BASIC_NOT_OK: {
- my $line = "not ok 267 Yada";
- my $point = TAP::Harness::Compatible::Point->from_test_line($line);
- isa_ok( $point, 'TAP::Harness::Compatible::Point', 'BASIC_NOT_OK' );
- is( $point->number, 267 );
- ok( !$point->ok );
- is( $point->description, 'Yada' );
-}
-
-CRAP: {
- my $point
- = TAP::Harness::Compatible::Point->from_test_line('ok14 - Blah');
- ok( !defined $point, 'CRAP 1' );
-
- $point = TAP::Harness::Compatible::Point->from_test_line('notok 14');
- ok( !defined $point, 'CRAP 2' );
-}
-
-PARSE_TODO: {
- my $point = TAP::Harness::Compatible::Point->from_test_line(
- 'not ok 14 - Calculate sqrt(-1) # TODO Still too rational');
- isa_ok( $point, 'TAP::Harness::Compatible::Point', 'PARSE_TODO' );
- is( $point->description, 'Calculate sqrt(-1)' );
- is( $point->directive_type, 'todo' );
- is( $point->directive_reason, 'Still too rational' );
- ok( !$point->is_skip );
- ok( $point->is_todo );
-}
-
-PARSE_SKIP: {
- my $point = TAP::Harness::Compatible::Point->from_test_line(
- 'ok 14 # skip Not on bucket #6');
- isa_ok( $point, 'TAP::Harness::Compatible::Point', 'PARSE_SKIP' );
- is( $point->description, '' );
- is( $point->directive_type, 'skip' );
- is( $point->directive_reason, 'Not on bucket #6' );
- ok( $point->is_skip );
- ok( !$point->is_todo );
-}
Deleted: trunk/t/compat/harness.t
===================================================================
--- trunk/t/compat/harness.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/harness.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,25 +0,0 @@
-#!/usr/bin/perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More;
-
-#plan tests => 2;
-plan skip_all => 'Harness has no Straps support yet';
-
-BEGIN {
- use_ok('TAP::Harness::Compatible');
-}
-
-my $strap = TAP::Harness::Compatible->strap;
-isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
Deleted: trunk/t/compat/point-parse.t
===================================================================
--- trunk/t/compat/point-parse.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/point-parse.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,104 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-
-use Test::More tests => 52;
-
-BEGIN {
- use_ok('TAP::Harness::Compatible::Point');
- use_ok('TAP::Harness::Compatible::Straps');
-}
-
-my $strap = TAP::Harness::Compatible::Straps->new;
-isa_ok( $strap, 'TAP::Harness::Compatible::Straps', 'new()' );
-
-my $testlines = {
- 'not ok' => { ok => 0 },
- 'not ok # TODO' => {
- ok => 0,
- reason => '',
- type => 'todo'
- },
- 'not ok 1' => {
- number => 1,
- ok => 0
- },
- 'not ok 11 - this is \\# all the name # skip this is not' => {
- description => 'this is \\# all the name',
- number => 11,
- ok => 0,
- reason => 'this is not',
- type => 'skip'
- },
- 'not ok 23 # TODO world peace' => {
- number => 23,
- ok => 0,
- reason => 'world peace',
- type => 'todo'
- },
- 'not ok 42 - universal constant' => {
- description => 'universal constant',
- number => 42,
- ok => 0
- },
- ok => { ok => 1 },
- 'ok # skip' => {
- ok => 1,
- type => 'skip'
- },
- 'ok 1' => {
- number => 1,
- ok => 1
- },
- 'ok 1066 - and all that' => {
- description => 'and all that',
- number => 1066,
- ok => 1
- },
- 'ok 11 - have life # TODO get a life' => {
- description => 'have life',
- number => 11,
- ok => 1,
- reason => 'get a life',
- type => 'todo'
- },
- 'ok 2938' => {
- number => 2938,
- ok => 1
- },
- 'ok 42 - _is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because'
- => {
- description =>
- '_is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because',
- number => 42,
- ok => 1
- }
-};
-my @untests = (
- ' ok',
- 'not',
- 'okay 23',
-);
-
-for my $line ( sort keys %$testlines ) {
- my $point = TAP::Harness::Compatible::Point->from_test_line($line);
- isa_ok( $point, 'TAP::Harness::Compatible::Point' );
-
- my $fields = $testlines->{$line};
- for my $property ( sort keys %$fields ) {
- my $value = $fields->{$property};
- is( eval "\$point->$property", $value, "$property on $line" );
-
- # Perls pre-5.6 can't handle $point->$property, and must be eval()d
- }
-}
Deleted: trunk/t/compat/point.t
===================================================================
--- trunk/t/compat/point.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/point.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,58 +0,0 @@
-#!perl -Tw
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 11;
-
-BEGIN {
- use_ok('TAP::Harness::Compatible::Point');
-}
-
-my $point = TAP::Harness::Compatible::Point->new;
-isa_ok( $point, 'TAP::Harness::Compatible::Point' );
-ok( !$point->ok, "Should start out not OK" );
-
-$point->set_ok(1);
-ok( $point->ok, "should have turned to true" );
-
-$point->set_ok(0);
-ok( !$point->ok, "should have turned false" );
-
-$point->set_number(2112);
-is( $point->number, 2112, "Number is set" );
-
-$point->set_description("Blah blah");
-is( $point->description, "Blah blah", "Description set" );
-
-$point->set_directive("Go now");
-is( $point->directive, "Go now", "Directive set" );
-
-$point->add_diagnostic("# Line 1");
-$point->add_diagnostic("# Line two");
-$point->add_diagnostic("# Third line");
-my @diags = $point->diagnostics;
-is( @diags, 3, "Three lines" );
-is_deeply(
- \@diags,
- [ "# Line 1", "# Line two", "# Third line" ],
- "Diagnostics in list context"
-);
-
-my $diagstr = <<EOF;
-# Line 1
-# Line two
-# Third line
-EOF
-
-chomp $diagstr;
-my $string_diagnostics = $point->diagnostics;
-is( $string_diagnostics, $diagstr, "Diagnostics in scalar context" );
Deleted: trunk/t/compat/prove-globbing.t
===================================================================
--- trunk/t/compat/prove-globbing.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/prove-globbing.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,34 +0,0 @@
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "prove not available";
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-plan tests => 1;
-
-my $tests = File::Spec->catfile( 't', 'compat', 'prove*.t' );
-my $prove
- = File::Spec->catfile( File::Spec->curdir, "blib", "script", "prove" );
-$prove = "$^X $prove";
-
-GLOBBAGE: {
- my @actual = sort qx/$prove --dry $tests/;
- chomp @actual;
-
- my @expected = (
- File::Spec->catfile( "t", "compat", "prove-globbing.t" ),
- File::Spec->catfile( "t", "compat", "prove-switches.t" ),
- );
- is_deeply( \@actual, \@expected, "Expands the wildcards" );
-}
Deleted: trunk/t/compat/prove-switches.t
===================================================================
--- trunk/t/compat/prove-switches.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/prove-switches.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,89 +0,0 @@
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-use Test::More;
-plan skip_all => "prove not available";
-plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE};
-plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE";
-
-# Work around a Cygwin bug. Remove this if Perl bug 30952 ever gets fixed.
-# http://rt.perl.org/rt3/Ticket/Display.html?id=30952.
-plan skip_all => "Skipping because of a Cygwin bug" if ( $^O =~ /cygwin/i );
-
-plan tests => 8;
-
-my $blib = File::Spec->catfile( File::Spec->curdir, "blib" );
-my $blib_lib = File::Spec->catfile( $blib, "lib" );
-my $blib_arch = File::Spec->catfile( $blib, "arch" );
-my $prove = File::Spec->catfile( $blib, "script", "prove" );
-$prove = "$^X $prove";
-
-CAPITAL_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/;
- my @expected = (
- "# \$TAP::Harness::Compatible::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n"
- );
- is_deeply( \@actual, \@expected, "Capital taint flags OK" );
-}
-
-LOWERCASE_TAINT: {
- local $ENV{PROVE_SWITCHES};
-
- my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/;
- my @expected = (
- "# \$TAP::Harness::Compatible::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n"
- );
- is_deeply( \@actual, \@expected, "Lowercase taint OK" );
-}
-
-PROVE_SWITCHES: {
- local $ENV{PROVE_SWITCHES} = "-dvb -I fark";
-
- my @actual = qx/$prove -Ibork -Dd/;
- my @expected = (
- "# \$TAP::Harness::Compatible::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n"
- );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_L: {
- my @actual = qx/$prove -l -Ibongo -Dd/;
- my @expected
- = ("# \$TAP::Harness::Compatible::Switches: -Ilib -Ibongo\n");
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_SWITCHES_LB: {
- my @actual = qx/$prove -lb -Dd/;
- my @expected = (
- "# \$TAP::Harness::Compatible::Switches: -Ilib -I$blib_arch -I$blib_lib\n"
- );
- is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" );
-}
-
-PROVE_VERSION: {
-
-# This also checks that the prove $VERSION is in sync with TAP::Harness::Compatible's $VERSION
- local $/ = undef;
-
- use_ok('TAP::Harness::Compatible');
-
- my $thv = $TAP::Harness::Compatible::VERSION;
- my @actual = qx/$prove --version/;
- is( scalar @actual, 1, 'Only 1 line returned' );
- like(
- $actual[0],
- qq{/^\Qprove v$thv, using TAP::Harness::Compatible v$thv and Perl v5\E/}
- );
-}
Deleted: trunk/t/compat/strap-analyze.t
===================================================================
--- trunk/t/compat/strap-analyze.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/strap-analyze.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,568 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use Test::More tests => 247;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS =
- $ENV{PERL_CORE}
- ? File::Spec->catdir( $Curdir, 'lib', 'sample-tests' )
- : File::Spec->catdir( $Curdir, 't', 'sample-tests' );
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-my $die_exit = $IsVMS ? 44 : 1;
-
-# We can only predict that the wait status should be zero or not.
-my $wait_non_zero = 1;
-
-my %samples = (
- bignum => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- combined_compat => {
- bonus => 1,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- name => "basset hounds got long ears",
- ok => 1
- },
- { actual_ok => 0,
- name => "all hell broke lose",
- ok => 0
- },
- { actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1,
- reason => "contract negociations",
- type => "skip"
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 0,
- ok => 0
- },
- { actual_ok => 0,
- ok => 1,
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 10,
- ok => 8,
- passing => 0,
- seen => 10,
- skip => 1,
- todo => 2,
- 'wait' => 0
- },
- descriptive => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- name => "Interlock activated",
- ok => 1
- },
- { actual_ok => 1,
- name => "Megathrusters are go",
- ok => 1
- },
- { actual_ok => 1,
- name => "Head formed",
- ok => 1
- },
- { actual_ok => 1,
- name => "Blazing sword formed",
- ok => 1
- },
- { actual_ok => 1,
- name => "Robeast destroyed",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- 'die' => {
- bonus => 0,
- details => [],
- 'exit' => $die_exit,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_head_end => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 4,
- ],
- 'exit' => $die_exit,
- max => 0,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- die_last_minute => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 4,
- ],
- 'exit' => $die_exit,
- max => 4,
- ok => 4,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => $wait_non_zero
- },
- duplicates => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 10,
- ],
- 'exit' => 0,
- max => 10,
- ok => 11,
- passing => 0,
- seen => 11,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_end => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 3,
- { actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- head_fail => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 0,
- ok => 0
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- diagnostics => "comment\nmore ignored stuff\nand yet more\n",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 4,
- ok => 3,
- passing => 0,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- lone_not_bug => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 4,
- ],
- 'exit' => 0,
- max => 4,
- ok => 4,
- passing => 1,
- seen => 4,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- no_output => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 0,
- seen => 0,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- shbang_misparse => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 2,
- ],
- 'exit' => 0,
- max => 2,
- ok => 2,
- passing => 1,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple => {
- bonus => 0,
- details => [
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 5,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- simple_fail => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 0,
- ok => 0
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 0,
- ok => 0
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 3,
- passing => 0,
- seen => 5,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- skip => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1,
- reason => "rain delay",
- type => "skip"
- },
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 3,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skip_nomsg => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- ok => 1,
- reason => "",
- type => "skip"
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 1,
- todo => 0,
- 'wait' => 0
- },
- skipall => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "rope",
- todo => 0,
- 'wait' => 0
- },
- skipall_nomsg => {
- bonus => 0,
- details => [],
- 'exit' => 0,
- max => 0,
- ok => 0,
- passing => 1,
- seen => 0,
- skip => 0,
- skip_all => "",
- todo => 0,
- 'wait' => 0
- },
- taint => {
- bonus => 0,
- details => [
- { actual_ok => 1,
- name => "-T honored",
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 1,
- ok => 1,
- passing => 1,
- seen => 1,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- todo => {
- bonus => 1,
- details => [
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 1,
- ok => 1,
- type => "todo"
- },
- { actual_ok => 0,
- ok => 1,
- type => "todo"
- },
- ( { actual_ok => 1,
- ok => 1
- }
- ) x 2,
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 2,
- 'wait' => 0
- },
- vms_nit => {
- bonus => 0,
- details => [
- { actual_ok => 0,
- ok => 0
- },
- { actual_ok => 1,
- ok => 1
- }
- ],
- 'exit' => 0,
- max => 2,
- ok => 1,
- passing => 0,
- seen => 2,
- skip => 0,
- todo => 0,
- 'wait' => 0
- },
- with_comments => {
- bonus => 2,
- details => [
- { actual_ok => 0,
- diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
- ok => 1,
- type => "todo"
- },
- { actual_ok => 1,
- ok => 1,
- reason => "at line 10 TODO?!)",
- type => "todo"
- },
- { actual_ok => 1,
- ok => 1
- },
- { actual_ok => 0,
- diagnostics =>
- "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n",
- ok => 1,
- type => "todo"
- },
- { actual_ok => 1,
- diagnostics => "woo\n",
- ok => 1,
- reason => "at line 13 TODO?!)",
- type => "todo"
- }
- ],
- 'exit' => 0,
- max => 5,
- ok => 5,
- passing => 1,
- seen => 5,
- skip => 0,
- todo => 4,
- 'wait' => 0
- },
-);
-
-use TAP::Harness::Compatible::Straps;
-my @_INC = map {qq{"-I$_"}} @INC;
-$TAP::Harness::Compatible::Switches = "@_INC -Mstrict";
-
-$SIG{__WARN__} = sub {
- warn @_
- unless $_[0] =~ /^Enormous test number/
- || $_[0] =~ /^Can't detailize/;
-};
-
-for my $test ( sort keys %samples ) {
- print "# Working on $test\n";
- my $expect = $samples{$test};
-
- for my $n ( 0 .. $#{ $expect->{details} } ) {
- for my $field (qw( type name reason )) {
- $expect->{details}[$n]{$field} = ''
- unless exists $expect->{details}[$n]{$field};
- }
- }
-
- my $test_path = File::Spec->catfile( $SAMPLE_TESTS, $test );
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
- my $results = $strap->analyze_file($test_path);
-
- is_deeply(
- $results->details, $expect->{details},
- qq{details of "$test"}
- );
-
- delete $expect->{details};
-
- SKIP: {
- skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
-
- # We can only check if it's zero or non-zero.
- is( !$results->wait, !$expect->{'wait'}, 'wait status' );
- delete $expect->{'wait'};
-
- # Have to check the exit status seperately so we can skip it
- # in MacPerl.
- is( $results->exit, $expect->{'exit'}, 'exit matches' );
- delete $expect->{'exit'};
- }
-
- for my $field ( sort keys %$expect ) {
- is( $results->$field(), $expect->{$field}, "Field $field" );
- }
-} # for %samples
-
-NON_EXISTENT_FILE: {
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
- ok( !$strap->analyze_file('I_dont_exist'),
- "Can't analyze a non-existant file"
- );
- is( $strap->{error}, "I_dont_exist does not exist",
- "And there should be one error"
- );
-}
Deleted: trunk/t/compat/strap.t
===================================================================
--- trunk/t/compat/strap.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/strap.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,172 +0,0 @@
-#!/usr/bin/perl -Tw
-
-use strict;
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use Test::More tests => 89;
-
-BEGIN { use_ok('TAP::Harness::Compatible::Straps'); }
-
-my $strap = TAP::Harness::Compatible::Straps->new;
-isa_ok( $strap, 'TAP::Harness::Compatible::Straps', 'new()' );
-
-### Testing _is_diagnostic()
-
-my $comment;
-ok( !$strap->_is_diagnostic( "foo", \$comment ),
- '_is_diagnostic(), not a comment'
-);
-ok( !defined $comment, ' no comment set' );
-
-ok( !$strap->_is_diagnostic( "f # oo", \$comment ),
- ' not a comment with #'
-);
-ok( !defined $comment, ' no comment set' );
-
-my %comments = (
- "# stuff and things # and stuff" => ' stuff and things # and stuff',
- " # more things " => ' more things ',
- "#" => '',
-);
-
-for my $line ( sort keys %comments ) {
- my $line_comment = $comments{$line};
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
-
- my $name = substr( $line, 0, 20 );
- ok( $strap->_is_diagnostic( $line, \$comment ), " comment '$name'" );
- is( $comment, $line_comment, ' right comment set' );
-}
-
-### Testing _is_header()
-
-my @not_headers = (
- ' 1..2',
- '1..M',
- '1..-1',
- '2..2',
- '1..a',
- '',
-);
-
-foreach my $unheader (@not_headers) {
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
-
- ok( !$strap->_is_header($unheader),
- "_is_header(), not a header '$unheader'"
- );
-
- ok( ( !grep { exists $strap->{$_} } qw(max todo skip_all) ),
- " max, todo and skip_all are not set"
- );
-}
-
-my @attribs = qw(max skip_all todo);
-my %headers = (
- '1..2' => { max => 2 },
- '1..1' => { max => 1 },
- '1..0' => {
- max => 0,
- skip_all => '',
- },
- '1..0 # Skipped: no leverage found' => {
- max => 0,
- skip_all => 'no leverage found',
- },
- '1..4 # Skipped: no leverage found' => {
- max => 4,
- skip_all => 'no leverage found',
- },
- '1..0 # skip skip skip because' => {
- max => 0,
- skip_all => 'skip skip because',
- },
- '1..10 todo 2 4 10' => {
- max => 10,
- 'todo' => {
- 2 => 1,
- 4 => 1,
- 10 => 1,
- },
- },
- '1..10 todo' => { max => 10 },
- '1..192 todo 4 2 13 192 # Skip skip skip because' => {
- max => 192,
- 'todo' => {
- 4 => 1,
- 2 => 1,
- 13 => 1,
- 192 => 1,
- },
- skip_all => 'skip skip because'
- }
-);
-
-for my $header ( sort keys %headers ) {
- my $expect = $headers{$header};
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
-
- ok( $strap->_is_header($header), "_is_header() is a header '$header'" );
-
- is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' )
- if defined $expect->{skip_all};
-
- ok( eq_set(
- [ map $strap->{$_}, grep defined $strap->{$_}, @attribs ],
- [ map $expect->{$_}, grep defined $expect->{$_}, @attribs ]
- ),
- ' the right attributes are there'
- );
-}
-
-### Test _is_bail_out()
-
-my %bails = (
- 'Bail out!' => undef,
- 'Bail out! Wing on fire.' => 'Wing on fire.',
- 'BAIL OUT!' => undef,
- 'bail out! - Out of coffee' => '- Out of coffee',
-);
-
-for my $line ( sort keys %bails ) {
- my $expect = $bails{$line};
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
-
- my $reason;
- ok( $strap->_is_bail_out( $line, \$reason ),
- "_is_bail_out() spots '$line'"
- );
- is( $reason, $expect, ' with the right reason' );
-}
-
-my @unbails = (
- ' Bail out!',
- 'BAIL OUT',
- 'frobnitz',
- 'ok 23 - BAIL OUT!',
-);
-
-foreach my $line (@unbails) {
- my $strap = TAP::Harness::Compatible::Straps->new;
- isa_ok( $strap, 'TAP::Harness::Compatible::Straps' );
-
- my $reason;
-
- ok( !$strap->_is_bail_out( $line, \$reason ),
- "_is_bail_out() ignores '$line'"
- );
- is( $reason, undef, ' and gives no reason' );
-}
Deleted: trunk/t/compat/test-harness.t
===================================================================
--- trunk/t/compat/test-harness.t 2007-03-10 22:16:07 UTC (rev 108)
+++ trunk/t/compat/test-harness.t 2007-03-11 11:45:04 UTC (rev 109)
@@ -1,577 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- if ( $ENV{PERL_CORE} ) {
- chdir 't';
- @INC = ( '../lib', 'lib' );
- }
- else {
- unshift @INC, 't/lib';
- }
-}
-
-use strict;
-use File::Spec;
-
-my $Curdir = File::Spec->curdir;
-my $SAMPLE_TESTS =
- $ENV{PERL_CORE}
- ? File::Spec->catdir( $Curdir, 'lib', 'sample-tests' )
- : File::Spec->catdir( $Curdir, 't', 'sample-tests' );
-
-use Test::More;
-use Dev::Null;
-
-my $IsMacPerl = $^O eq 'MacOS';
-my $IsVMS = $^O eq 'VMS';
-
-# VMS uses native, not POSIX, exit codes.
-# MacPerl's exit codes are broken.
-my $die_estat =
- $IsVMS ? 44
- : $IsMacPerl ? 0
- : 1;
-
-my %samples = (
- simple => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- simple_fail => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2 5',
- },
- all_ok => 0,
- },
- descriptive => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- no_nums => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3',
- },
- all_ok => 0,
- },
- 'todo' => {
- total => {
- bonus => 1,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- todo_inline => {
- total => {
- bonus => 1,
- max => 3,
- 'ok' => 3,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 2,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- 'skip' => {
- total => {
- bonus => 0,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- 'skip_nomsg' => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 1,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- bailout => 0,
- combined_compat => {
- total => {
- bonus => 1,
- max => 10,
- 'ok' => 8,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 1,
- 'todo' => 2,
- skipped => 0
- },
- failed => {
- canon => '3 9',
- },
- all_ok => 0,
- },
- duplicates => {
- total => {
- bonus => 0,
- max => 10,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- head_end => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- head_fail => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 3,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '2',
- },
- all_ok => 0,
- },
- no_output => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 0,
- },
- skipall => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => {},
- all_ok => 1,
- },
- skipall_nomsg => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 1,
- },
- failed => {},
- all_ok => 1,
- },
- with_comments => {
- total => {
- bonus => 2,
- max => 5,
- 'ok' => 5,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 4,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- taint => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
-
- taint_warn => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
-
- 'die' => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 0,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_head_end => {
- total => {
- bonus => 0,
- max => 0,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => '??',
- failed => '??',
- canon => '??',
- },
- all_ok => 0,
- },
-
- die_last_minute => {
- total => {
- bonus => 0,
- max => 4,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- estat => $die_estat,
- max => 4,
- failed => 0,
- canon => '??',
- },
- all_ok => 0,
- },
- bignum => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 4,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '??',
- },
- all_ok => 0,
- },
- bignum_many => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 11,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '3-100000',
- },
- all_ok => 0,
- },
- 'shbang_misparse' => {
- total => {
- bonus => 0,
- max => 2,
- 'ok' => 2,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
- too_many => {
- total => {
- bonus => 0,
- max => 3,
- 'ok' => 7,
- files => 1,
- bad => 1,
- good => 0,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {
- canon => '4-7',
- },
- all_ok => 0,
- },
- switches => {
- total => {
- bonus => 0,
- max => 1,
- 'ok' => 1,
- files => 1,
- bad => 0,
- good => 1,
- tests => 1,
- sub_skipped => 0,
- 'todo' => 0,
- skipped => 0,
- },
- failed => {},
- all_ok => 1,
- },
-);
-
-my $tests_per_loop = 8;
-plan skip_all => 'Harness compatibility not implemented yet';
-
-#plan tests => (keys(%samples) * $tests_per_loop);
-
-use TAP::Harness::Compatible;
-my @_INC = map {qq{"-I$_"}} @INC;
-$TAP::Harness::Compatible::Switches = "@_INC -Mstrict";
-
-tie *NULL, 'Dev::Null' or die $!;
-
-for my $test ( sort keys %samples ) {
- SKIP: {
- skip "-t introduced in 5.8.0", $tests_per_loop
- if ( $test eq 'taint_warn' ) && ( $] < 5.008 );
-
- my $expect = $samples{$test};
-
- # execute_tests() runs the tests but skips the formatting.
- my $test_path = File::Spec->catfile( $SAMPLE_TESTS, $test );
-
- print STDERR "# $test\n" if $ENV{TEST_VERBOSE};
- my $totals;
- my $failed;
- my $warning = '';
- eval {
- local $SIG{__WARN__} = sub { $warning .= join '', @_; };
- ( $totals, $failed )
- = TAP::Harness::Compatible::execute_tests(
- tests => [$test_path], out => \*NULL );
- };
-
- # $? is unreliable in MacPerl, so we'll just fudge it.
- $failed->{estat} = $die_estat if $IsMacPerl and $failed;
-
- SKIP: {
- skip "special tests for bailout", 1 unless $test eq 'bailout';
- like( $@, '/Further testing stopped: GERONI/i' );
- }
-
- SKIP: {
- skip "don't apply to a bailout", 6 if $test eq 'bailout';
- is( $@, '', '$@ is empty' );
- is( TAP::Harness::Compatible::_all_ok($totals),
- $expect->{all_ok},
- "$test - all ok"
- );
- ok( defined $expect->{total}, "$test - has total" );
- is_deeply(
- { map { $_ => $totals->{$_} } keys %{ $expect->{total} } },
- $expect->{total},
- "$test - totals"
- );
- is_deeply(
- { map { $_ => $failed->{$test_path}{$_} }
- keys %{ $expect->{failed} }
- },
- $expect->{failed},
- "$test - failed"
- );
-
- skip "No tests were run", 1 unless $totals->{max};
-
- my $output
- = TAP::Harness::Compatible::get_results( $totals, $failed );
- like(
- $output, '/All tests successful|List of Failed/',
- 'Got what looks like a valid summary'
- );
- }
-
- my $expected_warnings = "";
- if ( $test eq "bignum" ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 136211425]
-Can't detailize, too big.
-WARN
- }
- elsif ( $test eq 'bignum_many' ) {
- $expected_warnings = <<WARN;
-Enormous test number seen [test 100001]
-Can't detailize, too big.
-WARN
- }
- my $desc = $expected_warnings ? 'Got proper warnings' : 'No warnings';
- is( $warning, $expected_warnings, "$test - $desc" );
- } # taint SKIP block
-} # for tests
More information about the tapx-dev
mailing list