CURRENT/t/19_crossref.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 6;
   6 use Test::Exception;
   7 use t::common qw( new_fh );
   8
   9 use_ok( 'DBM::Deep' );
  10
  11 my ($fh2, $filename2) = new_fh();
  12 my $db2 = DBM::Deep->new( $filename2 );
  13
  14 {
  15     my ($fh, $filename) = new_fh();
  16     my $db = DBM::Deep->new( $filename );
  17
  18     ##
  19     # Create structure in $db
  20     ##
  21     $db->import(
  22         hash1 => {
  23             subkey1 => "subvalue1",
  24             subkey2 => "subvalue2",
  25         }
  26     );
  27     is( $db->{hash1}{subkey1}, 'subvalue1', "Value imported correctly" );
  28     is( $db->{hash1}{subkey2}, 'subvalue2', "Value imported correctly" );
  29     ##
  30     # Cross-ref nested hash accross DB objects
  31     ##
  32     throws_ok {
  33         $db2->{copy} = $db->{hash1};
  34     } qr/Cannot cross-reference\. Use export\(\) instead/, "cross-ref fails";
  35     $db2->{copy} = $db->{hash1}->export;
  36 }
  37
  38 ##
  39 # Make sure $db2 has copy of $db's hash structure
  40 ##
  41 is( $db2->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
  42 is( $db2->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );