Permalink
Browse files

add a permanent cache for testing that key escaping and metadata form…

…at don't change between versions
  • Loading branch information...
1 parent 88b0f29 commit bd1c2ca4ae61af932ce9d5242367ab9fc0fa9669 @jonswar jonswar committed Jun 4, 2010
Showing with 38 additions and 15 deletions.
  1. +38 −15 xt/release/file-driver.t
View
@@ -4,12 +4,16 @@ use strict;
use warnings;
use File::Basename;
use File::Temp qw(tempdir);
-use Test::More tests => 6;
+use Test::More;
use Test::Exception;
use CHI;
my $root_dir = tempdir( "file-digest-XXXX", TMPDIR => 1, CLEANUP => 1 );
my $cache;
+my ($keys, $values) = set_standard_keys_and_values();
+my @keynames = sort keys (%$keys);
+
+plan tests => (scalar(@keynames) * 2 + 1);
# Test key_digest (old name for key_digester) and file_extension
#
@@ -23,20 +27,39 @@ my $key = scalar( 'ab' x 256 );
my $file = basename( $cache->path_to_key($cache->transform_key($key)) );
is( $file, 'db62ffe116024a7a4e1bd949c0e30dbae9b5db77.sha', 'SHA-1 digest' );
-# These tests will break if the path_to_key algorithm changes. We want
-# to avoid this if possible and otherwise warn users about it.
+# Test that we can retrieve from a permanent cache in this directory. If
+# key escaping or metadata format changes between versions, this will break
+# - we at least want to know about it to warn users.
#
-$cache = CHI->new(
- driver => 'File',
- root_dir => $root_dir
+my $perm_cache = CHI->new(driver => 'File', root_dir => "xt/release/permcache");
+foreach my $keyname (@keynames) {
+ is($perm_cache->get($keys->{$keyname}), $values->{$keyname}, "get $keyname from perm test cache");
+ my $obj = $perm_cache->get_object($keys->{$keyname});
+ is($obj->created_at, 1275657865);
+}
+
+sub set_standard_keys_and_values {
+ my $self = shift;
+
+ my ( %keys, %values );
+ my @mixed_chars = ( 32 .. 48, 57 .. 65, 90 .. 97, 122 .. 126, 240 );
+
+ %keys = (
+ 'space' => ' ',
+ 'newline' => "\n",
+ 'char' => 'a',
+ 'zero' => 0,
+ 'one' => 1,
+ 'medium' => 'medium',
+ 'mixed' => join( "", map { chr($_) } @mixed_chars ),
+ 'empty' => 'empty',
);
-my @pairs =
- ([0, '6/3/0'],
- [1, '0/4/1'],
- ['medium', 'b/6/medium'],
- ['$20.00 plus 5% = $25.00', '+2420+2e00+20plus+205+25+20=+20+2425+2e00'],
- ["!@#" x 100, '2/d/2d30ab2394c82169942247a2c9583d9d']);
-foreach my $pair (@pairs) {
- my ($key, $expected) = @$pair;
- like($cache->path_to_key($cache->transform_key($key)), qr/\Q$expected\E\.dat/, "path for key '$key'");
+
+ %values = map {
+ ( $_, ref( $keys{$_} ) ? $keys{$_} : scalar( reverse( $keys{$_} ) ) )
+ } keys(%keys);
+ $values{empty} = '';
+
+ return ( \%keys, \%values );
}
+

0 comments on commit bd1c2ca

Please sign in to comment.