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