1use strict; 2use warnings; 3use Test::More tests => 41; 4BEGIN { use_ok('director_classic') } 5require_ok('director_classic'); 6 7{ 8 package TargetLangPerson; 9 use base 'director_classic::Person'; 10 sub id { return 'TargetLangPerson' } 11} 12 13{ 14 package TargetLangChild; 15 use base 'director_classic::Child'; 16 sub id { return 'TargetLangChild' } 17} 18 19{ 20 package TargetLangGrandChild; 21 use base 'director_classic::GrandChild'; 22 sub id { return 'TargetLangGrandChild' } 23} 24 25# Semis - don't override id() in target language 26{ 27 package TargetLangSemiPerson; 28 use base 'director_classic::Person'; 29 # No id() override 30} 31 32{ 33 package TargetLangSemiChild; 34 use base 'director_classic::Child'; 35 # No id() override 36} 37 38{ 39 package TargetLangSemiGrandChild; 40 use base 'director_classic::GrandChild'; 41 # No id() override 42} 43 44# Orphans - don't override id() in C++ 45{ 46 package TargetLangOrphanPerson; 47 use base 'director_classic::OrphanPerson'; 48 sub id { return "TargetLangOrphanPerson" } 49} 50 51{ 52 package TargetLangOrphanChild; 53 use base 'director_classic::OrphanChild'; 54 sub id { return "TargetLangOrphanChild" } 55} 56 57sub check { my($person, $expected) = @_; 58 # Normal target language polymorphic call 59 is($person->id(), $expected, "$expected from Perl"); 60 61 # Polymorphic call from C++ 62 my $caller = director_classic::Caller->new(); 63 $caller->setCallback($person); 64 is($caller->call(), $expected, "$expected from C++"); 65 66 # Polymorphic call of object created in target language and passed to C++ and back again 67 my $baseclass = $caller->baseClass(); 68 is($baseclass->id(), $expected, "$expected after bounce"); 69 70 $caller->resetCallback(); 71} 72 73my $person; 74 75$person = director_classic::Person->new(); 76check($person, "Person"); 77undef $person; 78 79$person = director_classic::Child->new(); 80check($person, "Child"); 81undef $person; 82 83$person = director_classic::GrandChild->new(); 84check($person, "GrandChild"); 85undef $person; 86 87$person = TargetLangPerson->new(); 88check($person, "TargetLangPerson"); 89undef $person; 90 91$person = TargetLangChild->new(); 92check($person, "TargetLangChild"); 93undef $person; 94 95$person = TargetLangGrandChild->new(); 96check($person, "TargetLangGrandChild"); 97undef $person; 98 99# Semis - don't override id() in target language 100$person = TargetLangSemiPerson->new(); 101check($person, "Person"); 102undef $person; 103 104$person = TargetLangSemiChild->new(); 105check($person, "Child"); 106undef $person; 107 108$person = TargetLangSemiGrandChild->new(); 109check($person, "GrandChild"); 110undef $person; 111 112# Orphans - don't override id() in C++ 113$person = director_classic::OrphanPerson->new(); 114check($person, "Person"); 115undef $person; 116 117$person = director_classic::OrphanChild->new(); 118check($person, "Child"); 119undef $person; 120 121$person = TargetLangOrphanPerson->new(); 122check($person, "TargetLangOrphanPerson"); 123undef $person; 124 125$person = TargetLangOrphanChild->new(); 126check($person, "TargetLangOrphanChild"); 127undef $person; 128 129