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
   8 use_ok( 'DBM::Deep' );
   9
  10 unlink 't/test.db';
  11 my $db = DBM::Deep->new( 't/test.db' );
  12
  13 {
  14     {
  15         package My::Tie::Hash;
  16
  17         sub TIEHASH {
  18             my $class = shift;
  19
  20             return bless {
  21             }, $class;
  22         }
  23     }
  24
  25     my %hash;
  26     tie %hash, 'My::Tie::Hash';
  27     isa_ok( tied(%hash), 'My::Tie::Hash' );
  28
  29     throws_ok {
  30         $db->{foo} = \%hash;
  31     } qr/Cannot store a tied value/, "Cannot store tied hashes";
  32 }
  33
  34 {
  35     {
  36         package My::Tie::Array;
  37
  38         sub TIEARRAY {
  39             my $class = shift;
  40
  41             return bless {
  42             }, $class;
  43         }
  44
  45         sub FETCHSIZE { 0 }
  46     }
  47
  48     my @array;
  49     tie @array, 'My::Tie::Array';
  50     isa_ok( tied(@array), 'My::Tie::Array' );
  51
  52     throws_ok {
  53         $db->{foo} = \@array;
  54     } qr/Cannot store a tied value/, "Cannot store tied arrays";
  55 }
  56
  57     {
  58         package My::Tie::Scalar;
  59
  60         sub TIESCALAR {
  61             my $class = shift;
  62
  63             return bless {
  64             }, $class;
  65         }
  66     }
  67
  68     my $scalar;
  69     tie $scalar, 'My::Tie::Scalar';
  70     isa_ok( tied($scalar), 'My::Tie::Scalar' );
  71
  72 throws_ok {
  73     $db->{foo} = \$scalar;
  74 } qr/Storage of variables of type 'SCALAR' is not supported/, "Cannot store scalar references, let alone tied scalars";