t/27-is_deeply-failing.t

   1 #!perl -T
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7
   8 use Test::Leaner ();
   9
  10 use lib 't/lib';
  11 use Test::Leaner::TestHelper;
  12
  13 my $buf;
  14 capture_to_buffer $buf
  15              or plan skip_all =>'perl 5.8 required to test is_deeply() failing';
  16
  17 plan tests => 3 * 2 * (32 + 1 + 2);
  18
  19 my $shrunk = [ [ 1, 2, 3 ] => [ 1, 2, 3 ] ];
  20 delete $shrunk->[0]->[2];
  21 $shrunk->[1]->[2] = undef;
  22
  23 my $scalar_ref = \1;
  24 my $array_ref  = [ ];
  25 my $hash_ref   = { };
  26 my $code_ref   = sub { };
  27
  28 my @tests = (
  29  [ undef, '' ],
  30  [ undef, 0  ],
  31
  32  [ 1   => 2     ],
  33  [ 1   => '1.0' ],
  34  [ 1   => '1e0' ],
  35  [ 'a' => 'A'   ],
  36  [ 'a' => 'a '  ],
  37
  38  [ \1      => \2    ],
  39  [ \(\1)   => \(\2) ],
  40
  41  [ [ undef ] => [ ]    ],
  42  [ [ undef ] => [ 0 ]  ],
  43  [ [ undef ] => [ '' ] ],
  44  [ [ 0 ]     => [ ]    ],
  45  [ [ 0 ]     => [ '' ] ],
  46  [ [ '' ]    => [ ]    ],
  47
  48  [ [ \1 ] => [ \"1.0" ] ],
  49
  50  [ [ 1, undef, 3 ] => [ 1, 2, 3 ] ],
  51  [ [ 1, 2, undef ] => [ 1, 2 ] ],
  52  $shrunk,
  53
  54  [ { a => undef } => { }         ],
  55  [ { a => undef } => { a => 0 }  ],
  56  [ { a => undef } => { a => '' } ],
  57  [ { a => 0 }     => { }         ],
  58  [ { a => 0 }     => { a => '' } ],
  59  [ { a => '' }    => { }         ],
  60
  61  [ { a => 1 } => { 'A' => 1 } ],
  62  [ { a => 1 } => { 'a' => \"1.0" } ],
  63
  64  [ [ { a => 1 }, 2, { b => \3 } ] => [ { a => 1 }, 2, { b => \'3.0' } ] ],
  65
  66  [ $scalar_ref => "$scalar_ref" ],
  67  [ $array_ref  => "$array_ref"  ],
  68  [ $hash_ref   => "$hash_ref"   ],
  69  [ $code_ref   => "$code_ref"   ],
  70 );
  71
  72 {
  73  package Test::Leaner::TestIsDeeplyObject;
  74
  75  sub new {
  76   my $class = shift;
  77
  78   bless { @_ }, $class;
  79  }
  80 }
  81
  82 push @tests, [
  83  Test::Leaner::TestIsDeeplyObject->new(a => 1),
  84  Test::Leaner::TestIsDeeplyObject->new(a => 2),
  85 ];
  86
  87 {
  88  package Test::Leaner::TestIsDeeplyOverload;
  89
  90  use overload 'eq' => sub {
  91   my ($x, $y, $r) = @_;
  92
  93   $x = $x->{str};
  94   $y = $y->{str} if ref $y;
  95
  96   ($x, $y) = ($y, $x) if $r;
  97
  98   return $x eq $y;
  99  };
 100
 101  sub new { bless { str => $_[1] }, $_[0] }
 102 }
 103
 104 push @tests, (
 105  [ map Test::Leaner::TestIsDeeplyOverload->new($_), qw<abc def> ],
 106  [ 'abc' => Test::Leaner::TestIsDeeplyOverload->new('abc') ],
 107 );
 108
 109 my $count = 0;
 110
 111 @tests = map {
 112  $_, [ $_->[1], $_->[0] ]
 113 } @tests;
 114
 115 for my $t (@tests) {
 116  reset_buffer {
 117   local $@;
 118   my $ret = eval { Test::Leaner::is_deeply($t->[0], $t->[1]) };
 119   ++$count if $@ eq '';
 120   is $@,    '',               'is_deeply(...) does not croak';
 121   ok !$ret,                   'is_deeply(...) returns false';
 122   is $buf, "not ok $count\n", 'is_deeply(...) produces the correct TAP code';
 123  }
 124 }