[svn:parrot] r35578 - in trunk: languages/t lib/Parrot/Harness t

[Will Coleda]

Smoke is dead, and languages are leaving the nest. What's the purpose
for restoring this option?

On Thu, Jan 15, 2009 at 4:46 AM,  <fperrad at cvs.perl.org> wrote:
> Author: fperrad
> Date: Thu Jan 15 01:46:49 2009
> New Revision: 35578
>
> Modified:
>   trunk/languages/t/harness
>   trunk/lib/Parrot/Harness/Smoke.pm
>   trunk/t/harness
>
> Log:
> [harness]
> - restore --html option
>
> Modified: trunk/languages/t/harness
> ==============================================================================
> --- trunk/languages/t/harness   (original)
> +++ trunk/languages/t/harness   Thu Jan 15 01:46:49 2009
> @@ -57,8 +57,10 @@
>
>
>  # Step 0: handle command line args
> +my $do_gen_html;       # smoke testing
>  my $languages_list;    # select a subset of languages
> -my $result = GetOptions( 'languages=s'   => \$languages_list );
> +my $result = GetOptions( 'html'          => \$do_gen_html,
> +                         'languages=s'   => \$languages_list );
>
>  # Step 1: find harness files for testable languages
>
> @@ -111,7 +113,74 @@
>  chomp(@tests);
>
>  # Step 3: test.
> -Test::Harness::runtests(@tests);
> +
> +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
>
> Modified: trunk/lib/Parrot/Harness/Smoke.pm
> ==============================================================================
> --- trunk/lib/Parrot/Harness/Smoke.pm   (original)
> +++ trunk/lib/Parrot/Harness/Smoke.pm   Thu Jan 15 01:46:49 2009
> @@ -12,6 +12,12 @@
>
>  Following subroutines are supported:
>
> +    generate_html_smoke_report (
> +        tests       => \@tests,
> +        args        => $args,
> +        file        => 'smoke.html',
> +    );
> +
>     my %env_data = collect_test_environment_data();
>
>     send_archive_to_smolder( %env_data );
> @@ -27,6 +33,7 @@
>  use Parrot::Config qw/%PConfig/;
>  use base qw( Exporter );
>  our @EXPORT_OK = qw(
> +    generate_html_smoke_report
>     collect_test_environment_data
>     send_archive_to_smolder
>  );
> @@ -114,6 +121,73 @@
>     return $compiler;
>  }
>
> +sub generate_html_smoke_report {
> +    my $argsref = shift;
> +    my $html_fn = $argsref->{file};
> +    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();
> +      $model->run_tests( @{ $argsref->{tests} } );
> +
> +      my $end = time();
> +
> +      my $duration = $end - $start;
> +
> +      my $v = Test::TAP::HTMLMatrix->new(
> +        $model,
> +        join("\n",
> +             "duration: $duration",
> +             "branch: unknown",
> +             "harness_args: " . (($argsref->{args}) ? $argsref->{args} : "N/A"),
> +             map { "$_: $PConfig{$_}" } sort @smoke_config_vars),
> +      );
> +
> +      $v->has_inline_css(1); # no separate css file
> +
> +      open my $HTML, '>', $html_fn;
> +      print {$HTML} $v->html();
> +      close $HTML;
> +
> +      print "$html_fn has been generated.\n";
> +    }
> +}
> +
>  1;
>
>  # Local Variables:
>
> Modified: trunk/t/harness
> ==============================================================================
> --- trunk/t/harness     (original)
> +++ trunk/t/harness     Thu Jan 15 01:46:49 2009
> @@ -22,6 +22,7 @@
>     Usage
>  );
>  use Parrot::Harness::Smoke qw(
> +    generate_html_smoke_report
>     send_archive_to_smolder
>     collect_test_environment_data
>  );
> @@ -92,6 +93,15 @@
>     send_archive_to_smolder(%env_data) if $longopts->{send_to_smolder};
>
>  }
> +elsif ($longopts->{html}) {
> +    generate_html_smoke_report(
> +        {
> +            tests => \@tests,
> +            args  => $args,
> +            file  => 'smoke.html',
> +        }
> +    );
> +}
>  else {
>     eval { require TAP::Harness };
>     if ($@) {
> @@ -186,6 +196,10 @@
>
>  Invoke parrot with '--gc-debug'.
>
> +=item C<--html>
> +
> +Emit a C<smoke.html> file instead of displaying results.
> +
>  =item C<--code-tests>
>
>  Run only the file metadata and basic coding standards tests.
>



-- 
Will "Coke" Coleda