Examples/test-suite/perl5/director_classic_runme.pl

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;