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     # Test cross-ref nested hash accross DB objects
  31     throws_ok {
  32         $db2->{copy} = $db->{hash1};
  33     } qr/Cannot store something that is tied\./, "cross-ref fails";
  34
  35     # This error text is for when internal cross-refs are implemented
  36     #} qr/Cannot cross-reference\. Use export\(\) instead\./, "cross-ref fails";
  37
  38     $db2->{copy} = $db->{hash1}->export;
  39 }
  40
  41 ##
  42 # Make sure $db2 has copy of $db's hash structure
  43 ##
  44 is( $db2->{copy}{subkey1}, 'subvalue1', "Value copied correctly" );
  45 is( $db2->{copy}{subkey2}, 'subvalue2', "Value copied correctly" );