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