1#!/usr/bin/perl -w
2
3use strict;
4
5use Params::Validate qw(validate);
6use Test::More tests => 13;
7
8{
9    my @p = ( foo => 'ClassCan' );
10
11    eval
12    {
13        validate( @p,
14                  { foo => { can => 'cancan' } },
15                );
16    };
17
18    is( $@, q{} );
19
20    eval
21    {
22        validate( @p,
23                  { foo => { can => 'thingy' } },
24                );
25    };
26
27    like( $@, qr/does not have the method: 'thingy'/ );
28}
29
30{
31    my @p = ( foo => undef );
32    eval
33    {
34        validate( @p,
35                  { foo => { can => 'baz' } },
36                );
37    };
38
39    like( $@, qr/does not have the method: 'baz'/ );
40}
41
42{
43    my $object = bless {}, 'ClassCan';
44    my @p = ( foo => $object );
45
46    eval
47    {
48        validate( @p,
49                  { foo => { can => 'cancan' } },
50                );
51    };
52
53    is( $@, q{} );
54
55    eval
56    {
57        validate( @p,
58                  { foo => { can => 'thingy' } },
59                );
60    };
61
62    like( $@, qr/does not have the method: 'thingy'/ );
63}
64
65{
66    my @p = ( foo => 'SubClass' );
67
68    eval
69    {
70        validate( @p,
71                  { foo => { can => 'cancan' } },
72                );
73    };
74
75    is( $@, q{}, 'SubClass->can(cancan)' );
76
77    eval
78    {
79        validate( @p,
80                  { foo => { can => 'thingy' } },
81                );
82    };
83
84    like( $@, qr/does not have the method: 'thingy'/ );
85}
86
87{
88    my $object = bless {}, 'SubClass';
89    my @p = ( foo => $object );
90
91    eval
92    {
93        validate( @p,
94                  { foo => { can => 'cancan' } },
95                );
96    };
97
98    is( $@, q{}, 'SubClass object->can(cancan)' );
99
100    eval
101    {
102        validate( @p,
103                  { foo => { can => 'thingy' } },
104                );
105    };
106
107    like( $@, qr/does not have the method: 'thingy'/ );
108}
109
110{
111    my @p = ( foo => {} );
112    eval
113    {
114        validate( @p,
115                  { foo => { can => 'thingy' } },
116                );
117    };
118    like( $@, qr/does not have the method: 'thingy'/, 'unblessed ref ->can' );
119
120    @p = ( foo => 27 );
121    eval
122    {
123        validate( @p,
124                  { foo => { can => 'thingy' } },
125                );
126    };
127    like( $@, qr/does not have the method: 'thingy'/, 'number can' );
128
129    @p = ( foo => 'A String' );
130    eval
131    {
132        validate( @p,
133                  { foo => { can => 'thingy' } },
134                );
135    };
136    like( $@, qr/does not have the method: 'thingy'/, 'string can' );
137
138    @p = ( foo => undef );
139    eval
140    {
141        validate( @p,
142                  { foo => { can => 'thingy' } },
143                );
144    };
145    like( $@, qr/does not have the method: 'thingy'/, 'undef can' );
146}
147
148
149package ClassCan;
150
151sub can
152{
153    return 1 if $_[1] eq 'cancan';
154    return 0;
155}
156
157sub thingy { 1 }
158
159package SubClass;
160
161use base 'ClassCan';
162
163
164