steals python directors and adapts to perl5

Examples/test-suite/perl5/director_classic_runme.pl

@@ -0,0 +1,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;
+