t/lib/TestSimpleHash.pm

   1 package TestSimpleHash;
   2
   3 use 5.6.0;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Test::More;
   9 use Test::Exception;
  10
  11 use base 'TestBase';
  12
  13 sub A_assignment : Test( 23 ) {
  14     my $self = shift;
  15     my $db = $self->{db};
  16
  17     my @keys = keys %{$self->{data}};
  18
  19     push @keys, $keys[0] while @keys < 3;
  20
  21     cmp_ok( keys %$db, '==', 0 );
  22
  23     foreach my $k ( @keys[0..2] ) {
  24         ok( !exists $db->{$k} );
  25         ok( !$db->exists( $k ) );
  26     }
  27
  28     $db->{$keys[0]} = $self->{data}{$keys[0]};
  29     $db->put( $keys[1] => $self->{data}{$keys[1]} );
  30     $db->store( $keys[2] => $self->{data}{$keys[2]} );
  31
  32     foreach my $k ( @keys[0..2] ) {
  33         ok( $db->exists( $k ) );
  34         ok( exists $db->{$k} );
  35
  36         is( $db->{$k}, $self->{data}{$k} );
  37         is( $db->get($k), $self->{data}{$k} );
  38         is( $db->fetch($k), $self->{data}{$k} );
  39     }
  40
  41     if ( @keys > 3 ) {
  42         $db->{$_} = $self->{data}{$_} for @keys[3..$#keys];
  43     }
  44
  45     cmp_ok( keys %$db, '==', @keys );
  46 }
  47
  48 sub B_check_keys : Test( 1 ) {
  49     my $self = shift;
  50     my $db = $self->{db};
  51
  52     my @control = sort keys %{$self->{data}};
  53     my @test1 = sort keys %$db;
  54     is_deeply( \@test1, \@control );
  55 }
  56
  57 sub C_each : Test( 1 ) {
  58     my $self = shift;
  59     my $db = $self->{db};
  60
  61     my $temp = {};
  62     while ( my ($k,$v) = each %$db ) {
  63         $temp->{$k} = $v;
  64     }
  65
  66     is_deeply( $temp, $self->{data} );
  67 }
  68
  69 sub D_firstkey : Test( 1 ) {
  70     my $self = shift;
  71     my $db = $self->{db};
  72
  73     my $temp = {};
  74
  75     my $key = $db->first_key;
  76     while ( $key ) {
  77         $temp->{$key} = $db->get( $key );
  78         $key = $db->next_key( $key );
  79     }
  80
  81     is_deeply( $temp, $self->{data} );
  82 }
  83
  84 sub E_delete : Test( 12 ) {
  85     my $self = shift;
  86     my $db = $self->{db};
  87
  88     my @keys = keys %{$self->{data}};
  89     cmp_ok( keys %$db, '==', @keys );
  90
  91     my $key1 = $keys[0];
  92     ok( exists $db->{$key1} );
  93     is( $db->{$key1}, $self->{data}{$key1} );
  94     is( delete $db->{$key1}, $self->{data}{$key1} );
  95     ok( !exists $db->{$key1} );
  96     cmp_ok( keys %$db, '==', @keys - 1 );
  97
  98     my $key2 = $keys[1];
  99     ok( exists $db->{$key2} );
 100     is( $db->{$key2}, $self->{data}{$key2} );
 101     is( $db->delete( $key2 ), $self->{data}{$key2} );
 102     ok( !exists $db->{$key2} );
 103     cmp_ok( keys %$db, '==', @keys - 2 );
 104
 105     @{$db}{ @keys[0,1] } = @{$self->{data}}{@keys[0,1]};
 106
 107     cmp_ok( keys %$db, '==', @keys );
 108 }
 109
 110 sub F_clear : Test( 3 ) {
 111     my $self = shift;
 112     my $db = $self->{db};
 113
 114     my @keys = keys %{$self->{data}};
 115     cmp_ok( keys %$db, '==', @keys );
 116
 117     %$db = ();
 118
 119     cmp_ok( keys %$db, '==', 0 );
 120
 121     %$db = %{$self->{data}};
 122     cmp_ok( keys %$db, '==', @keys );
 123 }
 124
 125 sub G_reassign_and_close : Test( 4 ) {
 126     my $self = shift;
 127
 128     my @keys = keys %{$self->{data}};
 129
 130     my $key1 = $keys[0];
 131
 132     my $long_value = 'long value' x 100;
 133     $self->{db}{$key1} = $long_value;
 134     is( $self->{db}{$key1}, $long_value );
 135
 136     my $filename = $self->{db}->_root->{file};
 137     undef $self->{db};
 138
 139     $self->{db} = DBM::Deep->new( $filename );
 140
 141     is( $self->{db}{$key1}, $long_value );
 142
 143     $self->{db}{$key1} = $self->{data}{$key1};
 144     is( $self->{db}{$key1}, $self->{data}{$key1} );
 145
 146     cmp_ok( keys %{$self->{db}}, '==', @keys );
 147 }
 148
 149 1;
 150 __END__