1use strict; 2use warnings; 3use Test::More tests => 9; 4BEGIN { use_ok 'director_constructor' } 5require_ok 'director_constructor'; 6 7{ 8 package Test; 9 use base 'director_constructor::Foo'; 10 sub doubleit { my($self) = @_; 11 $self->{a} *= 2; 12 } 13 sub test { 3 } 14} 15my $t = Test->new(5); 16isa_ok $t, 'Test'; 17is $t->getit, 5; 18is $t->do_test, 3; 19 20$t->doubleit(); 21 22is $t->getit, 10; 23 24{ 25 package Wrong; 26 use base 'director_constructor::Foo'; 27 sub doubleit { my($self) = @_; 28 # calling this should trigger a type error on attribute 29 # assignment 30 $self->{a} = {}; 31 } 32 sub test { 33 # if c++ calls this, retval copyout should trigger a type error 34 return bless {}, 'TotallyBogus'; 35 } 36} 37 38# TODO: these TypeErrors in director classes should be more detailed 39my $w = Wrong->new(12); 40is eval { $w->doubleit() }, undef; 41like $@, qr/TypeError/; 42is $w->getit(), 12, 'W.a should be unaffected'; 43 44# TODO: this is giving an unhandled C++ exception right now 45#is eval { $W->do_test() }, undef; 46#like $@, qr/TypeError/; 47