#! perl

use strict;
use warnings;

use Test::More tests => 47;

BEGIN { use_ok('UNIVERSAL::isa', 'isa') };

use warnings;

{
    package Foo;

    sub isa { 1 }
}

{
    package Bar;
}

{
    package Gorch;
    sub isa
    {
        my ($self, $class) = @_;
        $self->SUPER::isa($class) unless $class eq 'Glab';
    }
}

{
    package Baz;
    sub isa
    {
        my ($self, $class) = @_;
        UNIVERSAL::isa($self, $class) unless $class eq 'Glab';
    }
}

my ($f, $b, $g, $x) = map { bless [], $_ } qw( Foo Bar Gorch Baz );

{

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    ok(  isa( [], 'ARRAY' ), '[] is an array ref' );
    is( $warning, '', 'not warning by default' );

    $warning = '';
    ok(  isa( $b, 'Bar'   ), 'bar is a Bar'       );
    is( $warning, '', 'not warning by default' );

    $warning = '';
    ok(  isa( $f, 'Foo'   ), 'foo is a Foo'       );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok( !isa( $b, 'Zlap'  ), 'bar is not Zlap'    );
    is( $warning, '', 'not warning by default' );

    $warning = '';
    ok(  isa( $f, 'Zlap'  ), 'neither is Foo'     );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok(  isa( $g, 'Gorch' ), 'Gorch is itself'    );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok( !isa( $g, 'Zlap'  ), 'gorch is not Zlap'  );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok(  isa( $g, 'Glab'  ), '... it is dung'     );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok(  isa( $x, 'Baz'   ), 'Baz is itself'      );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok( !isa( $x, 'Zlap'  ), 'baz is not Zlap'    );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );

    $warning = '';
    ok(  isa( $x, 'Glab'  ), 'it is dung'         );
    like( $warning, qr/as a function.+basic.t/, '... warning by default' );
}

{
    use warnings 'UNIVERSAL::isa';

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    $warning = '';
    ok( isa( {},     'HASH' ),   'hash reference isa HASH'       );
    is( $warning,    '',         '... and no warning by default' );

    $warning = '';
    ok( isa( [],     'ARRAY' ),  'array reference isa ARRAY'     );
    is( $warning,    '',         '... and no warning by default' );

    $warning = '';
    ok( isa( sub {}, 'CODE' ),   'code reference isa CODE'       );
    is( $warning,    '',         '... and no warning by default' );

    $warning = '';
    ok( isa( \my $a, 'SCALAR' ), 'scalar reference isa SCALAR'   );
    is( $warning,    '',         '... and no warning by default' );

    $warning = '';
    ok( isa( qr//,   'Regexp' ), 'regexp reference isa Regexp'   );
    is( $warning,    '',         '... and no warning by default' );

    $warning = '';
    ok( isa( \local *FOO, 'GLOB' ), 'glob reference isa GLOB'     );
    is( $warning, '', '... and no warning by default' );
}

{
    use warnings 'UNIVERSAL::isa';
    UNIVERSAL::isa::->import( 'verbose' );

    my $warning = '';
    local $SIG{__WARN__} = sub { $warning = shift };

    ok( isa( {},     'HASH' ),      'hash reference isa HASH'     );
    like( $warning, qr/Called.+as a function.+reftyp.+basic.t/,
        '... warning in verbose mode' );

    $warning = '';
    ok( isa( [],     'ARRAY' ),     'array reference isa ARRAY'   );
    like( $warning, qr/Called.+as a function.+reftyp.+basic.t/,
        '... warning in verbose mode' );

    $warning = '';
    ok( isa( sub {}, 'CODE' ),      'code reference isa CODE'     );
    like( $warning, qr/Called.+as a function.+reftyp.+basic.t/,
        '... warning in verbose mode' );

    $warning = '';
    ok( isa( \my $a, 'SCALAR' ),    'scalar reference isa SCALAR' );
    like( $warning, qr/Called.+as a function.+reftyp.+basic.t/,
        '... warning in verbose mode' );

    $warning = '';
    ok( isa( qr//, 'Regexp' ),      'regexp reference isa Regexp' );
    like( $warning, qr/Called.+as a functio.+basic.t/,
        '... warning in verbose mode' );

    $warning = '';
    ok( isa( \local *FOO, 'GLOB' ), 'glob reference isa GLOB'     );
    like( $warning, qr/Called.+as a function.+reftyp.+basic.t/,
        '... warning in verbose mode' );
}