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