The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# DESCRIPTION: Perl ExtUtils: Type 'make test' to test this package
#
# Copyright 2006-2011 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.

use Time::HiRes qw (gettimeofday);
use strict;
use Test;

BEGIN { plan tests => 10 }
BEGIN { require "t/test_utils.pl"; }

$Schedule::Load::Safe::Debug = 1;

my $subself = { one=>1, two=>2, };

use Schedule::Load::Safe;
ok(1);

my $safe = Schedule::Load::Safe->new();
ok($safe);

print "Is our function correct?\n";
my $func = sub { return ($_[0]->{two}); };
ok($func->($subself) == 2);

print "Refs evaluate correctly?\n";
ok($safe->eval_cb(sub { return ($_[0]->{two}); }, $subself) == 2);

print "Strings evaluate correctly?\n";
ok($safe->eval_cb('sub { return ($_[0]->{two}); }', $subself) == 2);

# Second time cached strings evaluate correctly
ok($safe->eval_cb('sub { return ($_[0]->{two}); }', $subself) == 2);

print "Error case\n";
ok(!defined $safe->eval_cb('system("crash_and_die")', $subself));
$@ = undef;

print "Uncached performance\n";
profile_start();
for (my $i=0; $i<2000; $i++) {
    $safe->eval_cb("sub { return $i; }", $subself);
}
profile_end("2000 uncached evals");
ok(1);

print "Cached performance\n";
profile_start();
for (my $i=0; $i<2000; $i++) {
    $safe->eval_cb("sub { return 22; }", $subself);
}
profile_end("2000 cached evals");
ok(1);

# Did caching work, but not overflow memory?
ok(keys %{$safe->{_cache}} > 100 && keys %{$safe->{_cache}} < 1001);

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

our $_Last_Time = 0;
our $_Last_Time_Usec = 0;
sub profile_start {
    my ($time, $time_usec) = gettimeofday();
    $_Last_Time = $time;
    $_Last_Time_Usec = $time_usec;
}
sub profile_end {
    my $category = shift || 'undef';
    my ($time, $time_usec) = gettimeofday();
    my $dtime_usec = $time_usec - $_Last_Time_Usec;
    my $dtime = $time - $_Last_Time + $dtime_usec*1.0e-6;
    printf(" Profile time %08.6f for $category\n", $dtime, $category);
    return $dtime;
}