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 }