The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/site/perl/perl-5.10.1-1/bin/perl -w
use strict;
use warnings;

use lib '../../../../lib';

use Test::More;
use Data::Dumper;

plan tests => count_object_tests() + count_base_data_type_tests();

use Data::Abridge qw( abridge_recursive abridge_item );
use constant { ARG => 1, EXPECT => 2, TYPE => 0, REFEXPECT => 3, OBJECT => 4, OBJEXPECT => 4 };

sub foo { 'foo' }

my @objects;
{   #diag( 'Base data types' );

    no warnings 'once';

    my @TYPE_TESTS;
    BEGIN {
        my $dummy = 57;
        @TYPE_TESTS = (
            [ NONREF => 'Nonref', 'Nonref',              {SCALAR=>'Nonref'},                ],
            [ ARRAY  => [],       [],                    {SCALAR => []},                    ],
            [ HASH   => {},       {},                    {SCALAR => {}},                    ],
            [ SCALAR => \$dummy,  {SCALAR=>$dummy},      {SCALAR => {SCALAR =>$dummy}}      ],
            [ GLOB   => \*Foo,    {GLOB=>'\*main::Foo'}, {SCALAR => {GLOB=>'\*main::Foo'}}, ],
            [ CODE   => \&foo,    {CODE=>'\&main::foo'}, {SCALAR => {CODE=>'\&main::foo'}}, ],
        );
    }

    sub count_base_data_type_tests {  2 * @TYPE_TESTS };
    sub count_object_tests {  0 + grep ref($_->[ARG]), @TYPE_TESTS };

    for my $t ( @TYPE_TESTS ) {
        is_deeply( abridge_recursive($t->[ARG]), $t->[EXPECT], "$t->[TYPE] correct" );
        # print Dumper abridge_recursive($t->[ARG]);

        is_deeply( abridge_recursive(\$t->[ARG]), $t->[REFEXPECT], "REF $t->[TYPE] correct" );
        # print Dumper abridge_recursive(\$t->[ARG]);

        push @objects, [ @$t, bless $t->[ARG], 'SomeClass' ] if ref $t->[ARG];
    }



}

#diag( 'Blessed types' );
for my $o (@objects) {
    is_deeply( abridge_recursive($o->[OBJECT]), { 'SomeClass'=> $o->[EXPECT] }, "BLESSED $o->[TYPE] correct" );

        # print Dumper abridge_recursive(\$o->[OBJECT]);
}