The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

# $Id$

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

use strict;

use Test::More;
use Math::Int64 ('uint64', 'uint64_to_number');
use Win32::API::Test;
use Config;

plan tests => 7;
use vars qw($function $result $return $test_dll );


#use B::Concise;
use_ok('Win32::API');

$test_dll = Win32::API::Test::find_test_dll();
diag('API test dll found at (' . $test_dll . ')');
ok(-e $test_dll, 'found API test dll');

if(*Win32::API::_ResetTimes{CODE}) {
    if($Config{ptrsize} == 4) {
    my $GCP = new Win32::API('kernel32.dll', 'GetCurrentProcess', '', 'N');
    my $prochand = $GCP->Call();
    my $GPAM = new Win32::API::More('kernel32.dll', 'BOOL WINAPI GetProcessAffinityMask('
                   .'HANDLE hProcess, PHANDLE lpProcessAffinityMask, '
                   .'PHANDLE lpSystemAffinityMask);');
    die 'API obj for GetProcessAffinityMask failed' if !$GPAM;
    my ($ProcessAffinityMask, $SystemAffinityMask) = (0,0);
    die 'GetProcessAffinityMask failed' if !$GPAM->Call($prochand, $ProcessAffinityMask, $SystemAffinityMask);
    my $bitsinptr =  length(pack(PTR_LET(),0))*8;
    #low cpus on left side in string
    my $availcpus = unpack('b'.$bitsinptr, pack(PTR_LET, $SystemAffinityMask));
    my $highestCPU = index($availcpus, '0');
    die 'can\'t find highest CPU' if $highestCPU < 1;
    my $mask = 2**($highestCPU-1);
    diag("highest CPU mask is $mask\n");
    my $SPAM = new Win32::API('kernel32.dll',
    'BOOL WINAPI SetProcessAffinityMask(HANDLE hProcess, DWORD_PTR dwProcessAffinityMask);');
    die 'API obj for SetProcessAffinityMask failed '.($^E+0) if !$SPAM;
    die 'SPAM failed' if !$SPAM->Call($prochand, $mask);
    }
    Win32::API::_ResetTimes();
}

sub benchmark {
my $c_slr_loop= new Win32::API($test_dll, 'char * setlasterror_loop(int interations)');
ok(defined($c_slr_loop), 'setlasterror_loop() function defined');

my $QPC = Win32::API::More->new('kernel32.dll', "BOOL WINAPI QueryPerformanceCounter(
                        UINT64 * lpPerformanceCount );");
ok($QPC, "QueryPerformanceCounter Win32::API obj created");
$QPC->UseMI64(1) if IV_SIZE == 4;
my $freq;
$freq = uint64(0);
my $QPF = Win32::API::More->new('kernel32.dll', "BOOL WINAPI QueryPerformanceFrequency(
                            UINT64 *lpFrequency);");
$QPF->UseMI64(1) if IV_SIZE == 4;
ok($QPF->Call($freq), "QueryPerformanceFrequency Win32::API obj created and call success");

#note that we capture the garbage return value for SLR, this is to simulate that most
#c funcs have a return value
my $SLR = Win32::API->new('kernel32.dll', 'BOOL WINAPI SetLastError( DWORD dwErrCode );');
my $start = uint64(0);
my $end = uint64(0);
my ($startbool, $SLRret, $endbool);
my $iterations = 1000000;
$startbool = $QPC->Call($start);
$SLRret = $SLR->Call(1) for(0..$iterations);
$endbool = $QPC->Call($end);
ok($startbool && $endbool, "QPC calls succeeded");
my $delta = (uint64_to_number($end-$start)/uint64_to_number($freq));
diag("time was $delta secs, ".(($delta/scalar(@{[0..$iterations, 1,1]}))*1000)." ms per Win32::API call");

Win32::API->Import('kernel32.dll', 'BOOL WINAPI SetLastError( DWORD dwErrCode );');
$startbool = $QPC->Call($start);
$SLRret = SetLastError(1) for(0..$iterations);
$endbool = $QPC->Call($end);
ok($startbool && $endbool, "QPC calls succeeded");
$delta = (uint64_to_number($end-$start)/uint64_to_number($freq));
diag("time was $delta secs, ".(($delta/scalar(@{[0..$iterations, 1,1]}))*1000)." ms per Win32::AP::Import style call");

my $msg = $c_slr_loop->Call($iterations);
diag($msg);

if(*Win32::API::_xxSetLastError{CODE}) {
    $startbool = $QPC->Call($start);
    $SLRret = Win32::API::_xxSetLastError(1) for(0..$iterations);
    $endbool = $QPC->Call($end);
    die "QPC calls failed" unless $startbool && $endbool;
    $delta = (uint64_to_number($end-$start)/uint64_to_number($freq));
    diag("time was $delta secs, ".(($delta/scalar(@{[0..$iterations, 1,1]}))*1000)." ms per _xxSetLastError call");    
}
}
benchmark();
#my $walker = B::Concise::compile('-src','-exec', *benchmark{CODE});
#$walker->();