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