Bladeren bron

added perl examples

bmallred 11 jaren geleden
bovenliggende
commit
75bf6182dd
2 gewijzigde bestanden met toevoegingen van 121 en 0 verwijderingen
  1. 2 0
      examples/perl/umbrella
  2. 119 0
      examples/perl/umbrella.pl

+ 2 - 0
examples/perl/umbrella

@ -0,0 +1,2 @@
1
make testcover &> /dev/null
2
./umbrella.pl &> /dev/null

+ 119 - 0
examples/perl/umbrella.pl

@ -0,0 +1,119 @@
1
#!/usr/bin/perl
2
3
require 5.6.1;
4
5
use strict;
6
use warnings;
7
8
use Devel::Cover::DB;
9
use Config;
10
use File::Spec;
11
use File::Find ();
12
use File::Path;
13
use Getopt::Long;
14
15
my $Options = 
16
{
17
    add_uncoverable_point => [],
18
    annotation => [],
19
    coverage => [],
20
    delete => undef,
21
    gcov => $Config{gccversion},
22
    ignore => [],
23
    ignore_re => [],
24
    launch => 0,
25
    make => $Config{make},
26
    report => "",
27
    report_c0 => 75,
28
    report_c1 => 90,
29
    report_c2 => 100,
30
    select => [],
31
    select_re => [],
32
    summary => 1,
33
    uncoverable_file => [".uncoverable", glob("~/.uncoverable")],
34
};
35
36
sub main
37
{
38
    my $dbname = File::Spec->rel2abs("cover_db");
39
    die "Can't open database $dbname\n"
40
        if !-d $dbname;
41
42
    $Options->{outputdir} = File::Spec->rel2abs($dbname);
43
    mkpath($Options->{outputdir}) unless -d $Options->{outputdir};
44
45
    my $db = Devel::Cover::DB->new
46
    (
47
        db => $dbname,
48
        uncoverable_file => $Options->{uncoverable_file}, 
49
    );
50
51
    $db = $db->merge_runs;
52
    $db->add_uncoverable($Options->{add_uncoverable_point});
53
    $db->delete_uncoverable($Options->{delete_uncoverable_point});
54
    $db->clean_uncoverable
55
        if $Options->{clean_uncoverable_points};
56
    $db->calculate_summary(map { $_ => 1 } @{$Options->{coverage}});
57
58
    my $lines = "";
59
    
60
    # Loop through the coverage and output for each file.
61
    for my $file (sort keys %{$db->{summary}})
62
    {
63
        my $line = "$file;";
64
65
        my $numbers = "";
66
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
67
        {
68
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
69
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];
70
            
71
            if ($hits > 0 && length($errs // '') == 0)
72
            {
73
                $numbers .= $n . ",";
74
            }
75
        }
76
        
77
        chop($numbers);
78
        $line .= $numbers . ";";
79
    
80
        $numbers = "";
81
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
82
        {
83
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
84
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];
85
86
            if ($hits > 0 && length($errs // '') > 0)
87
            {
88
                $numbers .= $n . ",";
89
            }
90
        }
91
92
        chop($numbers);
93
        $line .= $numbers . ";";
94
95
        $numbers = "";
96
        for my $n (sort keys %{$db->cover->{$file}->{statement}})
97
        {
98
            my $hits = $db->cover->{$file}->{statement}->{$n}->[0]->[0];
99
            my $errs = $db->cover->{$file}->{statement}->{$n}->[0]->[1];
100
101
            if ($hits == 0 && length($errs // '') == 0)
102
            {
103
                $numbers .= $n . ",";
104
            }
105
        }
106
107
        chop($numbers);
108
        $line .= $numbers . ";";
109
        $lines .= $line . "\n";
110
        print $lines;
111
    }
112
113
    # Write to our coverage file.
114
    open(MYFILE, ">.umbrella-coverage");
115
    print MYFILE $lines;
116
    close(MYFILE);
117
}
118
119
main