t/19_crossref.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 15;
   6
   7 use_ok( 'DBM::Deep' );
   8
   9 unlink "t/test.db";
  10 my $db = DBM::Deep->new( "t/test.db" );
  11 if ($db->error()) {
  12         die "ERROR: " . $db->error();
  13 }
  14
  15 unlink "t/test2.db";
  16 my $db2 = DBM::Deep->new( "t/test2.db" );
  17 if ($db2->error()) {
  18         die "ERROR: " . $db2->error();
  19 }
  20
  21 ##
  22 # Create structure in $db
  23 ##
  24 $db->import(
  25         hash1 => {
  26                 subkey1 => "subvalue1",
  27                 subkey2 => "subvalue2"
  28         }
  29 );
  30
  31 is( $db->{hash1}{subkey1}, 'subvalue1', "Value imported correctly" );
  32 is( $db->{hash1}{subkey2}, 'subvalue2', "Value imported correctly" );
  33
  34 ##
  35 # Cross-ref nested hash accross DB objects
  36 ##
  37 $db2->{copy} = $db->{hash1};
  38
  39 $db->{hash1}{subkey3} = 'where does this go?';
  40 is( $db->{hash1}{subkey3}, 'where does this go?' );
  41
  42 $db2->{copy}{subkey4} = 'from the other side';
  43 is( $db2->{copy}{subkey4}, 'from the other side' );
  44
  45 ########
  46 # This is the failure case
  47 #
  48 {
  49     my $left = $db->{hash1};
  50     $db2->{right} = $left;
  51
  52     $db2->{right}{rightward} = 'floober';
  53     is( $db2->{right}{rightward}, 'floober' );
  54     isnt( $db->{hash1}{rightward}, 'floober' );
  55 }
  56 #
  57 #
  58 ########
  59
  60 ##
  61 # close, delete $db
  62 ##
  63 undef $db;
  64
  65 {
  66     my $db3 = DBM::Deep->new( 't/test.db' );
  67     if ($db3->error()) {
  68         die "ERROR: " . $db3->error();
  69     }
  70     is( $db3->{hash1}{subkey1}, 'subvalue1' );
  71     is( $db3->{hash1}{subkey2}, 'subvalue2' );
  72     is( $db3->{hash1}{subkey3}, 'where does this go?' );
  73     isnt( $db3->{hash1}{subkey4}, 'from the other side' );
  74 }
  75
  76 unlink "t/test.db";
  77
  78 ##
  79 # Make sure $db2 has copy of $db's hash structure
  80 ##
  81 is( $db2->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
  82 is( $db2->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );
  83 isnt( $db2->{copy}{subkey3}, 'where does this go?' );
  84 is( $db2->{copy}{subkey4}, 'from the other side' );