#! perl -w
# Copyright: 2004-2006 The Perl Foundation.  All Rights Reserved.
# $Id: harness 11641 2006-02-18 12:54:27Z bernhard $

use strict;
use warnings;

use FindBin;
use lib "$FindBin::Bin/../../lib";

use Data::Dumper;
use File::Spec;
use Test::Harness();
use Parrot::Config qw/%PConfig/;

=head1 Languages harness

There are 3 ways to run a language test: 

=over 4

=item Overall Harness

C<make languages-test> 

or

C<cd languages && make test>

=item * Smoke testing

C<make languages-smoke> 

or

C<cd languages && make smoke> or

=item Per Language Harness

For well behaved languages you can do something like:

C<cd languages/tcl && make test>

=item Run a single test for more detailed output.

e.g., C<cd languages/tcl && prove t/joe_test.t>

=back

=head1 TODO

There is too much overlap with ../t/harness.

=head1 AUTHOR

  Will "Coke" Coleda
  Jerome Quelin

=cut

=for comment

We are assuming that we are running out of parrot/languages; we are being
called by languages/Makefile with an explicit perl. All languages have 
a Makefile with a "test" target, and any prereqs required by that test
have already been built.

=cut


# Step 0: handle command line args

my $do_gen_html = grep { $_ eq '--html' } @ARGV;
@ARGV = grep { $_ ne '--html' } @ARGV;

# Step 1: find harness files for testable languages

# Various languages are not yet in smoke testing, some will never be.
#
# BASIC                No t/harness, two implementations
# cola                 not maintained
# conversion           No t/harness
# forth                No t/harness
# lisp                 No t/harness
# miniperl             not maintained, should be removed
# parakeet             No t/harness
# punie                Problems with exhaustive memory usage
# python               not maintained
# ruby                 not maintained, should be removed


my @unified_testable_languages = 
   qw( HQ9plus
       Zcode
       bc
       befunge
       bf
       jako
       lazy-k
       lua
       m4
       ook
       parrot_compiler
       regex
       scheme
       tcl
       unlambda
       urm );
# @unified_testable_languages = qw( bc );

my @harnesses =
    grep {-f $_}
        map { File::Spec->join($_,"t","harness") }
            @unified_testable_languages;

# Step 2: Get a listing of files from these harnesses.

my @tests;
foreach my $harness (@harnesses) {
    my $perl = "$^X -I" . File::Spec->join(File::Spec->updir(), 'lib');
    open(FILES, "$perl $harness --files |");  
    push @tests, <FILES>;
    close(FILES);
}
chomp(@tests);

# Step 3: test.

if ( ! $do_gen_html ) {
    Test::Harness::runtests(@tests);
} 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$@" 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 {
            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};
                $stats{ok}    += $data->{results}{ok};
            }

            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_with_tests(@tests);
        my $end = time;

        my $duration = $end - $start;
        my $languages = join( q{ }, @unified_testable_languages );
        my $v = Test::TAP::HTMLMatrix->new(
            $model,
            join("\n",
                 "languages: $languages",
                 "duration: $duration",
                 "branch: unknown",
                 "harness_args: languages",
                 map { "$_: $PConfig{$_}" } sort @smoke_config_vars),
        );

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

        print "$html_fn has been generated.\n";
    }
}

