lib/Test/Simple/t/is_deeply_dne_bug.t

   1 #!/usr/bin/perl -w
   2 # $Id: /mirror/googlecode/test-more/t/is_deeply_dne_bug.t 57943 2008-08-18T02:09:22.275428Z brooklyn.kid51  $
   3
   4 # test for rt.cpan.org 20768
   5 #
   6 # There was a bug where the internal "does not exist" object could get
   7 # confused with an overloaded object.
   8
   9 BEGIN {
  10     if( $ENV{PERL_CORE} ) {
  11         chdir 't';
  12         @INC = ('../lib', 'lib');
  13     }
  14     else {
  15         unshift @INC, 't/lib';
  16     }
  17 }
  18
  19 use strict;
  20 use Test::More;
  21
  22 BEGIN {
  23     if( !eval "require overload" ) {
  24         plan skip_all => "needs overload.pm";
  25     }
  26     else {
  27         plan tests => 2;
  28     }
  29 }
  30
  31 {
  32     package Foo;
  33
  34     use overload
  35     'eq' => \&overload_equiv,
  36     '==' => \&overload_equiv;
  37
  38     sub new {
  39         return bless {}, shift;
  40     }
  41
  42     sub overload_equiv {
  43         if (ref($_[0]) ne 'Foo' || ref($_[1]) ne 'Foo') {
  44             print ref($_[0]), " ", ref($_[1]), "\n";
  45             die "Invalid object passed to overload_equiv\n";
  46         }
  47
  48         return 1; # change to 0 ... makes little difference
  49     }
  50 }
  51
  52 my $obj1 = Foo->new();
  53 my $obj2 = Foo->new();
  54
  55 eval { is_deeply([$obj1, $obj2], [$obj1, $obj2]); };
  56 is $@, '';
  57