view release on metacpan or  search on metacpan

t/lib/Test/Harness.pm  view on Meta::CPAN

use vars qw(
    $VERSION 
    @ISA @EXPORT @EXPORT_OK 
    $Verbose $Switches $Debug
    $verbose $switches $debug
    $Columns
    $Timer
    $ML $Last_ML_Print
    $Strap
    $has_time_hires
);

BEGIN {
    eval q{use Time::HiRes 'time'};
    $has_time_hires = !$@;
}

=head1 NAME

Test::Harness - Run Perl standard test scripts with statistics

=head1 VERSION

Version 2.64

=cut

$VERSION = '2.64';

# Backwards compatibility for exportable variable names.
*verbose  = *Verbose;
*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} || 'Test::Harness::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('Test::Harness::Straps') ) {
    die "HARNESS_STRAP_CLASS '$HARNESS_STRAP_CLASS' must be a Test::Harness::Straps subclass";
}

$Strap = $HARNESS_STRAP_CLASS->new;

sub strap { return $Strap };

@ISA = ('Exporter');
@EXPORT    = qw(&runtests);
@EXPORT_OK = qw(&execute_tests $verbose $switches);

$Verbose  = $ENV{HARNESS_VERBOSE} || 0;
$Debug    = $ENV{HARNESS_DEBUG} || 0;
$Switches = '-w';
$Columns  = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
$Columns--;             # Some shells have trouble with a full line of text.
$Timer    = $ENV{HARNESS_TIMER} || 0;

=head1 SYNOPSIS

  use Test::Harness;

  runtests(@test_files);

=head1 DESCRIPTION

B<STOP!> If all you want to do is write a test script, consider
using Test::Simple.  Test::Harness 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 Test::Harness to use
those modules.

Test::Harness 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<Test::Harness::TAP>.

C<Test::Harness::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 Test::Harness.

=head2 Taint mode

Test::Harness will honor the C<-T> or C<-t> in the #! line on your
test files.  So if you begin a test with: