1#!/usr/bin/perl -w
2# DESCRIPTION: Perl ExtUtils: Type 'make test' to test this package
3#
4# Copyright 2006-2011 by Wilson Snyder.  This program is free software;
5# you can redistribute it and/or modify it under the terms of either the GNU
6# Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
7
8use Time::HiRes qw (gettimeofday);
9use strict;
10use Test;
11
12BEGIN { plan tests => 10 }
13BEGIN { require "t/test_utils.pl"; }
14
15$Schedule::Load::Safe::Debug = 1;
16
17my $subself = { one=>1, two=>2, };
18
19use Schedule::Load::Safe;
20ok(1);
21
22my $safe = Schedule::Load::Safe->new();
23ok($safe);
24
25print "Is our function correct?\n";
26my $func = sub { return ($_[0]->{two}); };
27ok($func->($subself) == 2);
28
29print "Refs evaluate correctly?\n";
30ok($safe->eval_cb(sub { return ($_[0]->{two}); }, $subself) == 2);
31
32print "Strings evaluate correctly?\n";
33ok($safe->eval_cb('sub { return ($_[0]->{two}); }', $subself) == 2);
34
35# Second time cached strings evaluate correctly
36ok($safe->eval_cb('sub { return ($_[0]->{two}); }', $subself) == 2);
37
38print "Error case\n";
39ok(!defined $safe->eval_cb('system("crash_and_die")', $subself));
40$@ = undef;
41
42print "Uncached performance\n";
43profile_start();
44for (my $i=0; $i<2000; $i++) {
45    $safe->eval_cb("sub { return $i; }", $subself);
46}
47profile_end("2000 uncached evals");
48ok(1);
49
50print "Cached performance\n";
51profile_start();
52for (my $i=0; $i<2000; $i++) {
53    $safe->eval_cb("sub { return 22; }", $subself);
54}
55profile_end("2000 cached evals");
56ok(1);
57
58# Did caching work, but not overflow memory?
59ok(keys %{$safe->{_cache}} > 100 && keys %{$safe->{_cache}} < 1001);
60
61######################################################################
62
63our $_Last_Time = 0;
64our $_Last_Time_Usec = 0;
65sub profile_start {
66    my ($time, $time_usec) = gettimeofday();
67    $_Last_Time = $time;
68    $_Last_Time_Usec = $time_usec;
69}
70sub profile_end {
71    my $category = shift || 'undef';
72    my ($time, $time_usec) = gettimeofday();
73    my $dtime_usec = $time_usec - $_Last_Time_Usec;
74    my $dtime = $time - $_Last_Time + $dtime_usec*1.0e-6;
75    printf(" Profile time %08.6f for $category\n", $dtime, $category);
76    return $dtime;
77}
78
79
80