Examples/test-suite/perl5/director_classes_runme.pl

use strict;
use warnings;
use Test::More tests => 32;
BEGIN { use_ok 'director_classes' }
require_ok 'director_classes';

{
  package PerlDerived;
  use base 'director_classes::Base';
  sub Val { $_[1] }
  sub Ref { $_[1] }
  sub Ptr { $_[1] }
  sub ConstPtrRef { $_[1] }
  sub FullyOverloaded {
    my $rv = shift->SUPER::FullyOverloaded(@_);
    $rv =~ s/Base/__PACKAGE__/sge;
    return $rv;
  }
  sub SemiOverloaded {
    # this is going to be awkward because we can't really
    # semi-overload in Perl, but we can sort of fake it.
    return shift->SUPER::SemiOverloaded(@_) unless $_[0] =~ /^\d+/;
    my $rv = shift->SUPER::SemiOverloaded(@_);
    $rv =~ s/Base/__PACKAGE__/sge;
    return $rv;
  }
  sub DefaultParms {
    my $rv = shift->SUPER::DefaultParms(@_);
    $rv =~ s/Base/__PACKAGE__/sge;
    return $rv;
  }
}

{
  my $c = director_classes::Caller->new();
  makeCalls($c, director_classes::Base->new(100.0));
  makeCalls($c, director_classes::Derived->new(200.0));
  makeCalls($c, PerlDerived->new(300.0));
}

sub makeCalls { my($caller, $base) = @_;
  my $bname = ref $base;
  $bname = $1 if $bname =~ /^director_classes::(.*)$/;
  $caller->set($base);
  my $dh = director_classes::DoubleHolder->new(444.555);
  is($caller->ValCall($dh)->{val}, $dh->{val}, "$bname.Val");
  is($caller->RefCall($dh)->{val}, $dh->{val}, "$bname.Ref");
  is($caller->PtrCall($dh)->{val}, $dh->{val}, "$bname.Ptr");
  is($caller->ConstPtrRefCall($dh)->{val}, $dh->{val}, "$bname.ConstPtrRef");
  is($caller->FullyOverloadedCall(1),
      "${bname}::FullyOverloaded(int)",
      "$bname.FullyOverloaded(int)");
  is($caller->FullyOverloadedCall(''),
      "${bname}::FullyOverloaded(bool)",
      "$bname.FullyOverloaded(bool)");
TODO: {
  local $TODO = 'investigation needed here' if $bname eq 'PerlDerived';
  is($caller->SemiOverloadedCall(-678),
      "${bname}::SemiOverloaded(int)",
      "$bname.SemiOverloaded(int)");
}
  is($caller->SemiOverloadedCall(''),
      "Base::SemiOverloaded(bool)",
      "$bname.SemiOverloaded(bool)");
  is($caller->DefaultParmsCall(10, 2.2),
      "${bname}::DefaultParms(int, double)",
      "$bname.DefaultParms(int, double)");
  is($caller->DefaultParmsCall(10),
      "${bname}::DefaultParms(int)",
      "$bname.DefaultParms(int)");
  $caller->reset();
}