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
66
67
68
69
|
#!perl
package test;
use strict;
use warnings;
use lib 't/lib';
# add all sorts of bad input that might get crazy results
my @inputs;
BEGIN
{
@inputs =
(
undef, '', \'', {}, [], 0, sub {}, do { local *FH; *FH }, -1, 0.003, '.'
);
}
# don't hardcode the test number, but do check for premature death
use Test::More tests => ( @inputs * 2 ) + 1;
# enable lexical warnings from module at compile time
BEGIN { use_ok( 'UNIVERSAL::can' ) }
=pod
This test is for the issue discussed in the PM post:
http://www.perlmonks.org/index.pl?node_id=516372
The errors which were reported were:
Use of uninitialized value in split at
/usr/local/share/perl/5.8.4/UNIVERSAL/can.pm line 51.
Called UNIVERSAL::can() as a function, not a method at
/usr/local/share/perl/5.8.4/Class/DBI.pm line 265
Can't call method "can" on an undefined value at
/usr/local/share/perl/5.8.4/UNIVERSAL/can.pm line 40.
Class::DBI line 265 is:
255 > my @pk_values = $self->_attrs($self->primary_columns);
265 > UNIVERSAL::can($_ => 'id') and $_ = $_->id for @pk_values;
In all likeliness Class::DBI line 265 really should be:
eval { $_->can( $_ => 'id') } and $_ = $_->id
for grep { defined $_ } @pk_values;
or something similar to prevent sending an undefined value to UNIVERSAL::can.
However, in the interest of making this module as useful as possible, it should
check for bad input and DWIM in those cases.
=cut
# this is a little ugly because nesting the warning test within the exception
# test didn't do The Right Thing
for my $bad ( @inputs )
{
my $bad_name = defined $bad ? $bad : '(undef)';
my $warnings = '';
local $SIG{__WARN__} = sub { $warnings = shift };
ok( ! UNIVERSAL::can( $bad, 'id' ), "$bad_name should be false" );
is( $warnings, '', '... and not throw a warning' );
}
|
