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, |
19 | fh => $fh, |
20 | ); |
21 | |
d6d8e27e |
22 | my $bar = bless { foo => 'ope' }, 'Foo'; |
5ef7542f |
23 | |
24 | eval { |
25 | $db->{bar} = $bar; |
26 | $db->{bar} = $bar; |
27 | }; |
28 | |
29 | ok(!$@, "repeated object assignment"); |
30 | isa_ok($db->{bar}, 'Foo'); |
31 | } |
32 | |
6e6789b0 |
33 | # This is bug #29957, reported by HANENKAMP |
edd45134 |
34 | { |
6e6789b0 |
35 | my ($fh, $filename) = new_fh(); |
36 | my $db = DBM::Deep->new( |
37 | file => $filename, |
38 | fh => $fh, |
39 | ); |
40 | |
41 | $db->{foo} = []; |
42 | |
43 | for my $value ( 1 .. 3 ) { |
edd45134 |
44 | lives_ok { |
45 | my $ref = $db->{foo}; |
46 | push @$ref, $value; |
47 | $db->{foo} = $ref; |
48 | } "Successfully added value $value"; |
6e6789b0 |
49 | } |
edd45134 |
50 | |
51 | cmp_deeply( [1,2,3], noclass($db->{foo}), "Everything looks ok" ); |
6e6789b0 |
52 | } |
53 | |
54 | # This is bug #33863, reported by PJS |
55 | { |
56 | my ($fh, $filename) = new_fh(); |
57 | my $db = DBM::Deep->new( |
58 | file => $filename, |
59 | fh => $fh, |
60 | ); |
61 | |
62 | $db->{foo} = [ 42 ]; |
63 | my $foo = shift @{ $db->{foo} }; |
64 | cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" ); |
65 | cmp_ok( $foo, '==', 42, "... And the value is correct." ); |
66 | |
edd45134 |
67 | $db->{bar} = [ [] ]; |
68 | my $bar = shift @{ $db->{bar} }; |
69 | cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" ); |
6e6789b0 |
70 | |
71 | $db->{baz} = { foo => [ 1 .. 3 ] }; |
72 | $db->{baz2} = [ $db->{baz} ]; |
73 | my $baz2 = shift @{ $db->{baz2} }; |
74 | cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" ); |
75 | ok( exists $db->{baz}{foo} ); |
76 | ok( exists $baz2->{foo} ); |
77 | } |
78 | |
79 | __END__ |