Commit | Line | Data |
6e6789b0 |
1 | use 5.006; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
edd45134 |
6 | use Test::More tests => 13; |
7 | use Test::Exception; |
8 | use Test::Deep; |
6e6789b0 |
9 | |
10 | use t::common qw( new_fh ); |
11 | |
12 | use_ok( 'DBM::Deep' ); |
13 | |
5ef7542f |
14 | # This is bug #34819, reported by EJS |
15 | { |
16 | my ($fh, $filename) = new_fh(); |
17 | my $db = DBM::Deep->new( |
18 | file => $filename, |
5ef7542f |
19 | ); |
20 | |
d6d8e27e |
21 | my $bar = bless { foo => 'ope' }, 'Foo'; |
5ef7542f |
22 | |
23 | eval { |
24 | $db->{bar} = $bar; |
25 | $db->{bar} = $bar; |
26 | }; |
27 | |
28 | ok(!$@, "repeated object assignment"); |
29 | isa_ok($db->{bar}, 'Foo'); |
30 | } |
31 | |
6e6789b0 |
32 | # This is bug #29957, reported by HANENKAMP |
edd45134 |
33 | { |
6e6789b0 |
34 | my ($fh, $filename) = new_fh(); |
33d7395d |
35 | my $db = DBM::Deep->new( $filename ); |
6e6789b0 |
36 | |
37 | $db->{foo} = []; |
38 | |
39 | for my $value ( 1 .. 3 ) { |
edd45134 |
40 | lives_ok { |
41 | my $ref = $db->{foo}; |
42 | push @$ref, $value; |
43 | $db->{foo} = $ref; |
44 | } "Successfully added value $value"; |
6e6789b0 |
45 | } |
edd45134 |
46 | |
47 | cmp_deeply( [1,2,3], noclass($db->{foo}), "Everything looks ok" ); |
6e6789b0 |
48 | } |
49 | |
50 | # This is bug #33863, reported by PJS |
51 | { |
52 | my ($fh, $filename) = new_fh(); |
33d7395d |
53 | my $db = DBM::Deep->new( $filename ); |
6e6789b0 |
54 | |
55 | $db->{foo} = [ 42 ]; |
56 | my $foo = shift @{ $db->{foo} }; |
57 | cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" ); |
58 | cmp_ok( $foo, '==', 42, "... And the value is correct." ); |
59 | |
edd45134 |
60 | $db->{bar} = [ [] ]; |
61 | my $bar = shift @{ $db->{bar} }; |
62 | cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" ); |
6e6789b0 |
63 | |
64 | $db->{baz} = { foo => [ 1 .. 3 ] }; |
65 | $db->{baz2} = [ $db->{baz} ]; |
66 | my $baz2 = shift @{ $db->{baz2} }; |
67 | cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" ); |
68 | ok( exists $db->{baz}{foo} ); |
69 | ok( exists $baz2->{foo} ); |
70 | } |
71 | |
72 | __END__ |