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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
#!/usr/bin/perl
use strict;
BEGIN
{
$| = 1;
$^W = 1;
$ENV{PERL_PARAMS_UTIL_PP} ||= 1;
}
use Test::More tests => 11;
use File::Spec::Functions ':ALL';
BEGIN
{
use_ok('Params::Util', qw(_INVOCANT));
}
my $object = bless \do { my $i }
=> 'Params::Util::Test::Bogus::Whatever';
my $false_obj1 = bless \do { my $i }
=> 0;
my $false_obj2 = bless \do { my $i }
=> "\0";
my $tied = tie my $x, 'Params::Util::Test::_INVOCANT::Tied';
my $unpkg = 'Params::Util::Test::_INVOCANT::Fake';
my $pkg = 'Params::Util::Test::_INVOCANT::Real';
eval "package $pkg;"; ## no critic
my @data = ( # I
[undef, 0, 'undef'],
[
1000 => 0,
'1000'
],
[
$unpkg => 1,
qq("$unpkg")
],
[
$pkg => 1,
qq("$pkg")
],
[
[] => 0,
'[]'
],
[
{} => 0,
'{}'
],
[
$object => 1,
'blessed reference'
],
[
$false_obj1 => 1,
'blessed reference'
],
[
$tied => 1,
'tied value'
],
);
for my $datum (@data)
{
is(_INVOCANT($datum->[0]) ? 1 : 0, $datum->[1], "$datum->[2] " . ($datum->[1] ? 'is' : "isn't") . " _IN");
}
# Skip the most evil test except on automated testing, because it
# fails on at least one common production OS (RedHat Enterprise Linux 4)
# and the test case should be practically impossible to encounter
# in real life. The damage the bug could cause users in production is
# far lower than the damage caused by Params::Util failing to install.
SKIP:
{
unless ($ENV{AUTOMATED_TESTING})
{
skip("Skipping nasty test unless AUTOMATED_TESTING", 1);
}
ok(!!_INVOCANT($false_obj2), 'Testing null class as an invocant');
}
package Params::Util::Test::_INVOCANT::Tied;
sub TIESCALAR
{
my ($class, $value) = @_;
return bless \$value => $class;
}
|
