t/op/smobj.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 5;
  10
  11 use strict;
  12 use warnings;
  13
  14 {
  15     package Test::Object::NoOverload;
  16     sub new { bless { key => 1 } }
  17 }
  18
  19 {
  20     my $obj = Test::Object::NoOverload->new;
  21     isa_ok($obj, 'Test::Object::NoOverload');
  22     my $r = eval { ($obj ~~ 'key') };
  23
  24     local $::TODO = 'To be implemented';
  25
  26     ok(
  27         ! defined $r,
  28         "we do not smart match against an object's underlying implementation",
  29     );
  30
  31     like(
  32         $@,
  33         qr/overload/,
  34         "we die when smart matching an obj with no ~~ overload",
  35     );
  36 }
  37
  38 {
  39     package Test::Object::CopyOverload;
  40     sub new { bless { key => 1 } }
  41     use overload '~~' => sub { my %hash = %{ $_[0] }; %hash ~~ $_[1] };
  42 }
  43
  44 {
  45     my $obj = Test::Object::CopyOverload->new;
  46     isa_ok($obj, 'Test::Object::CopyOverload');
  47     ok($obj ~~ 'key', 'we are able to make an object ~~ overload');
  48 }