VaKeR CYBER ARMY
Logo of a company Server : Apache/2.4.41 (Ubuntu)
System : Linux absol.cf 5.4.0-198-generic #218-Ubuntu SMP Fri Sep 27 20:18:53 UTC 2024 x86_64
User : www-data ( 33)
PHP Version : 7.4.33
Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare,
Directory :  /proc/thread-self/root/usr/local/lib/node_modules/mediasoup/worker/deps/lcov/test/bin/

Upload File :
current_dir [ Writeable ] document_root [ Writeable ]

 

Current File : //proc/thread-self/root/usr/local/lib/node_modules/mediasoup/worker/deps/lcov/test/bin/mkinfo
#!/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);

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

		reduce_list_num(\@blocks, $numblocks);

		foreach my $block (@blocks) {
			my $numbranch = rand_dist($branchdist);

			for (my $branch = 0; $branch < $numbranch; $branch++) {
				push(@branches, [ $brline, $block, $branch]);
			}
		}
	}

	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);

	# 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);

VaKeR 2022