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(); }