The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More 'tests' => 32;

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 @sr :Field
           :Acc(sr)
           :Type(SCALARref);

    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 @array_of_num  :Field :All(array_of_num) :Type( ARRAY_ref(numeric) );

    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 { $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('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)');
    my $foo3 = Foo->new('array_of_num' => [ 1957, 42, 3.14 ]);
    is_deeply($foo3->array_of_num(), [ 1957, 42, 3.14 ]  => 'InitArgs type arrayref(numeric)');
    $foo3->array_of_num( [1,2,3] );
    is_deeply($foo3->array_of_num(), [ 1, 2, 3 ]  => 'Set arrayref(numeric)');
}

exit(0);

# EOF