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