#! perl
# Copyright (C) 2004-2009, The Perl Foundation.
# $Id: /mirror/trunk/languages/t/harness 35745 2009-01-18T12:09:17.170228Z 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

    make languages-test

or

    cd languages && make test

=item Selected languages

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

=item Per Language Harness

For almost all languages you can do something like:

    cd languages/tcl && make test

=item Run a single test for more detailed output.

    cd languages/tcl && prove -v t/cmd_lsort.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 unified testing; some will never be.
#
# BASIC                No t/harness, two implementations
# ecmascript           No t/harness
# forth                No t/harness
# perl6                test scripts are written in Perl 6, not Perl 5
# pheme                test scripts are written in Scheme, not Perl 5
# PIR                  many test failures
# pynie                test scripts are written in PIR, not Perl 5
# scheme               many test failures
# urm                  uses deprecated parrot features
# Zcode                Method 'instantiate' not found for 'Zmachine'

my @unified_testable_languages
    = defined $languages_list ?
          split( /\s*,\s*/, $languages_list )
          :
          qw( abc APL
              befunge bf
              cola
              dotnet
              jako
              lazy-k lisp lua
              markdown
              ook
              parrot_compiler pipp punie
              regex
              unlambda
              WMLScript
            );
my @harnesses
    = grep {-f $_}
          map { File::Spec->join($_, 't', 'harness') }
              @unified_testable_languages;

# Step 2: Get a listing of files from these harnesses.
#
# See L<Parrot::Test::Harness> for information regarding --master.

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

# Step 3: test.

if ( ! $do_gen_html ) {
    Test::Harness::runtests(@tests);
}
else {
    my $html_fn = "languages_smoke.html";
    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 $@;

    {
        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} || 0;
                $stats{ok}    += $data->{results}{ok}  || 0;
            }

            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

        open HTML, '>', $html_fn;
        print HTML $v->html();
        close HTML;

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

# Local Variables:
#   mode: cperl
#   cperl-indent-level: 4
#   fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
