use strict; use warnings; use Test::More 'tests' => 34; package My::Class; { use Object::InsideOut; sub is_scalar :Private { return (! ref(shift)); } sub is_int { my $arg = $_[0]; return (Scalar::Util::looks_like_number($arg) && (int($arg) == $arg)); } my @aa :Field('acc'=>'aa', 'type' => 'array'); my @as :Field('acc'=>'as', 'type' => 'array(My::Class)'); my @ar :Field('acc'=>'ar', 'type' => 'array_ref'); my @cc :Field({'acc'=>'cc', 'type' => sub{ shift > 0 } }); my @hh :Field('acc'=>'hh', 'type' => 'hash'); my @hr :Field('acc'=>'hr', 'type' => 'hashref'); my @mc :Field({'acc'=>'mc', 'type' => 'My::Class'}); my @nn :Field({'acc'=>'nn', 'type' => 'num'}); my @sr :Field({'acc'=>'sr', 'type' => 'scalar_ref'}); my @ss :Field :Acc(ss) :Type(\&My::Class::is_scalar); my @scal :Field :Acc(scal) :Type(scalar); my %init_args :InitArgs = ( 'DATA' => { 'Field' => \@nn, 'Type' => \&is_int, }, 'INFO' => { 'Type' => sub { $_[0] } }, 'BAD' => { 'Type' => sub { shift > 0 } }, 'SC' => { 'Field' => \@scal, 'Type' => 'scalar', } ); } package main; MAIN: { my $obj = My::Class->new('DATA' => 5, 'SC' => 'bork'); $obj->aa('test'); is_deeply($obj->aa(), ['test'] => 'Array single value'); $obj->aa('zero', 5); is_deeply($obj->aa(), ['zero', 5] => 'Array multiple values'); $obj->aa(['x', 42, 'z']); is_deeply($obj->aa(), ['x', 42, 'z'] => 'Array ref value'); { my $a = My::Class->new(); my $b = My::Class->new(); my $c = My::Class->new(); $obj->as($a); is_deeply($obj->as(), [$a] => 'Array single class'); $obj->as($a, $b, $c); is_deeply($obj->as(), [$a, $b, $c] => 'Array multiple class'); $obj->as([$c, $a, $b]); is_deeply($obj->as(), [$c, $a, $b] => 'Array ref class'); } eval { $obj->ar('test'); }; like($@->message, qr/Wrong type/ => 'Not array ref'); $obj->ar([3, [ 'a' ]]); is_deeply($obj->ar(), [3, [ 'a' ]] => 'Array ref'); $obj->cc(12); is($obj->cc(), 12 => 'Type sub'); eval { $obj->cc(-5); }; like($@->message, qr/failed type check/ => 'Type failure'); eval { $obj->cc('hello'); }; like($@->message, qr/Problem with type check routine/ => 'Type sub failure'); $obj->hh('x' => 5); is_deeply($obj->hh(), {'x'=>5} => 'Hash single pair'); $obj->hh('a' => 'z', '0' => '9'); is_deeply($obj->hh(), {'a'=>'z','0'=>'9'} => 'Hash multiple pairs'); $obj->hh({'2b'=>'not'}); is_deeply($obj->hh(), {'2b'=>'not'} => 'Hash ref value'); eval { $obj->hr('test'); }; like($@->message, qr/Wrong type/ => 'Not hash ref'); $obj->hr({'frog'=>{'prince'=>'John'}}); is_deeply($obj->hr(), {'frog'=>{'prince'=>'John'}} => 'Hash ref'); my $obj2 = My::Class->new(); $obj->mc($obj2); my $obj3 = $obj->mc(); isa_ok($obj3, 'My::Class' => 'Object'); is($$obj3, $$obj2 => 'Objects equal'); eval { $obj2->mc('test'); }; like($@->message, qr/Wrong type/ => 'Not object'); $obj->nn(99); is_deeply($obj->nn(), 99 => 'Numeric'); eval { $obj->nn('x'); }; like($@->message, qr/Bad argument/ => 'Numeric failure'); $obj->ss('hello'); is($obj->ss(), 'hello' => 'Scalar'); eval { $obj->ss([1]); }; like($@->message, qr/failed type check/ => 'Scalar failure'); is($obj->scal(), 'bork' => 'Scalar'); $obj->scal('foo'); is($obj->scal(), 'foo' => 'Scalar'); eval { $obj->scal(bless({}, 'Foo')); }; like($@->message, qr/Bad argument/ => 'Scalar failure'); eval { $obj->sr('test'); }; like($@->message, qr/Wrong type/ => 'Not scalar ref'); my $x = 42; $obj->sr(\$x); is($obj->sr(), \$x => 'Scalar ref'); my $y = $obj->sr(); is($$y, 42 => 'Scalar ref value'); eval { $obj2 = My::Class->new('DATA' => 'hello'); }; like($@->message, qr/failed type check/ => 'Type failure'); eval { $obj2 = My::Class->new('INFO' => ''); }; like($@->message, qr/failed type check/ => 'Type failure'); eval { $obj2 = My::Class->new('SC' => []); }; like($@->message, qr/Bad value/ => 'Scalar failure'); eval { $obj2 = My::Class->new('BAD' => ''); }; like($@->message, qr/Problem with type check routine/ => 'Type sub failure'); $obj = bless({}, 'SomeClass'); ok(UNIVERSAL::isa($obj, '') || UNIVERSAL::isa($obj, 0) || UNIVERSAL::isa($obj, 'SomeClass'), 'isa works'); } exit(0); # EOF