#!/usr/bin/perl
my
$foo
= Foo->new;
my
$sentry
= Object::Destroyer->new(
$foo
,
'release'
);
isa_ok(
$foo
,
'Foo'
);
isa_ok(
$foo
,
'Bar'
);
isa_ok(
$sentry
,
'Foo'
);
isa_ok(
$sentry
,
'Bar'
);
isa_ok(
$sentry
,
'Object::Destroyer'
);
ok(!
$sentry
->isa(
'BAZ'
));
can_ok(
$foo
,
'hello'
);
can_ok(
$foo
,
'bar'
);
can_ok(
$sentry
,
'hello'
);
can_ok(
$sentry
,
'release'
);
can_ok(
$sentry
,
'self_test'
);
can_ok(
$sentry
,
'params_count'
);
can_ok(
$sentry
,
'bar'
);
ok(!
$sentry
->can(
'impossible'
));
ok(
$foo
->self_test );
ok(
$sentry
->self_test );
is(
$foo
->params_count(1,1,1), 3);
is(
$sentry
->params_count(1,1,1), 3);
is(
$foo
->hello,
'Hello World!'
,
'Foo->hello returns as expected'
);
is(
$sentry
->hello,
'Hello World!'
);
is(
$foo
->hello(
'Bob'
),
'Hello Bob!'
,
'Foo->hello(args) returns as expected'
);
is(
$sentry
->hello(
'Bob'
),
'Hello Bob!'
);
is(
scalar
(
$foo
->test_context), -1);
is(
scalar
(
$sentry
->test_context), -1);
is_deeply([
$foo
->test_context], [1, 2]);
is_deeply([
$sentry
->test_context], [1, 2]);
$_
= 0;
$foo
->test_context;
is(
$_
, 1);
my
$new
=
$sentry
->new;
is(
ref
$new
,
'Foo'
);
eval
{
$sentry
->impossible };
like(
$@,
qr/Can't locate object method "impossible"/
,
'AUTOLOAD handles errors correctly'
);
eval
{
$sentry
->DESTROY;
$sentry
->impossible;
};
like(
$@,
qr/Can't locate object to call method 'impossible'/
,
'AUTOLOAD cannot find method after DESTROY'
);
$sentry
= Object::Destroyer->new(
sub
{ 123; });
eval
{
$sentry
->impossible };
like(
$@,
qr/Can't locate object to call method 'impossible'/
,
'AUTOLOAD cannot find method when there is no object'
);
isnt(
ref
(
$sentry
->can(
'foo'
)),
'CODE'
,
'can does not pass through without object'
);
my
$buzz
= Buzz->new();
$sentry
= Object::Destroyer->new(
$buzz
);
is(
scalar
(
$sentry
->test(1)),
"test"
);
is(
scalar
(
$sentry
->foo),
"foofoo"
);
is(
scalar
(
$sentry
->bar(3)),
"barbarbar"
);
is_deeply( [
$sentry
->bar], [
"bar"
,
"bar"
]);
is_deeply( [
$sentry
->foo(1)], [
"foo"
]);
is_deeply( [
$sentry
->t(3)], [
qw/t t t/
]);
eval
{
$sentry
->void;
return
;
};
ok !$@,
'AUTOLOAD in void context works'
;
done_testing;
use
vars
qw{$destroy_counter @ISA}
;
BEGIN {
$destroy_counter
= 0;
@ISA
=
'Bar'
};
sub
new {
my
$class
=
ref
$_
[0] ?
ref
shift
:
shift
;
my
$self
=
bless
{},
$class
;
$self
->{self} =
$self
;
return
$self
;
}
sub
self_test{
my
$self
=
shift
;
return
$self
==
$self
->{self};
}
sub
params_count{
my
$self
=
shift
;
return
scalar
(
@_
);
}
sub
hello {
shift
;
return
(
@_
) ?
"Hello $_[0]!"
:
"Hello World!"
}
sub
test_context{
return
(
wantarray
) ? (1, 2) :
(
defined
wantarray
) ? -1 : ++
$_
;
}
sub
DESTROY {
$destroy_counter
++;
}
sub
release{
my
$self
=
shift
;
undef
$self
->{self};
}
sub
bar {}
sub
new{
my
$class
=
shift
;
return
bless
{},
ref
$class
||
$class
;
}
sub
AUTOLOAD{
my
$self
=
shift
;
my
$repeat_number
=
shift
|| 2;
my
(
$method
) =
$AUTOLOAD
=~ /.*::(.*)$/;
return
(
wantarray
) ?
(
$method
) x
$repeat_number
:
$method
x
$repeat_number
;
}
sub
DESTROY{
}
1;