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