1use strict; 2use warnings; 3use Test::More tests => 32; 4BEGIN { use_ok 'director_classes' } 5require_ok 'director_classes'; 6 7{ 8 package PerlDerived; 9 use base 'director_classes::Base'; 10 sub Val { $_[1] } 11 sub Ref { $_[1] } 12 sub Ptr { $_[1] } 13 sub ConstPtrRef { $_[1] } 14 sub FullyOverloaded { 15 my $rv = shift->SUPER::FullyOverloaded(@_); 16 $rv =~ s/Base/__PACKAGE__/sge; 17 return $rv; 18 } 19 sub SemiOverloaded { 20 # this is going to be awkward because we can't really 21 # semi-overload in Perl, but we can sort of fake it. 22 return shift->SUPER::SemiOverloaded(@_) unless $_[0] =~ /^\d+/; 23 my $rv = shift->SUPER::SemiOverloaded(@_); 24 $rv =~ s/Base/__PACKAGE__/sge; 25 return $rv; 26 } 27 sub DefaultParms { 28 my $rv = shift->SUPER::DefaultParms(@_); 29 $rv =~ s/Base/__PACKAGE__/sge; 30 return $rv; 31 } 32} 33 34{ 35 my $c = director_classes::Caller->new(); 36 makeCalls($c, director_classes::Base->new(100.0)); 37 makeCalls($c, director_classes::Derived->new(200.0)); 38 makeCalls($c, PerlDerived->new(300.0)); 39} 40 41sub makeCalls { my($caller, $base) = @_; 42 my $bname = ref $base; 43 $bname = $1 if $bname =~ /^director_classes::(.*)$/; 44 $caller->set($base); 45 my $dh = director_classes::DoubleHolder->new(444.555); 46 is($caller->ValCall($dh)->{val}, $dh->{val}, "$bname.Val"); 47 is($caller->RefCall($dh)->{val}, $dh->{val}, "$bname.Ref"); 48 is($caller->PtrCall($dh)->{val}, $dh->{val}, "$bname.Ptr"); 49 is($caller->ConstPtrRefCall($dh)->{val}, $dh->{val}, "$bname.ConstPtrRef"); 50 is($caller->FullyOverloadedCall(1), 51 "${bname}::FullyOverloaded(int)", 52 "$bname.FullyOverloaded(int)"); 53 is($caller->FullyOverloadedCall(''), 54 "${bname}::FullyOverloaded(bool)", 55 "$bname.FullyOverloaded(bool)"); 56TODO: { 57 local $TODO = 'investigation needed here' if $bname eq 'PerlDerived'; 58 is($caller->SemiOverloadedCall(-678), 59 "${bname}::SemiOverloaded(int)", 60 "$bname.SemiOverloaded(int)"); 61} 62 is($caller->SemiOverloadedCall(''), 63 "Base::SemiOverloaded(bool)", 64 "$bname.SemiOverloaded(bool)"); 65 is($caller->DefaultParmsCall(10, 2.2), 66 "${bname}::DefaultParms(int, double)", 67 "$bname.DefaultParms(int, double)"); 68 is($caller->DefaultParmsCall(10), 69 "${bname}::DefaultParms(int)", 70 "$bname.DefaultParms(int)"); 71 $caller->reset(); 72} 73