use strict; use warnings; use Test::More 'no_plan'; 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) :Name(aa) :Type(array); 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) :Name(hr) :Type(hashref); my @mc :Field :Acc(mc) :Type(My::Class); my @nn :Field :Acc(nn) :Type(num); my @ns :Field :Acc(ns) :Type(list(num)); my @ss :Field :Acc(ss) :Type(\&My::Class::is_scalar); my %init_args :InitArgs = ( 'DATA' => { 'Field' => \@nn, 'Type' => \&is_int, }, 'INFO' => { 'Type' => sub { $_[0] } }, 'BAD' => { 'Type' => sub { shift > 0 } }, ); } package Foo; { use Object::InsideOut; my @foo :Field :Acc(foo); my %init_args :InitArgs = ( 'FOO' => { 'field' => \@foo, 'type' => 'ARRAYref(UNIVERSAL)' } ); } package main; MAIN: { my $obj = My::Class->new('DATA' => 5); $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'); 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->ns(86); is_deeply($obj->ns(), [86] => 'Array single num'); $obj->ns(1, 2.5, 5); is_deeply($obj->ns(), [1, 2.5, 5] => 'Array multiple num'); $obj->ns([42, 0, -1]); is_deeply($obj->ns(), [42, 0, -1] => 'Array ref num'); $obj->ss('hello'); is($obj->ss(), 'hello' => 'Scalar'); eval { $obj->ss([1]); }; like($@->message, qr/failed type check/ => 'Scalar failure'); 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('BAD' => ''); }; like($@->message, qr/Problem with type check routine/ => 'Type sub failure'); my $foo = Foo->new(); my $foo2 = Foo->new('FOO' => [ $foo, $obj ]); is_deeply($foo2->foo(), [ $foo, $obj ] => 'InitArgs type arrayref(UNIV)'); } exit(0); # EOF