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
|
use warnings;
use strict;
use Test::More tests => 1 + (4*3 + 8 + 8*3 + 8*3)*6;
BEGIN { use_ok "Params::Classify", qw(
is_ref check_ref
is_blessed check_blessed
is_strictly_blessed check_strictly_blessed
is_able check_able
); }
foreach my $arg (
undef,
"foo",
*STDOUT,
bless({}, "main"),
\1,
{},
) {
foreach my $type (undef, *STDOUT, {}) {
eval { is_ref($arg, $type); };
is $@, "reference type argument is not a string\n";
eval { &is_ref($arg, $type); };
is $@, "reference type argument is not a string\n";
eval { check_ref($arg, $type); };
is $@, "reference type argument is not a string\n";
eval { &check_ref($arg, $type); };
is $@, "reference type argument is not a string\n";
}
eval { is_ref($arg, "WIBBLE"); };
is $@, "invalid reference type\n";
eval { &is_ref($arg, "WIBBLE"); };
is $@, "invalid reference type\n";
eval { check_ref($arg, "WIBBLE"); };
is $@, "invalid reference type\n";
eval { &check_ref($arg, "WIBBLE"); };
is $@, "invalid reference type\n";
my $type = "WIBBLE";
eval { is_ref($arg, $type); };
is $@, "invalid reference type\n";
eval { &is_ref($arg, $type); };
is $@, "invalid reference type\n";
eval { check_ref($arg, $type); };
is $@, "invalid reference type\n";
eval { &check_ref($arg, $type); };
is $@, "invalid reference type\n";
foreach my $class (undef, *STDOUT, {}) {
eval { is_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { &is_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { check_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { &check_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { is_strictly_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { &is_strictly_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { check_strictly_blessed($arg, $class); };
is $@, "class argument is not a string\n";
eval { &check_strictly_blessed($arg, $class); };
is $@, "class argument is not a string\n";
}
foreach my $meth (undef, *STDOUT, {}) {
eval { is_able($arg, $meth); };
is $@, "methods argument is not a string or array\n";
eval { &is_able($arg, $meth); };
is $@, "methods argument is not a string or array\n";
eval { check_able($arg, $meth); };
is $@, "methods argument is not a string or array\n";
eval { &check_able($arg, $meth); };
is $@, "methods argument is not a string or array\n";
eval { is_able($arg, [$meth]); };
is $@, "method name is not a string\n";
eval { &is_able($arg, [$meth]); };
is $@, "method name is not a string\n";
eval { check_able($arg, [$meth]); };
is $@, "method name is not a string\n";
eval { &check_able($arg, [$meth]); };
is $@, "method name is not a string\n";
}
}
1;
|
