t/16_circular.t

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