#! perl

# Copyright (C) 2004-2006, The Perl Foundation.
# $Id: /mirror/trunk/languages/t/harness 13394 2006-07-20T06:00:01.955543Z fperrad  $

use strict;
use warnings;
use 5.006;
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

    make languages-test 

or

    cd languages && make test

=item Smoke testing

    make languages-smoke

or

    cd languages && make smoke

=item Selected languages

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

=item Per Language Harness

For well behaved languages you can do something like:

    cd languages/tcl && make test

=item Run a single test for more detailed output.

    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 or languages/pheme.

=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
# perl6                test scrips are written in Perl 6, not Perl 5
# pheme                test scrips are written in Scheme, not Perl 5
# 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
              cardinal
              dotnet
              HQ9plus
              jako
              lazy-k
              lua
              m4
              ook
              parrot_compiler
              punie
              regex
              scheme
              tcl
              unlambda
              urm
              WMLScript
              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";
    }
}
