Commit | Line | Data |
6e6789b0 |
1 | use 5.006; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | use Scalar::Util qw( reftype ); |
5ef7542f |
7 | use Test::More tests => 12; |
6e6789b0 |
8 | |
9 | use t::common qw( new_fh ); |
10 | |
11 | use_ok( 'DBM::Deep' ); |
12 | |
5ef7542f |
13 | # This is bug #34819, reported by EJS |
14 | { |
15 | my ($fh, $filename) = new_fh(); |
16 | my $db = DBM::Deep->new( |
17 | file => $filename, |
18 | fh => $fh, |
19 | ); |
20 | |
d6d8e27e |
21 | my $bar = bless { foo => 'ope' }, 'Foo'; |
5ef7542f |
22 | |
23 | eval { |
24 | $db->{bar} = $bar; |
d6d8e27e |
25 | warn "$db->{bar}: $bar\n"; |
5ef7542f |
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 |
34 | TODO: { |
35 | todo_skip "This crashes the code", 4; |
36 | my ($fh, $filename) = new_fh(); |
37 | my $db = DBM::Deep->new( |
38 | file => $filename, |
39 | fh => $fh, |
40 | ); |
41 | |
42 | $db->{foo} = []; |
43 | |
44 | for my $value ( 1 .. 3 ) { |
45 | my $ref = $db->{foo}; |
46 | push @$ref, $value; |
47 | $db->{foo} = $ref; |
48 | ok( 1, "T $value" ); |
49 | } |
50 | } |
51 | |
52 | # This is bug #33863, reported by PJS |
53 | { |
54 | my ($fh, $filename) = new_fh(); |
55 | my $db = DBM::Deep->new( |
56 | file => $filename, |
57 | fh => $fh, |
58 | ); |
59 | |
60 | $db->{foo} = [ 42 ]; |
61 | my $foo = shift @{ $db->{foo} }; |
62 | cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" ); |
63 | cmp_ok( $foo, '==', 42, "... And the value is correct." ); |
64 | |
65 | # $db->{bar} = [ [] ]; |
66 | # my $bar = shift @{ $db->{bar} }; |
67 | # cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" ); |
68 | # use Data::Dumper; warn Dumper $bar; |
69 | |
70 | $db->{baz} = { foo => [ 1 .. 3 ] }; |
71 | $db->{baz2} = [ $db->{baz} ]; |
72 | my $baz2 = shift @{ $db->{baz2} }; |
73 | cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" ); |
74 | ok( exists $db->{baz}{foo} ); |
75 | ok( exists $baz2->{foo} ); |
76 | } |
77 | |
78 | __END__ |