#!/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' );

}