The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Class::Delegations INIT{} block dosen't work with 5.004
require 5.006;

use vars qw( $called );

package Delegation::Base;

sub new {
  my ($class) = @_;
  my $self = {};
  bless $self, $class;
  $self;
};

sub frob {
  $::called = 1;
};

package Delegation::Test::Delegator1;
use Class::Delegation
  send => 'frob',
  to   => 'frobnicator';

sub new {
  my ($class) = @_;
  my $self = {
    frobnicator => Delegation::Base->new(),
  };
  bless $self, $class;
  $self;
};

package Delegation::Test::Delegator2;
use Class::Delegation
  send => 'frob',
  to   => 'delegator1';

sub new {
  my ($class) = @_;
  my $self = {
    delegator1 => Delegation::Test::Delegator1->new(),
  };
  bless $self, $class;
  $self;
};

package main;
use Test::More tests => 3;

my $delegator2 = Delegation::Test::Delegator2->new();
ok( ! UNIVERSAL::can( $delegator2, "frob" ), "delegator2->frob is not autoloaded" );
eval { $delegator2->frob() };
is($@,"","Calling delegator2->frob() works");
if ($@) {
  diag "This is most likely caused by a bug in Class::Delegation";
  diag "Class::Delegation checks whether an object can() a method,";
  diag "which prevents inherited autoloaded methods. Please change";
  diag "line 94 from";
  diag '  return unless eval { $target->can($as) };';
  diag "to";
  diag '  #return unless eval { $target->can($as) };';
  diag "Yes, this bug has already been reported, but I haven't heard";
  diag "back yet, please bear with me.";
};
is($called,1,"Delegation::Base->frob() was called");