#!/usr/bin/env perl
#
# Copyright IBM Corp. 2017
#
# Usage: mkinfo <config_file> [-o <output_dir>] [--seed <seed>]
#               [<key>=<value>...]
#
# Create a fake lcov code coverage data file and optionally the corresponding
# source tree. DATA_FILE contains all specifications for creating the data
# file. Directives can be overridden using KEY=VALUE specifications with KEY
# being in the form SECTION.KEY. SEED specifies the number used to initialize
# the pseudo random number generator.
#
# Example:
# mkinfo profiles/small -o src files.numfiles=12
#

use strict;
use warnings;

use Getopt::Long;
use Cwd qw(abs_path getcwd);
use File::Path qw(make_path);
use File::Basename;
use Data::Dumper;

my $MAX_TAKEN  = 1000;
my $use_colors = -t STDIN;
my $BOLD       = $use_colors ? "\033[1m" : "";
my $RESET      = $use_colors ? "\033[0m" : "";

sub usage()
{
    print(<<EOF);
Usage: $0 <config_file> [-o <output_dir>] [--seed <seed>] [<key>=<value>...]

Create a fake lcov code coverage data file and optionally the corresponding
source tree. DATA_FILE contains all specifications for creating the data
file. Directives can be overridden using KEY=VALUE specifications with KEY
being in the form SECTION.KEY. SEED specifies the number used to initialize
the pseudo random number generator.

Example:
$0 profiles/small -o src files.numfiles=12
EOF
}

sub read_config($)
{
    my ($filename) = @_;
    my $fd;
    my %config;
    my $section;

    open($fd, "<", $filename) or die("Could not open $filename: $!\n");
    while (my $line = <$fd>) {
        my ($key, $value);

        $line =~ s/(^\s*|\s*$)//g;
        next if ($line eq "" || $line =~ /^#/);
        if ($line =~ /^\[\s*(\S+)\s*]$/) {
            $section = $1;
            next;
        }
        if ($line !~ /^(\S+)\s*=\s*(.*)$/) {
            die("$filename:$.: Unknown line format: $line\n");
        }
        ($key, $value) = ($1, $2);
        if (!defined($section)) {
            die("$filename:$.: Directive outside of section\n");
        }
        $config{$section}->{$1} = $2;
    }
    close($fd);

    return \%config;
}

sub apply_config($$)
{
    my ($config, $directive) = @_;

    for my $dir (@$directive) {
        if ($dir !~ /^([^\.]+)\.([^=]+)=(.*)$/) {
            die("Unknown directive format: $dir\n");
        }
        $config->{$1}->{$2} = $3;
    }
}

sub get_value($$;$)
{
    my ($config, $dir, $default) = @_;
    my ($section, $key, $value);

    if ($dir !~ /^([^\.]+)\.([^=]+)$/) {
        die("$0: Internal error: Unknown key format: $key\n");
    }
    ($section, $key) = ($1, $2);

    $value = $config->{$section}->{$key};

    if (!defined($value)) {
        if (!defined($default)) {
            die("$0: Missing config value for $dir\n");
        }
        $value = $default;
    }

    return $value;
}

sub get_int($$;$$$)
{
    my ($config, $dir, $default, $min, $max) = @_;
    my $value = get_value($config, $dir, $default);

    if ($value !~ /^\d+$/) {
        die("$0: Config value $dir must be an integer: $value\n");
    }
    $value = int($value);
    if (defined($min) && $value < $min) {
        die("$0: Config value $dir is too low (min $min): $value\n");
    }
    if (defined($max) && $value > $max) {
        die("$0: Config value $dir is too high (max $max): $value\n");
    }

    return int($value);
}

sub get_list($$;$)
{
    my ($config, $dir, $default) = @_;
    my $value = get_value($config, $dir, $default);
    my @list  = split(/\s+/, $value);

    return \@list;
}

sub randlist($)
{
    my ($list) = @_;

    return "" if (!@$list);
    return $list->[int(rand(scalar(@$list)))];
}

sub randbool()
{
    return int(rand(2));
}

# Reduce LIST to PERCENTAGE of its former size.
sub reduce_list_per($$)
{
    my ($list, $percentage) = @_;
    my $remove;

    $remove = int((100 - $percentage) * scalar(@$list) / 100);

    for (my $i = 0; $i < $remove; $i++) {
        splice(@$list, int(rand(scalar(@$list))), 1);
    }
}

# Reduce LIST to NUM items.
sub reduce_list_num($$)
{
    my ($list, $num) = @_;
    my $remove;

    $remove = scalar(@$list) - $num;

    for (my $i = 0; $i < $remove; $i++) {
        splice(@$list, int(rand(scalar(@$list))), 1);
    }
}

sub _gen_filename($$)
{
    my ($c, $root) = @_;
    my $ltop    = get_list($c, "files.top", "");
    my $lsub    = get_list($c, "files.sub", "");
    my $lsubsub = get_list($c, "files.subsub", "");
    my $lprefix = get_list($c, "files.prefix");
    my $lsuffix = get_list($c, "files.suffix", "");
    my $lext    = get_list($c, "files.ext");
    my ($top, $sub, $subsub, $prefix, $suffix, $ext) = ("", "", "", "", "", "");
    my $filename = "";

    $top    = randlist($ltop) if (randbool());
    $sub    = randlist($lsub) if (randbool());
    $subsub = randlist($lsubsub) if (randbool());
    $prefix = randlist($lprefix);
    $suffix = randlist($lsuffix) if (randbool());
    $ext    = randlist($lext);

    $filename = $root;
    $filename .= "/" . $top if ($top ne "");
    $filename .= "/" . $sub if ($sub ne "");
    $filename .= "/" . $subsub if ($subsub ne "");
    $filename .= "/" . $prefix;
    $filename .= "_" . $suffix if ($suffix ne "");
    $filename .= $ext;
    $filename =~ s#^//#/#;

    return $filename;
}

sub gen_filename($$$)
{
    my ($c, $root, $filenames) = @_;
    my $filename;

    do {
        $filename = _gen_filename($c, $root);
    } while ($filenames->{$filename});
    $filenames->{$filename} = 1;

    return $filename;
}

sub gen_lines($$)
{
    my ($c, $length) = @_;
    my @lines   = 1 .. $length;
    my $percent = get_int($c, "lines.instrumented", undef, 0, 100);

    reduce_list_per(\@lines, $percent);

    return \@lines;
}

sub gen_fnname($$)
{
    my ($c, $hash) = @_;
    my $lverb = get_list($c, "functions.verb");
    my $ladj  = get_list($c, "functions.adj", "");
    my $lnoun = get_list($c, "functions.noun", "");
    my ($verb, $adj, $noun) = ("", "", "");
    my $fnname;

    $verb = randlist($lverb);
    $adj  = randlist($ladj) if (randbool());
    $noun = randlist($lnoun) if (randbool());

    $fnname = $verb;
    $fnname .= "_" . $adj if ($adj ne "");
    $fnname .= "_" . $noun if ($noun ne "");

    if (exists($hash->{$fnname})) {
        my $i = 2;

        while (exists($hash->{$fnname . $i})) {
            $i++;
        }
        $fnname .= $i;
    }
    $hash->{$fnname} = 1;

    return $fnname;
}

sub gen_functions($$)
{
    my ($c, $lines) = @_;
    my @fnlines;
    my @functions;
    my %names;
    my $percent = get_int($c, "functions.perinstrumented", undef, 0, 100);

    @fnlines = @$lines;
    reduce_list_per(\@fnlines, $percent);

    foreach my $fnline (@fnlines) {
        push(@functions, [$fnline, gen_fnname($c, \%names)]);
    }

    return \@functions;
}

# Returns a value distribution object. This object can be used to randomly
# choose one element from a list of elements with a given relative distribution.
#
# dist: [ sumprob, probs]
# sumprob: Sum of all probabilities
# probs: [ prob1, prob2, ... ]
# prob: [ num, x ]
# num: Value
sub get_dist($$;$)
{
    my ($c, $dir, $default) = @_;
    my $list    = get_list($c, $dir, $default);
    my $sumprob = 0;
    my @probs;

    foreach my $spec (@$list) {
        my ($n, $p);

        if ($spec =~ /^(\d+):(\d+)$/) {
            ($n, $p) = ($1, $2);
        } elsif ($spec =~ /^(\d+)$/) {
            $n = $1;
            $p = 1;
        } else {
            die("$0: Config value $dir must be a distribution " .
                "list (a:p1 b:p2 ...)\n");
        }
        $sumprob += $p;
        push(@probs, [$n, $sumprob]);
    }

    return [$sumprob, \@probs];
}

sub rand_dist($)
{
    my ($dist) = @_;
    my ($sumprob, $probs) = @$dist;
    my $r = int(rand($sumprob));

    foreach my $prob (@$probs) {
        my ($num, $x) = @$prob;
        return $num if ($r < $x);
    }

    die("Internal error: Incomplete distribution list\n");
}

sub gen_branches($$)
{
    my ($c, $lines) = @_;
    my $percent    = get_int($c, "branches.perinstrumented", undef, 0, 100);
    my @allblocks  = @{get_list($c, "branches.blocks", "0")};
    my $branchdist = get_dist($c, "branches.branchdist", "2");
    my @brlines;
    my @branches;

    @brlines = @$lines;
    reduce_list_per(\@brlines, $percent);

    my @branchData;

    foreach my $brline (@brlines) {
        my @blocks    = @allblocks;
        my $numblocks = int(rand(scalar(@blocks))) + 1;

        reduce_list_num(\@blocks, $numblocks);
        my @blkList;

        my $blockId = 0;
        foreach my $block (@blocks) {
            my $numbranch = rand_dist($branchdist);
            my @block;
            push(@blkList, \@block);

            for (my $branch = 0; $branch < $numbranch; $branch++) {
                #push(@branches, [$brline, $blockId, $branch]);
                push(@block, $branch);
            }
            ++$blockId;
        }
        # sort the list of branches by number of branch elements
        foreach my $i (sort({
                                my $A = $blkList[$a];
                                my $B = $blkList[$b];
                                $#$A <=> $#$B or $a <=> $b
                       } 0 .. $#blkList)
        ) {
            my $blockId = 0;
            foreach my $b (@{$blkList[$i]}) {
                push(@branches, [$brline, $blockId, $b]);
            }
            ++$blockId;
        }

    }

    return \@branches;
}

sub gen_filesrc($)
{
    my ($c) = @_;
    my ($length, $lines, $functions, $branches);
    my $do_ln = get_int($c, "lines.enabled");
    my $do_fn = get_int($c, "functions.enabled");
    my $do_br = get_int($c, "branches.enabled");

    $length    = 1 + int(rand(get_int($c, "lines.maxlines")));
    $lines     = gen_lines($c, $length);
    $functions = gen_functions($c, $lines) if ($do_fn);
    $branches  = gen_branches($c, $lines) if ($do_br);

    return [$length, $lines, $functions, $branches];
}

# Generate fake source tree.
#
# returns:	[ files, numlns, numfns, numbrs ]
# files:	filename -> filesrc
# filesrc:	[ length, lines, functions, branches ]
# length:	Total number of lines in file
#
# lines:	[ line1, line2, ... ]
#
# functions:	[ fn1, fn2, ... ]
# fn:		[ fnline, fnname ]
# fnline:	Starting line of function
# fnname:	Function name
#
# branches:	[ brdata1, brdata2, ...]
# brdata:	[ brline, block, branch ]
# brline:	Line number containing branches
# block:	Block ID
# branch:	Branch ID
#
sub gen_src($$)
{
    my ($c, $root) = @_;
    my %files;
    my $numfiles = get_int($c, "files.numfiles");
    my %filenames;
    my ($numlns, $numfns, $numbrs) = (0, 0, 0);

    for (my $i = 0; $i < $numfiles; $i++) {
        my $filename = gen_filename($c, $root, \%filenames);
        my $filesrc  = gen_filesrc($c);

        $files{$filename} = $filesrc;
        $numlns += scalar(@{$filesrc->[1]}) if (defined($filesrc->[1]));
        $numfns += scalar(@{$filesrc->[2]}) if (defined($filesrc->[2]));
        $numbrs += scalar(@{$filesrc->[3]}) if (defined($filesrc->[3]));
    }

    return [\%files, $numlns, $numfns, $numbrs];
}

sub write_src($)
{
    my ($src) = @_;
    my ($files, $numlns, $numfns, $numbrs) = @$src;

    foreach my $filename (sort(keys(%{$files}))) {
        my $filesrc = $files->{$filename};
        my $length  = $filesrc->[0];
        my $dir     = dirname($filename);
        my $fd;

        if (!-d $dir) {
            make_path($dir) or
                die("Could not create directory $dir\n");
        }

        open($fd, ">", $filename) or
            die("Could not create file $filename: $!\n");
        for (my $i = 0; $i < $length; $i++) {
            print($fd "\n");
        }
        close($fd);
    }
}

sub write_branches($$$$)
{
    my ($fd, $branches, $brhits, $iref) = @_;
    my ($found, $hit) = (0, 0);

    # generates some very large numbers sometimes...easier to mask than to fix
    # Line coverage data
    foreach my $brdata (@$branches) {
        my $brhit = $brhits->[$$iref++];
        my ($brline, $block, $branch) = @$brdata;

        $found++;
        $hit++ if ($brhit ne "-" && $brhit > 0);
        print($fd "BRDA:$brline,$block,$branch,$brhit\n");
    }
    if ($found > 0) {
        print($fd "BRF:$found\n");
        print($fd "BRH:$hit\n");
    }
}

sub write_lines($$$$)
{
    my ($fd, $lines, $lnhist, $iref) = @_;
    my ($found, $hit) = (0, 0);

    # Line coverage data
    foreach my $line (@$lines) {
        my $lnhit = $lnhist->[$$iref++];

        $found++;
        $hit++ if ($lnhit > 0);
        print($fd "DA:$line,$lnhit\n");
    }
    print($fd "LF:$found\n");
    print($fd "LH:$hit\n");
}

sub write_functions($$$$)
{
    my ($fd, $functions, $fnhits, $iref) = @_;
    my ($found, $hit) = (0, 0);

    # Function coverage data
    foreach my $fn (@$functions) {
        my ($fnline, $fnname) = @$fn;

        print($fd "FN:$fnline,$fnname\n");
    }
    foreach my $fn (@$functions) {
        my ($fnline, $fnname) = @$fn;
        my $fnhit = $fnhits->[$$iref++];

        $found++;
        $hit++ if ($fnhit > 0);
        print($fd "FNDA:$fnhit,$fnname\n");
    }
    print($fd "FNF:$found\n");
    print($fd "FNH:$hit\n");
}

sub write_filesrc($$$$$)
{
    my ($c, $fd, $filesrc, $hits, $iter) = @_;
    my ($length, $lines, $functions, $branches) = @$filesrc;
    my $do_ln = get_int($c, "lines.enabled");
    my $do_fn = get_int($c, "functions.enabled");
    my $do_br = get_int($c, "branches.enabled");

    write_functions($fd, $functions, $hits->[1], \$iter->[1]) if ($do_fn);
    write_branches($fd, $branches, $hits->[2], \$iter->[2]) if ($do_br);
    write_lines($fd, $lines, $hits->[0], \$iter->[0]) if ($do_ln);
}

sub write_info($$$$)
{
    my ($c, $filename, $src, $hits) = @_;
    my $files = $src->[0];
    my $fd;
    my %iters;

    foreach my $testname (keys(%{$hits})) {
        $iters{$testname} = [0, 0, 0];
    }

    open($fd, ">", $filename) or die("Could not create $filename: $!\n");

    foreach my $filename (sort(keys(%{$files}))) {
        my $filesrc = $files->{$filename};

        foreach my $testname (sort(keys(%{$hits}))) {
            my $testhits = $hits->{$testname};
            my $iter     = $iters{$testname};

            print($fd "TN:$testname\n");
            print($fd "SF:$filename\n");

            write_filesrc($c, $fd, $filesrc, $testhits, $iter);

            print($fd "end_of_record\n");
        }
    }

    close($fd);
}

sub get_hit_found($)
{
    my ($list) = @_;
    my ($hit, $found) = (0, 0);

    foreach my $e (@$list) {
        $hit++ if ($e ne "-" && $e > 0);
        $found++;
    }
    return ($hit, $found);
}

sub write_counts($$)
{
    my ($filename, $hits) = @_;
    my $fd;
    my (@tlnhits, @tfnhits, @tbrhits);

    foreach my $testname (keys(%{$hits})) {
        my $testhits = $hits->{$testname};
        my ($lnhits, $fnhits, $brhits) = @$testhits;

        for (my $i = 0; $i < scalar(@$lnhits); $i++) {
            $tlnhits[$i] += $lnhits->[$i];
        }
        for (my $i = 0; $i < scalar(@$fnhits); $i++) {
            $tfnhits[$i] += $fnhits->[$i];
        }
        for (my $i = 0; $i < scalar(@$brhits); $i++) {
            my $h = $brhits->[$i];

            $h = 0 if ($h eq "-");
            $tbrhits[$i] += $h;
        }
    }

    open($fd, ">", $filename) or die("Could not create $filename: $!\n");
    print($fd join(" ",
                   get_hit_found(\@tlnhits), get_hit_found(\@tfnhits),
                   get_hit_found(\@tbrhits)) .
              "\n");
    close($fd);
}

# A branch hit value for a block that was not hit must be "-". A branch hit
# value for a block that was hit cannot be "-", but must be "0" if not hit.
sub sanitize_brhits($)
{
    my ($brhits) = @_;
    my $block_hit = 0;

    foreach my $brhit_ref (@$brhits) {
        if ($$brhit_ref ne "-" && $$brhit_ref > 0) {
            $block_hit = 1;
            last;
        }
    }
    foreach my $brhit_ref (@$brhits) {
        if (!$block_hit) {
            $$brhit_ref = "-";
        } elsif ($$brhit_ref eq "-") {
            $$brhit_ref = 0;
        }
    }
}

# Ensure coverage rate interdependencies are met
sub sanitize_hits($$)
{
    my ($src, $hits) = @_;
    my $files = $src->[0];

    foreach my $hits (values(%{$hits})) {
        my $brhits = $hits->[2];
        my $i      = 0;

        foreach my $filename (sort(keys(%{$files}))) {
            my $filesrc  = $files->{$filename};
            my $branches = $filesrc->[3];
            my $lastblock;
            my $lastline;
            my @blist;

            foreach my $brdata (@$branches) {
                my ($brline, $block, $branch) = @$brdata;

                if (!defined($lastblock) ||
                    $block != $lastblock ||
                    $brline != $lastline) {
                    sanitize_brhits(\@blist);
                    @blist     = ();
                    $lastblock = $block;
                    $lastline  = $brline;
                }
                push(@blist, \$brhits->[$i++]);
            }
            sanitize_brhits(\@blist);
        }
    }
}

# Generate random coverage data
#
# returns:	testname -> testhits
# testhits:	[ lnhits, fnhits, brhits ]
# lnhits:	[ ln1hit, ln2hit, ... ]
# lnhit:	Number of times a line was hit by a specific test
# fnhits:	[ fn1hit, fn2hit, ... ]
# fnhit:	Number of times a function was hit by a specific test
# brhits:	[ br1hit, br2hit, ... ]
# brhit:	Number of times a branch was hit by a specific test
sub gen_hits($$)
{
    my ($c, $src) = @_;
    my (@lnhits, @fnhits, @brhits);
    my ($files, $numlns, $numfns, $numbrs) = @$src;
    my $testnames = get_list($c, "tests.names", "");
    my %hits;

    $testnames = [""] if (!@$testnames);

    foreach my $testname (@$testnames) {
        my (@lnhits, @fnhits, @brhits);

        for (my $i = 0; $i < $numlns; $i++) {
            push(@lnhits, 1 + int(rand($MAX_TAKEN)));
        }

        for (my $i = 0; $i < $numfns; $i++) {
            push(@fnhits, 1 + int(rand($MAX_TAKEN)));
        }

        for (my $i = 0; $i < $numbrs; $i++) {
            push(@brhits, 1 + int(rand($MAX_TAKEN)));
        }

        $hits{$testname} = [\@lnhits, \@fnhits, \@brhits];
    }

    sanitize_hits($src, \%hits);

    return \%hits;
}

# Return a hash containing RATE percent of indices [0..NUM-1].
sub gen_filter($$)
{
    my ($num, $rate) = @_;
    my @list = (0 .. ($num - 1));
    my %hash;

    reduce_list_per(\@list, $rate);
    foreach my $i (@list) {
        $hash{$i} = 1;
    }

    return \%hash;
}

# Zero all entries in LIST identified by the indices in FILTER.
sub zero_by_filter($$)
{
    my ($list, $filter) = @_;

    foreach my $i (keys(%{$filter})) {
        $list->[$i] = 0;
    }
}

# Add a random number of indices between [0..NUM-1] to FILTER.
sub widen_filter($$)
{
    my ($filter, $num) = @_;
    my @list;

    for (my $i = 0; $i < $num; $i++) {
        push(@list, $i) if (!exists($filter->{$i}));
    }
    reduce_list_per(\@list, int(rand(101)));

    foreach my $i (@list) {
        $filter->{$i} = 1;
    }
}

# Zero coverage data in HITS until the combined coverage rates reach the
# specified RATEs.
sub reduce_hits($$$$$)
{
    my ($src, $hits, $lnrate, $fnrate, $brrate) = @_;
    my ($files, $numlns, $numfns, $numbrs) = @$src;
    my ($lnfilter, $fnfilter, $brfilter);

    $lnfilter = gen_filter($numlns, 100 - $lnrate);
    $fnfilter = gen_filter($numfns, 100 - $fnrate);
    $brfilter = gen_filter($numbrs, 100 - $brrate);

    foreach my $testhits (values(%{$hits})) {
        my ($lnhits, $fnhits, $brhits) = @$testhits;

        zero_by_filter($lnhits, $lnfilter);
        zero_by_filter($fnhits, $fnfilter);
        zero_by_filter($brhits, $brfilter);

        # Provide some variation between tests
        widen_filter($lnfilter, $numlns);
        widen_filter($fnfilter, $numfns);
        widen_filter($brfilter, $numbrs);
    }

    sanitize_hits($src, $hits);
}

sub zero_list($)
{
    my ($list) = @_;

    foreach my $i (@$list) {
        $i = 0;
    }
}

# Zero all coverage in HITS.
sub zero_hits($$)
{
    my ($src, $hits) = @_;

    foreach my $testhits (values(%{$hits})) {
        my ($lnhits, $fnhits, $brhits) = @$testhits;

        zero_list($lnhits);
        zero_list($fnhits);
        zero_list($brhits);
    }

    sanitize_hits($src, $hits);
}

# Distribute items from LIST to A and B depending on whether the index for
# an item is found in FILTER.
sub split_by_filter($$$$)
{
    my ($list, $filter, $a, $b) = @_;

    for (my $i = 0; $i < scalar(@$list); $i++) {
        if (exists($filter->{$i})) {
            push(@$a, $list->[$i]);
            push(@$b, 0);
        } else {
            push(@$a, 0);
            push(@$b, $list->[$i]);
        }
    }
}

sub split_hits($$$)
{
    my ($c, $src, $hits) = @_;
    my ($files, $numlns, $numfns, $numbrs) = @$src;
    my ($lnsplit, $fnsplit, $brsplit);
    my (%a, %b);

    $lnsplit = gen_filter($numlns, int(rand(101)));
    $fnsplit = gen_filter($numfns, int(rand(101)));
    $brsplit = gen_filter($numbrs, int(rand(101)));

    foreach my $testname (keys(%{$hits})) {
        my $testhits = $hits->{$testname};
        my ($lnhits, $fnhits, $brhits) = @$testhits;
        my (@lnhitsa, @fnhitsa, @brhitsa);
        my (@lnhitsb, @fnhitsb, @brhitsb);

        split_by_filter($lnhits, $lnsplit, \@lnhitsa, \@lnhitsb);
        split_by_filter($fnhits, $fnsplit, \@fnhitsa, \@fnhitsb);
        split_by_filter($brhits, $brsplit, \@brhitsa, \@brhitsb);

        $a{$testname} = [\@lnhitsa, \@fnhitsa, \@brhitsa];
        $b{$testname} = [\@lnhitsb, \@fnhitsb, \@brhitsb];
    }

    sanitize_hits($src, \%a);
    sanitize_hits($src, \%b);

    return (\%a, \%b);
}

sub plural($$$)
{
    my ($num, $sing, $plur) = @_;

    return $num <= 1 ? $sing : $plur;
}

sub print_intro($)
{
    my ($c)      = @_;
    my $numtests = scalar(@{get_list($c, "tests.names")});
    my $numfiles = get_int($c, "files.numfiles");

    $numtests = 1 if ($numtests < 1);

    print($BOLD. "Creating coverage files ($numtests " .
          plural($numtests, "test", "tests") . ", $numfiles " .
          plural($numfiles, "source file", "source files") . ")\n" . $RESET);
}

sub main()
{
    my $opt_help;
    my $opt_output;
    my $opt_configfile;
    my $opt_seed = 0;
    my $c;
    my $src;
    my $hits;
    my $root;
    my $enum;
    my ($a, $b);

    # Parse options
    if (!GetOptions("output|o=s" => \$opt_output,
                    "seed=s"     => \$opt_seed,
                    "help|h"     => \$opt_help,
    )) {
        print(STDERR "Use $0 --help to get usage information\n");
        exit(2);
    }

    if ($opt_help) {
        usage();
        exit(0);
    }

    $opt_configfile = shift(@ARGV);
    if (!defined($opt_configfile)) {
        print(STDERR "Please specify a config file\n");
        exit(2);
    }

    if (defined($opt_output)) {
        if (!-d $opt_output) {
            mkdir($opt_output) or
                die("$0: Could not create directory " . "$opt_output: $!\n");
        }
        $root = abs_path($opt_output);
    } else {
        $root = "/";
    }

    srand($opt_seed);

    # Get config
    $c = read_config($opt_configfile);
    apply_config($c, \@ARGV) if (@ARGV);

    print_intro($c);
    # Show lines on STDOUT without newline
    $| = 1;

    # Create source tree
    print("  Source tree ......... ");
    $src = gen_src($c, $root);
    # Write out source code if requested
    write_src($src) if (defined($opt_output));
    print("done (");
    print($src->[1] . " lines, ");
    print($src->[2] . " functions, ");
    print($src->[3] . " branches)\n");

    # Write out full-coverage data files
    print("  Full coverage ....... ");
    $hits = gen_hits($c, $src);
    write_info($c, "full.info", $src, $hits);
    write_counts("full.counts", $hits);
    print("done\n");

    # Write out data files with target coverage rates
    print("  Target coverage ..... ");
    reduce_hits($src, $hits,
                get_int($c, "lines.covered"),
                get_int($c, "functions.covered"),
                get_int($c, "branches.covered"));
    write_info($c, "target.info", $src, $hits);
    write_counts("target.counts", $hits);
    print("done\n");

    # Write out partial data files
    print("  Partial coverage .... ");
    ($a, $b) = split_hits($c, $src, $hits);
    write_info($c, "part1.info", $src, $a);
    write_counts("part1.counts", $a);
    write_info($c, "part2.info", $src, $b);
    write_counts("part2.counts", $b);
    print("done\n");

    # Write out zero-coverage data files
    print("  Zero coverage ....... ");
    zero_hits($src, $hits);
    write_info($c, "zero.info", $src, $hits);
    write_counts("zero.counts", $hits);
    print("done\n");
}

main();
exit(0);
