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