[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 $SCALAR_REF     = \( my $var );
my $SCALAR_REF_REF = \$SCALAR_REF;
my $ARRAY_REF      = [];
my $HASH_REF       = {};
my $CODE_REF       = sub { };

no warnings 'once';    # << I *hates* that warning ...
my $GLOB     = *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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $GLOB,
            $UNDEF,
        ],
    },
    Num => {
        accept => [
            $ZERO,
            $ONE,
            $INT,
            $NEG_INT,
            $NUM,
            $NEG_NUM,
        ],
        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,
            $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,
        ],
        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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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,
            $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 ) {
    my $type = Moose::Util::TypeConstraints::find_type_constraint($name)
        or BAIL_OUT("No such 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->inlined->('$_[0]') . ' ) }';
        die $@ if $@;
    }

    for my $accept ( @{ $tests{$name}{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{$name}{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"
            );
        }
    }
}

# 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 describe {
    my $val = shift;

    return 'undef' unless defined $val;

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

    return $val unless ref $val;

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

    return ( 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;
	9	use Moose::Util::TypeConstraints ();
	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';
	22
	23	my $SCALAR_REF = \( my $var );
	24	my $SCALAR_REF_REF = \$SCALAR_REF;
	25	my $ARRAY_REF = [];
	26	my $HASH_REF = {};
	27	my $CODE_REF = sub { };
	28
	29	no warnings 'once'; # << I hates that warning ...
	30	my $GLOB = *GLOB_REF;
	31	my $GLOB_REF = \$GLOB;
	32
	33	open my $FH, '<', $0 or die "Could not open $0 for the test";
a15dff8d	34
94ab1609	35	my $FH_OBJECT = IO::File->new( $0, 'r' )
	36	or die "Could not open $0 for the test";
	37
	38	my $REGEX = qr/../;
	39	my $REGEX_OBJ = bless qr/../, 'BlessedQR';
	40
	41	my $OBJECT = bless {}, 'Foo';
	42
	43	my $UNDEF = undef;
5030b52f	44
5030b52f	45	{
94ab1609	46	package Thing;
5d776bdf	47
94ab1609	48	sub foo { }
5030b52f	49	}
5030b52f	50
94ab1609	51	my $CLASS_NAME = 'Thing';
f0cac16f	52
f0cac16f	53	{
94ab1609	54	package Role;
	55	use Moose::Role;
	56
	57	sub foo { }
f0cac16f	58	}
f0cac16f	59
94ab1609	60	my $ROLE_NAME = 'Role';
	61
	62	my %tests = (
	63	Any => {
	64	accept => [
	65	$ZERO,
	66	$ONE,
	67	$INT,
	68	$NEG_INT,
	69	$NUM,
	70	$NEG_NUM,
	71	$EMPTY_STRING,
	72	$STRING,
	73	$NUM_IN_STRING,
	74	$SCALAR_REF,
	75	$SCALAR_REF_REF,
	76	$ARRAY_REF,
	77	$HASH_REF,
	78	$CODE_REF,
	79	$GLOB,
	80	$GLOB_REF,
	81	$FH,
	82	$FH_OBJECT,
	83	$REGEX,
	84	$REGEX_OBJ,
	85	$OBJECT,
	86	$UNDEF,
	87	],
	88	},
	89	Item => {
	90	accept => [
	91	$ZERO,
	92	$ONE,
	93	$INT,
	94	$NEG_INT,
	95	$NUM,
	96	$NEG_NUM,
	97	$EMPTY_STRING,
	98	$STRING,
	99	$NUM_IN_STRING,
	100	$SCALAR_REF,
	101	$SCALAR_REF_REF,
	102	$ARRAY_REF,
	103	$HASH_REF,
	104	$CODE_REF,
	105	$GLOB,
	106	$GLOB_REF,
	107	$FH,
	108	$FH_OBJECT,
	109	$REGEX,
	110	$REGEX_OBJ,
	111	$OBJECT,
	112	$UNDEF,
	113	],
	114	},
	115	Defined => {
	116	accept => [
	117	$ZERO,
	118	$ONE,
	119	$INT,
	120	$NEG_INT,
	121	$NUM,
	122	$NEG_NUM,
	123	$EMPTY_STRING,
124	$STRING,
125	$NUM_IN_STRING,
126	$SCALAR_REF,
127	$SCALAR_REF_REF,
128	$ARRAY_REF,
129	$HASH_REF,
130	$CODE_REF,
131	$GLOB,
132	$GLOB_REF,
133	$FH,
134	$FH_OBJECT,
135	$REGEX,
136	$REGEX_OBJ,
137	$OBJECT,
138	],
139	reject => [
140	$UNDEF,
141	],
142	},
143	Undef => {
144	accept => [
145	$UNDEF,
146	],
147	reject => [
148	$ZERO,
149	$ONE,
150	$INT,
151	$NEG_INT,
152	$NUM,
153	$NEG_NUM,
154	$EMPTY_STRING,
155	$STRING,
156	$NUM_IN_STRING,
157	$SCALAR_REF,
158	$SCALAR_REF_REF,
159	$ARRAY_REF,
160	$HASH_REF,
161	$CODE_REF,
162	$GLOB,
163	$GLOB_REF,
164	$FH,
165	$FH_OBJECT,
166	$REGEX,
167	$REGEX_OBJ,
168	$OBJECT,
169	],
170	},
171	Bool => {
172	accept => [
173	$ZERO,
174	$ONE,
175	$EMPTY_STRING,
176	$UNDEF,
177	],
178	reject => [
179	$INT,
180	$NEG_INT,
181	$NUM,
182	$NEG_NUM,
183	$STRING,
184	$NUM_IN_STRING,
185	$SCALAR_REF,
186	$SCALAR_REF_REF,
187	$ARRAY_REF,
188	$HASH_REF,
189	$CODE_REF,
190	$GLOB,
191	$GLOB_REF,
192	$FH,
193	$FH_OBJECT,
194	$REGEX,
195	$REGEX_OBJ,
196	$OBJECT,
197	],
198	},
7fb4b360	199	Maybe => {
	200	accept => [
	201	$ZERO,
	202	$ONE,
	203	$INT,
	204	$NEG_INT,
	205	$NUM,
	206	$NEG_NUM,
	207	$EMPTY_STRING,
	208	$STRING,
	209	$NUM_IN_STRING,
	210	$SCALAR_REF,
	211	$SCALAR_REF_REF,
	212	$ARRAY_REF,
	213	$HASH_REF,
	214	$CODE_REF,
	215	$GLOB,
	216	$GLOB_REF,
	217	$FH,
	218	$FH_OBJECT,
	219	$REGEX,
	220	$REGEX_OBJ,
	221	$OBJECT,
	222	$UNDEF,
	223	],
	224	},
94ab1609	225	Value => {
	226	accept => [
	227	$ZERO,
	228	$ONE,
	229	$INT,
	230	$NEG_INT,
	231	$NUM,
	232	$NEG_NUM,
	233	$EMPTY_STRING,
	234	$STRING,
	235	$NUM_IN_STRING,
	236	$GLOB,
	237	],
	238	reject => [
	239	$SCALAR_REF,
	240	$SCALAR_REF_REF,
	241	$ARRAY_REF,
	242	$HASH_REF,
	243	$CODE_REF,
	244	$GLOB_REF,
	245	$FH,
	246	$FH_OBJECT,
	247	$REGEX,
	248	$REGEX_OBJ,
	249	$OBJECT,
	250	$UNDEF,
	251	],
	252	},
	253	Ref => {
	254	accept => [
	255	$SCALAR_REF,
	256	$SCALAR_REF_REF,
	257	$ARRAY_REF,
	258	$HASH_REF,
	259	$CODE_REF,
	260	$GLOB_REF,
	261	$FH,
	262	$FH_OBJECT,
	263	$REGEX,
	264	$REGEX_OBJ,
	265	$OBJECT,
	266	],
	267	reject => [
	268	$ZERO,
	269	$ONE,
	270	$INT,
	271	$NEG_INT,
	272	$NUM,
	273	$NEG_NUM,
	274	$EMPTY_STRING,
	275	$STRING,
	276	$NUM_IN_STRING,
	277	$GLOB,
	278	$UNDEF,
	279	],
	280	},
	281	Num => {
	282	accept => [
	283	$ZERO,
	284	$ONE,
	285	$INT,
	286	$NEG_INT,
	287	$NUM,
	288	$NEG_NUM,
289	],
290	reject => [
291	$EMPTY_STRING,
292	$STRING,
293	$NUM_IN_STRING,
294	$SCALAR_REF,
295	$SCALAR_REF_REF,
296	$ARRAY_REF,
297	$HASH_REF,
298	$CODE_REF,
299	$GLOB,
300	$GLOB_REF,
301	$FH,
302	$FH_OBJECT,
303	$REGEX,
304	$REGEX_OBJ,
305	$OBJECT,
306	$UNDEF,
307	],
308	},
309	Int => {
310	accept => [
311	$ZERO,
312	$ONE,
313	$INT,
314	$NEG_INT,
315	],
316	reject => [
317	$NUM,
318	$NEG_NUM,
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,
333	$OBJECT,
334	$UNDEF,
335	],
336	},
337	Str => {
338	accept => [
339	$ZERO,
340	$ONE,
341	$INT,
342	$NEG_INT,
343	$NUM,
344	$NEG_NUM,
345	$EMPTY_STRING,
346	$STRING,
347	$NUM_IN_STRING,
348	],
349	reject => [
350	$SCALAR_REF,
351	$SCALAR_REF_REF,
352	$ARRAY_REF,
353	$HASH_REF,
354	$CODE_REF,
355	$GLOB,
356	$GLOB_REF,
357	$FH,
358	$FH_OBJECT,
359	$REGEX,
360	$REGEX_OBJ,
361	$OBJECT,
362	$UNDEF,
363	],
364	},
365	ScalarRef => {
366	accept => [
367	$SCALAR_REF,
368	$SCALAR_REF_REF,
369	],
370	reject => [
371	$ZERO,
372	$ONE,
373	$INT,
374	$NEG_INT,
375	$NUM,
376	$NEG_NUM,
377	$EMPTY_STRING,
378	$STRING,
379	$NUM_IN_STRING,
380	$ARRAY_REF,
381	$HASH_REF,
382	$CODE_REF,
383	$GLOB,
384	$GLOB_REF,
385	$FH,
386	$FH_OBJECT,
387	$REGEX,
388	$REGEX_OBJ,
389	$OBJECT,
390	$UNDEF,
391	],
392	},
393	ArrayRef => {
394	accept => [
395	$ARRAY_REF,
396	],
397	reject => [
398	$ZERO,
399	$ONE,
400	$INT,
401	$NEG_INT,
402	$NUM,
403	$NEG_NUM,
404	$EMPTY_STRING,
405	$STRING,
406	$NUM_IN_STRING,
407	$SCALAR_REF,
408	$SCALAR_REF_REF,
409	$HASH_REF,
410	$CODE_REF,
411	$GLOB,
412	$GLOB_REF,
413	$FH,
414	$FH_OBJECT,
415	$REGEX,
416	$REGEX_OBJ,
417	$OBJECT,
418	$UNDEF,
419	],
420	},
421	HashRef => {
422	accept => [
423	$HASH_REF,
424	],
425	reject => [
426	$ZERO,
427	$ONE,
428	$INT,
429	$NEG_INT,
430	$NUM,
431	$NEG_NUM,
432	$EMPTY_STRING,
433	$STRING,
434	$NUM_IN_STRING,
435	$SCALAR_REF,
436	$SCALAR_REF_REF,
437	$ARRAY_REF,
438	$CODE_REF,
439	$GLOB,
440	$GLOB_REF,
441	$FH,
442	$FH_OBJECT,
443	$REGEX,
444	$REGEX_OBJ,
445	$OBJECT,
446	$UNDEF,
447	],
448	},
449	CodeRef => {
450	accept => [
451	$CODE_REF,
452	],
453	reject => [
454	$ZERO,
455	$ONE,
456	$INT,
457	$NEG_INT,
458	$NUM,
459	$NEG_NUM,
460	$EMPTY_STRING,
461	$STRING,
462	$NUM_IN_STRING,
463	$SCALAR_REF,
464	$SCALAR_REF_REF,
465	$ARRAY_REF,
466	$HASH_REF,
467	$GLOB,
468	$GLOB_REF,
469	$FH,
470	$FH_OBJECT,
471	$REGEX,
472	$REGEX_OBJ,
473	$OBJECT,
474	$UNDEF,
475	],
476	},
477	RegexpRef => {
478	accept => [
479	$REGEX,
480	$REGEX_OBJ,
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,
492	$SCALAR_REF,
493	$SCALAR_REF_REF,
494	$ARRAY_REF,
495	$HASH_REF,
496	$CODE_REF,
497	$GLOB,
498	$GLOB_REF,
499	$FH,
500	$FH_OBJECT,
501	$OBJECT,
502	$UNDEF,
503	],
504	},
505	GlobRef => {
506	accept => [
507	$GLOB_REF,
508	$FH,
509	],
510	reject => [
511	$ZERO,
512	$ONE,
513	$INT,
514	$NEG_INT,
515	$NUM,
516	$NEG_NUM,
517	$EMPTY_STRING,
518	$STRING,
519	$NUM_IN_STRING,
520	$SCALAR_REF,
521	$SCALAR_REF_REF,
522	$ARRAY_REF,
523	$HASH_REF,
524	$CODE_REF,
525	$GLOB,
526	$FH_OBJECT,
527	$OBJECT,
528	$REGEX,
529	$REGEX_OBJ,
530	$UNDEF,
531	],
532	},
533	FileHandle => {
534	accept => [
535	$FH,
536	$FH_OBJECT,
537	],
538	reject => [
539	$ZERO,
540	$ONE,
541	$INT,
542	$NEG_INT,
543	$NUM,
544	$NEG_NUM,
545	$EMPTY_STRING,
546	$STRING,
547	$NUM_IN_STRING,
548	$SCALAR_REF,
549	$SCALAR_REF_REF,
550	$ARRAY_REF,
551	$HASH_REF,
552	$CODE_REF,
553	$GLOB,
554	$GLOB_REF,
555	$OBJECT,
556	$REGEX,
557	$REGEX_OBJ,
558	$UNDEF,
559	],
560	},
561	Object => {
562	accept => [
563	$FH_OBJECT,
564	$REGEX,
565	$REGEX_OBJ,
566	$OBJECT,
567	],
568	reject => [
569	$ZERO,
570	$ONE,
571	$INT,
572	$NEG_INT,
573	$NUM,
574	$NEG_NUM,
575	$EMPTY_STRING,
576	$STRING,
577	$NUM_IN_STRING,
578	$SCALAR_REF,
579	$SCALAR_REF_REF,
580	$ARRAY_REF,
581	$HASH_REF,
582	$CODE_REF,
583	$GLOB,
584	$GLOB_REF,
585	$FH,
586	$UNDEF,
587	],
588	},
589	ClassName => {
590	accept => [
591	$CLASS_NAME,
592	$ROLE_NAME,
593	],
594	reject => [
595	$ZERO,
596	$ONE,
597	$INT,
598	$NEG_INT,
599	$NUM,
600	$NEG_NUM,
601	$EMPTY_STRING,
602	$STRING,
603	$NUM_IN_STRING,
604	$SCALAR_REF,
605	$SCALAR_REF_REF,
606	$ARRAY_REF,
607	$HASH_REF,
608	$CODE_REF,
609	$GLOB,
610	$GLOB_REF,
611	$FH,
612	$FH_OBJECT,
613	$REGEX,
614	$REGEX_OBJ,
615	$OBJECT,
616	$UNDEF,
617	],
618	},
619	RoleName => {
620	accept => [
621	$ROLE_NAME,
622	],
623	reject => [
624	$CLASS_NAME,
625	$ZERO,
626	$ONE,
627	$INT,
628	$NEG_INT,
629	$NUM,
630	$NEG_NUM,
631	$EMPTY_STRING,
632	$STRING,
633	$NUM_IN_STRING,
634	$SCALAR_REF,
635	$SCALAR_REF_REF,
636	$ARRAY_REF,
637	$HASH_REF,
638	$CODE_REF,
639	$GLOB,
640	$GLOB_REF,
641	$FH,
642	$FH_OBJECT,
643	$REGEX,
644	$REGEX_OBJ,
645	$OBJECT,
646	$UNDEF,
647	],
648	},
649	);
650
651	for my $name ( sort keys %tests ) {
652	my $type = Moose::Util::TypeConstraints::find_type_constraint($name)
653	or BAIL_OUT("No such type $name!");
654
655	my $unoptimized
656	= $type->has_parent
657	? $type->_compile_subtype( $type->constraint )
658	: $type->_compile_type( $type->constraint );
659
660	my $inlined;
661	if ( $type->has_inlined_type_constraint ) {
662	local $@;
663	$inlined = eval 'sub { ( ' . $type->inlined->('$_[0]') . ' ) }';
664	die $@ if $@;
665	}
666
667	for my $accept ( @{ $tests{$name}{accept} \|\| [] } ) {
668	my $described = describe($accept);
669	ok(
670	$type->check($accept),
671	"$name accepts $described using ->check"
672	);
673	ok(
674	$unoptimized->($accept),
675	"$name accepts $described using unoptimized constraint"
676	);
677	if ($inlined) {
678	ok(
679	$inlined->($accept),
680	"$name accepts $described using inlined constraint"
681	);
682	}
683	}
684
685	for my $reject ( @{ $tests{$name}{reject} \|\| [] } ) {
686	my $described = describe($reject);
687	ok(
688	!$type->check($reject),
689	"$name rejects $described using ->check"
690	);
691	ok(
692	!$unoptimized->($reject),
693	"$name rejects $described using unoptimized constraint"
694	);
695	if ($inlined) {
696	ok(
697	!$inlined->($reject),
698	"$name rejects $described using inlined constraint"
699	);
700	}
701	}
702	}
703
704	# Test how $_ is used in XS implementation
7c29582b	705	{
94ab1609	706	local $_ = qr/./;
	707	ok(
	708	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	709	'$_ is RegexpRef'
	710	);
	711	ok(
	712	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
	713	'$_ is not read when param provided'
	714	);
	715
	716	$_ = bless qr/./, 'Blessed';
	717
	718	ok(
	719	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	720	'$_ is RegexpRef'
	721	);
	722
	723	$_ = 42;
	724	ok(
	725	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	726	'$_ is not RegexpRef'
	727	);
	728	ok(
	729	Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
	730	'$_ is not read when param provided'
	731	);
7c29582b	732	}
7c29582b	733
94ab1609	734	close $FH
	735	or warn "Could not close the filehandle $0 for test";
	736	$FH_OBJECT->close
	737	or warn "Could not close the filehandle $0 for test";
a28e50e4	738
a28e50e4	739	done_testing;
94ab1609	740
	741	sub describe {
	742	my $val = shift;
	743
	744	return 'undef' unless defined $val;
	745
	746	if ( !ref $val ) {
	747	return q{''} if $val eq q{};
	748	}
	749
	750	return $val unless ref $val;
	751
	752	return 'open filehandle'
	753	if openhandle $val && !blessed $val;
	754
	755	return ( ref $val ) . ' reference';
	756	}