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

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.

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