t/op/smobj.t

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