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 }