Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tag: RELEASE_0_5_2
Fetching contributors…

Cannot retrieve contributors at this time

340 lines (254 sloc) 7.787 kB
#!perl
# Copyright (C) 2001-2007, 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 Parrot::Config qw/%PConfig/;
use FindBin qw/$Bin/;
# 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 $core_tests_only = grep { $_ eq '--core-tests' } @ARGV;
@ARGV = grep { $_ ne '--core-tests' } @ARGV;
my $runcore_tests_only = grep { $_ eq '--runcore-tests' } @ARGV;
@ARGV = grep { $_ ne '--runcore-tests' } @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;
my $use_test_run = grep { $_ eq '--tr' } @ARGV;
@ARGV = grep { $_ ne '--tr' } @ARGV;
$use_test_run ||= $ENV{'PARROT_USE_TEST_RUN'};
# 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
--core-tests
--runcore-tests
--html
--tr ... run using Test::Run
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;
# Build the lists of tests to be run
# runcore tests are always run.
my @runcore_tests = qw(
t/compilers/imcc/*/*.t
t/op/*.t
t/pmc/*.t
t/oo/*.t
t/native_pbc/*.t
t/dynpmc/*.t
t/dynoplibs/*.t
t/compilers/pge/*.t
t/compilers/pge/p5regex/*.t
t/compilers/pge/perl6regex/*.t
t/compilers/tge/*.t
t/library/*.t
);
# core tests are run unless --runcore-tests is present. Typically
# this list and the list above are run in response to --core-tests
my @core_tests = qw(
t/run/*.t
t/src/*.t
t/tools/*.t
t/perl/*.t
t/stm/*.t
);
# configure tests are tests to be run at the beginning of 'make test';
# standard tests are other tests run by default with no core options
# present
my @configure_tests = qw( t/configure/*.t t/steps/*.t t/postconfigure/*.t );
my @standard_tests = qw(
t/compilers/json/*.t
t/examples/*.t
t/doc/*.t
t/distro/manifest.t
);
# add metadata.t and coding standards tests only if we're DEVELOPING
if ( -e "$Bin/../DEVELOPING" ) {
push @standard_tests, 't/distro/file_metadata.t';
push @standard_tests, map { "t/codingstd/$_" } qw(
c_code_coda.t
c_header_guards.t
c_indent.t
c_struct.t
check_toxxx.t
copyright.t
cppcomments.t
cuddled_else.t
filenames.t
gmt_utc.t
linelength.t
pccmethod_deps.t
pir_code_coda.t
svn_id.t
tabs.t
trailing_space.t
);
# XXX: This takes WAY too long to run: perlcritic.t
}
# build the list of default tests
my @default_tests = @runcore_tests;
unless ($runcore_tests_only) {
push @default_tests, @core_tests;
unless ($core_tests_only) {
unshift @default_tests, @configure_tests;
push @default_tests, @standard_tests;
}
}
# now build the list of tests to run, either from the command
# line or from @default tests
my @tests = map { glob( $_ ) } (@ARGV ? @ARGV : @default_tests);
if ($use_test_run) {
require Test::Run::CmdLine::Iface;
my $test_run =
Test::Run::CmdLine::Iface->new(
{
'test_files' => [@tests],
}
# 'backend_params' => $self->_get_backend_params(),
);
$test_run->run();
}
elsif (!$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$@"
if $@;
## 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} || 0;
$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:
Jump to Line
Something went wrong with that request. Please try again.