t/27-is_deeply-failing.t

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