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