Ticket #323: tt323-better-smoke.patch

File tt323-better-smoke.patch, 3.4 KB (added by rurban, 6 years ago)

no refusal, list mods, sample:  http://smolder.plusthree.com/app/public_projects/report_details/18536

  • lib/Parrot/Harness/Smoke.pm

    old new  
    100100} 
    101101 
    102102sub collect_test_environment_data { 
    103     return ( 
    104         'Architecture' => $PConfig{cpuarch}, 
     103    my ($branch, @mods); 
     104    # rename sun4 to sparc 
     105    my $arch = $PConfig{cpuarch} eq 'sun4' ? 'sparc' : $PConfig{cpuarch}; 
     106    # add the 32/64 bit suffix to the cpuarch 
     107    if ($PConfig{cpuarch} !~ /\d$/) { 
     108      $arch = $PConfig{cpuarch} . (8*$PConfig{wordsize}); 
     109    } 
     110    my $devel = $PConfig{DEVEL}; 
     111    # check for local-modifications if -d .svn and query to continue 
     112    if (-d ".svn") { 
     113        my $status = `svn status`; 
     114        @mods = grep /\S/, map { /^M +(.+)$/ and $1 } split(/\n/, $status); 
     115        if (@mods) { 
     116            $devel .= (" ".@mods." mods"); 
     117        } 
     118        my $info = `svn info .`; 
     119        ($branch) = $info =~ m{URL: .+/parrot/(\w+)$}m; 
     120    } 
     121    my @data = ( 
     122        'Architecture' => $arch, 
    105123        'Compiler'     => _get_compiler_version(), 
    106         'DEVEL'        => $PConfig{DEVEL}, 
     124        'DEVEL'        => $devel, 
    107125        'Optimize'     => ($PConfig{optimize} || 'none'), 
    108126        'Perl Version' => (sprintf('%vd', $^V) . " $PConfig{archname}"), 
    109127        'Platform'     => $PConfig{osname}, 
    110128        'SVN Revision' => $PConfig{revision}, 
    111129        'Version'      => $PConfig{VERSION}, 
    112130    ); 
     131    push @data, ( 'Branch' => $branch ) if $branch; 
     132    push @data, ( 'Modifications' => join(" ", @mods) ) if @mods; 
     133    return @data; 
    113134} 
    114135 
    115136# this can be expanded to more than just GCC 
    116137sub _get_compiler_version { 
    117138    my $compiler = $PConfig{cc}; 
    118     if($compiler eq 'gcc') { 
     139    if ($compiler =~ /gcc/ and $PConfig{gccversion}) { 
    119140        $compiler .= " $PConfig{gccversion}"; 
    120141    } 
     142    elsif ($compiler =~ /cl/ and $PConfig{msvcversion}) { 
     143        $compiler .= " $PConfig{msvcversion}"; 
     144    } 
    121145    return $compiler; 
    122146} 
    123147 
    124148sub generate_html_smoke_report { 
    125149    my $argsref = shift; 
    126150    my $html_fn = $argsref->{file}; 
    127     my @smoke_config_vars = qw( 
    128         osname archname cc build_dir cpuarch revision VERSION optimize DEVEL 
    129     ); 
    130151 
    131152    eval { 
    132153        require Test::TAP::HTMLMatrix; 
     
    135156    die "You must have Test::TAP::HTMLMatrix installed.\n\n$@" 
    136157        if $@; 
    137158 
    138     my $branch = "unknown"; 
    139     # check for local-modifications if -d .svn and query to continue 
    140     if (-d ".svn") { 
    141         my $status = `svn status`; 
    142         my @mods = grep /^M +(.+)$/, split(/\n/, $status); 
    143         my $info = `svn info .`; 
    144         ($branch) = $info =~ m/URL: .+/parrot/(\w+)$//m; 
    145     } 
     159    my @test_env_data = collect_test_environment_data(); 
    146160 
    147161    { 
    148162      no warnings qw/redefine once/; 
     
    177191      my $end = time(); 
    178192 
    179193      my $duration = $end - $start; 
    180  
     194      my %hash = @test_env_data; 
     195      my $branch = $hash{Branch} ||= 'trunk'; 
    181196      my $v = Test::TAP::HTMLMatrix->new( 
    182197        $model, 
    183198        join("\n", 
    184199             "duration: $duration", 
    185200             "branch: $branch", 
    186201             "harness_args: " . (($argsref->{args}) ? $argsref->{args} : "N/A"), 
    187              map { "$_: $PConfig{$_}" } sort @smoke_config_vars), 
     202             map { "$_: $hash{$_}" } keys %hash), 
    188203      ); 
    189204 
    190205      $v->has_inline_css(1); # no separate css file