Ticket #69: patch.patch

File patch.patch, 40.4 KB (added by coke, 13 years ago)

Patch to convert smoke to smolder (and drop any smoke-specific items)

  • DEPRECATED.pod 

    Property changes on: .
___________________________________________________________________
Name: svn:ignore
   - *.patch
*.tmp
*.vcproj*
*.sln
*.ncb
*.suo
CFLAGS
MANIFEST.configure.generated
Makefile
TAGS
all_cstring.str
blib
config_lib.pasm
install_config.fpmc
libparrot.def
libparrot.dll
miniparrot
myconfig
parrot
parrot_config
parrot_config.c
parrot_config.pbc
parrot.ilk
parrot.pdb
parrot.pc
parrot_test_run.tar.gz
pbc_disassemble
pbc_info
pbc_merge
pdump
smoke.html
tags
temp.file
test
test.c
test.cco
test.err
test.ilk
test.ldo
test.o
test.out
test.pdb
vc60.pdb
vc70.pdb
vtable.dump
installable*
*.exe
*.core
*.pdb
*.ilk
*.def
*.lib
*.obj
*.exp
*.manifest
parrot.iss
cover_db
pbc_to_exe
pbc_to_exe.*
perl6
.parrot_current_rev
.git
parrot_debugger

   + *.patch
*.tmp
*.vcproj*
*.sln
*.ncb
*.suo
CFLAGS
MANIFEST.configure.generated
Makefile
TAGS
all_cstring.str
blib
config_lib.pasm
install_config.fpmc
libparrot.def
libparrot.dll
miniparrot
myconfig
parrot
parrot_config
parrot_config.c
parrot_config.pbc
parrot.ilk
parrot.pdb
parrot.pc
parrot_test_run.tar.gz
pbc_disassemble
pbc_info
pbc_merge
pdump
tags
temp.file
test
test.c
test.cco
test.err
test.ilk
test.ldo
test.o
test.out
test.pdb
vc60.pdb
vc70.pdb
vtable.dump
installable*
*.exe
*.core
*.pdb
*.ilk
*.def
*.lib
*.obj
*.exp
*.manifest
parrot.iss
cover_db
pbc_to_exe
pbc_to_exe.*
perl6
.parrot_current_rev
.git
parrot_debugger
     
    165165 
    166166=back 
    167167 
    168 =head1 Misc. 
    169  
    170 =over 4 
    171  
    172 =item 'make smoke' [post 0.8.2] 
    173  
    174 The functionality currently provided by "make smoke" will be changing to 
    175 be an alias for "make smolder_test". We're moving towards smolder as our 
    176 single point of online test reporting, and will keep the make target to 
    177 simplify the switch for anyone currently smoking parrot.  See RT #49276. 
    178  
    179 =back 
    180  
    181168=cut 

  • docs/tests.pod

     
    2424C<make languages-test> runs the test suite for most language implementations 
    2525in the languages directory. 
    2626 
    27 =head2 Submitting smoke test results 
     27=head2 Submitting smolder test results 
    2828 
    29 Parrot has a status page with smoke test results 
    30 L<http://smoke.parrotcode.org/smoke/>. You can supply new tests 
    31 results by just running C<make smoke>. It will run the same tests as 
    32 C<make test> would, but will additionally create a HTML table with the test 
    33 results. At the end, it will try to upload the test results to the 
    34 smoke server. 
     29Parrot has a status page with smoke test results at 
     30L<http://smolder.plusthree.com/app/public_projects/details/8>. 
    3531 
    36 It is also possible to run a smoke test on JIT. For that, try running 
    37 C<make smokej>. 
     32You can supply new tests results by just running C<make smoke>.  
     33It will run the same tests as C<make test> would, but will upload 
     34the test results to the website. 
    3835 
    39 C<make languages-smoke> does smoke testing for most language implementations 
    40 in the languages directory. 
    41  
    4236=head1 Location of the test files 
    4337 
    4438The parrot test files, the F<*.t> files, can be found in the F<t> directory. 

  • tools/util/smokeserv-client.pl

     
    1 #! perl 
    2  
    3 # Copyright (C) 2005-2007, The Perl Foundation. 
    4 # $Id$ 
    5  
    6 use strict; 
    7 use warnings; 
    8  
    9 use Getopt::Long; 
    10 use LWP::UserAgent; 
    11  
    12 use constant VERSION => 0.4; 
    13 sub debug; 
    14  
    15 our $compress = sub { return }; 
    16  
    17 GetOptions( 
    18     "smokeserv=s" => \( my $smokeserv          = "http://smoke.parrotcode.org/smoke/" ), 
    19     "help"        => \&usage, 
    20     "compress|c!" => \( my $compression_wanted = 1 ), 
    21     "version" => sub { print "smokeserv-client.pl v" . VERSION . "\n"; exit }, 
    22 )          or usage(); 
    23 @ARGV == 1 or usage(); 
    24  
    25 debug "smokeserv-client v" . VERSION . " started.\n"; 
    26  
    27 setup_compression() if $compression_wanted; 
    28  
    29 my %request = ( upload => 1, version => VERSION, smokes => [] ); 
    30  
    31 { 
    32     my $file = shift @ARGV; 
    33     debug "Reading smoke \"$file\" to upload... "; 
    34  
    35     open my $fh, "<", $file or die "Couldn't open \"$file\" for reading: $!\n"; 
    36     local $/; 
    37     my $smoke = <$fh>; 
    38  
    39     unless ( $smoke =~ /^<!DOCTYPE html/ ) { 
    40         debug "doesn't look like a smoke; aborting.\n"; 
    41         exit 1; 
    42     } 
    43  
    44     $request{smoke} = $compress->($smoke) || $smoke; 
    45     debug "ok.\n"; 
    46 } 
    47  
    48 { 
    49     debug "Sending data to smokeserver \"$smokeserv\"... "; 
    50     my $ua = LWP::UserAgent->new; 
    51     $ua->agent( "parrot-smokeserv-client/" . VERSION ); 
    52     $ua->env_proxy; 
    53  
    54     my $resp = $ua->post( $smokeserv => \%request ); 
    55     if ( $resp->is_success ) { 
    56         if ( $resp->content =~ /^ok/ ) { 
    57             debug "success!\n"; 
    58             exit 0; 
    59         } 
    60         else { 
    61             debug "error: " . $resp->content . "\n"; 
    62             exit 1; 
    63         } 
    64     } 
    65     else { 
    66         debug "error: " . $resp->status_line . "\n"; 
    67         exit 1; 
    68     } 
    69 } 
    70  
    71 sub usage { 
    72     print STDERR <<USAGE; exit } 
    73 Usage: $0 [options] -- smoke1.html smoke2.html ... 
    74  
    75 Available options: 
    76   --smokeserv=http://path/to/smokeserv.pl 
    77     Sets the path to the smoke server. 
    78   --version 
    79     Outputs the version of this program and exits. 
    80   --help 
    81     Show this help. 
    82  
    83 Options may be abbreviated to uniqueness. 
    84 USAGE 
    85  
    86 # Nice debugging output. 
    87 { 
    88     my $fresh; 
    89  
    90     sub debug { 
    91         my $msg = shift; 
    92  
    93         print STDERR "* " and $fresh++ unless $fresh; 
    94         print STDERR $msg; 
    95         $fresh = 0 if substr( $msg, -1 ) eq "\n"; 
    96         1; 
    97     } 
    98 } 
    99  
    100 sub setup_compression { 
    101     eval { require Compress::Bzip2; debug "Bzip2 compression on\n" } 
    102         and return $compress = sub { Compress::Bzip2::memBzip(shift) }; 
    103     eval { require Compress::Zlib; debug "Gzip compression on\n" } 
    104         and $compress = sub { Compress::Zlib::memGzip(shift) }; 
    105 } 
    106  
    107 # Local Variables: 
    108 #   mode: cperl 
    109 #   cperl-indent-level: 4 
    110 #   fill-column: 100 
    111 # End: 
    112 # vim: expandtab shiftwidth=4: 

  • tools/util/smokeserv-README.pod

     
    1 =head1 NAME 
    2  
    3 smokeserv - Parrot Smoke Reports Server 
    4  
    5 =head1 DESCRIPTION 
    6  
    7 C<smokeserv-client.pl> is a Perl 5 program which submits smokes as generated by 
    8 the C<smoke-*> make targets (C<smoke>, C<smoke-perl5>, C<smoke-js>) to a public 
    9 smokeserver. 
    10  
    11 C<smokeserv-server.pl> is the smokeserver which accepts the smokes submitted 
    12 by C<smokeserv-client.pl>. 
    13  
    14 =head1 USAGE 
    15  
    16 =head2 Client 
    17  
    18 Using the client is easy. In the first place, you have to generate a 
    19 C<smoke.html>. You can achieve this by running C<make>: 
    20  
    21   $ make smoke        # or 
    22   $ make smoke-js     # or 
    23   $ make smoke-perl5  # or 
    24   $ make smoke-pir 
    25  
    26 Then you can upload the resulting smoke: 
    27  
    28   $ ./tools/util/smokeserv-client.pl ./smoke.html 
    29  
    30 You don't need to be careful to only submit a smoke only once, etc. -- the 
    31 smokeserver takes care of this. 
    32  
    33 =head2 Server 
    34  
    35 Setting up a server is easy, too, all you have to do is to install several CPAN 
    36 modules (C<CGI>, C<CGI::Carp>, C<Fcntl>, C<Storable>, C<HTML::Template>, 
    37 C<Algorithm::TokenBucket>, C<Time::Piece>, C<Time::Seconds>, C<Compress::Zlib>, 
    38 and C<Compress::Bzip2>) and change the constants at the top of 
    39 C<smokeserv-server.pl>. 
    40  
    41 =head1 LICENSE 
    42  
    43 This program is free software; you can redistribute it and/or modify it under 
    44 the same terms as Perl itself. See L<perlgpl> and L<perlartistic> for details. 
    45  
    46 =cut 

  • tools/util/smokeserv-server.pl

     
    1 #! perl 
    2 # Copyright (C) 2005-2008, The Perl Foundation. 
    3 # $Id$ 
    4 use strict; 
    5 use warnings; 
    6  
    7 use CGI; 
    8 use CGI::Carp qw<fatalsToBrowser>; 
    9 use Fcntl qw<:DEFAULT :flock>; 
    10 use Storable qw<store_fd fd_retrieve freeze>; 
    11 use Digest::MD5 qw<md5_hex>; 
    12 use HTML::Template; 
    13 use Algorithm::TokenBucket; 
    14 use Time::Piece; 
    15 use Time::Seconds; 
    16  
    17 require_compression_modules(); 
    18  
    19 use constant { 
    20     VERSION                     => 0.4, 
    21     MAX_SIZE                    => 2**20 * 3.0,             # MiB limit 
    22     BASEDIR                     => "/tmp/parrot_smokes/", 
    23     BASEHTTPDIR                 => "/", 
    24     BUCKET                      => "bucket.dat", 
    25     MAX_RATE                    => 1 / 30,                  # Allow a new smoke all 30s 
    26     BURST                       => 5,                       # Set max burst to 5 
    27     MAX_SMOKES_OF_SAME_CATEGORY => 5, 
    28 }; 
    29 $CGI::POST_MAX = MAX_SIZE; 
    30 chdir BASEDIR or die "Couldn't chdir into \"@{[ BASEDIR ]}\": $!\n"; 
    31  
    32 $SIG{PIPE} = "IGNORE"; 
    33  
    34 my $t = do { local $/; <DATA> }; 
    35  
    36 my $CGI = new CGI; 
    37  
    38 if ( $CGI->url( -path => 1 ) =~ /html$/ ) { 
    39     print $CGI->header; 
    40     my $file = $CGI->url( -absolute => 1, -path => 1 ); 
    41     my $basehttpdir = BASEHTTPDIR; 
    42     $file =~ s!^$basehttpdir!!; 
    43     die "Invalid File" 
    44         if $file =~ m!/|\.\.!; 
    45     if ( -e BASEDIR . "/" . $file ) { 
    46         open my $f, "<", BASEDIR . "/" . $file or die $!; 
    47         print do { local $/; <$f> }; 
    48     } 
    49 } 
    50 else { 
    51     if ( $CGI->param("upload") ) { 
    52         eval { process_upload($CGI) }; 
    53     } 
    54     else { 
    55         eval { process_list($CGI) }; 
    56     } 
    57 } 
    58  
    59 exit; 
    60  
    61 sub process_upload { 
    62     my $CGI = shift; 
    63  
    64     print $CGI->header; 
    65  
    66     limit_rate(); 
    67     validate_params($CGI); 
    68     add_smoke($CGI); 
    69     clean_obsolete_smokes(); 
    70  
    71     print "ok"; 
    72 } 
    73  
    74 sub validate_params { 
    75     my $CGI = shift; 
    76  
    77     if ( not $CGI->param("version") or $CGI->param("version") != VERSION ) { 
    78         print "Versions do not match!"; 
    79         exit; 
    80     } 
    81  
    82     if ( not $CGI->param("smoke") ) { 
    83         print "No smoke given!"; 
    84         exit; 
    85     } 
    86  
    87     uncompress_smoke($CGI); 
    88     unless ( $CGI->param("smoke") =~ /^<!DOCTYPE html/ ) { 
    89         print "The submitted smoke does not look like a smoke!"; 
    90         exit; 
    91     } 
    92 } 
    93  
    94 sub uncompress_smoke { 
    95     my $CGI = shift; 
    96     $CGI->param( "smoke", 
    97         Compress::Zlib::memGunzip( $CGI->param("smoke") ) 
    98             || Compress::Bzip2::memBunzip( $CGI->param("smoke") ) 
    99             || $CGI->param("smoke") ); 
    100 } 
    101  
    102 sub require_compression_modules { 
    103     no strict 'refs'; 
    104     eval { require Compress::Zlib } 
    105         or *Compress::Zlib::memGunzip = sub { return }; 
    106     eval { require Compress::Bzip2 } 
    107         or *Compress::Bzip2::memBunzip = sub { return }; 
    108 } 
    109  
    110 sub add_smoke { 
    111     my $CGI  = shift; 
    112     my $html = $CGI->param("smoke"); 
    113  
    114     my $id = md5_hex $html; 
    115     if ( glob "parrot-smoke-*-$id.html" ) { 
    116         print "The submitted smoke was already submitted!"; 
    117         exit; 
    118     } 
    119  
    120     my %smoke; 
    121     $html =~ /revision: (\d+)/      and $smoke{revision}     = $1; 
    122     $html =~ /duration: (\d+)/      and $smoke{duration}     = $1; 
    123     $html =~ /VERSION: ([\d\.]+)/   and $smoke{VERSION}      = $1; 
    124     $html =~ /branch: ([\w\-]+)/    and $smoke{branch}       = $1; 
    125     $html =~ /cpuarch: ([\w\d]+)/   and $smoke{cpuarch}      = $1; 
    126     $html =~ /osname: ([\w\d]+)/    and $smoke{osname}       = $1; 
    127     $html =~ /cc: ([\w\d]+)/        and $smoke{cc}           = $1; 
    128     $html =~ /DEVEL: -?(\w+)/       and $smoke{DEVEL}        = $1; 
    129     $html =~ /harness_args: (.+)$/m and $smoke{harness_args} = $1; 
    130     $html =~ /build_dir: (.+)$/m    and $smoke{build_dir}    = $1; 
    131     $html =~ 
    132 /summary="(\d+) test cases: (\d+) ok, (\d+) failed, (\d+) todo, (\d+) skipped and (\d+) unexpectedly succeeded"/ 
    133         and $smoke{summary} = { 
    134         total    => $1, 
    135         ok       => $2, 
    136         failed   => $3, 
    137         todo     => $4, 
    138         skipped  => $5, 
    139         unexpect => $6, 
    140         }; 
    141  
    142     if ( grep { not $smoke{$_} } qw<harness_args revision> ) { 
    143         print "The submitted smoke has an invalid format!"; 
    144         exit; 
    145     } 
    146  
    147     $smoke{runcore} = runcore_from_args( $smoke{harness_args} ); 
    148     $smoke{revision} ||= 0; 
    149     $smoke{timestamp} = time; 
    150     $smoke{id}        = $id; 
    151     my $filename = pack_smoke(%smoke); 
    152  
    153     open my $fh, ">", $filename 
    154         or die "Couldn't open \"$filename\" for writing: $!\n"; 
    155     print $fh $html 
    156         or die "Couldn't write to \"$filename\": $!\n"; 
    157     close $fh 
    158         or die "Couldn't close \"$filename\": $!\n"; 
    159 } 
    160  
    161 sub clean_obsolete_smokes { 
    162     my $category = sub { 
    163         return join "-", ( map { $_[0]->{$_} } 
    164             qw<branch cpuarch osname cc runcore harness_args> ), 
    165             $_[0]->{DEVEL} eq "devel" ? "dev" : "release",; 
    166     }; 
    167  
    168     my %cats; 
    169     my @smokes = map { unpack_smoke($_) } glob "parrot-smoke-*.html"; 
    170     push @{ $cats{ $category->($_) } }, $_ for @smokes; 
    171  
    172     $cats{$_} = [ 
    173         ( 
    174             sort { $b->{revision} <=> $a->{revision} || $b->{timestamp}[0] <=> $a->{timestamp}[0] } 
    175                 @{ $cats{$_} } 
    176         )[ 0 .. MAX_SMOKES_OF_SAME_CATEGORY- 1 ] 
    177         ] 
    178         for keys %cats; 
    179  
    180     my %delete = map { $_->{filename} => 1 } @smokes; 
    181     for ( map { @$_ } values %cats ) { 
    182         next unless $_; 
    183  
    184         delete $delete{ $_->{filename} }; 
    185     } 
    186  
    187     unlink keys %delete; 
    188 } 
    189  
    190 sub process_list { 
    191     my $CGI = shift; 
    192     my $tmpl = HTML::Template->new( scalarref => \$t, die_on_bad_params => 0 ); 
    193  
    194     print $CGI->header; 
    195  
    196     my $category = sub { 
    197         return sprintf "%s / %s runcore on %s-%s-%s", 
    198             $_[0]->{DEVEL} eq "devel" ? "repository snapshot" : "release", 
    199             runcore2human( $_[0]->{runcore} ), $_[0]->{cpuarch}, $_[0]->{osname}, $_[0]->{cc},; 
    200     }; 
    201  
    202     my @smokes = map { unpack_smoke($_) } glob "parrot-smoke-*.html"; 
    203     my %branches; 
    204     push @{ $branches{ $_->{branch} }{ $category->($_) } }, $_ for @smokes; 
    205  
    206     foreach my $branch ( keys %branches ) { 
    207         foreach my $cat ( keys %{ $branches{$branch} } ) { 
    208             $branches{$branch}{$cat} = [ 
    209                 map { 
    210                     { %$_, timestamp => $_->{timestamp}[1] } 
    211                     } 
    212                     sort { 
    213                     $b->{revision} <=> $a->{revision} 
    214                         || lc $a->{osname} cmp lc $b->{osname} 
    215                         || $b->{timestamp}[0] <=> $a->{timestamp}[0] 
    216                     } @{ $branches{$branch}{$cat} } 
    217             ]; 
    218         } 
    219  
    220         $branches{$branch} = [ 
    221             map { { catname => $_, smokes => $branches{$branch}{$_}, } } 
    222                 sort { lc $a cmp lc $b } keys %{ $branches{$branch} } 
    223         ]; 
    224     } 
    225  
    226     $tmpl->param( 
    227         branches => my $p = [ 
    228             map { { name => $_, categories => $branches{$_}, } } 
    229                 sort { ( $a eq "trunk" ? -1 : 0 ) || ( $b eq "trunk" ? 1 : 0 ) || ( $a cmp $b ) } 
    230                 keys %branches 
    231             ] 
    232     ); 
    233     print $tmpl->output; 
    234 } 
    235  
    236 sub pack_smoke { 
    237     my %smoke = @_; 
    238  
    239     my $summary = join( "-", map { $smoke{summary}{$_} } 
    240         qw<total ok failed todo skipped unexpect> ); 
    241     my $args = unpack( "H*", $smoke{harness_args} ); 
    242  
    243 #                           1       2          3        4         5        6         7      8           9        10          ... 
    244     my $str = 
    245 "parrot-smoke-<VERSION>-<DEVEL>-r<revision>-<branch>--<cpuarch>-<osname>-<cc>-<runcore>--<timestamp>-<duration>--$summary--$args--<id>.html"; 
    246  
    247     $str =~ s/<(.+?)>/$smoke{$1}/g; 
    248  
    249     $str; 
    250 } 
    251  
    252 sub unpack_smoke { 
    253     my $name = shift; 
    254  
    255     /^parrot-smoke-([\d\.]+)    #  1 VERSION 
    256                 -(\w+)          #  2 DEVEL 
    257                 -r(\d+)         #  3 revision 
    258                 -([\w\-]+)      #  4 branch 
    259                --([\w\d]+)      #  5 cpuarch 
    260                 -([\w\d]+)      #  6 osname 
    261                 -([\w\d]+)      #  7 cc 
    262                 -(\w+)          #  8 runcore 
    263                --(\d+)          #  9 timestamp 
    264                 -(\d+)          # 10 duration 
    265                --(\d+)          # 11 total 
    266                 -(\d+)          # 12 ok 
    267                 -(\d+)          # 13 failed 
    268                 -(\d+)          # 14 todo 
    269                 -(\d+)          # 15 skipped 
    270                 -(\d+)          # 16 unexpected 
    271                --([a-f0-9]+)    # 17 harness_args 
    272                --([a-f0-9]+)    # 18 id 
    273    .html$/x 
    274         and return { 
    275         VERSION   => $1, 
    276         DEVEL     => $2, 
    277         revision  => $3, 
    278         branch    => $4, 
    279         cpuarch   => $5, 
    280         osname    => $6, 
    281         cc        => $7, 
    282         runcore   => $8, 
    283         timestamp => [ 
    284             $9, 
    285             do { 
    286                 my $str = gmtime($9)->strftime("%d %b %Y %H:%M %a"); 
    287                 $str =~ s/ /&nbsp;/g; 
    288  
    289                 # hack, to make the timestamps not break so the 
    290                 # smoke reports look good even on 640x480 
    291                 $str; 
    292             }, 
    293         ], 
    294         duration => sprintf( "%.02f", 
    295             Time::Seconds->new($10)->minutes ) . "&nbsp;min", 
    296         summary => [ 
    297             { 
    298                 total    => $11, 
    299                 ok       => $12, 
    300                 failed   => $13, 
    301                 todo     => $14, 
    302                 skipped  => $15, 
    303                 unexpect => $16, 
    304             } 
    305         ], 
    306         percentage   => sprintf( "%.02f", $12 / ( $11 || 1 ) * 100 ), 
    307         harness_args => pack( "H*", $17 ), 
    308         id           => $18, 
    309         filename     => $name, 
    310         link         => BASEHTTPDIR . $name, 
    311         }; 
    312     return (); 
    313 } 
    314  
    315 sub runcore2human { 
    316     my %runcore = ( 
    317         goto    => "computed goto", 
    318         jit     => "JIT", 
    319         cgp     => "CGP", 
    320         switch  => "switch", 
    321         fast    => "fast", 
    322         default => "default", 
    323     ); 
    324  
    325     $runcore{ $_[0] }; 
    326 } 
    327  
    328 sub runcore_from_args { 
    329     local $_ = shift; 
    330  
    331     /\b-g\b/ and return "goto"; 
    332     /\b-j\b/ and return "jit"; 
    333     /\b-C\b/ and return "cgp"; 
    334     /\b-S\b/ and return "switch"; 
    335     /\b-f\b/ and return "fast"; 
    336     return "default"; 
    337 } 
    338  
    339 # Rate limiting 
    340 sub limit_rate { 
    341  
    342     # Open the DB and lock it exclusively. See perldoc -q lock. 
    343     sysopen my $fh, BUCKET, O_RDWR | O_CREAT 
    344         or die "Couldn't open \"@{[ BUCKET ]}\": $!\n"; 
    345     flock $fh, LOCK_EX 
    346         or die "Couldn't flock \"@{[ BUCKET ]}\": $!\n"; 
    347  
    348     my $data = eval { fd_retrieve $fh }; 
    349     $data ||= [ MAX_RATE, BURST ]; 
    350     my $bucket = Algorithm::TokenBucket->new(@$data); 
    351  
    352     my $exit; 
    353     unless ( $bucket->conform(1) ) { 
    354         print "Rate limiting -- please wait a bit and try again, thanks."; 
    355         $exit++; 
    356     } 
    357     $bucket->count(1); 
    358  
    359     seek $fh, 0, 0 or die "Couldn't rewind \"@{[ BUCKET ]}\": $!\n"; 
    360     truncate $fh, 0 or die "Couldn't truncate \"@{[ BUCKET ]}\": $!\n"; 
    361  
    362     store_fd [ $bucket->state ] => $fh 
    363         or die "Couldn't serialize bucket to \"@{[ BUCKET ]}\": $!\n"; 
    364  
    365     exit if $exit; 
    366 } 
    367  
    368 # Local Variables: 
    369 #   mode: cperl 
    370 #   cperl-indent-level: 4 
    371 #   fill-column: 100 
    372 # End: 
    373 # vim: expandtab shiftwidth=4: 
    374  
    375 __DATA__ 
    376 <?xml version="1.0" encoding="UTF-8"?> 
    377 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" 
    378   "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> 
    379 <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en"> 
    380 <head> 
    381   <title>Parrot Smoke Reports</title> 
    382   <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> 
    383  
    384   <style type="text/css"> 
    385     body { 
    386       background-color: white; 
    387       margin:           0; 
    388  
    389       font-family: sans-serif; 
    390       line-height: 1.3em; 
    391       font-size:   95%; 
    392     } 
    393  
    394     h1, h2 { 
    395       background-color: #313052; 
    396       color:            white; 
    397       padding:          10px; 
    398     } 
    399  
    400     th       { text-align: left; } 
    401     .indent0 { padding-top:  30px; border-bottom: 2px solid #313052; } 
    402     .indent1 { padding-top:  10px; border-bottom: 1px solid #313052; } 
    403     .indent2 { padding-left: 40px; } 
    404     .indent3 { padding-left: 80px; padding-bottom: 10px; } 
    405  
    406     p, dl, pre, table { margin:      15px; } 
    407     dt    { font-weight: bold; } 
    408     dd+dt { margin-top:  1em;  } 
    409     .leftsep  { padding-left: 10px;  } 
    410     .num      { text-align:   right; } 
    411  
    412     .details  { display: none; } 
    413     .expander { color: blue; cursor: pointer; }  /* hack? */ 
    414  
    415     .tests_ok       { color: #050; } 
    416     .tests_failed   { color: #500; } 
    417     .tests_todo     { color: #030; } 
    418     .tests_skipped  { color: #555; } 
    419     .tests_unexpect { color: #550; } 
    420   </style> 
    421  
    422   <script type="text/javascript">//<![CDATA[[ 
    423     function toggle_visibility (id) { 
    424       var elem     = document.getElementById("details_"  + id), 
    425           expander = document.getElementById("expander_" + id); 
    426       if(elem.className == "details") { 
    427         elem.className = "";  /* hack? */ 
    428         expander.innerHTML = "&laquo;"; 
    429       } 
    430       else { 
    431         elem.className = "details"; 
    432         expander.innerHTML = "&raquo;"; 
    433       } 
    434     } 
    435   //]]></script> 
    436 </head> 
    437  
    438 <body> 
    439   <h1>Parrot Smoke Reports</h1> 
    440  
    441   <p> 
    442     Here's a list of recently submitted <a 
    443     href="http://www.parrotcode.org/">Parrot</a> smoke reports. These smokes are 
    444     automatically generated and show how various runcores are functioning across 
    445     a variety of platforms. Individual languages targetting parrot (e.g. tcl), 
    446     are also available. 
    447   </p> 
    448  
    449   <p> 
    450     Submitting your own smoke is easy, 
    451   </p> 
    452  
    453   <pre class="indent2">$ make smoke 
    454 </pre> 
    455  
    456   <p> 
    457     should suffice. To test the languages that are shipped with parrot, change 
    458     to the languages directory and issue the same command. 
    459   </p> 
    460  
    461   <p> 
    462     Note that old smoke reports are automatically deleted, so you may not want 
    463     to link directly to a smoke. 
    464   </p> 
    465  
    466   <p> 
    467     Note: Timezone is UTC.<br /> 
    468   </p> 
    469  
    470   <table> 
    471     <tmpl_loop name=branches> 
    472       <tr><th colspan="11" class="indent0"><tmpl_var name=name></th></tr> 
    473       <tmpl_loop name=categories> 
    474         <tr><th colspan="12" class="indent1"><tmpl_var name=catname></th></tr> 
    475         <tmpl_loop name=smokes> 
    476           <tr> 
    477             <td class="indent2">Parrot&nbsp;<tmpl_var name=VERSION></td> 
    478             <td> 
    479               <tmpl_if name=revision> 
    480                 r<tmpl_var name=revision> 
    481               </tmpl_if> 
    482             </td> 
    483             <td class="leftsep"><tmpl_var name=timestamp></td> 
    484             <td class="leftsep"><tmpl_var name=harness_args></td> 
    485             <td class="leftsep num"><tmpl_var name=duration></td> 
    486             <td class="leftsep num"><tmpl_var name=percentage>&nbsp;%&nbsp;ok</td> 
    487         <tmpl_loop name=summary> 
    488           <td class="leftsep num tests_total"><tmpl_var name=total>:</td> 
    489           <td class="num tests_ok"><tmpl_var name=ok>,</td> 
    490           <td class="num tests_failed"><tmpl_var name=failed>,</td> 
    491           <td class="num tests_todo"><tmpl_var name=todo>,</td> 
    492           <td class="num tests_skipped"><tmpl_var name=skipped>,</td> 
    493           <td class="num tests_unexpect"><tmpl_var name=unexpect></td> 
    494         </tmpl_loop> 
    495         <td><span title="Details" class="expander" onclick="toggle_visibility('<tmpl_var name=id>')" id="expander_<tmpl_var name=id>">&raquo;</span></td> 
    496         <td><a style="text-decoration: none" href="<tmpl_var name=link>" title="Full smoke report">&raquo;</a></td> 
    497           </tr> 
    498           <tr class="details" id="details_<tmpl_var name=id>"> 
    499             <td colspan="12" class="indent3"> 
    500               <tmpl_loop name=summary> 
    501                 <span class="tests_total"><tmpl_var name=total> test cases</span>:<br /> 
    502                 <span class="tests_ok"><tmpl_var name=ok> ok</span>, 
    503                 <span class="tests_failed"><tmpl_var name=failed> failed</span>, 
    504                 <span class="tests_todo"><tmpl_var name=todo> todo</span>,<br /> 
    505                 <span class="tests_skipped"><tmpl_var name=skipped> skipped</span> and 
    506                 <span class="tests_unexpect"><tmpl_var name=unexpect> unexpectedly succeeded</span> 
    507               </tmpl_loop><br /> 
    508               <a href="<tmpl_var name=link>" title="Full smoke report">View full smoke report</a> 
    509             </td> 
    510           </tr> 
    511         </tmpl_loop> 
    512       </tmpl_loop> 
    513     </tmpl_loop> 
    514   </table> 
    515 </body> 
    516 </html> 

  • MANIFEST

     
    11# ex: set ro: 
    22# $Id$ 
    33# 
    4 # generated by tools\dev\mk_manifest_and_skip.pl Wed Dec 17 21:37:57 2008 UT 
     4# generated by tools/dev/mk_manifest_and_skip.pl Fri Dec 19 03:05:24 2008 UT 
    55# 
    66# See tools/dev/install_files.pl for documentation on the 
    77# format of this file. 
    … …  
    15551555languages/ecmascript/src/parser/grammar.pg                  [ecmascript] 
    15561556languages/ecmascript/t/00-comments.t                        [ecmascript] 
    15571557languages/ecmascript/t/01-literals.t                        [ecmascript] 
     1558languages/ecmascript/t/02-operators.t                       [ecmascript] 
    15581559languages/ecmascript/t/harness                              [ecmascript] 
    15591560languages/forth/MAINTAINER                                  [forth] 
    15601561languages/forth/config/makefiles/root.in                    [forth] 
    … …  
    37803781tools/util/perltidy.conf                                    [] 
    37813782tools/util/pgegrep                                          [] 
    37823783tools/util/release.json                                     [] 
    3783 tools/util/smokeserv-README.pod                             [] 
    3784 tools/util/smokeserv-client.pl                              [] 
    3785 tools/util/smokeserv-server.pl                              [] 
    37863784tools/util/templates.json                                   [] 
    37873785tools/util/update_copyright.pl                              [] 
    37883786xconf/samples/testfoobar                                    [] 

  • lib/Parrot/Harness/Smoke.pm

     
    33 
    44=head1 NAME 
    55 
    6 Parrot::Harness::Smoke - Subroutines used by harness-skripts to generate smoke reports 
     6Parrot::Harness::Smoke - Subroutines used by harness-scripts to generate smoke reports 
    77 
    88=head1 DESCRIPTION 
    99 
    … …  
    1212 
    1313Following subroutines are supported: 
    1414 
    15     generate_html_smoke_report ( 
    16         tests       => \@tests, 
    17         args        => $args, 
    18         file        => 'smoke.html', 
    19     ); 
    20  
    2115    my %env_data = collect_test_environment_data(); 
    2216 
    2317    send_archive_to_smolder( %env_data ); 
    … …  
    3327use Parrot::Config qw/%PConfig/; 
    3428use base qw( Exporter ); 
    3529our @EXPORT_OK = qw( 
    36     generate_html_smoke_report 
    3730    collect_test_environment_data 
    3831    send_archive_to_smolder 
    3932); 
    … …  
    119112    return $compiler; 
    120113} 
    121114 
    122 sub generate_html_smoke_report { 
    123     my $argsref = shift; 
    124     my $html_fn = $argsref->{file}; 
    125     my @smoke_config_vars = qw( 
    126         osname archname cc build_dir cpuarch revision VERSION optimize DEVEL 
    127     ); 
    128  
    129     eval { 
    130         require Test::TAP::HTMLMatrix; 
    131         require Test::TAP::Model::Visual; 
    132     }; 
    133     die "You must have Test::TAP::HTMLMatrix installed.\n\n$@" 
    134         if $@; 
    135  
    136     { 
    137       no warnings qw/redefine once/; 
    138       *Test::TAP::Model::run_tests = sub { 
    139         my $self = shift; 
    140  
    141         $self->_init; 
    142         $self->{meat}{start_time} = time(); 
    143  
    144         my %stats; 
    145  
    146         foreach my $file (@_) { 
    147             my $data; 
    148             print STDERR "- $file\n"; 
    149             $data = $self->run_test($file); 
    150             $stats{tests} += $data->{results}{max} || 0; 
    151             $stats{ok}    += $data->{results}{ok}  || 0; 
    152         } 
    153  
    154         printf STDERR "%s OK from %s tests (%.2f%% ok)\n\n", 
    155             $stats{ok}, 
    156             $stats{tests}, 
    157             $stats{ok} / $stats{tests} * 100; 
    158  
    159         $self->{meat}{end_time} = time(); 
    160       }; 
    161  
    162       my $start = time(); 
    163       my $model = Test::TAP::Model::Visual->new(); 
    164       $model->run_tests( @{ $argsref->{tests} } ); 
    165  
    166       my $end = time(); 
    167  
    168       my $duration = $end - $start; 
    169  
    170       my $v = Test::TAP::HTMLMatrix->new( 
    171         $model, 
    172         join("\n", 
    173              "duration: $duration", 
    174              "branch: unknown", 
    175              "harness_args: " . (($argsref->{args}) ? $argsref->{args} : "N/A"), 
    176              map { "$_: $PConfig{$_}" } sort @smoke_config_vars), 
    177       ); 
    178  
    179       $v->has_inline_css(1); # no separate css file 
    180  
    181       open my $HTML, '>', $html_fn; 
    182       print {$HTML} $v->html(); 
    183       close $HTML; 
    184  
    185       print "$html_fn has been generated.\n"; 
    186     } 
    187 } 
    188  
    1891151; 
    190116 
    191117# Local Variables: 

  • t/harness

     
    2222    Usage 
    2323); 
    2424use Parrot::Harness::Smoke qw( 
    25     generate_html_smoke_report 
    2625    send_archive_to_smolder 
    2726    collect_test_environment_data 
    2827); 
    … …  
    6463    @tests = map { glob($_) } (@ARGV ? @ARGV : @default_tests); 
    6564} 
    6665 
    67 if ($longopts->{html}) { 
    68     generate_html_smoke_report( 
     66my $harness; 
     67if ($longopts->{archive}) { 
     68    eval { require TAP::Harness::Archive }; 
     69    if ($@) { 
     70        die "\n" . ('-' x 55) . "\nCould not load TAP::Harness::Archive." 
     71            . "\nPlease install it if you want to create TAP archives.\n" 
     72            . ('-' x 55) . "\n\n$@\n"; 
     73    } 
     74    # for extra_properties we need TAP::Harness::Archive >= .10 
     75    if ($TAP::Harness::Archive::VERSION < .10) { 
     76        die "\n" . ('-' x 55) . "\nWe need TAP::Harness::Archive >= .10." 
     77            . "\nPlease install it if you want to create TAP archives.\n" 
     78            . ('-' x 55) . "\n"; 
     79    } 
     80 
     81    my %env_data = collect_test_environment_data(); 
     82    $harness = TAP::Harness::Archive->new( 
    6983        { 
    70             tests => \@tests, 
    71             args  => $args, 
    72             file  => 'smoke.html', 
     84            verbosity        => $ENV{HARNESS_VERBOSE}, 
     85            archive          => 'parrot_test_run.tar.gz', 
     86            merge            => 1, 
     87            extra_properties => \%env_data, 
    7388        } 
    7489    ); 
    75 } else { 
    76     my $harness; 
    77     if ($longopts->{archive}) { 
    78         eval { require TAP::Harness::Archive }; 
    79         if ($@) { 
    80             die "\n" . ('-' x 55) . "\nCould not load TAP::Harness::Archive." 
    81                 . "\nPlease install it if you want to create TAP archives.\n" 
    82                 . ('-' x 55) . "\n\n$@\n"; 
    83         } 
    84         # for extra_properties we need TAP::Harness::Archive >= .10 
    85         if ($TAP::Harness::Archive::VERSION < .10) { 
    86             die "\n" . ('-' x 55) . "\nWe need TAP::Harness::Archive >= .10." 
    87                 . "\nPlease install it if you want to create TAP archives.\n" 
    88                 . ('-' x 55) . "\n"; 
    89         } 
     90    $harness->runtests(@tests); 
     91    send_archive_to_smolder(%env_data) if $longopts->{send_to_smolder}; 
    9092 
    91         my %env_data = collect_test_environment_data(); 
    92         $harness = TAP::Harness::Archive->new( 
    93             { 
    94                 verbosity        => $ENV{HARNESS_VERBOSE}, 
    95                 archive          => 'parrot_test_run.tar.gz', 
    96                 merge            => 1, 
    97                 extra_properties => \%env_data, 
    98             } 
    99         ); 
    100         $harness->runtests(@tests); 
    101         send_archive_to_smolder(%env_data) if $longopts->{send_to_smolder}; 
    102  
     93} else { 
     94    eval { require TAP::Harness }; 
     95    if ($@) { 
     96        Test::Harness::runtests(@tests); 
     97        exit; 
    10398    } else { 
    104         eval { require TAP::Harness }; 
    105         if ($@) { 
    106             Test::Harness::runtests(@tests); 
    107             exit; 
    108         } else { 
    109             $harness = TAP::Harness->new({ 
    110                 verbosity => $ENV{HARNESS_VERBOSE}, 
    111                 merge     => 0, 
    112                 jobs      => $ENV{TEST_JOBS} || 1, 
    113                 directives => 1, 
    114             }); 
    115         } 
    116         my $results = $harness->runtests(@tests); 
    117  
    118         # a non-zero code stops make after test failures (RT #60116) 
    119         exit ( $results->all_passed() ? 0 : 1 ); 
     99        $harness = TAP::Harness->new({ 
     100            verbosity => $ENV{HARNESS_VERBOSE}, 
     101            merge     => 0, 
     102            jobs      => $ENV{TEST_JOBS} || 1, 
     103            directives => 1, 
     104        }); 
    120105    } 
     106    my $results = $harness->runtests(@tests); 
     107 
     108    # a non-zero code stops make after test failures (RT #60116) 
     109    exit ( $results->all_passed() ? 0 : 1 ); 
    121110} 
    122111 
    123112=head1 NAME 
    … …  
    194183 
    195184Invoke parrot with '--gc-debug'. 
    196185 
    197 =item C<--html> 
    198  
    199 Emit a C<smoke.html> file instead of displaying results. 
    200  
    201186=item C<--code-tests> 
    202187 
    203188Run only the file metadata and basic coding standards tests. 

  • config/gen/makefiles/root.in

     
    689689        @echo "  examples_tests:    Test the example scripts." 
    690690        @echo "" 
    691691        @echo "Smoke Testing:" 
    692         @echo "  smoke:             Run the test suite and send smoke.html to " 
    693         @echo "                     http:////smoke.parrotcode.org//" 
    694         @echo "  smokej:            Same as smoke, but with JIT runcore" 
    695         @echo "  smokeexec:         Same as smoke, but generate first executables" 
    696         @echo "                     with the exec runcore" 
    697         @echo "  smoke-clean:       clean up smoke.html" 
    698692        @echo "  smolder_test:      Run the test suite and send report to the smolder server" 
     693        @echo "  smoke:             Alias for smolder_test" 
    699694        @echo "" 
    700695        @echo "Benchmarks:" 
    701696        @echo "  mopsbench:         Million operations" 
    … …  
    724719        @echo "  languages-test:    Proxy for target 'test' of languages/Makefile" 
    725720        @echo "  languages-test-unified:  Proxy for target 'test-unified' of languages/Makefile" 
    726721        @echo "  languages-test-separate: Proxy for target 'test-separate' of languages/Makefile" 
    727         @echo "  languages-smoke:   Proxy for target 'smoke' of languages/Makefile" 
    728722        @echo "  languages-clean:   Proxy for target 'clean' of languages/Makefile" 
    729723        @echo "" 
    730724        @echo "Fetch from source repository:" 
    … …  
    13711365languages-test-separate : 
    13721366        $(MAKE) languages test-separate 
    13731367 
    1374 languages-smoke : 
    1375         $(MAKE) languages smoke 
    1376  
    13771368languages-clean : 
    13781369        $(MAKE) languages clean 
    13791370 
    … …  
    14651456test : test_prep 
    14661457        $(PERL) t/harness $(EXTRA_TEST_ARGS) 
    14671458 
    1468 # run the test suite, create a TAP archive and send it off to smolder 
    1469 smolder_test : test_prep 
    1470         $(PERL) t/harness $(EXTRA_TEST_ARGS) --archive --send-to-smolder 
    1471  
    14721459# "core tests" -- test basic functionality but not ancillaries 
    14731460coretest : test_prep 
    14741461        $(PERL) t/harness $(EXTRA_TEST_ARGS) --core-tests 
    … …  
    16081595    examples-clean \ 
    16091596    imcc-clean \ 
    16101597    compilers-clean \ 
    1611     smoke-clean \ 
    16121598#INVERSE_CONDITIONED_LINE(win32):    cover-clean \ 
    16131599    editor-clean 
    16141600        @TEMP_cg_r@ 
    … …  
    22692255 
    22702256############################################################################### 
    22712257# 
    2272 # smoke: 
     2258# smolder 
    22732259# 
    22742260############################################################################### 
    22752261 
    2276 smoke : all 
    2277         $(PERL) t/harness --html $(EXTRA_TEST_ARGS) 
    2278         $(PERL) tools/util/smokeserv-client.pl smoke.html 
    22792262 
    2280 smokej : all 
    2281         $(PERL) t/harness --html $(EXTRA_TEST_ARGS) -j 
    2282         $(PERL) tools/util/smokeserv-client.pl smoke.html 
     2263# run the test suite, create a TAP archive and send it off to smolder 
     2264smolder_test : test_prep 
     2265        $(PERL) t/harness $(EXTRA_TEST_ARGS) --archive --send-to-smolder 
    22832266 
    2284 smokeexec: all 
    2285         $(PERL) t/harness --html $(EXTRA_TEST_ARGS) --run-exec $(RUNCORE_TEST_FILES) 
    2286         $(PERL) tools/util/smokeserv-client.pl smoke.html 
     2267smoke : smolder_test 
    22872268 
    2288 smoke-clean : 
    2289         $(RM_F) smoke.html 
    2290  
    22912269# 
    22922270# Local variables: 
    22932271# mode: makefile 

  • config/gen/makefiles/ext.in

     
    3232        @echo "" 
    3333        @echo "  help:         Print this help message." 
    3434        @echo "" 
    35         @echo "  smoke:        Run the test suite and send smoke.html to " 
    36         @echo "                http:////smoke.parrotcode.org//" 
    37         @echo "" 
    38         @echo "  smoke-clean:  clean up smoke.html" 
    39         @echo "" 
    40         @echo "" 
    4135        @echo "Following languages are available:" 
    4236        @echo "  $(LANGUAGES)" 
    4337        @echo "A particular language <lang> can be built, tested and cleand up" 

  • config/gen/makefiles/languages.in

     
    5050        @echo "" 
    5151        @echo "  help:          Print this help message." 
    5252        @echo "" 
    53         @echo "  smoke:         Run the unified test suite and send smoke.html to " 
    54         @echo "                 http:////smoke.parrotcode.org//" 
    55         @echo "" 
    56         @echo "  smoke-clean:   clean up smoke.html" 
    57         @echo "" 
    58         @echo "" 
    5953        @echo "Following languages are available:" 
    6054        @echo "  $(LANGUAGES)" 
    6155        @echo "" 
    … …  
    9791    Zcode.test 
    9892 
    9993 
    100 smoke:  all 
    101         $(PERL) t/harness --html 
    102         $(PERL) ../tools/util/smokeserv-client.pl languages_smoke.html 
    103  
    104 smoke-clean : 
    105         $(RM_F) languages_smoke.html 
    106  
    10794clean: \ 
    10895    abc.clean APL.clean \ 
    10996    BASIC.clean befunge.clean bf.clean \ 
    … …  
    122109    scheme.clean squaak.clean \ 
    123110    urm.clean \ 
    124111    WMLScript.clean \ 
    125     Zcode.clean \ 
    126     smoke-clean 
     112    Zcode.clean 
    127113 
    128114realclean: \ 
    129115    abc.realclean APL.realclean \ 

  • languages/LANGUAGES_STATUS.pod

     
    1010should be tracked in the respective languages/*/MAINTAINER files, and we 
    1111don't want to repeat ourselves. 
    1212 
    13 For current status of some languages see also 
    14 L<http://smoke.parrotcode.org/smoke/> 
    15  
    1613Languages that work with the unified languages test suite 
    1714will have their test results listed under the smokes marked 
    1815'languages'. 

  • languages/t/harness

     
    2626 
    2727    cd languages && make test 
    2828 
    29 =item Smoke testing 
    30  
    31     make languages-smoke 
    32  
    33 or 
    34  
    35     cd languages && make smoke 
    36  
    3729=item Selected languages 
    3830 
    3931    cd languages && perl t/harness --languages=m4,punie 
    … …  
    6658 
    6759 
    6860# Step 0: handle command line args 
    69 my $do_gen_html;       # smoke testing 
    7061my $languages_list;    # select a subset of languages 
    71 my $result = GetOptions( 'html'          => \$do_gen_html, 
    72                          'languages=s'   => \$languages_list ); 
     62my $result = GetOptions( 'languages=s'   => \$languages_list ); 
    7363 
    7464# Step 1: find harness files for testable languages 
    7565 
    76 # Various languages are not yet in smoke testing, some will never be. 
     66# Various languages are not yet in unified testing, some will never be. 
    7767# 
    7868# BASIC                No t/harness, two implementations 
    7969# ecmascript           No t/harness 
    … …  
    125115 
    126116# Step 3: test. 
    127117 
    128 if ( ! $do_gen_html ) { 
    129     Test::Harness::runtests(@tests); 
    130 } 
    131 else { 
    132     my $html_fn = "languages_smoke.html"; 
    133     my @smoke_config_vars = qw( 
    134       osname archname cc build_dir cpuarch revision VERSION optimize DEVEL 
    135     ); 
     118Test::Harness::runtests(@tests); 
    136119 
    137     eval { 
    138         require Test::TAP::HTMLMatrix; 
    139         require Test::TAP::Model::Visual; 
    140     }; 
    141     die "You must have Test::TAP::HTMLMatrix installed.\n\n$@" 
    142         if $@; 
    143  
    144     { 
    145         no warnings qw/redefine once/; 
    146         *Test::TAP::Model::run_tests = sub { 
    147             my $self = shift; 
    148  
    149             $self->_init; 
    150             $self->{meat}{start_time} = time(); 
    151  
    152             my %stats; 
    153  
    154             foreach my $file (@_) { 
    155                 my $data; 
    156                 print STDERR "- $file\n"; 
    157                 $data = $self->run_test($file); 
    158                 $stats{tests} += $data->{results}{max} || 0; 
    159                 $stats{ok}    += $data->{results}{ok}  || 0; 
    160             } 
    161  
    162             printf STDERR "%s OK from %s tests (%.2f%% ok)\n\n", 
    163             $stats{ok}, 
    164             $stats{tests}, 
    165             $stats{ok} / $stats{tests} * 100; 
    166  
    167             $self->{meat}{end_time} = time(); 
    168         }; 
    169  
    170         my $start = time(); 
    171         my $model = Test::TAP::Model::Visual->new_with_tests(@tests); 
    172         my $end   = time(); 
    173  
    174         my $duration = $end - $start; 
    175         my $languages = join( q{ }, @unified_testable_languages ); 
    176         my $v = Test::TAP::HTMLMatrix->new( 
    177             $model, 
    178             join("\n", 
    179                  "languages: $languages", 
    180                  "duration: $duration", 
    181                  "branch: unknown", 
    182                  "harness_args: languages", 
    183                  map { "$_: $PConfig{$_}" } sort @smoke_config_vars), 
    184         ); 
    185  
    186         $v->has_inline_css(1); # no separate css file 
    187  
    188         open HTML, '>', $html_fn; 
    189         print HTML $v->html(); 
    190         close HTML; 
    191  
    192         print "$html_fn has been generated.\n"; 
    193     } 
    194 } 
    195  
    196120# Local Variables: 
    197121#   mode: cperl 
    198122#   cperl-indent-level: 4