#!/usr/bin/perl

use strict;

BEGIN
{
    $|  = 1;
    $^W = 1;
    $ENV{PERL_PARAMS_UTIL_PP} ||= 1;
}

use Test::More tests => 91;
use File::Spec::Functions ':ALL';

BEGIN
{
    ok(!defined &_CLASSISA, '_CLASSISA does not exist');
    ok(!defined &_SUBCLASS, '_SUBCLASS does not exist');
    ok(!defined &_DRIVER,   '_DRIVER does not exist');
    use_ok('Params::Util', qw(_CLASSISA _SUBCLASS _DRIVER));
    ok(defined &_CLASSISA, '_CLASSISA imported ok');
    ok(defined &_SUBCLASS, '_SUBCLASS imported ok');
    ok(defined &_DRIVER,   '_DRIVER imported ok');
}

# Import refaddr to make certain we have it
use Scalar::Util 'refaddr';

#####################################################################
# Preparing

my $A = catfile('t', 'driver', 'A.pm');
ok(-f $A, 'A exists');
my $B = catfile('t', 'driver', 'My_B.pm');
ok(-f $B, 'My_B exists');
my $C = catfile('t', 'driver', 'C.pm');
ok(!-f $C, 'C does not exist');
my $D = catfile('t', 'driver', 'D.pm');
ok(-f $D, 'D does not exist');
my $E = catfile('t', 'driver', 'E.pm');
ok(-f $E, 'E does not exist');
my $F = catfile('t', 'driver', 'F.pm');
ok(-f $F, 'F does not exist');

unshift @INC, catdir('t', 'driver');

#####################################################################
# Things that are not file handles

foreach (undef, '', ' ', 'foo bar', 1, 0, -1, 1.23, [], {}, \'', bless({}, "foo"))
{
    is(_CLASSISA($_, 'A'), undef, 'Non-classisa returns undef');
    is(_SUBCLASS($_, 'A'), undef, 'Non-subclass returns undef');
    is(_DRIVER($_, 'A'),   undef, 'Non-driver returns undef');
}

#####################################################################
# Sample Classes

# classisa should not load classes
is(_CLASSISA('A',    'A'), 'A',   'A: Driver base class is undef');
is(_CLASSISA('My_B', 'A'), undef, 'B: Good driver returns ok');
is(_CLASSISA('My_B', 'H'), undef, 'B: Good driver return undef for incorrect base');
is(_CLASSISA('C',    'A'), undef, 'C: Non-existant driver is undef');
is(_CLASSISA('D',    'A'), undef, 'D: Broken driver is undef');
is(_CLASSISA('E',    'A'), undef, 'E: Not a driver returns undef');
is(_CLASSISA('F',    'A'), undef, 'F: Faked isa returns ok');

# classisa should not load classes
is(_SUBCLASS('A',    'A'), undef, 'A: Driver base class is undef');
is(_SUBCLASS('My_B', 'A'), undef, 'B: Good driver returns ok');
is(_SUBCLASS('My_B', 'H'), undef, 'B: Good driver return undef for incorrect base');
is(_SUBCLASS('C',    'A'), undef, 'C: Non-existant driver is undef');
is(_SUBCLASS('D',    'A'), undef, 'D: Broken driver is undef');
is(_SUBCLASS('E',    'A'), undef, 'E: Not a driver returns undef');
is(_SUBCLASS('F',    'A'), undef, 'F: Faked isa returns ok');

# The base class itself is not a driver
is(_DRIVER('A', 'A'), undef, 'A: Driver base class is undef');
ok($A::VERSION, 'A: Class is loaded ok');
is(_DRIVER('My_B', 'A'), 'My_B', 'B: Good driver returns ok');
is(_DRIVER('My_B', 'H'), undef,  'B: Good driver return undef for incorrect base');
ok($My_B::VERSION, 'B: Class is loaded ok');
is(_DRIVER('C', 'A'), undef, 'C: Non-existant driver is undef');
is(_DRIVER('D', 'A'), undef, 'D: Broken driver is undef');
is(_DRIVER('E', 'A'), undef, 'E: Not a driver returns undef');
is(_DRIVER('F', 'A'), 'F',   'F: Faked isa returns ok');

# Repeat for classisa
is(_CLASSISA('A',    'A'), 'A',    'A: Driver base class is undef');
is(_CLASSISA('My_B', 'A'), 'My_B', 'B: Good driver returns ok');
is(_CLASSISA('My_B', 'H'), undef,  'B: Good driver return undef for incorrect base');
is(_CLASSISA('C',    'A'), undef,  'C: Non-existant driver is undef');
is(_CLASSISA('D',    'A'), 'D',    'D: Broken driver is undef');
is(_CLASSISA('E',    'A'), undef,  'E: Not a driver returns undef');
is(_CLASSISA('F',    'A'), 'F',    'F: Faked isa returns ok');

# Repeat for subclasses
is(_SUBCLASS('A',    'A'), undef,  'A: Driver base class is undef');
is(_SUBCLASS('My_B', 'A'), 'My_B', 'B: Good driver returns ok');
is(_SUBCLASS('My_B', 'H'), undef,  'B: Good driver return undef for incorrect base');
is(_SUBCLASS('C',    'A'), undef,  'C: Non-existant driver is undef');
is(_SUBCLASS('D',    'A'), 'D',    'D: Broken driver is undef');
is(_SUBCLASS('E',    'A'), undef,  'E: Not a driver returns undef');
is(_SUBCLASS('F',    'A'), 'F',    'F: Faked isa returns ok');

SKIP:
{
    use_ok('Params::Util', qw(_CLASSDOES));

    skip "DOES tests do not make sense on perls before 5.10", 4
      unless $] >= 5.010;

    is(_CLASSDOES('A',    'A'), 'A',    'A: DOES A');
    is(_CLASSDOES('My_B', 'A'), 'My_B', 'My_B: DOES A');
    is(_CLASSDOES('E',    'A'), undef,  'E: DOES not A');
    is(_CLASSDOES('F',    'A'), 'F',    'F: DOES A');
}
