Skip to content

Commit

Permalink
Updated harness that doesn't rely on Parrot::Test::Harness.
Browse files Browse the repository at this point in the history
This version doesn't honor the --jobs option; patches welcome
to re-add that feature.  Also needs testing on Win32.
  • Loading branch information
pmichaud committed Feb 25, 2009
1 parent 70d9081 commit 5944501
Showing 1 changed file with 20 additions and 48 deletions.
68 changes: 20 additions & 48 deletions t/harness
Expand Up @@ -8,50 +8,33 @@
use FindBin;
use File::Spec;
use Getopt::Long qw(:config pass_through);
use lib qw( parrot/lib ../../lib );
use strict;

our %harness_args;
our $recurse = 1;

our %harness_args = (
language => 'perl6',
compiler => 'perl6.pbc',
verbosity => 0,
);

if (-d 'parrot') {
$harness_args{exec} = ['parrot/parrot', 'perl6.pbc'];
} else {
$harness_args{compiler} = 'perl6.pbc';
}
$ENV{'HARNESS_PERL'} = './perl6';
use Test::Harness;
$Test::Harness::switches = '';

GetOptions(
'tests-from-file=s' => \my $list_file,
'fudge' => \my $do_fudge,
'verbosity=i' => \$harness_args{verbosity},
# A sensible default is num_cores + 1.
# Many people have two cores these days.
'jobs:3' => \$harness_args{jobs},
);


'tests-from-file=s' => \my $list_file,
'fudge' => \my $do_fudge,
'verbosity=i' => \my $verbosity,
'jobs:3' => \my $jobs,
);
my @pass_through_options = grep m/^--?[^-]/, @ARGV;
my @files = grep m/^[^-]/, @ARGV;

my %accepted_tests;
my $slash = $^O eq 'MSWin32' ? '\\' : '/';

if ($list_file) {
open(my $f, '<', $list_file)
or die "Can't open file '$list_file' for reading: $!";
my $slash = $^O eq 'MSWin32' ? '\\' : '/';
while (<$f>){
while (<$f>) {
next if m/^\s*#/;
next unless m/\S/;
chomp;
my ($fn, $fudgespec) = split m/\s+#\s*/;
$fn = "t/spec/$fn" unless $fn =~ m/^t\Q$slash\Espec\Q$slash\E/;
$fn =~ s/\//$slash/g;
if( -r $fn ) {
$fn =~ s{/}{$slash}g;
if ( -r $fn ) {
push @files, $fn;
} else {
warn "Missing test file: $fn\n";
Expand All @@ -60,25 +43,14 @@ if ($list_file) {
close $f;
}

# first prepare our list of files
my @tfiles = map { all_in($_) } sort @files;

# then decide if and what to fudge
if ($do_fudge) {
@tfiles = fudge(@tfiles);
}

$harness_args{arguments} = \@tfiles;

sub fudge {
my $impl = 'rakudo';
my $cmd = join ' ', $^X, 't/spec/fudgeall',
@pass_through_options, $impl, @_;
# print "$cmd\n";
return split ' ', `$cmd`;
}
runtests(@tfiles);

# Stolen directly from 'prove'
# adapted to return only files ending in '.t'
sub all_in {
my $start = shift;
Expand Down Expand Up @@ -110,9 +82,9 @@ sub all_in {
return @hits;
}

# Set up PERL6LIB environment path so the "use" tests can find libraries
$ENV{PERL6LIB} = "$FindBin::Bin/01-sanity";

eval 'use Parrot::Test::Harness %harness_args';


sub fudge {
my $impl = 'rakudo';
my $cmd = join ' ', $^X, 't/spec/fudgeall',
@pass_through_options, $impl, @_;
return split ' ', `$cmd`;
}

0 comments on commit 5944501

Please sign in to comment.