#! perl

# Copyright: 2004-2006 The Perl Foundation.  All Rights Reserved.
# $Id: harness 12273 2006-04-16 10:39:21Z bernhard $

use strict;
use warnings;
use lib qw( lib ../lib );

use File::Spec;
use Getopt::Long;
use Parrot::Config qw/%PConfig/;
use Test::Harness  ();

=head1 Languages harness

There are 4 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>

=item Selected languages

  C<cd languages && perl t/harness --languages=m4,punie>

=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

It should be possible to use non-Perl5 test files, like for languages/perl6.

=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.

=cut


# Step 0: handle command line args
my $do_gen_html;       # smoke testing
my $languages_list;    # select a subset of languages
my $result = GetOptions( 'html'          => \$do_gen_html,    
                         'languages=s'   => \$languages_list );  

# 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
# python               not maintained
# ruby                 not maintained, should be removed



my @unified_testable_languages
    = defined $languages_list ?
          split( /\s*,\s*/, $languages_list )
          : 
          qw( APL
              bc
              befunge
              bf
              HQ9plus
              jako
              lazy-k
              lua
              m4
              ook
              parrot_compiler
              perl6
              punie
              regex
              scheme
              tcl
              unlambda
              urm
              Zcode
            );
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";
    }
}

