]> git.vpit.fr Git - perl/modules/Test-Leaner.git/blob - t/26-is_deeply.t
This is 0.01
[perl/modules/Test-Leaner.git] / t / 26-is_deeply.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::Leaner tests => 21 + 2 + 1 + 2;
7
8 my $lacunary = [ [ 1, 2, 3 ] => [ 1, 2, 3 ] ];
9 delete $lacunary->[0]->[1];
10 $lacunary->[1]->[1] = undef;
11
12 my $scalar_ref = \1;
13 my $array_ref  = [ ];
14 my $hash_ref   = { };
15 my $code_ref   = sub { };
16
17 my @tests = (
18  [ undef, undef ],
19
20  [ 1   => 1   ],
21  [ 'a' => 'a' ],
22
23  [ \1      => \1      ],
24  [ \'a'    => \'a'    ],
25  [ \(\1)   => \(\1)   ],
26  [ \(\'a') => \(\'a') ],
27
28  [ [ 1 ]   => [ 1 ]   ],
29  [ [ 'a' ] => [ 'a' ] ],
30  [ [ \1 ]  => [ \1 ]  ],
31
32  [ [ 1, 2, 3 ]     => [ 1, 2, 3 ] ],
33  [ [ 1, undef, 3 ] => [ 1, undef, 3 ] ],
34  $lacunary,
35
36  [ { a => 1 }     => { a => 1 }     ],
37  [ { a => undef } => { a => undef } ],
38  [ { a => \1 }    => { a => \1 }    ],
39
40  [ { a => [ 1, undef, 2 ], b => \3 } => { a => [ 1, undef, 2 ], b => \3 } ],
41
42  [ $scalar_ref => $scalar_ref ],
43  [ $array_ref  => $array_ref  ],
44  [ $hash_ref   => $hash_ref   ],
45  [ $code_ref   => $code_ref   ],
46 );
47
48 # Test breaking encapsulation
49
50 {
51  package Test::Leaner::TestIsDeeplyObject;
52
53  sub new {
54   my $class = shift;
55
56   bless { @_ }, $class;
57  }
58 }
59
60 {
61  package Test::Leaner::TestIsDeeplyObject2;
62
63  sub new {
64   my $class = shift;
65
66   bless { @_ }, $class;
67  }
68 }
69
70 push @tests, (
71  [ map Test::Leaner::TestIsDeeplyObject->new(
72   a => [ 1, { b => 2, c => undef }, undef, \3 ],
73   c => { d => \(\4), e => [ 5, undef ] },
74  ), 1 .. 2 ],
75  [
76   Test::Leaner::TestIsDeeplyObject->new(a => 1),
77   Test::Leaner::TestIsDeeplyObject2->new(a => 1),
78  ],
79 );
80
81 {
82  package Test::Leaner::TestIsDeeplyOverload;
83
84  use overload 'eq' => sub {
85   my ($x, $y, $r) = @_;
86
87   $x = $x->{str};
88   $y = $y->{str} if ref $y;
89
90   ($x, $y) = ($y, $x) if $r;
91
92   return $x eq $y;
93  };
94
95  sub new { bless { str => $_[1] }, $_[0] }
96 }
97
98 push @tests, [ map Test::Leaner::TestIsDeeplyOverload->new('foo'), 1 .. 2 ];
99
100 for my $t (@tests) {
101  is_deeply $t->[0], $t->[1];
102 }
103
104 # Test vivification of deleted elements of an array
105
106 {
107  my @l = (1);
108  $l[2] = 3;
109  is_deeply \@l, [ 1, undef, 3 ];
110  delete $l[2];
111  is_deeply \@l, [ 1 ];
112 }