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 * (30 + 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, undef, 3 ] => [ 1, 2, 3 ] ],
  49  [ [ 1, 2, undef ] => [ 1, 2 ] ],
  50  $shrunk,
  51
  52  [ { a => undef } => { }         ],
  53  [ { a => undef } => { a => 0 }  ],
  54  [ { a => undef } => { a => '' } ],
  55  [ { a => 0 }     => { }         ],
  56  [ { a => 0 }     => { a => '' } ],
  57  [ { a => '' }    => { }         ],
  58
  59  [ { a => 1 } => { 'A' => 1 } ],
  60
  61  [ [ { a => 1 }, 2, { b => \3 } ] => [ { a => 1 }, 2, { b => \'3.0' } ] ],
  62
  63  [ $scalar_ref => "$scalar_ref" ],
  64  [ $array_ref  => "$array_ref"  ],
  65  [ $hash_ref   => "$hash_ref"   ],
  66  [ $code_ref   => "$code_ref"   ],
  67 );
  68
  69 {
  70  package Test::Leaner::TestIsDeeplyObject;
  71
  72  sub new {
  73   my $class = shift;
  74
  75   bless { @_ }, $class;
  76  }
  77 }
  78
  79 push @tests, [
  80  Test::Leaner::TestIsDeeplyObject->new(a => 1),
  81  Test::Leaner::TestIsDeeplyObject->new(a => 2),
  82 ];
  83
  84 {
  85  package Test::Leaner::TestIsDeeplyOverload;
  86
  87  use overload 'eq' => sub {
  88   my ($x, $y, $r) = @_;
  89
  90   $x = $x->{str};
  91   $y = $y->{str} if ref $y;
  92
  93   ($x, $y) = ($y, $x) if $r;
  94
  95   return $x eq $y;
  96  };
  97
  98  sub new { bless { str => $_[1] }, $_[0] }
  99 }
 100
 101 push @tests, (
 102  [ map Test::Leaner::TestIsDeeplyOverload->new($_), qw<abc def> ],
 103  [ 'abc' => Test::Leaner::TestIsDeeplyOverload->new('abc') ],
 104 );
 105
 106 my $count = 0;
 107
 108 @tests = map {
 109  $_, [ $_->[1], $_->[0] ]
 110 } @tests;
 111
 112 for my $t (@tests) {
 113  reset_buffer {
 114   local $@;
 115   my $ret = eval { Test::Leaner::is_deeply($t->[0], $t->[1]) };
 116   ++$count if $@ eq '';
 117   is $@,    '',               'is_deeply(...) does not croak';
 118   ok !$ret,                   'is_deeply(...) returns false';
 119   is $buf, "not ok $count\n", 'is_deeply(...) produces the correct TAP code';
 120  }
 121 }