Test::More 0.88 is required for done_testing
[dbsrgits/DBM-Deep.git] / t / 30_already_tied.t
CommitLineData
019ab3a1 1##
2# DBM::Deep Test
3##
4use strict;
5use Test::More tests => 7;
6use Test::Exception;
fde3db1a 7use t::common qw( new_fh );
019ab3a1 8
9use_ok( 'DBM::Deep' );
10
fde3db1a 11my ($fh, $filename) = new_fh();
019ab3a1 12my $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
5b35c384 73throws_ok {
74 $db->{foo} = \$scalar;
86867f3a 75} qr/Storage of references of type 'SCALAR' is not supported/, "Cannot store scalar references, let alone tied scalars";