jyapayne/swig
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

steals python directors and adapts to perl5

Browse source
This commit is contained in:
Robert Stone 2013-11-12 12:45:03 -08:00
commit 0901a3e867
23 changed files with 1741 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

70
Examples/test-suite/perl5/director_classes_runme.pl Normal file
View file

@ -0,0 +1,70 @@
use strict;
use warnings;
use Test::More tests => 29;
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 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->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();
}