1*5759b3d2Safresh1#!/usr/bin/perl -w 2*5759b3d2Safresh1 3*5759b3d2Safresh1BEGIN { 4*5759b3d2Safresh1 if( $ENV{PERL_CORE} ) { 5*5759b3d2Safresh1 chdir 't'; 6*5759b3d2Safresh1 @INC = ('../lib', 'lib'); 7*5759b3d2Safresh1 } 8*5759b3d2Safresh1 else { 9*5759b3d2Safresh1 unshift @INC, 't/lib'; 10*5759b3d2Safresh1 } 11*5759b3d2Safresh1} 12*5759b3d2Safresh1 13*5759b3d2Safresh1use strict; 14*5759b3d2Safresh1use Test::More tests => 19; 15*5759b3d2Safresh1 16*5759b3d2Safresh1 17*5759b3d2Safresh1package Overloaded; 18*5759b3d2Safresh1 19*5759b3d2Safresh1use overload 20*5759b3d2Safresh1 q{eq} => sub { $_[0]->{string} eq $_[1] }, 21*5759b3d2Safresh1 q{==} => sub { $_[0]->{num} == $_[1] }, 22*5759b3d2Safresh1 q{""} => sub { $_[0]->{stringify}++; $_[0]->{string} }, 23*5759b3d2Safresh1 q{0+} => sub { $_[0]->{numify}++; $_[0]->{num} } 24*5759b3d2Safresh1; 25*5759b3d2Safresh1 26*5759b3d2Safresh1sub new { 27*5759b3d2Safresh1 my $class = shift; 28*5759b3d2Safresh1 bless { 29*5759b3d2Safresh1 string => shift, 30*5759b3d2Safresh1 num => shift, 31*5759b3d2Safresh1 stringify => 0, 32*5759b3d2Safresh1 numify => 0, 33*5759b3d2Safresh1 }, $class; 34*5759b3d2Safresh1} 35*5759b3d2Safresh1 36*5759b3d2Safresh1 37*5759b3d2Safresh1package main; 38*5759b3d2Safresh1 39*5759b3d2Safresh1local $SIG{__DIE__} = sub { 40*5759b3d2Safresh1 my($call_file, $call_line) = (caller)[1,2]; 41*5759b3d2Safresh1 fail("SIGDIE accidentally called"); 42*5759b3d2Safresh1 diag("From $call_file at $call_line"); 43*5759b3d2Safresh1}; 44*5759b3d2Safresh1 45*5759b3d2Safresh1my $obj = Overloaded->new('foo', 42); 46*5759b3d2Safresh1isa_ok $obj, 'Overloaded'; 47*5759b3d2Safresh1 48*5759b3d2Safresh1cmp_ok $obj, 'eq', 'foo', 'cmp_ok() eq'; 49*5759b3d2Safresh1is $obj->{stringify}, 0, ' does not stringify'; 50*5759b3d2Safresh1is $obj, 'foo', 'is() with string overloading'; 51*5759b3d2Safresh1cmp_ok $obj, '==', 42, 'cmp_ok() with number overloading'; 52*5759b3d2Safresh1is $obj->{numify}, 0, ' does not numify'; 53*5759b3d2Safresh1 54*5759b3d2Safresh1is_deeply [$obj], ['foo'], 'is_deeply with string overloading'; 55*5759b3d2Safresh1ok eq_array([$obj], ['foo']), 'eq_array ...'; 56*5759b3d2Safresh1ok eq_hash({foo => $obj}, {foo => 'foo'}), 'eq_hash ...'; 57*5759b3d2Safresh1 58*5759b3d2Safresh1# rt.cpan.org 13506 59*5759b3d2Safresh1is_deeply $obj, 'foo', 'is_deeply with string overloading at the top'; 60*5759b3d2Safresh1 61*5759b3d2Safresh1Test::More->builder->is_num($obj, 42); 62*5759b3d2Safresh1Test::More->builder->is_eq ($obj, "foo"); 63*5759b3d2Safresh1 64*5759b3d2Safresh1 65*5759b3d2Safresh1{ 66*5759b3d2Safresh1 # rt.cpan.org 14675 67*5759b3d2Safresh1 package TestPackage; 68*5759b3d2Safresh1 use overload q{""} => sub { ::fail("This should not be called") }; 69*5759b3d2Safresh1 70*5759b3d2Safresh1 package Foo; 71*5759b3d2Safresh1 ::is_deeply(['TestPackage'], ['TestPackage']); 72*5759b3d2Safresh1 ::is_deeply({'TestPackage' => 'TestPackage'}, 73*5759b3d2Safresh1 {'TestPackage' => 'TestPackage'}); 74*5759b3d2Safresh1 ::is_deeply('TestPackage', 'TestPackage'); 75*5759b3d2Safresh1} 76*5759b3d2Safresh1 77*5759b3d2Safresh1 78*5759b3d2Safresh1# Make sure 0 isn't a special case. [rt.cpan.org 41109] 79*5759b3d2Safresh1{ 80*5759b3d2Safresh1 my $obj = Overloaded->new('0', 42); 81*5759b3d2Safresh1 isa_ok $obj, 'Overloaded'; 82*5759b3d2Safresh1 83*5759b3d2Safresh1 cmp_ok $obj, 'eq', '0', 'cmp_ok() eq'; 84*5759b3d2Safresh1 is $obj->{stringify}, 0, ' does not stringify'; 85*5759b3d2Safresh1 is $obj, '0', 'is() with string overloading'; 86*5759b3d2Safresh1} 87