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