Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
array.t	1.41 KB	-r--r--r--	2014-12-27 11:48
array_confusion.t	771 B	-r--r--r--	2014-12-27 11:48
correctness.t	3.04 KB	-r--r--r--	2014-12-27 11:48
errors.t	1.38 KB	-r--r--r--	2014-12-27 11:48
expfile.t	1.32 KB	-r--r--r--	2014-12-27 11:48
expire.t	943 B	-r--r--r--	2014-12-27 11:48
expmod_n.t	1.1 KB	-r--r--r--	2014-12-27 11:48
expmod_t.t	2.36 KB	-r--r--r--	2014-12-27 11:48
flush.t	614 B	-r--r--r--	2014-12-27 11:48
normalize.t	1.38 KB	-r--r--r--	2014-12-27 11:48
prototype.t	570 B	-r--r--r--	2014-12-27 11:48
speed.t	2.99 KB	-r--r--r--	2014-12-27 11:48
tie.t	1.54 KB	-r--r--r--	2014-12-27 11:48
tie_gdbm.t	1.23 KB	-r--r--r--	2014-12-27 11:48
tie_ndbm.t	1.31 KB	-r--r--r--	2014-12-27 11:48
tie_sdbm.t	1.41 KB	-r--r--r--	2014-12-27 11:48
tie_storable.t	1.29 KB	-r--r--r--	2014-12-27 11:48
tiefeatures.t	1.18 KB	-r--r--r--	2014-12-27 11:48
unmemoize.t	520 B	-r--r--r--	2014-12-27 11:48

Rename

#!/usr/bin/perl

use lib '..';
use Memoize;
BEGIN {
  eval {require Time::HiRes};
  if ($@ || $ENV{SLOW}) {
#    $SLOW_TESTS = 1;
  } else {
    'Time::HiRes'->import('time');
  }
}

my $DEBUG = 0;

my $n = 0;
$| = 1;

if (-e '.fast') {
  print "1..0\n";
  exit 0;
}

# Perhaps nobody will notice if we don't say anything
# print "# Warning: I'm testing the timed expiration policy.\n# This will take about thirty seconds.\n";

print "1..15\n";
$| = 1;

# (1)
++$n; print "ok $n\n";

# (2)
require Memoize::Expire;
++$n; print "ok $n\n";

sub close_enough {
#  print "Close enough? @_[0,1]\n";
  abs($_[0] - $_[1]) <= 2;
}

sub very_close {
#  print "Close enough? @_[0,1]\n";
  abs($_[0] - $_[1]) <= 0.01;
}

my $t0;
sub start_timer {
  $t0 = time;
  $DEBUG and print "# $t0\n";
}

sub wait_until {
  my $until = shift();
  my $diff = $until - (time() - $t0);
  $DEBUG and print "# until $until; diff = $diff\n";
  return if $diff <= 0;
  select undef, undef, undef, $diff;
}

sub now {
#  print "NOW: @_ ", time(), "\n";
  time;
}

tie my %cache => 'Memoize::Expire', LIFETIME => 15;
memoize 'now',
    SCALAR_CACHE => [HASH => \%cache ],
    LIST_CACHE => 'FAULT'
    ;

# (3)
++$n; print "ok $n\n";

# (4-6)
# T
start_timer();
for (1,2,3) {
  $when{$_} = now($_);
  ++$n;
  print "not " unless close_enough($when{$_}, time());
  print "ok $n\n";
  sleep 6 if $_ < 3;
  $DEBUG and print "# ", time()-$t0, "\n";
}
# values will now expire at T=15, 21, 27
# it is now T=12

# T+12
for (1,2,3) {
  $again{$_} = now($_); # Should be the same as before, because of memoization
}

# (7-9)
# T+12
foreach (1,2,3) {
  ++$n;
  if (very_close($when{$_}, $again{$_})) {
    print "ok $n\n";
  } else {
    print "not ok $n # expected $when{$_}, got $again{$_}\n";
  }
}

# (10)
wait_until(18);  # now(1) expires
print "not " unless close_enough(time, $again{1} = now(1));
++$n; print "ok $n\n";

# (11-12)
# T+18
foreach (2,3) {			# Should not have expired yet.
  ++$n;
  print "not " unless now($_) == $again{$_};
  print "ok $n\n";
}

wait_until(24);  # now(2) expires

# (13)
# T+24
print "not " unless close_enough(time, $again{2} = now(2));
++$n; print "ok $n\n";

# (14-15)
# T+24
foreach (1,3) {  # 1 is good again because it was recomputed after it expired
  ++$n;
  if (very_close(scalar(now($_)), $again{$_})) {
    print "ok $n\n";
  } else {
    print "not ok $n # expected $when{$_}, got $again{$_}\n";
  }
}