t/30_already_tied.t

   1 ##
   2 # DBM::Deep Test
   3 ##
   4 use strict;
   5 use Test::More tests => 7;
   6 use Test::Exception;
   7 use File::Temp qw( tempfile tempdir );
   8 use Fcntl qw( :flock );
   9
  10 use_ok( 'DBM::Deep' );
  11
  12 my $dir = tempdir( CLEANUP => 1 );
  13 my ($fh, $filename) = tempfile( 'tmpXXXX', UNLINK => 1, DIR => $dir );
  14 flock $fh, LOCK_UN;
  15 my $db = DBM::Deep->new( $filename );
  16
  17 {
  18     {
  19         package My::Tie::Hash;
  20
  21         sub TIEHASH {
  22             my $class = shift;
  23
  24             return bless {
  25             }, $class;
  26         }
  27     }
  28
  29     my %hash;
  30     tie %hash, 'My::Tie::Hash';
  31     isa_ok( tied(%hash), 'My::Tie::Hash' );
  32
  33     throws_ok {
  34         $db->{foo} = \%hash;
  35     } qr/Cannot store something that is tied/, "Cannot store tied hashes";
  36 }
  37
  38 {
  39     {
  40         package My::Tie::Array;
  41
  42         sub TIEARRAY {
  43             my $class = shift;
  44
  45             return bless {
  46             }, $class;
  47         }
  48
  49         sub FETCHSIZE { 0 }
  50     }
  51
  52     my @array;
  53     tie @array, 'My::Tie::Array';
  54     isa_ok( tied(@array), 'My::Tie::Array' );
  55
  56     throws_ok {
  57         $db->{foo} = \@array;
  58     } qr/Cannot store something that is tied/, "Cannot store tied arrays";
  59 }
  60
  61     {
  62         package My::Tie::Scalar;
  63
  64         sub TIESCALAR {
  65             my $class = shift;
  66
  67             return bless {
  68             }, $class;
  69         }
  70     }
  71
  72     my $scalar;
  73     tie $scalar, 'My::Tie::Scalar';
  74     isa_ok( tied($scalar), 'My::Tie::Scalar' );
  75
  76 throws_ok {
  77     $db->{foo} = \$scalar;
  78 } qr/Storage of variables of type 'SCALAR' is not supported/, "Cannot store scalar references, let alone tied scalars";