Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
branch: avl_string_cac…
Fetching contributors…

Cannot retrieve contributors at this time

220 lines (157 sloc) 4.434 kB
#!perl
# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
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' ],
}
);
$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<CGoto> core.
=item C<-G>
Run the C<GCDebug> core.
=item C<-j>
Alias for running with the fast core.
=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<--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:
Jump to Line
Something went wrong with that request. Please try again.