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