#! perl

# $Id: /mirror/trunk/languages/perl6/t/harness 31016 2008-09-11T14:37:09.395532Z moritz  $

# note: du to a limitation in Getopt::Long options that should be passed
# through to fudgeall have to come after all other options

use FindBin;
use File::Spec;
use Getopt::Long qw(:config pass_through);
use lib qw( ../../lib );
use strict;

our %harness_args;
our $recurse = 1;

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

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},
    );


my @pass_through_options = grep m/^--?[^-]/, @ARGV;
my @files = grep m/^[^-]/, @ARGV;

my %accepted_tests;
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>){
        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 ) {
            push @files, $fn;
        } else {
            warn "Missing test file: $fn\n";
        }
    }
    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`;
}

# Stolen directly from 'prove'
# adapted to return only files ending in '.t'
sub all_in {
    my $start = shift;

    return $start unless -d $start;

    my @hits = ();

    local *DH;
    if ( opendir( DH, $start ) ) {
        my @files = sort readdir DH;
        closedir DH;
        for my $file ( @files ) {
            next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
            next if $file eq ".svn";
            next if $file eq "CVS";

            my $currfile = File::Spec->catfile( $start, $file );
            if ( -d $currfile ) {
                push( @hits, all_in( $currfile ) ) if $recurse;
            } else {
                push( @hits, $currfile ) if $currfile =~ /\.t$/;
            }
        }
    } else {
        warn "$start: $!\n";
    }

    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';


