#!/usr/bin/env perl
# See copyright, etc in below POD section.
######################################################################

use warnings;
use Cwd;
use File::Copy qw(cp);
use File::Path qw(mkpath);
use File::Spec;
use FindBin qw($RealBin);
use Getopt::Long;
use Parallel::Forker;
use Unix::Processors;
use IO::File;
use Pod::Usage;
use strict;
use vars qw($Debug);

our $Opt_Stop = 1;
our $Opt_Fastcov = 1;
our $Exclude_Branch_Regexp;
our $Exclude_Line_Regexp;
our $Remove_Gcda_Regexp;

our @Remove_Sources;
our @Source_Globs;

our $Fork = new Parallel::Forker(use_sig_child => 1, poll_interval => 10*1000);
$Fork->max_proc(Unix::Processors->new->max_online * 1.5);
$SIG{CHLD} = sub { Parallel::Forker::sig_child($Fork); };
$SIG{TERM} = sub { $Fork->kill_tree_all('TERM') if $Fork && $Fork->in_parent; die "Quitting...\n"; };

#======================================================================
# main

our $Opt_Hashset;
our $opt_stages = '';
our $Opt_Scenarios;
our %Opt_Stages;
our @Opt_Tests;

autoflush STDOUT 1;
autoflush STDERR 1;
Getopt::Long::config("no_auto_abbrev");
if (! GetOptions(
          "debug"       => sub { $Debug = 1; },
          "hashset=s"   => \$Opt_Hashset,  # driver.pl hashset
          "<>"          => sub { die "%Error: Unknown parameter: $_[0]\n"; },
          "fastcov!"    => \$Opt_Fastcov,  # use fastcov, not documented, for debug
          "scenarios=s" => \$Opt_Scenarios,  # driver.pl scenarios
          "stage=s"     => \$opt_stages,  # starting stage number
          "stages=s"    => \$opt_stages,  # starting stage number
          "stop!"       => \$Opt_Stop,  # stop/do not stop on error in tests
          "test=s@"     => \@Opt_Tests,  # test name
    )) {
    die "%Error: Bad usage, try 'code_coverage --help'\n";
}

{
    my $start = 0;
    my $end = 99;
    if ($opt_stages && $opt_stages =~ /^(\d+)$/) {
        $start = $end = $1;
    } elsif ($opt_stages && $opt_stages =~ /^(\d+)-(\d+$)$/) {
        $start = $1; $end = $2;
    } elsif ($opt_stages && $opt_stages =~ /^-(\d+$)$/) {
        $end = $1;
    } elsif ($opt_stages && $opt_stages =~ /^(\d+)-$/) {
        $start = $1;
    } elsif ($opt_stages) {
        die "%Error: --stages not understood: $opt_stages,";
    }
    for (my $n = $start; $n <= $end; ++$n) { $Opt_Stages{$n} = 1; }
}

test();
exit(0);

#######################################################################

sub test {
    -r "nodist/code_coverage.dat" or die "%Error: Run from the top of the verilator kit,";
    require "./nodist/code_coverage.dat";

    if ($Opt_Stages{1}) {
        travis_fold_start("configure");
        print "Stage 1: configure (coverage on)\n";
        run("make distclean || true");
        run("autoconf");
        # Exceptions can pollute the branch coverage data
        run("./configure --enable-longtests CXX='g++ --coverage -fno-exceptions -DVL_GCOV'");
        travis_fold_end();
    }

    if ($Opt_Stages{2}) {
        travis_fold_start("build");
        print "Stage 2: build\n";
        my $nproc = Unix::Processors->new->max_online;
        run("make -k -j $nproc VERILATOR_NO_OPT_BUILD=1");
        # The optimized versions will not collect good coverage, overwrite them
        run("cp bin/verilator_bin_dbg bin/verilator_bin");
        run("cp bin/verilator_coverage_bin_dbg bin/verilator_coverage_bin");
        travis_fold_end();
    }

    if ($Opt_Stages{3}) {
        travis_fold_start("test");
        print "Stage 3: make tests (with coverage on)\n";
        if ($#Opt_Tests < 0) {
            run("make examples VERILATOR_NO_OPT_BUILD=1")
                if !$Opt_Scenarios || $Opt_Scenarios =~ /dist/i;
            run("make test_regress VERILATOR_NO_OPT_BUILD=1"
                . ($Opt_Scenarios ? " SCENARIOS='".$Opt_Scenarios."'" : "")
                . ($Opt_Hashset ? " DRIVER_HASHSET='--hashset=".$Opt_Hashset."'" : "")
                . ($Opt_Stop ? '' : ' || true'));
        } else {
            foreach my $test (@Opt_Tests) {
                if (! -f $test && -f "test_regress/t/${test}") {
                    $test = "test_regress/t/${test}";
                }
                run($test);
            }
        }
        travis_fold_end();
    }

    my $cc_dir = "nodist/obj_dir/coverage";
    if ($Opt_Stages{4}) {
        travis_fold_start("gcno");
        print "Stage 4: Create gcno files under $cc_dir\n";
        mkpath($cc_dir);
        mkpath("$cc_dir/info");
        my $dats = `find . -print | grep .gcda`;
        my %dats;
        foreach my $dat (split '\n', $dats) {
            $dats{$dat} = 1;
        }
        foreach my $dat (sort keys %dats) {
            (my $gcno = $dat) =~ s!\.gcda$!.gcno!;
            if ($dat =~ /$Remove_Gcda_Regexp/) {
                # Remove .gcda/.gcno for files we don't care about before we slowly
                # read them
                unlink $dat;
                unlink $gcno;
                delete $dats{$dat};
                next;
            }
        }
        $dats = `find . -print | grep .gcno`;
        my %gcnos;
        foreach my $gcno (split '\n', $dats) {
            (my $gbase = $gcno) =~ s!.*/!!;
            $gcnos{$gbase} = File::Spec->rel2abs($gcno);
        }
        # We need a matching .gcno for every .gcda, try to find a matching file elsewhere
        foreach my $dat (sort keys %dats) {
            (my $gcno = $dat) =~ s!\.gcda$!.gcno!;
            (my $gbase = $gcno) =~ s!.*/!!;
            if (!-r $gcno) {
                if ($gcnos{$gbase}) {
                    symlink($gcnos{$gbase}, $gcno)
                        or die "%Error: can't ln -s $gcnos{$gbase} $gcno,";
                } else {
                    warn "MISSING .gcno for a .gcda: $gcno\n";
                }
            }
        }
        travis_fold_end();
    }

    if ($Opt_Stages{5} && $Opt_Fastcov) {
        travis_fold_start("fastcov");
        # Must run in root directory to find all files
        mkpath($cc_dir);
        #run("${RealBin}/fastcov.py -b -c src/obj_dbg -X".
        #    " --exclude /usr --exclude test_regress"
        #    ." -o ${cc_dir}/app_total.json");
        run("${RealBin}/fastcov.py -b -c src/obj_dbg -X --lcov".
            " --exclude /usr --exclude test_regress"
            ." -o ${cc_dir}/app_total.info");
        travis_fold_end();
    }

    if ($Opt_Stages{5} && !$Opt_Fastcov) {
        travis_fold_start("infos");
        print "Stage 5: make infos\n";
        my $dats = `find . -print | grep .gcda`;
        my %dirs;
        foreach my $dat (split '\n', $dats) {
            (my $dir = $dat) =~ s!/[^/]+$!!;
            $dirs{$dir} = 1;
        }

        foreach my $dir (sort keys %dirs) {
            (my $outname = $dir) =~ s![^a-zA-Z0-9]+!_!g;
            $Fork->schedule(run_on_start => sub {
                # .info may be empty, so ignore errors (unfortunately)
                run("cd $cc_dir/info ; lcov -c -d ../../../../$dir --exclude /usr -o app_test_${outname}.info || true");
                            })->run;
        }
        $Fork->wait_all;
        travis_fold_end();
    }

    if ($Opt_Stages{6}) {
        travis_fold_start("clone");
        # No control file to override single lines, so replicate the sources
        # Also lets us see the insertion markers in the HTML source res
        print "Stage 6: Clone sources under $cc_dir\n";
        clone_sources($cc_dir);
        travis_fold_end();
    }

    if ($Opt_Stages{8} && !$Opt_Fastcov) {
        travis_fold_start("copy");
        print "Stage 8: Copy .gcno files\n";
        my $dats = `find . -print | grep .gcno`;
        foreach my $dat (sort (split '\n', $dats)) {
            next if $dat =~ /$cc_dir/;
            my $outdat = $cc_dir."/".$dat;
            #print "cp $dat, $outdat);\n";
            cp($dat, $outdat);
        }
        travis_fold_end();
    }

    if ($Opt_Stages{10} && !$Opt_Fastcov) {
        travis_fold_start("combine");
        print "Stage 10: Combine data files\n";
        {
            run("cd $cc_dir ; lcov -c -i -d src/obj_dbg -o app_base.info");
            run("cd $cc_dir ; lcov -a app_base.info -o app_total.info");
            my $infos = `cd $cc_dir ; find info -print | grep .info`;
            my $comb = "";
            my @infos = (sort (split /\n/, $infos));
            foreach my $info (@infos) {
                $comb .= " -a $info";
                # Need to batch them to avoid overrunning shell command length limit
                if (length($comb) > 10000 || $info eq $infos[$#infos]) {
                    # .info may be empty, so ignore errors (unfortunately)
                    run("cd $cc_dir ; lcov -a app_total.info $comb -o app_total.info || true");
                    $comb = "";
                }
            }
        }
        travis_fold_end();
    }

    if ($Opt_Stages{11}) {
        travis_fold_start("dirs");
        print "Stage 11: Cleanup paths\n";
        if ($Opt_Fastcov) {
            cleanup_abs_paths_info($cc_dir, "$cc_dir/app_total.info", "$cc_dir/app_total.info");
            #cleanup_abs_paths_json($cc_dir, "$cc_dir/app_total.json", "$cc_dir/app_total.json");
        } else {
            cleanup_abs_paths_info($cc_dir, "$cc_dir/app_total.info", "$cc_dir/app_total.info");
        }
        travis_fold_end();
    }

    if ($Opt_Stages{12}) {
        travis_fold_start("filter");
        print "Stage 12: Filter processed source files\n";
        my $inc = '';
        foreach my $glob (@Source_Globs) {
            foreach my $infile (glob $glob) {
                $inc .= " '$infile'";
            }
        }
        my $exc = '';
        foreach my $glob (@Remove_Sources) {
            # Fastcov does exact match not globbing at present
            # Lcov requires whole path match so needs the glob
            $glob =~ s!^\*!! if $Opt_Fastcov;
            $glob =~ s!\*$!! if $Opt_Fastcov;
            $exc .= " '$glob'";
        }
        if ($Opt_Fastcov) {
            $inc = "--include ".$inc if $inc ne '';
            $exc = "--exclude ".$exc if $exc ne '';
            run("cd $cc_dir ; ${RealBin}/fastcov.py -C app_total.info ${inc} ${exc} -x --lcov -o app_total_f.info");
        } else {
            run("cd $cc_dir ; lcov --remove app_total.info $exc -o app_total_f.info");
        }
        travis_fold_end();
    }

    if ($Opt_Stages{17}) {
        travis_fold_start("report");
        print "Stage 17: Create HTML\n";
        run("cd $cc_dir ; genhtml app_total_f.info --demangle-cpp"
            ." --rc lcov_branch_coverage=1 --rc genhtml_hi_limit=100 --output-directory html");
        travis_fold_end();
    }

    if ($Opt_Stages{18}) {
        travis_fold_start("upload");
        print "Stage 18: Upload\n";
        my $cmd = "bash <(curl -s https://codecov.io/bash) -f $cc_dir/app_total.info";
        print "print: Not running: export CODECOV_TOKEN=<hidden>\n";
        print "print: Not running: $cmd\n";
        travis_fold_end();
    }

    if ($Opt_Stages{19}) {
        print "*-* All Finished *-*\n";
        print "\n";
        print "* See report in ${cc_dir}/html/index.html\n";
        print "* Remember to make distclean && ./configure before working on non-coverage\n";
    }
}

sub clone_sources {
    my $cc_dir = shift;
    my $excluded_lines = 0;
    my $excluded_br_lines = 0;
    foreach my $glob (@Source_Globs) {
        foreach my $infile (glob $glob) {
            $infile !~ m!^/!
                or die "%Error: source globs should be relative not absolute filenames,";
            my $outfile = $cc_dir."/".$infile;
            (my $outpath = $outfile) =~ s!/[^/]*$!!;
            mkpath($outpath);
            my $fh = IO::File->new("<$infile") or die "%Error: $! $infile,";
            my $ofh = IO::File->new(">$outfile") or die "%Error: $! $outfile,";
            my $lineno = 0;
            while (defined(my $line = $fh->getline)) {
                $lineno++;
                chomp $line;
                if ($line =~ /LCOV_EXCL_LINE/) {
                    $line .= " LCOV_EXCL_BR_LINE";
                }
                elsif ($line =~ /LCOV_EXCL_START/) {
                    $line .= " LCOV_EXCL_BR_START";
                }
                elsif ($line =~ /LCOV_EXCL_STOP/) {
                    $line .= " LCOV_EXCL_BR_STOP";
                }
                elsif ($line =~ /$Exclude_Line_Regexp/) {
                    $line .= "  //code_coverage: // LCOV_EXCL_LINE LCOV_EXCL_BR_LINE";
                    $excluded_lines++;
                    $excluded_br_lines++;
                    #print "$infile:$lineno: $line";
                }
                elsif ($line =~ /$Exclude_Branch_Regexp/) {
                    $line .= "  //code_coverage: // LCOV_EXCL_BR_LINE";
                    $excluded_br_lines++;
                    #print "$infile:$lineno: $line";
                }
                $ofh->print("$line\n");
            }
        }
    }
    print "Number of source lines automatically LCOV_EXCL_LINE'ed: $excluded_lines\n";
    print "Number of source lines automatically LCOV_EXCL_BR_LINE'ed: $excluded_br_lines\n";
}

sub cleanup_abs_paths_info {
    my $cc_dir = shift;
    my $infile = shift;
    my $outfile = shift;
    my $fh = IO::File->new("<$infile") or die "%Error: $! $infile,";
    my @lines;
    while (defined(my $line = $fh->getline)) {
        if ($line =~ m!^SF:!) {
            $line =~ s!$ENV{VERILATOR_ROOT}/!!;
            $line =~ s!$cc_dir/!!;
            $line =~ s!obj_dbg/verilog.y$!verilog.y!;
            #print "Remaining SF: ",$line;
        }
        push @lines, $line;
    }
    my $ofh = IO::File->new(">$outfile") or die "%Error: $! $outfile,";
    $ofh->print(@lines);
}

sub cleanup_abs_paths_json {
    my $cc_dir = shift;
    my $infile = shift;
    my $outfile = shift;
    # Handcrafted cleanup, alternative would be to deserialize/serialize JSON
    # But JSON::Parse not installed by default
    # JSON::PP more likely to be installed, but slower
    my $fh = IO::File->new("<$infile") or die "%Error: $! $infile,";
    my @lines;
    while (defined(my $line = $fh->getline)) {
        $line =~ s!"$ENV{VERILATOR_ROOT}/!"!g;
        $line =~ s!"$cc_dir/!"!g;
        $line =~ s!obj_dbg/verilog.y$!verilog.y!g;
        push @lines, $line;
    }
    my $ofh = IO::File->new(">$outfile") or die "%Error: $! $outfile,";
    $ofh->print(@lines);
}

#######################################################################
# .dat file callbacks

sub exclude_branch_regexp {
    $Exclude_Branch_Regexp = shift;
}
sub exclude_line_regexp {
    $Exclude_Line_Regexp = shift;
}
sub remove_gcda_regexp {
    $Remove_Gcda_Regexp = shift;
}
sub remove_source {
    my @srcs = @_;
    push @Remove_Sources, @srcs;
}
sub source_globs {
    my @dirs = @_;
    push @Source_Globs, @dirs;
}

#######################################################################

sub run {
    # Run a system command, check errors
    my $command = shift;
    print "\t$command\n";
    system "$command";
    my $status = $?;
    ($status == 0) or die "%Error: Command Failed $command, $status, stopped";
}

our $_Travis_Action;
sub travis_fold_start {
    $_Travis_Action = shift;
    print "travis_fold:start:$_Travis_Action\n";
}
sub travis_fold_end {
    print "travis_fold:end:$_Travis_Action\n";
}

#######################################################################
__END__

=pod

=head1 NAME

code_coverage - Build and collect Verilator coverage

=head1 SYNOPSIS

  cd $VERILATOR_ROOT
  nodist/code_coverage

=head1 DESCRIPTION

code_coverage builds Verilator with C++ coverage support and runs tests
with coverage enabled.

This will rebuild the current object files.

=head1 ARGUMENTS

=over 4

=item --hashset I<hashset>

Pass test hashset onto driver.pl test harness.

=item --help

Displays this message and program version and exits.

=item --scenarios I<scenarios>

Pass test scenarios onto driver.pl test harness.

=item --stages I<stage>

Runs a specific stage or range of stages (see the script).

=item --no-stop

Do not stop collecting data if tests fail.

=item --test I<test_regress_test_name>

Instead of normal regressions, run the specified test.  May be specified
multiple times for multiple tests.

=back

=head1 DISTRIBUTION

Copyright 2019-2020 by Wilson Snyder. This program is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License Version 3 or the Perl Artistic License
Version 2.0.

SPDX-License-Identifier: LGPL-3.0-only OR Artistic-2.0

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

C<lcov>

=cut

######################################################################
### Local Variables:
### compile-command: "cd .. ; nodist/code_coverage "
### End:
