t/16_circular.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 32;
   6 use File::Temp qw( tempfile tempdir );
   7 use Fcntl qw( :flock );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 my $dir = tempdir( CLEANUP => 1 );
  12 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
  13 flock $fh, LOCK_UN;
  14 my $db = DBM::Deep->new( $filename );
  15
  16 ##
  17 # put/get simple keys
  18 ##
  19 $db->{key1} = "value1";
  20 $db->{key2} = "value2";
  21
  22 my @keys_1 = sort keys %$db;
  23
  24 $db->{key3} = $db->{key1};
  25
  26 my @keys_2 = sort keys %$db;
  27 is( @keys_2 + 0, @keys_1 + 1, "Correct number of keys" );
  28 is_deeply(
  29     [ @keys_1, 'key3' ],
  30     [ @keys_2 ],
  31     "Keys still match after circular reference is added",
  32 );
  33
  34 $db->{key4} = { 'foo' => 'bar' };
  35 $db->{key5} = $db->{key4};
  36 $db->{key6} = $db->{key5};
  37
  38 my @keys_3 = sort keys %$db;
  39
  40 is( @keys_3 + 0, @keys_2 + 3, "Correct number of keys" );
  41 is_deeply(
  42     [ @keys_2, 'key4', 'key5', 'key6', ],
  43     [ @keys_3 ],
  44     "Keys still match after circular reference is added (@keys_3)",
  45 );
  46
  47 ##
  48 # Insert circular reference
  49 ##
  50 $db->{circle} = $db;
  51
  52 my @keys_4 = sort keys %$db;
  53
  54 is( @keys_4 + 0, @keys_3 + 1, "Correct number of keys" );
  55 is_deeply(
  56     [ 'circle', @keys_3 ],
  57     [ @keys_4 ],
  58     "Keys still match after circular reference is added",
  59 );
  60
  61 ##
  62 # Make sure keys exist in both places
  63 ##
  64 is( $db->{key1}, 'value1', "The value is there directly" );
  65 is( $db->{circle}{key1}, 'value1', "The value is there in one loop of the circle" );
  66 is( $db->{circle}{circle}{key1}, 'value1', "The value is there in two loops of the circle" );
  67 is( $db->{circle}{circle}{circle}{key1}, 'value1', "The value is there in three loops of the circle" );
  68
  69 ##
  70 # Make sure changes are reflected in both places
  71 ##
  72 $db->{key1} = "another value";
  73
  74 isnt( $db->{key3}, 'another value', "Simple scalars are copied by value" );
  75
  76 is( $db->{key1}, 'another value', "The value is there directly" );
  77 is( $db->{circle}{key1}, 'another value', "The value is there in one loop of the circle" );
  78 is( $db->{circle}{circle}{key1}, 'another value', "The value is there in two loops of the circle" );
  79 is( $db->{circle}{circle}{circle}{key1}, 'another value', "The value is there in three loops of the circle" );
  80
  81 $db->{circle}{circle}{circle}{circle}{key1} = "circles";
  82
  83 is( $db->{key1}, 'circles', "The value is there directly" );
  84 is( $db->{circle}{key1}, 'circles', "The value is there in one loop of the circle" );
  85 is( $db->{circle}{circle}{key1}, 'circles', "The value is there in two loops of the circle" );
  86 is( $db->{circle}{circle}{circle}{key1}, 'circles', "The value is there in three loops of the circle" );
  87
  88 is( $db->{key4}{foo}, 'bar' );
  89 is( $db->{key5}{foo}, 'bar' );
  90 is( $db->{key6}{foo}, 'bar' );
  91
  92 $db->{key4}{foo2} = 'bar2';
  93 is( $db->{key4}{foo2}, 'bar2' );
  94 is( $db->{key5}{foo2}, 'bar2' );
  95 is( $db->{key6}{foo2}, 'bar2' );
  96
  97 $db->{key4}{foo3} = 'bar3';
  98 is( $db->{key4}{foo3}, 'bar3' );
  99 is( $db->{key5}{foo3}, 'bar3' );
 100 is( $db->{key6}{foo3}, 'bar3' );
 101
 102 $db->{key4}{foo4} = 'bar4';
 103 is( $db->{key4}{foo4}, 'bar4' );
 104 is( $db->{key5}{foo4}, 'bar4' );
 105 is( $db->{key6}{foo4}, 'bar4' );
 106