#! /usr/bin/env perl
# vim: ts=8 sw=4 sts=4 expandtab:
##########################################################
## This script is part of the Devel::NYTProf distribution
##
## Copyright, contact and other information can be found
## at the bottom of this file, or by going to:
## http://search.cpan.org/perldoc?Devel::NYTProf
##
###########################################################
## $Id: benchmark.pl 322 2008-07-15 04:33:35Z tim.bunce $
###########################################################
use warnings;
use strict;

use Carp;
use Config;
use Getopt::Long;
use Benchmark qw(:hireswallclock timethese cmpthese);
use Devel::NYTProf::Data; # just to print path

GetOptions(
    'v|verbose' => \my $opt_verbose,
) or exit 1;

my $regex = shift;

my $subs_count = shift || 2000;
my $loop_count = shift || 1000;

# simple benchmark script to measure profiling overhead
my $test_script = "benchmark_code.pl";
open my $fh, ">", $test_script or die "Can't write to $test_script: $!\n";
print $fh q{
    my $subs_count = shift || die "No subs count";
    my $loop_count = shift || die "No loop count";
    sub foo {
        my $loop = shift;
        my $a = 0;
        while ($loop-- > 0) { ++$a; ++$a; ++$a; }
    }
    while ($subs_count-- > 0) {
        foo($loop_count)
    }
};
close $fh or die "Error writing to $test_script: $!\n";
END { unlink $test_script };


my %tests = (
    baseline => {
        perlargs => '',
    },
    dprof => {
        perlargs => '-d:DProf',
        datafile => 'tmon.out',
    },
    fastprof => {
        perlargs => '-MDevel::FastProf',
        datafile => 'fastprof.out',
    },
    profit => {
        perlargs => '-MDevel::Profit',
        datafile => 'profit.out',
    },
    nytprof_o => {
        env => [ NYTPROF => 'use_db_sub=0:file=nytprof_o.out' ],
        perlargs => '-d:NYTProf',
        datafile => 'nytprof_o.out',
    },
    nytprof_s => {
        env => [ NYTPROF => 'use_db_sub=1:file=nytprof_s.out' ],
        perlargs => '-d:NYTProf',
        datafile => 'nytprof_s.out',
    },
    nytprof_ob => {
        env => [ NYTPROF => 'blocks:file=nytprof_ob.out' ],
        perlargs => '-d:NYTProf',
        datafile => 'nytprof_ob.out',
    },
);

my %test_subs;
while ( my ($testname, $testinfo) = each %tests ) {
    if ($regex && $testname ne 'baseline' && $testname !~ m/$regex/o) {
        warn "Skipped $testname\n";
        next;
    }
    if (!run_test($testinfo, 1, 1)) {
        warn "Can't run $testname profiler - skipped\n";
        next;
    }
    $testinfo->{testname} = $testname;
    $test_subs{$testname} = sub { run_test($testinfo, $subs_count, $loop_count) };
}

printf "Profiler performance using perl %8s %s (%s %s %s)\n",
    $], $Config{archname},
    $Config{gccversion} ? 'gcc' : $Config{cc},
    (split / /, $Config{gccversion}||$Config{ccversion}||'')[0]||'',
    $Config{optimize};
printf "NYTProf is $INC{'Devel/NYTProf/Data.pm'}\n";

cmpthese(4, \%test_subs, 'nop');

for my $testname (sort keys %test_subs) {
    my $testinfo = $tests{$testname};
    if ($testinfo->{datafile}) {
        printf "%10s: %6dKB %s\n",
            $testname, (-s $testinfo->{datafile})/1024, $testinfo->{datafile};
        unlink $testinfo->{datafile};
    }
}

exit 0;

sub run_test {
    my($testinfo, $subs_count, $loop_count) = @_;

    my $env = $testinfo->{env};
    local $ENV{$env->[0]} = $env->[1] if $env;

    my $cmd = "perl $testinfo->{perlargs} $test_script $subs_count $loop_count";
    system($cmd) == 0;
}