New tests (and TODO tests) for ~~ and overloading,

[p5sagit/p5-mst-13.2.git] / t / op / smobj.t

#!./perl

BEGIN {
    chdir 't';
    @INC = '../lib';
    require './test.pl';
}

plan tests => 5;

use strict;
use warnings;

{
    package Test::Object::NoOverload;
    sub new { bless { key => 1 } }
}

{
    my $obj = Test::Object::NoOverload->new;
    isa_ok($obj, 'Test::Object::NoOverload');
    my $r = eval { ($obj ~~ 'key') };

    local $::TODO = 'To be implemented';

    ok(
	! defined $r,
	"we do not smart match against an object's underlying implementation",
    );

    like(
	$@,
	qr/overload/,
	"we die when smart matching an obj with no ~~ overload",
    );
}

{
    package Test::Object::CopyOverload;
    sub new { bless { key => 1 } }
    use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] };
}

{
    my $obj = Test::Object::CopyOverload->new;
    isa_ok($obj, 'Test::Object::CopyOverload');
    ok($obj ~~ 'key', 'we are able to make an object ~~ overload');
}