1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
#!perl
use strict;
use warnings;
use Test::More tests => 6;
# enable lexical warnings from module at compile time
BEGIN { use_ok( 'UNIVERSAL::can' ) }
{
package Foo;
use vars '$AUTOLOAD';
use Scalar::Util 'blessed';
sub new
{
my ($class, %args) = @_;
while (my ($name, $value) = each %args)
{
$args{$name} = sub { return $value };
}
bless \%args, $class;
}
sub can
{
my ($self, $name) = @_;
return $self->SUPER::can( $name ) unless blessed( $self );
return $self->{$name} if exists $self->{$name};
return $self->SUPER::can( $name );
}
sub DESTROY {}
sub AUTOLOAD
{
my $self = shift;
my ($method) = $AUTOLOAD =~ /::(\w+)$/;
return unless exists $self->{$method};
return $self->{$method}->( @_ );
}
}
my $foo = Foo->new( foo => 'it is foo', bar => 'it is not foo' );
my ($can_foo, $can_baz);
eval { die "Failure\n" };
{
no warnings 'UNIVERSAL::can';
$can_foo = UNIVERSAL::can( $foo, 'foo' );
$can_baz = UNIVERSAL::can( $foo, 'baz' );
}
ok( defined $can_foo,
'UNIVERSAL::can() should return a true value, if possible' );
ok( defined &$can_foo, '... a code ref, if possible' );
ok( ! defined $can_baz, '... or undef if not' );
is( $can_foo->(), 'it is foo', '... the proper code ref' );
is( $@, "Failure\n", '... not eating any exceptions already thrown' );
|
