The patch attach provides the refactoring of t/harness proposed in the OP. Please review. I'll apply in 3 days or so if no one objects.
Thank you very much. kid51 (svn merge did not give me the intended results. Only the files that were altered went into the patch; the newly added files did not. Hence, the multiple files, for which I apologize in advance.)
# Copyright (C) 2006-2007, The Perl Foundation.
# $Id: Smoke.pm 25272 2008-01-27 05:13:48Z jkeenan $
=head1 NAME
Parrot::Harness::Smoke - Subroutines used by F<t/harness> to generate smoke
reports
=head1 DESCRIPTION
This package exports on request subroutines used by F<t/harness> to generate
smoke reports.
Currently, only one such subroutine is supported:
generate_html_smoke_report (
tests => [EMAIL PROTECTED],
args => $args,
file => 'smoke.html',
);
=cut
package Parrot::Harness::Smoke;
use strict;
use lib qw( . lib ../lib ../../lib );
use Parrot::Config qw/%PConfig/;
use base qw( Exporter );
our @EXPORT_OK = qw(
generate_html_smoke_report
);
sub generate_html_smoke_report {
my $argsref = shift;
my $html_fn = $argsref->{file};
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 $@;
{
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->run_tests( @{ $argsref->{tests} } );
my $end = time();
my $duration = $end - $start;
my $v = Test::TAP::HTMLMatrix->new(
$model,
join("\n",
"duration: $duration",
"branch: unknown",
"harness_args: " . (($argsref->{args}) ? $argsref->{args} : "N/A"),
map { "$_: $PConfig{$_}" } sort @smoke_config_vars),
);
$v->has_inline_css(1); # no separate css file
open HTML, '>', $html_fn;
print HTML $v->html();
close HTML;
print "$html_fn has been generated.\n";
}
}
1;
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
01-default_tests.t
Description: Binary data
02-get_test_prog_args.t
Description: Binary data
# Copyright (C) 2006-2007, The Perl Foundation.
# $Id: Options.pm 25324 2008-01-29 00:57:18Z jkeenan $
=head1 NAME
Parrot::Harness::Options - Handle options and argument processing in
F<t/harness>
=head1 DESCRIPTION
=cut
package Parrot::Harness::Options;
use strict;
use base qw( Exporter );
our @EXPORT_OK = qw(
handle_long_options
get_test_prog_args
Usage
);
sub handle_long_options {
my @argv = @_;
my %longopts;
$longopts{running_make_test} = grep { $_ eq '--running-make-test' } @argv;
@argv = grep { $_ ne '--running-make-test' } @argv;
$longopts{gc_debug} = grep { $_ eq '--gc-debug' } @argv;
@argv = grep { $_ ne '--gc-debug' } @argv;
$longopts{core_tests_only} = grep { $_ eq '--core-tests' } @argv;
@argv = grep { $_ ne '--core-tests' } @argv;
$longopts{runcore_tests_only} = grep { $_ eq '--runcore-tests' } @argv;
@argv = grep { $_ ne '--runcore-tests' } @argv;
$longopts{html} = grep { $_ eq '--html' } @argv;
@argv = grep { $_ ne '--html' } @argv;
$longopts{run_exec} = grep { $_ eq '--run-exec' } @argv;
@argv = grep { $_ ne '--run-exec' } @argv;
$longopts{help} = grep { $_ eq '--help' } @argv;
@argv = grep { $_ ne '--help' } @argv;
return (\%longopts, @argv);
}
sub get_test_prog_args {
my ($optsref, $gc_debug, $run_exec) = @_;
my %opts = %{ $optsref };
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;
return $args;
}
sub Usage {
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
EOF
}
1;
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Index: MANIFEST
===================================================================
--- MANIFEST (revision 25639)
+++ MANIFEST (working copy)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools\dev\mk_manifest_and_skip.pl Sun Feb 10 12:42:56 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Feb 11 03:07:38 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2458,6 +2458,9 @@
lib/Parrot/Docs/Section/Perl.pm [devel]
lib/Parrot/Docs/Section/Tests.pm [devel]
lib/Parrot/Docs/Section/Tools.pm [devel]
+lib/Parrot/Harness/DefaultTests.pm [devel]
+lib/Parrot/Harness/Options.pm [devel]
+lib/Parrot/Harness/Smoke.pm [devel]
lib/Parrot/Headerizer.pm [devel]
lib/Parrot/IO/Directory.pm [devel]
lib/Parrot/IO/File.pm [devel]
@@ -3202,6 +3205,10 @@
t/perl/Parrot_PIR_Formatter.t []
t/perl/Parrot_Test.t []
t/perl/README []
+t/pharness/01-default_tests.t []
+t/pharness/02-get_test_prog_args.t []
+t/pharness/03-handle_long_options.t []
+t/pharness/04-Usage.t []
t/pmc/addrregistry.t []
t/pmc/array.t []
t/pmc/bigint.t []
Index: lib/Parrot/Configure/Options/Test.pm
===================================================================
--- lib/Parrot/Configure/Options/Test.pm (revision 25639)
+++ lib/Parrot/Configure/Options/Test.pm (working copy)
@@ -52,6 +52,7 @@
glob("t/tools/ops2cutils/*.t"),
glob("t/tools/ops2pmutils/*.t"),
glob("t/tools/revision/*.t"),
+ glob("t/pharness/*.t"),
);
sub new {
Index: t/harness
===================================================================
--- t/harness (revision 25639)
+++ t/harness (working copy)
@@ -2,6 +2,64 @@
# Copyright (C) 2001-2007, The Perl Foundation.
# $Id$
+
+use strict;
+use warnings;
+use Getopt::Std;
+use Test::Harness();
+use lib qw( lib );
+use Parrot::Harness::DefaultTests;
+use Parrot::Harness::Options qw(
+ handle_long_options
+ get_test_prog_args
+ Usage
+);
+use Parrot::Harness::Smoke qw(
+ generate_html_smoke_report
+);
+
+local @ARGV = @ARGV;
+my $longopts;
+($longopts, @ARGV) = handle_long_options(@ARGV);
+
+$ENV{RUNNING_MAKE_TEST} = $longopts->{running_make_test};
+
+# Suck the short options into the TEST_PROG_ARGS
+# environmental variable.
+my %opts;
+getopts('wgjPCSefbvdr?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;
+
+# now build the list of tests to run, either from the command
+# line or from @default tests
+my @default_tests = get_default_tests(
+ $longopts->{core_tests_only},
+ $longopts->{runcore_tests_only}
+);
+
+my @tests = map { glob( $_ ) } (@ARGV ? @ARGV : @default_tests);
+
+if (!$longopts->{html}) {
+ Test::Harness::runtests(@tests);
+} else {
+ generate_html_smoke_report ( {
+ tests => [EMAIL PROTECTED],
+ args => $args,
+ file => 'smoke.html',
+ } );
+}
+
=head1 NAME
t/harness - Parrot Test Harness
Index: config/gen/makefiles/root.in
===================================================================
--- config/gen/makefiles/root.in (revision 25639)
+++ config/gen/makefiles/root.in (working copy)
@@ -1392,11 +1392,13 @@
OPS2PMUTILS_DIR = t/tools/ops2pmutils
OPS2CUTILS_DIR = t/tools/ops2cutils
REVISIONUTILS_DIR = t/tools/revision
+HARNESS_DIR = t/pharness
BUILDTOOLS_TEST_FILES = \
$(PMC2CUTILS_DIR)/*.t \
$(OPS2PMUTILS_DIR)/*.t \
$(OPS2CUTILS_DIR)/*.t \
- $(REVISIONUTILS_DIR)/*.t
+ $(REVISIONUTILS_DIR)/*.t \
+ $(HARNESS_DIR)/*.t
MANIFEST_DIR = t/manifest
MANIFEST_TEST_FILES = \
$(MANIFEST_DIR)/01-basic.t \
Index: languages/t/harness
===================================================================
--- languages/t/harness (revision 25639)
+++ languages/t/harness (working copy)
@@ -127,28 +127,18 @@
Test::Harness::runtests(@tests);
}
else {
+ my $html_fn = "languages_smoke.html";
my @smoke_config_vars = qw(
- osname
- archname
- cc
- build_dir
- cpuarch
- revision
- VERSION
- optimize
- DEVEL
+ 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 $@;
+ 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 {
@@ -163,8 +153,8 @@
my $data;
print STDERR "- $file\n";
$data = $self->run_test($file);
- $stats{tests} += $data->{results}{max};
- $stats{ok} += $data->{results}{ok} || 0;
+ $stats{tests} += $data->{results}{max} || 0;
+ $stats{ok} += $data->{results}{ok} || 0;
}
printf STDERR "%s OK from %s tests (%.2f%% ok)\n\n",
@@ -172,7 +162,7 @@
$stats{tests},
$stats{ok} / $stats{tests} * 100;
- $self->{meat}{end_time} = time;
+ $self->{meat}{end_time} = time();
};
my $start = time();
@@ -193,7 +183,6 @@
$v->has_inline_css(1); # no separate css file
- my $html_fn = "languages_smoke.html";
open HTML, '>', $html_fn;
print HTML $v->html();
close HTML;
03-handle_long_options.t
Description: Binary data
04-Usage.t
Description: Binary data
# Copyright (C) 2006-2007, The Perl Foundation.
# $Id: DefaultTests.pm 25269 2008-01-27 03:00:03Z jkeenan $
=head1 NAME
Parrot::Harness::DefaultTests - Tests run by default by F<t/harness>
=head1 DESCRIPTION
This file exports by default a single subroutine, C<get_default_tests()>,
which is the list of tests run by F<t/harness> by default.
In list context, C<get_default_tests()> returns the list of default tests. In
scalar context it returns a reference to that list.
=cut
package Parrot::Harness::DefaultTests;
use strict;
use base qw( Exporter );
our @EXPORT = qw( get_default_tests );
# runcore tests are always run.
our @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
our @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
our @configure_tests = qw( t/configure/*.t t/steps/*.t t/postconfigure/*.t );
our @standard_tests = qw(
t/compilers/json/*.t
t/examples/*.t
t/doc/*.t
t/distro/manifest.t
);
our @developing_tests = (
't/distro/file_metadata.t',
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
)
);
sub get_default_tests {
my ($core_tests_only, $runcore_tests_only) = @_;
# add metadata.t and coding standards tests only if we're DEVELOPING
if ( -e "DEVELOPING" ) {
push @standard_tests, @developing_tests;
}
# 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;
}
}
wantarray
? return @default_tests
: return [ @default_tests ];
}
1;
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
