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