[gitmo/Moose.git] / t / type_constraints / util_std_type_constraints.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More;

use IO::File;
use Moose::Util::TypeConstraints;
use Scalar::Util qw( blessed openhandle );

my $ZERO    = 0;
my $ONE     = 1;
my $INT     = 100;
my $NEG_INT = -100;
my $NUM     = 42.42;
my $NEG_NUM = -42.42;

my $EMPTY_STRING  = q{};
my $STRING        = 'foo';
my $NUM_IN_STRING = 'has 42 in it';
my $INT_WITH_NL1  = "1\n";
my $INT_WITH_NL2  = "\n1";

my $SCALAR_REF     = \( my $var );
my $SCALAR_REF_REF = \$SCALAR_REF;
my $ARRAY_REF      = [];
my $HASH_REF       = {};
my $CODE_REF       = sub { };

my $GLOB     = do { no warnings 'once'; *GLOB_REF };
my $GLOB_REF = \$GLOB;

open my $FH, '<', $0 or die "Could not open $0 for the test";

my $FH_OBJECT = IO::File->new( $0, 'r' )
    or die "Could not open $0 for the test";

my $REGEX      = qr/../;
my $REGEX_OBJ  = bless qr/../, 'BlessedQR';
my $FAKE_REGEX = bless {}, 'Regexp';

my $OBJECT = bless {}, 'Foo';

my $UNDEF = undef;

{
    package Thing;

    sub foo { }
}

my $CLASS_NAME = 'Thing';

{
    package Role;
    use Moose::Role;

    sub foo { }
}

my $ROLE_NAME = 'Role';

my %tests = (
    Any => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Item => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Defined => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
        ],
        reject => [
            $UNDEF,
        ],
    },
    Undef => {
        accept => [
            $UNDEF,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
        ],
    },
    Bool => {
        accept => [
            $ZERO,
            $ONE,
            $EMPTY_STRING,
            $UNDEF,
        ],
        reject => [
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
        ],
    },
    Maybe => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Value => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $GLOB,
        ],
        reject => [
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Ref => {
        accept => [
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $GLOB,
            $UNDEF,
        ],
    },
    Num => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
        ],
        reject => [
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Int => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
        ],
        reject => [
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    Str => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
        ],
        reject => [
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    ScalarRef => {
        accept => [
            $SCALAR_REF,
            $SCALAR_REF_REF,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    ArrayRef => {
        accept => [
            $ARRAY_REF,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    HashRef => {
        accept => [
            $HASH_REF,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    CodeRef => {
        accept => [
            $CODE_REF,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    RegexpRef => {
        accept => [
            $REGEX,
            $REGEX_OBJ,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $OBJECT,
            $UNDEF,
            $FAKE_REGEX,
        ],
    },
    GlobRef => {
        accept => [
            $GLOB_REF,
            $FH,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $FH_OBJECT,
            $OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $UNDEF,
        ],
    },
    FileHandle => {
        accept => [
            $FH,
            $FH_OBJECT,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $UNDEF,
        ],
    },
    Object => {
        accept => [
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $UNDEF,
        ],
    },
    ClassName => {
        accept => [
            $CLASS_NAME,
            $ROLE_NAME,
        ],
        reject => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
    RoleName => {
        accept => [
            $ROLE_NAME,
        ],
        reject => [
            $CLASS_NAME,
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
            $EMPTY_STRING,
            $STRING,
            $NUM_IN_STRING,
            $INT_WITH_NL1,
            $INT_WITH_NL2,
            $SCALAR_REF,
            $SCALAR_REF_REF,
            $ARRAY_REF,
            $HASH_REF,
            $CODE_REF,
            $GLOB,
            $GLOB_REF,
            $FH,
            $FH_OBJECT,
            $REGEX,
            $REGEX_OBJ,
            $FAKE_REGEX,
            $OBJECT,
            $UNDEF,
        ],
    },
);

for my $name ( sort keys %tests ) {
    test_constraint( $name, $tests{$name} );
}

# We need to test that the Str constraint accepts the return val of substr() -
# which means passing that return val directly to the checking code
{
    my $str = 'some string';

    my $type = Moose::Util::TypeConstraints::find_type_constraint('Str');

    my $unoptimized
        = $type->has_parent
        ? $type->_compile_subtype( $type->constraint )
        : $type->_compile_type( $type->constraint );

    my $inlined;
    {
        local $@;
        $inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
        die $@ if $@;
    }

    ok(
        $type->check( substr( $str, 1, 3 ) ),
        'Str accepts return val from substr using ->check'
    );
    ok(
        $unoptimized->( substr( $str, 1, 3 ) ),
        'Str accepts return val from substr using unoptimized constraint'
    );
    ok(
        $inlined->( substr( $str, 1, 3 ) ),
        'Str accepts return val from substr using inlined constraint'
    );

    ok(
        $type->check( substr( $str, 0, 0 ) ),
        'Str accepts empty return val from substr using ->check'
    );
    ok(
        $unoptimized->( substr( $str, 0, 0 ) ),
        'Str accepts empty return val from substr using unoptimized constraint'
    );
    ok(
        $inlined->( substr( $str, 0, 0 ) ),
        'Str accepts empty return val from substr using inlined constraint'
    );
}

{
    my $class_tc = class_type('Thing');

    test_constraint(
        $class_tc, {
            accept => [
                ( bless {}, 'Thing' ),
            ],
            reject => [
                'Thing',
                $ZERO,
                $ONE,
                $INT,
                $NEG_INT,
                $NUM,
                $NEG_NUM,
                $EMPTY_STRING,
                $STRING,
                $NUM_IN_STRING,
                $INT_WITH_NL1,
                $INT_WITH_NL2,
                $SCALAR_REF,
                $SCALAR_REF_REF,
                $ARRAY_REF,
                $HASH_REF,
                $CODE_REF,
                $GLOB,
                $GLOB_REF,
                $FH,
                $FH_OBJECT,
                $REGEX,
                $REGEX_OBJ,
                $FAKE_REGEX,
                $OBJECT,
                $UNDEF,
            ],
        }
    );
}

{
    package Duck;

    sub quack { }
    sub flap  { }
}

{
    package DuckLike;

    sub quack { }
    sub flap  { }
}

{
    package Bird;

    sub flap { }
}

{
    my @methods = qw( quack flap );
    duck_type 'Duck' => @methods;

    test_constraint(
        'Duck', {
            accept => [
                ( bless {}, 'Duck' ),
                ( bless {}, 'DuckLike' ),
            ],
            reject => [
                $ZERO,
                $ONE,
                $INT,
                $NEG_INT,
                $NUM,
                $NEG_NUM,
                $EMPTY_STRING,
                $STRING,
                $NUM_IN_STRING,
                $INT_WITH_NL1,
                $INT_WITH_NL2,
                $SCALAR_REF,
                $SCALAR_REF_REF,
                $ARRAY_REF,
                $HASH_REF,
                $CODE_REF,
                $GLOB,
                $GLOB_REF,
                $FH,
                $FH_OBJECT,
                $REGEX,
                $REGEX_OBJ,
                $FAKE_REGEX,
                $OBJECT,
                ( bless {}, 'Bird' ),
                $UNDEF,
            ],
        }
    );
}

{
    my @allowed = qw( bar baz quux );
    enum 'Enumerated' => @allowed;

    test_constraint(
        'Enumerated', {
            accept => \@allowed,
            reject => [
                $ZERO,
                $ONE,
                $INT,
                $NEG_INT,
                $NUM,
                $NEG_NUM,
                $EMPTY_STRING,
                $STRING,
                $NUM_IN_STRING,
                $INT_WITH_NL1,
                $INT_WITH_NL2,
                $SCALAR_REF,
                $SCALAR_REF_REF,
                $ARRAY_REF,
                $HASH_REF,
                $CODE_REF,
                $GLOB,
                $GLOB_REF,
                $FH,
                $FH_OBJECT,
                $REGEX,
                $REGEX_OBJ,
                $FAKE_REGEX,
                $OBJECT,
                $UNDEF,
            ],
        }
    );
}

{
    my $union = Moose::Meta::TypeConstraint::Union->new(
        type_constraints => [
            find_type_constraint('Int'),
            find_type_constraint('Object'),
        ],
    );

    test_constraint(
        $union, {
            accept => [
                $ZERO,
                $ONE,
                $INT,
                $NEG_INT,
                $FH_OBJECT,
                $REGEX,
                $REGEX_OBJ,
                $FAKE_REGEX,
                $OBJECT,
            ],
            reject => [
                $NUM,
                $NEG_NUM,
                $EMPTY_STRING,
                $STRING,
                $NUM_IN_STRING,
                $INT_WITH_NL1,
                $INT_WITH_NL2,
                $SCALAR_REF,
                $SCALAR_REF_REF,
                $ARRAY_REF,
                $HASH_REF,
                $CODE_REF,
                $GLOB,
                $GLOB_REF,
                $FH,
                $UNDEF,
            ],
        }
    );
}

{
    package DoesRole;

    use Moose;

    with 'Role';
}

# Test how $_ is used in XS implementation
{
    local $_ = qr/./;
    ok(
        Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
        '$_ is RegexpRef'
    );
    ok(
        !Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
        '$_ is not read when param provided'
    );

    $_ = bless qr/./, 'Blessed';

    ok(
        Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
        '$_ is RegexpRef'
    );

    $_ = 42;
    ok(
        !Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
        '$_ is not RegexpRef'
    );
    ok(
        Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
        '$_ is not read when param provided'
    );
}

close $FH
    or warn "Could not close the filehandle $0 for test";
$FH_OBJECT->close
    or warn "Could not close the filehandle $0 for test";

done_testing;

sub test_constraint {
    my $type  = shift;
    my $tests = shift;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    unless ( blessed $type ) {
        $type = Moose::Util::TypeConstraints::find_type_constraint($type)
            or BAIL_OUT("No such type $type!");
    }

    my $name = $type->name;

    my $unoptimized
        = $type->has_parent
        ? $type->_compile_subtype( $type->constraint )
        : $type->_compile_type( $type->constraint );

    my $inlined;
    if ( $type->has_inlined_type_constraint ) {
        local $@;
        $inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
        die $@ if $@;
    }

    for my $accept ( @{ $tests->{accept} || [] } ) {
        my $described = describe($accept);
        ok(
            $type->check($accept),
            "$name accepts $described using ->check"
        );
        ok(
            $unoptimized->($accept),
            "$name accepts $described using unoptimized constraint"
        );
        if ($inlined) {
            ok(
                $inlined->($accept),
                "$name accepts $described using inlined constraint"
            );
        }
    }

    for my $reject ( @{ $tests->{reject} || [] } ) {
        my $described = describe($reject);
        ok(
            !$type->check($reject),
            "$name rejects $described using ->check"
        );
        ok(
            !$unoptimized->($reject),
            "$name rejects $described using unoptimized constraint"
        );
        if ($inlined) {
            ok(
                !$inlined->($reject),
                "$name rejects $described using inlined constraint"
            );
        }
    }
}

sub describe {
    my $val = shift;

    return 'undef' unless defined $val;

    if ( !ref $val ) {
        return q{''} if $val eq q{};

        $val =~ s/\n/\\n/g;

        return $val;
    }

    return 'open filehandle'
        if openhandle $val && !blessed $val;

    return blessed $val
        ? ( ref $val ) . ' object'
        : ( ref $val ) . ' reference';
}
Commit	Line	Data
a15dff8d	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
a28e50e4	6	use Test::More;
a15dff8d	7
94ab1609	8	use IO::File;
964294c1	9	use Moose::Util::TypeConstraints;
94ab1609	10	use Scalar::Util qw( blessed openhandle );
a15dff8d	11
94ab1609	12	my $ZERO = 0;
	13	my $ONE = 1;
	14	my $INT = 100;
	15	my $NEG_INT = -100;
	16	my $NUM = 42.42;
	17	my $NEG_NUM = -42.42;
	18
	19	my $EMPTY_STRING = q{};
	20	my $STRING = 'foo';
	21	my $NUM_IN_STRING = 'has 42 in it';
743ec002	22	my $INT_WITH_NL1 = "1\n";
743ec002	23	my $INT_WITH_NL2 = "\n1";
94ab1609	24
	25	my $SCALAR_REF = \( my $var );
	26	my $SCALAR_REF_REF = \$SCALAR_REF;
	27	my $ARRAY_REF = [];
	28	my $HASH_REF = {};
	29	my $CODE_REF = sub { };
	30
4ba256d5	31	my $GLOB = do { no warnings 'once'; *GLOB_REF };
94ab1609	32	my $GLOB_REF = \$GLOB;
	33
	34	open my $FH, '<', $0 or die "Could not open $0 for the test";
a15dff8d	35
94ab1609	36	my $FH_OBJECT = IO::File->new( $0, 'r' )
	37	or die "Could not open $0 for the test";
	38
4ba256d5	39	my $REGEX = qr/../;
4ba256d5	40	my $REGEX_OBJ = bless qr/../, 'BlessedQR';
6b5fae23	41	my $FAKE_REGEX = bless {}, 'Regexp';
94ab1609	42
	43	my $OBJECT = bless {}, 'Foo';
	44
	45	my $UNDEF = undef;
5030b52f	46
5030b52f	47	{
94ab1609	48	package Thing;
5d776bdf	49
94ab1609	50	sub foo { }
5030b52f	51	}
5030b52f	52
94ab1609	53	my $CLASS_NAME = 'Thing';
f0cac16f	54
f0cac16f	55	{
94ab1609	56	package Role;
	57	use Moose::Role;
	58
	59	sub foo { }
f0cac16f	60	}
f0cac16f	61
94ab1609	62	my $ROLE_NAME = 'Role';
	63
	64	my %tests = (
	65	Any => {
	66	accept => [
	67	$ZERO,
	68	$ONE,
	69	$INT,
	70	$NEG_INT,
	71	$NUM,
	72	$NEG_NUM,
	73	$EMPTY_STRING,
	74	$STRING,
	75	$NUM_IN_STRING,
743ec002	76	$INT_WITH_NL1,
743ec002	77	$INT_WITH_NL2,
94ab1609	78	$SCALAR_REF,
	79	$SCALAR_REF_REF,
	80	$ARRAY_REF,
	81	$HASH_REF,
	82	$CODE_REF,
	83	$GLOB,
	84	$GLOB_REF,
	85	$FH,
	86	$FH_OBJECT,
	87	$REGEX,
	88	$REGEX_OBJ,
6b5fae23	89	$FAKE_REGEX,
94ab1609	90	$OBJECT,
	91	$UNDEF,
	92	],
	93	},
	94	Item => {
	95	accept => [
	96	$ZERO,
	97	$ONE,
	98	$INT,
	99	$NEG_INT,
	100	$NUM,
	101	$NEG_NUM,
	102	$EMPTY_STRING,
	103	$STRING,
	104	$NUM_IN_STRING,
743ec002	105	$INT_WITH_NL1,
743ec002	106	$INT_WITH_NL2,
94ab1609	107	$SCALAR_REF,
	108	$SCALAR_REF_REF,
	109	$ARRAY_REF,
	110	$HASH_REF,
	111	$CODE_REF,
	112	$GLOB,
	113	$GLOB_REF,
	114	$FH,
	115	$FH_OBJECT,
	116	$REGEX,
	117	$REGEX_OBJ,
6b5fae23	118	$FAKE_REGEX,
94ab1609	119	$OBJECT,
	120	$UNDEF,
	121	],
	122	},
	123	Defined => {
	124	accept => [
	125	$ZERO,
	126	$ONE,
	127	$INT,
	128	$NEG_INT,
	129	$NUM,
	130	$NEG_NUM,
	131	$EMPTY_STRING,
	132	$STRING,
	133	$NUM_IN_STRING,
743ec002	134	$INT_WITH_NL1,
743ec002	135	$INT_WITH_NL2,
94ab1609	136	$SCALAR_REF,
	137	$SCALAR_REF_REF,
	138	$ARRAY_REF,
	139	$HASH_REF,
	140	$CODE_REF,
	141	$GLOB,
	142	$GLOB_REF,
	143	$FH,
	144	$FH_OBJECT,
	145	$REGEX,
	146	$REGEX_OBJ,
6b5fae23	147	$FAKE_REGEX,
94ab1609	148	$OBJECT,
	149	],
	150	reject => [
	151	$UNDEF,
	152	],
	153	},
	154	Undef => {
	155	accept => [
	156	$UNDEF,
	157	],
	158	reject => [
	159	$ZERO,
	160	$ONE,
	161	$INT,
	162	$NEG_INT,
	163	$NUM,
	164	$NEG_NUM,
	165	$EMPTY_STRING,
	166	$STRING,
	167	$NUM_IN_STRING,
743ec002	168	$INT_WITH_NL1,
743ec002	169	$INT_WITH_NL2,
94ab1609	170	$SCALAR_REF,
	171	$SCALAR_REF_REF,
	172	$ARRAY_REF,
	173	$HASH_REF,
	174	$CODE_REF,
	175	$GLOB,
	176	$GLOB_REF,
	177	$FH,
	178	$FH_OBJECT,
	179	$REGEX,
	180	$REGEX_OBJ,
6b5fae23	181	$FAKE_REGEX,
94ab1609	182	$OBJECT,
	183	],
	184	},
	185	Bool => {
	186	accept => [
	187	$ZERO,
	188	$ONE,
	189	$EMPTY_STRING,
	190	$UNDEF,
	191	],
	192	reject => [
	193	$INT,
	194	$NEG_INT,
	195	$NUM,
	196	$NEG_NUM,
	197	$STRING,
	198	$NUM_IN_STRING,
743ec002	199	$INT_WITH_NL1,
743ec002	200	$INT_WITH_NL2,
94ab1609	201	$SCALAR_REF,
	202	$SCALAR_REF_REF,
	203	$ARRAY_REF,
	204	$HASH_REF,
	205	$CODE_REF,
	206	$GLOB,
	207	$GLOB_REF,
	208	$FH,
	209	$FH_OBJECT,
	210	$REGEX,
	211	$REGEX_OBJ,
6b5fae23	212	$FAKE_REGEX,
94ab1609	213	$OBJECT,
	214	],
	215	},
7fb4b360	216	Maybe => {
	217	accept => [
	218	$ZERO,
	219	$ONE,
	220	$INT,
	221	$NEG_INT,
	222	$NUM,
	223	$NEG_NUM,
	224	$EMPTY_STRING,
	225	$STRING,
	226	$NUM_IN_STRING,
743ec002	227	$INT_WITH_NL1,
743ec002	228	$INT_WITH_NL2,
7fb4b360	229	$SCALAR_REF,
	230	$SCALAR_REF_REF,
	231	$ARRAY_REF,
	232	$HASH_REF,
	233	$CODE_REF,
	234	$GLOB,
	235	$GLOB_REF,
	236	$FH,
	237	$FH_OBJECT,
	238	$REGEX,
	239	$REGEX_OBJ,
6b5fae23	240	$FAKE_REGEX,
7fb4b360	241	$OBJECT,
	242	$UNDEF,
	243	],
	244	},
94ab1609	245	Value => {
	246	accept => [
	247	$ZERO,
	248	$ONE,
	249	$INT,
	250	$NEG_INT,
	251	$NUM,
	252	$NEG_NUM,
	253	$EMPTY_STRING,
	254	$STRING,
	255	$NUM_IN_STRING,
743ec002	256	$INT_WITH_NL1,
743ec002	257	$INT_WITH_NL2,
94ab1609	258	$GLOB,
	259	],
	260	reject => [
	261	$SCALAR_REF,
	262	$SCALAR_REF_REF,
	263	$ARRAY_REF,
	264	$HASH_REF,
	265	$CODE_REF,
	266	$GLOB_REF,
	267	$FH,
	268	$FH_OBJECT,
	269	$REGEX,
	270	$REGEX_OBJ,
6b5fae23	271	$FAKE_REGEX,
94ab1609	272	$OBJECT,
	273	$UNDEF,
	274	],
	275	},
	276	Ref => {
	277	accept => [
	278	$SCALAR_REF,
	279	$SCALAR_REF_REF,
	280	$ARRAY_REF,
	281	$HASH_REF,
	282	$CODE_REF,
	283	$GLOB_REF,
	284	$FH,
	285	$FH_OBJECT,
	286	$REGEX,
	287	$REGEX_OBJ,
6b5fae23	288	$FAKE_REGEX,
94ab1609	289	$OBJECT,
	290	],
	291	reject => [
	292	$ZERO,
	293	$ONE,
	294	$INT,
	295	$NEG_INT,
	296	$NUM,
	297	$NEG_NUM,
	298	$EMPTY_STRING,
	299	$STRING,
	300	$NUM_IN_STRING,
743ec002	301	$INT_WITH_NL1,
743ec002	302	$INT_WITH_NL2,
94ab1609	303	$GLOB,
	304	$UNDEF,
	305	],
	306	},
	307	Num => {
	308	accept => [
	309	$ZERO,
	310	$ONE,
	311	$INT,
	312	$NEG_INT,
	313	$NUM,
	314	$NEG_NUM,
743ec002	315	$INT_WITH_NL1,
743ec002	316	$INT_WITH_NL2,
94ab1609	317	],
	318	reject => [
	319	$EMPTY_STRING,
	320	$STRING,
	321	$NUM_IN_STRING,
	322	$SCALAR_REF,
	323	$SCALAR_REF_REF,
	324	$ARRAY_REF,
	325	$HASH_REF,
	326	$CODE_REF,
	327	$GLOB,
	328	$GLOB_REF,
	329	$FH,
	330	$FH_OBJECT,
	331	$REGEX,
	332	$REGEX_OBJ,
6b5fae23	333	$FAKE_REGEX,
94ab1609	334	$OBJECT,
	335	$UNDEF,
	336	],
	337	},
	338	Int => {
	339	accept => [
	340	$ZERO,
	341	$ONE,
	342	$INT,
	343	$NEG_INT,
	344	],
	345	reject => [
	346	$NUM,
	347	$NEG_NUM,
	348	$EMPTY_STRING,
	349	$STRING,
	350	$NUM_IN_STRING,
743ec002	351	$INT_WITH_NL1,
743ec002	352	$INT_WITH_NL2,
94ab1609	353	$SCALAR_REF,
	354	$SCALAR_REF_REF,
	355	$ARRAY_REF,
	356	$HASH_REF,
	357	$CODE_REF,
	358	$GLOB,
	359	$GLOB_REF,
	360	$FH,
	361	$FH_OBJECT,
	362	$REGEX,
	363	$REGEX_OBJ,
6b5fae23	364	$FAKE_REGEX,
94ab1609	365	$OBJECT,
	366	$UNDEF,
	367	],
	368	},
	369	Str => {
	370	accept => [
	371	$ZERO,
	372	$ONE,
	373	$INT,
	374	$NEG_INT,
	375	$NUM,
	376	$NEG_NUM,
	377	$EMPTY_STRING,
	378	$STRING,
	379	$NUM_IN_STRING,
743ec002	380	$INT_WITH_NL1,
743ec002	381	$INT_WITH_NL2,
94ab1609	382	],
	383	reject => [
	384	$SCALAR_REF,
	385	$SCALAR_REF_REF,
	386	$ARRAY_REF,
	387	$HASH_REF,
	388	$CODE_REF,
	389	$GLOB,
	390	$GLOB_REF,
	391	$FH,
	392	$FH_OBJECT,
	393	$REGEX,
	394	$REGEX_OBJ,
6b5fae23	395	$FAKE_REGEX,
94ab1609	396	$OBJECT,
	397	$UNDEF,
	398	],
	399	},
	400	ScalarRef => {
	401	accept => [
	402	$SCALAR_REF,
	403	$SCALAR_REF_REF,
	404	],
	405	reject => [
	406	$ZERO,
	407	$ONE,
	408	$INT,
	409	$NEG_INT,
	410	$NUM,
	411	$NEG_NUM,
	412	$EMPTY_STRING,
	413	$STRING,
	414	$NUM_IN_STRING,
743ec002	415	$INT_WITH_NL1,
743ec002	416	$INT_WITH_NL2,
94ab1609	417	$ARRAY_REF,
	418	$HASH_REF,
	419	$CODE_REF,
	420	$GLOB,
	421	$GLOB_REF,
	422	$FH,
	423	$FH_OBJECT,
	424	$REGEX,
	425	$REGEX_OBJ,
6b5fae23	426	$FAKE_REGEX,
94ab1609	427	$OBJECT,
	428	$UNDEF,
	429	],
	430	},
	431	ArrayRef => {
	432	accept => [
	433	$ARRAY_REF,
	434	],
	435	reject => [
	436	$ZERO,
	437	$ONE,
	438	$INT,
	439	$NEG_INT,
	440	$NUM,
	441	$NEG_NUM,
	442	$EMPTY_STRING,
	443	$STRING,
	444	$NUM_IN_STRING,
743ec002	445	$INT_WITH_NL1,
743ec002	446	$INT_WITH_NL2,
94ab1609	447	$SCALAR_REF,
	448	$SCALAR_REF_REF,
	449	$HASH_REF,
	450	$CODE_REF,
	451	$GLOB,
	452	$GLOB_REF,
	453	$FH,
	454	$FH_OBJECT,
	455	$REGEX,
	456	$REGEX_OBJ,
6b5fae23	457	$FAKE_REGEX,
94ab1609	458	$OBJECT,
	459	$UNDEF,
	460	],
	461	},
	462	HashRef => {
	463	accept => [
	464	$HASH_REF,
	465	],
	466	reject => [
	467	$ZERO,
	468	$ONE,
	469	$INT,
	470	$NEG_INT,
	471	$NUM,
	472	$NEG_NUM,
	473	$EMPTY_STRING,
	474	$STRING,
	475	$NUM_IN_STRING,
743ec002	476	$INT_WITH_NL1,
743ec002	477	$INT_WITH_NL2,
94ab1609	478	$SCALAR_REF,
	479	$SCALAR_REF_REF,
	480	$ARRAY_REF,
	481	$CODE_REF,
	482	$GLOB,
	483	$GLOB_REF,
	484	$FH,
	485	$FH_OBJECT,
	486	$REGEX,
	487	$REGEX_OBJ,
6b5fae23	488	$FAKE_REGEX,
94ab1609	489	$OBJECT,
	490	$UNDEF,
	491	],
	492	},
	493	CodeRef => {
	494	accept => [
	495	$CODE_REF,
	496	],
	497	reject => [
	498	$ZERO,
	499	$ONE,
	500	$INT,
	501	$NEG_INT,
	502	$NUM,
	503	$NEG_NUM,
	504	$EMPTY_STRING,
	505	$STRING,
	506	$NUM_IN_STRING,
743ec002	507	$INT_WITH_NL1,
743ec002	508	$INT_WITH_NL2,
94ab1609	509	$SCALAR_REF,
	510	$SCALAR_REF_REF,
	511	$ARRAY_REF,
	512	$HASH_REF,
	513	$GLOB,
	514	$GLOB_REF,
	515	$FH,
	516	$FH_OBJECT,
	517	$REGEX,
	518	$REGEX_OBJ,
6b5fae23	519	$FAKE_REGEX,
94ab1609	520	$OBJECT,
	521	$UNDEF,
	522	],
	523	},
	524	RegexpRef => {
	525	accept => [
	526	$REGEX,
	527	$REGEX_OBJ,
	528	],
	529	reject => [
	530	$ZERO,
	531	$ONE,
	532	$INT,
	533	$NEG_INT,
	534	$NUM,
	535	$NEG_NUM,
	536	$EMPTY_STRING,
	537	$STRING,
	538	$NUM_IN_STRING,
743ec002	539	$INT_WITH_NL1,
743ec002	540	$INT_WITH_NL2,
94ab1609	541	$SCALAR_REF,
	542	$SCALAR_REF_REF,
	543	$ARRAY_REF,
	544	$HASH_REF,
	545	$CODE_REF,
	546	$GLOB,
	547	$GLOB_REF,
	548	$FH,
	549	$FH_OBJECT,
	550	$OBJECT,
	551	$UNDEF,
6b5fae23	552	$FAKE_REGEX,
94ab1609	553	],
	554	},
	555	GlobRef => {
	556	accept => [
	557	$GLOB_REF,
	558	$FH,
	559	],
	560	reject => [
	561	$ZERO,
	562	$ONE,
	563	$INT,
	564	$NEG_INT,
	565	$NUM,
	566	$NEG_NUM,
	567	$EMPTY_STRING,
	568	$STRING,
	569	$NUM_IN_STRING,
743ec002	570	$INT_WITH_NL1,
743ec002	571	$INT_WITH_NL2,
94ab1609	572	$SCALAR_REF,
	573	$SCALAR_REF_REF,
	574	$ARRAY_REF,
	575	$HASH_REF,
	576	$CODE_REF,
	577	$GLOB,
	578	$FH_OBJECT,
	579	$OBJECT,
	580	$REGEX,
	581	$REGEX_OBJ,
6b5fae23	582	$FAKE_REGEX,
94ab1609	583	$UNDEF,
	584	],
	585	},
	586	FileHandle => {
	587	accept => [
	588	$FH,
	589	$FH_OBJECT,
	590	],
	591	reject => [
	592	$ZERO,
	593	$ONE,
	594	$INT,
	595	$NEG_INT,
	596	$NUM,
	597	$NEG_NUM,
	598	$EMPTY_STRING,
	599	$STRING,
	600	$NUM_IN_STRING,
743ec002	601	$INT_WITH_NL1,
743ec002	602	$INT_WITH_NL2,
94ab1609	603	$SCALAR_REF,
	604	$SCALAR_REF_REF,
	605	$ARRAY_REF,
	606	$HASH_REF,
	607	$CODE_REF,
	608	$GLOB,
	609	$GLOB_REF,
	610	$OBJECT,
	611	$REGEX,
	612	$REGEX_OBJ,
6b5fae23	613	$FAKE_REGEX,
94ab1609	614	$UNDEF,
	615	],
	616	},
	617	Object => {
	618	accept => [
	619	$FH_OBJECT,
	620	$REGEX,
	621	$REGEX_OBJ,
6b5fae23	622	$FAKE_REGEX,
94ab1609	623	$OBJECT,
	624	],
	625	reject => [
	626	$ZERO,
	627	$ONE,
	628	$INT,
	629	$NEG_INT,
	630	$NUM,
	631	$NEG_NUM,
	632	$EMPTY_STRING,
	633	$STRING,
	634	$NUM_IN_STRING,
743ec002	635	$INT_WITH_NL1,
743ec002	636	$INT_WITH_NL2,
94ab1609	637	$SCALAR_REF,
	638	$SCALAR_REF_REF,
	639	$ARRAY_REF,
	640	$HASH_REF,
	641	$CODE_REF,
	642	$GLOB,
	643	$GLOB_REF,
	644	$FH,
	645	$UNDEF,
	646	],
	647	},
	648	ClassName => {
	649	accept => [
	650	$CLASS_NAME,
	651	$ROLE_NAME,
	652	],
	653	reject => [
	654	$ZERO,
	655	$ONE,
	656	$INT,
	657	$NEG_INT,
	658	$NUM,
	659	$NEG_NUM,
	660	$EMPTY_STRING,
	661	$STRING,
	662	$NUM_IN_STRING,
743ec002	663	$INT_WITH_NL1,
743ec002	664	$INT_WITH_NL2,
94ab1609	665	$SCALAR_REF,
	666	$SCALAR_REF_REF,
	667	$ARRAY_REF,
	668	$HASH_REF,
	669	$CODE_REF,
	670	$GLOB,
	671	$GLOB_REF,
	672	$FH,
	673	$FH_OBJECT,
	674	$REGEX,
	675	$REGEX_OBJ,
6b5fae23	676	$FAKE_REGEX,
94ab1609	677	$OBJECT,
	678	$UNDEF,
	679	],
	680	},
	681	RoleName => {
	682	accept => [
	683	$ROLE_NAME,
	684	],
	685	reject => [
	686	$CLASS_NAME,
	687	$ZERO,
	688	$ONE,
	689	$INT,
	690	$NEG_INT,
	691	$NUM,
	692	$NEG_NUM,
	693	$EMPTY_STRING,
	694	$STRING,
	695	$NUM_IN_STRING,
743ec002	696	$INT_WITH_NL1,
743ec002	697	$INT_WITH_NL2,
94ab1609	698	$SCALAR_REF,
	699	$SCALAR_REF_REF,
	700	$ARRAY_REF,
	701	$HASH_REF,
	702	$CODE_REF,
	703	$GLOB,
	704	$GLOB_REF,
	705	$FH,
	706	$FH_OBJECT,
	707	$REGEX,
	708	$REGEX_OBJ,
6b5fae23	709	$FAKE_REGEX,
94ab1609	710	$OBJECT,
	711	$UNDEF,
	712	],
	713	},
	714	);
	715
	716	for my $name ( sort keys %tests ) {
964294c1	717	test_constraint( $name, $tests{$name} );
	718	}
	719
bb4cf777	720	# We need to test that the Str constraint accepts the return val of substr() -
	721	# which means passing that return val directly to the checking code
	722	{
	723	my $str = 'some string';
	724
	725	my $type = Moose::Util::TypeConstraints::find_type_constraint('Str');
	726
	727	my $unoptimized
	728	= $type->has_parent
	729	? $type->_compile_subtype( $type->constraint )
	730	: $type->_compile_type( $type->constraint );
	731
	732	my $inlined;
	733	{
	734	local $@;
	735	$inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
	736	die $@ if $@;
	737	}
	738
	739	ok(
	740	$type->check( substr( $str, 1, 3 ) ),
	741	'Str accepts return val from substr using ->check'
	742	);
	743	ok(
	744	$unoptimized->( substr( $str, 1, 3 ) ),
	745	'Str accepts return val from substr using unoptimized constraint'
	746	);
	747	ok(
	748	$inlined->( substr( $str, 1, 3 ) ),
	749	'Str accepts return val from substr using inlined constraint'
	750	);
	751
	752	ok(
	753	$type->check( substr( $str, 0, 0 ) ),
	754	'Str accepts empty return val from substr using ->check'
	755	);
	756	ok(
	757	$unoptimized->( substr( $str, 0, 0 ) ),
	758	'Str accepts empty return val from substr using unoptimized constraint'
	759	);
	760	ok(
	761	$inlined->( substr( $str, 0, 0 ) ),
	762	'Str accepts empty return val from substr using inlined constraint'
	763	);
	764	}
	765
964294c1	766	{
	767	my $class_tc = class_type('Thing');
	768
	769	test_constraint(
	770	$class_tc, {
	771	accept => [
	772	( bless {}, 'Thing' ),
	773	],
	774	reject => [
	775	'Thing',
	776	$ZERO,
	777	$ONE,
	778	$INT,
	779	$NEG_INT,
	780	$NUM,
	781	$NEG_NUM,
	782	$EMPTY_STRING,
	783	$STRING,
	784	$NUM_IN_STRING,
743ec002	785	$INT_WITH_NL1,
743ec002	786	$INT_WITH_NL2,
964294c1	787	$SCALAR_REF,
	788	$SCALAR_REF_REF,
	789	$ARRAY_REF,
	790	$HASH_REF,
	791	$CODE_REF,
	792	$GLOB,
	793	$GLOB_REF,
	794	$FH,
	795	$FH_OBJECT,
	796	$REGEX,
	797	$REGEX_OBJ,
6b5fae23	798	$FAKE_REGEX,
964294c1	799	$OBJECT,
	800	$UNDEF,
	801	],
	802	}
	803	);
	804	}
	805
	806	{
	807	package Duck;
	808
743ec002	809	sub quack { }
743ec002	810	sub flap { }
964294c1	811	}
	812
	813	{
	814	package DuckLike;
	815
743ec002	816	sub quack { }
743ec002	817	sub flap { }
964294c1	818	}
	819
	820	{
	821	package Bird;
	822
743ec002	823	sub flap { }
964294c1	824	}
	825
	826	{
	827	my @methods = qw( quack flap );
	828	duck_type 'Duck' => @methods;
	829
	830	test_constraint(
	831	'Duck', {
	832	accept => [
	833	( bless {}, 'Duck' ),
	834	( bless {}, 'DuckLike' ),
	835	],
	836	reject => [
964294c1	837	$ZERO,
	838	$ONE,
	839	$INT,
	840	$NEG_INT,
	841	$NUM,
	842	$NEG_NUM,
	843	$EMPTY_STRING,
	844	$STRING,
	845	$NUM_IN_STRING,
743ec002	846	$INT_WITH_NL1,
743ec002	847	$INT_WITH_NL2,
964294c1	848	$SCALAR_REF,
	849	$SCALAR_REF_REF,
	850	$ARRAY_REF,
	851	$HASH_REF,
	852	$CODE_REF,
	853	$GLOB,
	854	$GLOB_REF,
	855	$FH,
	856	$FH_OBJECT,
	857	$REGEX,
	858	$REGEX_OBJ,
6b5fae23	859	$FAKE_REGEX,
964294c1	860	$OBJECT,
	861	( bless {}, 'Bird' ),
	862	$UNDEF,
	863	],
	864	}
	865	);
	866	}
	867
	868	{
	869	my @allowed = qw( bar baz quux );
	870	enum 'Enumerated' => @allowed;
	871
	872	test_constraint(
	873	'Enumerated', {
	874	accept => \@allowed,
	875	reject => [
964294c1	876	$ZERO,
	877	$ONE,
	878	$INT,
	879	$NEG_INT,
	880	$NUM,
	881	$NEG_NUM,
	882	$EMPTY_STRING,
	883	$STRING,
	884	$NUM_IN_STRING,
743ec002	885	$INT_WITH_NL1,
743ec002	886	$INT_WITH_NL2,
964294c1	887	$SCALAR_REF,
	888	$SCALAR_REF_REF,
	889	$ARRAY_REF,
	890	$HASH_REF,
	891	$CODE_REF,
	892	$GLOB,
	893	$GLOB_REF,
	894	$FH,
	895	$FH_OBJECT,
	896	$REGEX,
	897	$REGEX_OBJ,
6b5fae23	898	$FAKE_REGEX,
964294c1	899	$OBJECT,
	900	$UNDEF,
	901	],
	902	}
	903	);
	904	}
	905
	906	{
09532816	907	my $union = Moose::Meta::TypeConstraint::Union->new(
	908	type_constraints => [
	909	find_type_constraint('Int'),
	910	find_type_constraint('Object'),
	911	],
	912	);
	913
	914	test_constraint(
	915	$union, {
	916	accept => [
	917	$ZERO,
	918	$ONE,
	919	$INT,
	920	$NEG_INT,
	921	$FH_OBJECT,
	922	$REGEX,
	923	$REGEX_OBJ,
6b5fae23	924	$FAKE_REGEX,
09532816	925	$OBJECT,
	926	],
	927	reject => [
	928	$NUM,
	929	$NEG_NUM,
	930	$EMPTY_STRING,
	931	$STRING,
	932	$NUM_IN_STRING,
743ec002	933	$INT_WITH_NL1,
743ec002	934	$INT_WITH_NL2,
09532816	935	$SCALAR_REF,
	936	$SCALAR_REF_REF,
	937	$ARRAY_REF,
	938	$HASH_REF,
	939	$CODE_REF,
	940	$GLOB,
	941	$GLOB_REF,
	942	$FH,
	943	$UNDEF,
	944	],
	945	}
	946	);
	947	}
	948
	949	{
964294c1	950	package DoesRole;
	951
	952	use Moose;
	953
	954	with 'Role';
	955	}
	956
	957	# Test how $_ is used in XS implementation
	958	{
	959	local $_ = qr/./;
	960	ok(
	961	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	962	'$_ is RegexpRef'
	963	);
	964	ok(
	965	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
	966	'$_ is not read when param provided'
	967	);
	968
	969	$_ = bless qr/./, 'Blessed';
	970
	971	ok(
	972	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	973	'$_ is RegexpRef'
	974	);
	975
	976	$_ = 42;
	977	ok(
	978	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	979	'$_ is not RegexpRef'
	980	);
	981	ok(
	982	Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
	983	'$_ is not read when param provided'
	984	);
	985	}
	986
	987	close $FH
	988	or warn "Could not close the filehandle $0 for test";
	989	$FH_OBJECT->close
	990	or warn "Could not close the filehandle $0 for test";
	991
	992	done_testing;
	993
	994	sub test_constraint {
	995	my $type = shift;
	996	my $tests = shift;
	997
	998	local $Test::Builder::Level = $Test::Builder::Level + 1;
	999
	1000	unless ( blessed $type ) {
	1001	$type = Moose::Util::TypeConstraints::find_type_constraint($type)
	1002	or BAIL_OUT("No such type $type!");
	1003	}
	1004
	1005	my $name = $type->name;
94ab1609	1006
	1007	my $unoptimized
	1008	= $type->has_parent
	1009	? $type->_compile_subtype( $type->constraint )
	1010	: $type->_compile_type( $type->constraint );
	1011
	1012	my $inlined;
	1013	if ( $type->has_inlined_type_constraint ) {
	1014	local $@;
964294c1	1015	$inlined = eval 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }';
94ab1609	1016	die $@ if $@;
	1017	}
	1018
964294c1	1019	for my $accept ( @{ $tests->{accept} \|\| [] } ) {
94ab1609	1020	my $described = describe($accept);
	1021	ok(
	1022	$type->check($accept),
	1023	"$name accepts $described using ->check"
	1024	);
	1025	ok(
	1026	$unoptimized->($accept),
	1027	"$name accepts $described using unoptimized constraint"
	1028	);
	1029	if ($inlined) {
	1030	ok(
	1031	$inlined->($accept),
	1032	"$name accepts $described using inlined constraint"
	1033	);
	1034	}
	1035	}
	1036
964294c1	1037	for my $reject ( @{ $tests->{reject} \|\| [] } ) {
94ab1609	1038	my $described = describe($reject);
	1039	ok(
	1040	!$type->check($reject),
	1041	"$name rejects $described using ->check"
	1042	);
	1043	ok(
	1044	!$unoptimized->($reject),
	1045	"$name rejects $described using unoptimized constraint"
	1046	);
	1047	if ($inlined) {
	1048	ok(
	1049	!$inlined->($reject),
	1050	"$name rejects $described using inlined constraint"
	1051	);
	1052	}
	1053	}
	1054	}
	1055
94ab1609	1056	sub describe {
	1057	my $val = shift;
	1058
	1059	return 'undef' unless defined $val;
	1060
	1061	if ( !ref $val ) {
	1062	return q{''} if $val eq q{};
94ab1609	1063
743ec002	1064	$val =~ s/\n/\\n/g;
	1065
	1066	return $val;
	1067	}
94ab1609	1068
	1069	return 'open filehandle'
	1070	if openhandle $val && !blessed $val;
	1071
964294c1	1072	return blessed $val
	1073	? ( ref $val ) . ' object'
	1074	: ( ref $val ) . ' reference';
94ab1609	1075	}