harness

#!perl
# Copyright (C) 2001-2006, The Perl Foundation.
# $Id$

=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<CGoto> core.

=item C<-j>

Run with JIT enabled.

=item C<-C>

Run the C<CGP> core.

=item C<-S>

Run Switched.

=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<--running-make-test>

Some test scripts run more quickly when this is set.

=item C<--gc-debug>

Invoke parrot with '--gc-debug'.

=item C<--html>

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

=back

=cut


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

use Getopt::Std;
use Test::Harness();
use English qw( -no_match_vars );
use Parrot::Config qw/%PConfig/;


# handle the long options

$ENV{RUNNING_MAKE_TEST} = grep { $_ eq '--running-make-test' } @ARGV;
@ARGV = grep { $_ ne '--running-make-test' } @ARGV;

my $gc_debug = grep { $_ eq '--gc-debug' } @ARGV;
@ARGV = grep { $_ ne '--gc-debug' } @ARGV;

my $html = grep { $_ eq '--html' } @ARGV;
@ARGV = grep { $_ ne '--html' } @ARGV;

my $run_exec = grep { $_ eq '--run-exec' } @ARGV;
@ARGV = grep { $_ ne '--run-exec' } @ARGV;

# Suck the short options into the TEST_PROG_ARGS evar:
my %opts;
getopts('wgjPCSefbvdr?hO:D:', \%opts);
if ($opts{'?'} || $opts{h}) {
    print <<"EOF";
perl t/harness [options] [testfiles]
    -w         ... warnings on
    -g         ... run CGoto
    -j         ... run JIT
    -C         ... run CGP
    -S         ... run Switched
    -b         ... run bounds checked
    --run-exec ... run exec core
    -f         ... run fast core
    -v         ... run verbose
    -d         ... run debug
    -r         ... assemble to PBC run PBC
    -O[012]    ... optimize
    -D[number] ... pass debug flags to parrot interpreter
    --running-make-test
    --gc-debug
    --html
EOF
    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 = join(' ', map { "-$_" } keys %opts );
$args =~ s/-O/-O$opts{O}/ if exists $opts{O};
$args =~ s/-D/-D$opts{D}/;
$args .= ' --gc-debug'    if $gc_debug;
# XXX find better way for passing run_exec to Parrot::Test
$args .= ' --run-exec'    if $run_exec; 
$ENV{TEST_PROG_ARGS} = $args;

# Pass in a list of tests to run on the command line, else run all the tests.
my @default_tests = map {glob "t/$_/*.t"} qw(
    configure compilers/imcc/* op pmc native_pbc dynpmc dynoplibs
    compilers/past compilers/pge compilers/pge/p5regex compilers/pge/p6regex
    compilers/tge compilers/json library examples run src tools perl doc stm
);
push @default_tests, 't/distro/manifest.t';

# collect the coding standard tests (that we want to run) together and
# append them to the list of default tests
my @coding_std_tests = map { "t/codingstd/$_" } qw(
    c_code_coda.t 
    c_indent.t
    cppcomments.t 
    cuddled_else.t 
    line_endings.t
    tabs.t 
    trailing_space.t
);
push @default_tests, @coding_std_tests;

my @tests = @ARGV ? map { glob( $_ ) } @ARGV : @default_tests;

unless ($html) {
    Test::Harness::runtests(@tests);
} else {
    my @smoke_config_vars = qw(
        osname archname cc build_dir cpuarch revision VERSION optimize DEVEL
    );

    eval {
        require Test::TAP::HTMLMatrix;
        require Test::TAP::Model::Visual;
    };
    die "You must have Test::TAP::HTMLMatrix installed.\n\n$EVAL_ERROR"
        if $EVAL_ERROR;

    ## FIXME: ###
    # This is a temporary solution until Test::TAP::Model version
    # 0.05.  At that point, this function should be removed, and the
    # verbose line below should be uncommented.
    {
      no warnings qw/redefine once/;
      *Test::TAP::Model::run_tests = sub {
        my $self = shift;

        $self->_init;
        $self->{meat}{start_time} = time;

        my %stats;

        foreach my $file (@_) {
            my $data;
            print STDERR "- $file\n";
            $data = $self->run_test($file);
            $stats{tests} += $data->{results}{max};
            $stats{ok}    += $data->{results}{ok} || 0;
        }

        printf STDERR "%s OK from %s tests (%.2f%% ok)\n\n",
            $stats{ok},
            $stats{tests},
            $stats{ok} / $stats{tests} * 100;

        $self->{meat}{end_time} = time;
      };

      my $start = time();
      my $model = Test::TAP::Model::Visual->new();
      # $model->set_verbose();
      $model->run_tests(@tests);

      my $end = time();

      my $duration = $end - $start;

      my $v = Test::TAP::HTMLMatrix->new(
        $model,
        join("\n",
             "duration: $duration",
             "branch: unknown",
             "harness_args: " . (($args) ? $args : "N/A"),
             map { "$_: $PConfig{$_}" } sort @smoke_config_vars),
                   );

      $v->has_inline_css(1); # no separate css file

      open HTML, ">", "smoke.html";
      print HTML $v->html;
      close HTML;

      print "smoke.html has been generated.\n";
    }
}

=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: