Commit | Line | Data |
6e6789b0 |
1 | use 5.006; |
2 | |
3 | use strict; |
4 | use warnings FATAL => 'all'; |
5 | |
6 | use Scalar::Util qw( reftype ); |
7 | use Test::More tests => 10; |
8 | |
9 | use t::common qw( new_fh ); |
10 | |
11 | use_ok( 'DBM::Deep' ); |
12 | |
13 | # This is bug #29957, reported by HANENKAMP |
14 | TODO: { |
15 | todo_skip "This crashes the code", 4; |
16 | my ($fh, $filename) = new_fh(); |
17 | my $db = DBM::Deep->new( |
18 | file => $filename, |
19 | fh => $fh, |
20 | ); |
21 | |
22 | $db->{foo} = []; |
23 | |
24 | for my $value ( 1 .. 3 ) { |
25 | my $ref = $db->{foo}; |
26 | push @$ref, $value; |
27 | $db->{foo} = $ref; |
28 | ok( 1, "T $value" ); |
29 | } |
30 | } |
31 | |
32 | # This is bug #33863, reported by PJS |
33 | { |
34 | my ($fh, $filename) = new_fh(); |
35 | my $db = DBM::Deep->new( |
36 | file => $filename, |
37 | fh => $fh, |
38 | ); |
39 | |
40 | $db->{foo} = [ 42 ]; |
41 | my $foo = shift @{ $db->{foo} }; |
42 | cmp_ok( @{ $db->{foo} }, '==', 0, "Shifting a scalar leaves no values" ); |
43 | cmp_ok( $foo, '==', 42, "... And the value is correct." ); |
44 | |
45 | # $db->{bar} = [ [] ]; |
46 | # my $bar = shift @{ $db->{bar} }; |
47 | # cmp_ok( @{ $db->{bar} }, '==', 0, "Shifting an arrayref leaves no values" ); |
48 | # use Data::Dumper; warn Dumper $bar; |
49 | |
50 | $db->{baz} = { foo => [ 1 .. 3 ] }; |
51 | $db->{baz2} = [ $db->{baz} ]; |
52 | my $baz2 = shift @{ $db->{baz2} }; |
53 | cmp_ok( @{ $db->{baz2} }, '==', 0, "Shifting an arrayref leaves no values" ); |
54 | ok( exists $db->{baz}{foo} ); |
55 | ok( exists $baz2->{foo} ); |
56 | } |
57 | |
58 | __END__ |