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