t/16_circular.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 19;
   6 use File::Temp qw( tempfile tempdir );
   7
   8 use_ok( 'DBM::Deep' );
   9
  10 my $dir = tempdir( CLEANUP => 1 );
  11 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
  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} = {};
  33 $db->{key5} = $db->{key4};
  34
  35 my @keys_3 = sort keys %$db;
  36
  37 TODO: {
  38     local $TODO = "Need to fix how internal references are stored";
  39     is( @keys_3 + 0, @keys_2 + 2, "Correct number of keys" );
  40     is_deeply(
  41         [ @keys_2, 'key4', 'key5' ],
  42         [ @keys_3 ],
  43         "Keys still match after circular reference is added (@keys_3)",
  44     );
  45
  46     ##
  47     # Insert circular reference
  48     ##
  49     $db->{circle} = $db;
  50
  51     my @keys_4 = sort keys %$db;
  52     print "@keys_4\n";
  53
  54     is( @keys_4 + 0, @keys_3 + 1, "Correct number of keys" );
  55     is_deeply(
  56         [ '[base]', @keys_3 ],
  57         [ @keys_4 ],
  58         "Keys still match after circular reference is added",
  59     );
  60 }
  61
  62 ##
  63 # Make sure keys exist in both places
  64 ##
  65 is( $db->{key1}, 'value1', "The value is there directly" );
  66 is( $db->{circle}{key1}, 'value1', "The value is there in one loop of the circle" );
  67 is( $db->{circle}{circle}{key1}, 'value1', "The value is there in two loops of the circle" );
  68 is( $db->{circle}{circle}{circle}{key1}, 'value1', "The value is there in three loops of the circle" );
  69
  70 ##
  71 # Make sure changes are reflected in both places
  72 ##
  73 $db->{key1} = "another value";
  74
  75 is( $db->{key1}, 'another value', "The value is there directly" );
  76 is( $db->{circle}{key1}, 'another value', "The value is there in one loop of the circle" );
  77 is( $db->{circle}{circle}{key1}, 'another value', "The value is there in two loops of the circle" );
  78 is( $db->{circle}{circle}{circle}{key1}, 'another value', "The value is there in three loops of the circle" );
  79
  80 $db->{circle}{circle}{circle}{circle}{key1} = "circles";
  81
  82 is( $db->{key1}, 'circles', "The value is there directly" );
  83 is( $db->{circle}{key1}, 'circles', "The value is there in one loop of the circle" );
  84 is( $db->{circle}{circle}{key1}, 'circles', "The value is there in two loops of the circle" );
  85 is( $db->{circle}{circle}{circle}{key1}, 'circles', "The value is there in three loops of the circle" );