harness

#!perl
# Copyright (C) 2001-2009, Parrot Foundation.

use strict;
use warnings;
use lib qw( lib );

use Getopt::Std;

# need runtests from T::H, but avoid running all our parrot invocations with -w
use Test::Harness ();
undef $Test::Harness::Switches;

use Parrot::Harness::DefaultTests qw(
    get_common_tests
    @developing_tests
);
use Parrot::Harness::Options qw(
    handle_long_options
    get_test_prog_args
    Usage
);
use Parrot::Harness::Smoke qw(
    generate_html_smoke_report
    send_archive_to_smolder
    collect_test_environment_data
);

local @ARGV = @ARGV;
(my $longopts, @ARGV) = handle_long_options(@ARGV);

# Suck the short options into the TEST_PROG_ARGS
# environmental variable.
my %opts;
getopts('wgGjPCSefbvdr?hO:D:', \%opts);

if ($opts{'?'} || $opts{h} || $longopts->{help}) {
    Usage();
    exit;
}

# add -D40;  merge it with any existing -D argument
$opts{D} = sprintf( '%x', hex(40) | (exists $opts{D} ? hex($opts{D}) : 0));

my $args = get_test_prog_args(
    \%opts, $longopts->{gc_debug}, $longopts->{run_exec}
);
$ENV{TEST_PROG_ARGS} = $args;

my @tests;
if ($longopts->{code}) {
    @tests = @developing_tests;
}
else {
    @tests = map { glob($_) } (@ARGV
        ? @ARGV
        : get_common_tests( $longopts )
    );
}

my $harness;
if ($longopts->{archive}) {
    eval { require TAP::Harness::Archive };
    if ($@) {
        die "\n" . ('-' x 55) . "\nCould not load TAP::Harness::Archive."
            . "\nPlease install it if you want to create TAP archives.\n"
            . ('-' x 55) . "\n\n$@\n";
    }
    # for extra_properties we need TAP::Harness::Archive >= .10
    if ($TAP::Harness::Archive::VERSION < .10) {
        die "\n" . ('-' x 55) . "\nWe need TAP::Harness::Archive >= .10."
            . "\nPlease install it if you want to create TAP archives.\n"
            . ('-' x 55) . "\n";
    }

    my %env_data = collect_test_environment_data();
    $harness = TAP::Harness::Archive->new(
        {
            verbosity        => $ENV{HARNESS_VERBOSE},
            archive          => 'parrot_test_run.tar.gz',
            merge            => 1,
            extra_properties => \%env_data,
            extra_files      => [ 'myconfig', 'config_lib.pir' ],
            jobs             => $ENV{TEST_JOBS} || 1,
        }
    );
    $harness->runtests(@tests);
    send_archive_to_smolder(%env_data) if $longopts->{send_to_smolder};

}
elsif ($longopts->{html}) {
    generate_html_smoke_report(
        {
            tests => \@tests,
            args  => $args,
            file  => 'smoke.html',
        }
    );
}
else {
    eval { require TAP::Harness };
    if ($@) {
        Test::Harness::runtests(@tests);
        exit;
    }
    else {
        $harness = TAP::Harness->new({
            verbosity => $ENV{HARNESS_VERBOSE},
            merge     => 0,
            jobs      => $ENV{TEST_JOBS} || 1,
            directives => 1,
        });
    }
    my $results = $harness->runtests(@tests);

    exit ( $results->all_passed() ? 0 : 1 );
}

=head1 NAME

t/harness - Parrot Test Harness

=head1 SYNOPSIS

    % perl t/harness [options] [testfiles]

=head1 DESCRIPTION

The short command line options are:

=over 4

=item C<-w>

Turn warnings on.

=item C<-G>

Run the C<GCDebug> core.

=item C<-j>

Alias for running with the fast core.

=item C<-b>

Run bounds checking enabled.

=item C<-d>

Run with debugging enabled.

=item C<-f>

Run fast core.

=item C<-r>

compile to Parrot bytecode and then run the bytecode.

=item C<-O[012]>

Run optimized to the specified level.

=item C<-D[number]>

Pass the specified debug bits to the parrot interpreter.  Note that
C<-D40> (fill I, N registers with garbage) is always enabled.
See 'parrot --help-debug' for available flags.

=back

There are also long command line options:

=over 4

=item C<--gc-debug>

Invoke parrot with '--gc-debug'.

=item C<--html>

Emit a C<smoke.html> file instead of displaying results.

=item C<--code-tests>

Run only the file metadata and basic coding standards tests.

=back

=head1 HISTORY

Mike Lambert stole F<t/harness> for F<languages/perl6/t/harness>.

Leo Toetsch stole F<languages/perl6/t/harness> for F<imcc/t/harness>.

Bernhard Schmalhofer merged F<imcc/t/harness> back into F<t/harness>.

=cut


# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4: