Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tag: RELEASE_0_4_9
Fetching contributors…

Cannot retrieve contributors at this time

261 lines (183 sloc) 5.913 kb
# Copyright (C) 2001-2006, The Perl Foundation.
# $Id$
=head1 NAME
t/harness - Parrot Test Harness
% perl t/harness [options] [testfiles]
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.
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.
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
# 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;
# 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(
push @default_tests, @coding_std_tests;
my @tests = @ARGV ? map { glob( $_ ) } @ARGV : @default_tests;
unless ($html) {
} 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"
## 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->{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} * 100;
$self->{meat}{end_time} = time;
my $start = time();
my $model = Test::TAP::Model::Visual->new();
# $model->set_verbose();
my $end = time();
my $duration = $end - $start;
my $v = Test::TAP::HTMLMatrix->new(
"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>.
# 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.