t/16_circular.t

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