[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,
        ],
    },
    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	},
199	Value => {
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	$GLOB,
211	],
212	reject => [
213	$SCALAR_REF,
214	$SCALAR_REF_REF,
215	$ARRAY_REF,
216	$HASH_REF,
217	$CODE_REF,
218	$GLOB_REF,
219	$FH,
220	$FH_OBJECT,
221	$REGEX,
222	$REGEX_OBJ,
223	$OBJECT,
224	$UNDEF,
225	],
226	},
227	Ref => {
228	accept => [
229	$SCALAR_REF,
230	$SCALAR_REF_REF,
231	$ARRAY_REF,
232	$HASH_REF,
233	$CODE_REF,
234	$GLOB_REF,
235	$FH,
236	$FH_OBJECT,
237	$REGEX,
238	$REGEX_OBJ,
239	$OBJECT,
240	],
241	reject => [
242	$ZERO,
243	$ONE,
244	$INT,
245	$NEG_INT,
246	$NUM,
247	$NEG_NUM,
248	$EMPTY_STRING,
249	$STRING,
250	$NUM_IN_STRING,
251	$GLOB,
252	$UNDEF,
253	],
254	},
255	Num => {
256	accept => [
257	$ZERO,
258	$ONE,
259	$INT,
260	$NEG_INT,
261	$NUM,
262	$NEG_NUM,
263	],
264	reject => [
265	$EMPTY_STRING,
266	$STRING,
267	$NUM_IN_STRING,
268	$SCALAR_REF,
269	$SCALAR_REF_REF,
270	$ARRAY_REF,
271	$HASH_REF,
272	$CODE_REF,
273	$GLOB,
274	$GLOB_REF,
275	$FH,
276	$FH_OBJECT,
277	$REGEX,
278	$REGEX_OBJ,
279	$OBJECT,
280	$UNDEF,
281	],
282	},
283	Int => {
284	accept => [
285	$ZERO,
286	$ONE,
287	$INT,
288	$NEG_INT,
289	],
290	reject => [
291	$NUM,
292	$NEG_NUM,
293	$EMPTY_STRING,
294	$STRING,
295	$NUM_IN_STRING,
296	$SCALAR_REF,
297	$SCALAR_REF_REF,
298	$ARRAY_REF,
299	$HASH_REF,
300	$CODE_REF,
301	$GLOB,
302	$GLOB_REF,
303	$FH,
304	$FH_OBJECT,
305	$REGEX,
306	$REGEX_OBJ,
307	$OBJECT,
308	$UNDEF,
309	],
310	},
311	Str => {
312	accept => [
313	$ZERO,
314	$ONE,
315	$INT,
316	$NEG_INT,
317	$NUM,
318	$NEG_NUM,
319	$EMPTY_STRING,
320	$STRING,
321	$NUM_IN_STRING,
322	],
323	reject => [
324	$SCALAR_REF,
325	$SCALAR_REF_REF,
326	$ARRAY_REF,
327	$HASH_REF,
328	$CODE_REF,
329	$GLOB,
330	$GLOB_REF,
331	$FH,
332	$FH_OBJECT,
333	$REGEX,
334	$REGEX_OBJ,
335	$OBJECT,
336	$UNDEF,
337	],
338	},
339	ScalarRef => {
340	accept => [
341	$SCALAR_REF,
342	$SCALAR_REF_REF,
343	],
344	reject => [
345	$ZERO,
346	$ONE,
347	$INT,
348	$NEG_INT,
349	$NUM,
350	$NEG_NUM,
351	$EMPTY_STRING,
352	$STRING,
353	$NUM_IN_STRING,
354	$ARRAY_REF,
355	$HASH_REF,
356	$CODE_REF,
357	$GLOB,
358	$GLOB_REF,
359	$FH,
360	$FH_OBJECT,
361	$REGEX,
362	$REGEX_OBJ,
363	$OBJECT,
364	$UNDEF,
365	],
366	},
367	ArrayRef => {
368	accept => [
369	$ARRAY_REF,
370	],
371	reject => [
372	$ZERO,
373	$ONE,
374	$INT,
375	$NEG_INT,
376	$NUM,
377	$NEG_NUM,
378	$EMPTY_STRING,
379	$STRING,
380	$NUM_IN_STRING,
381	$SCALAR_REF,
382	$SCALAR_REF_REF,
383	$HASH_REF,
384	$CODE_REF,
385	$GLOB,
386	$GLOB_REF,
387	$FH,
388	$FH_OBJECT,
389	$REGEX,
390	$REGEX_OBJ,
391	$OBJECT,
392	$UNDEF,
393	],
394	},
395	HashRef => {
396	accept => [
397	$HASH_REF,
398	],
399	reject => [
400	$ZERO,
401	$ONE,
402	$INT,
403	$NEG_INT,
404	$NUM,
405	$NEG_NUM,
406	$EMPTY_STRING,
407	$STRING,
408	$NUM_IN_STRING,
409	$SCALAR_REF,
410	$SCALAR_REF_REF,
411	$ARRAY_REF,
412	$CODE_REF,
413	$GLOB,
414	$GLOB_REF,
415	$FH,
416	$FH_OBJECT,
417	$REGEX,
418	$REGEX_OBJ,
419	$OBJECT,
420	$UNDEF,
421	],
422	},
423	CodeRef => {
424	accept => [
425	$CODE_REF,
426	],
427	reject => [
428	$ZERO,
429	$ONE,
430	$INT,
431	$NEG_INT,
432	$NUM,
433	$NEG_NUM,
434	$EMPTY_STRING,
435	$STRING,
436	$NUM_IN_STRING,
437	$SCALAR_REF,
438	$SCALAR_REF_REF,
439	$ARRAY_REF,
440	$HASH_REF,
441	$GLOB,
442	$GLOB_REF,
443	$FH,
444	$FH_OBJECT,
445	$REGEX,
446	$REGEX_OBJ,
447	$OBJECT,
448	$UNDEF,
449	],
450	},
451	RegexpRef => {
452	accept => [
453	$REGEX,
454	$REGEX_OBJ,
455	],
456	reject => [
457	$ZERO,
458	$ONE,
459	$INT,
460	$NEG_INT,
461	$NUM,
462	$NEG_NUM,
463	$EMPTY_STRING,
464	$STRING,
465	$NUM_IN_STRING,
466	$SCALAR_REF,
467	$SCALAR_REF_REF,
468	$ARRAY_REF,
469	$HASH_REF,
470	$CODE_REF,
471	$GLOB,
472	$GLOB_REF,
473	$FH,
474	$FH_OBJECT,
475	$OBJECT,
476	$UNDEF,
477	],
478	},
479	GlobRef => {
480	accept => [
481	$GLOB_REF,
482	$FH,
483	],
484	reject => [
485	$ZERO,
486	$ONE,
487	$INT,
488	$NEG_INT,
489	$NUM,
490	$NEG_NUM,
491	$EMPTY_STRING,
492	$STRING,
493	$NUM_IN_STRING,
494	$SCALAR_REF,
495	$SCALAR_REF_REF,
496	$ARRAY_REF,
497	$HASH_REF,
498	$CODE_REF,
499	$GLOB,
500	$FH_OBJECT,
501	$OBJECT,
502	$REGEX,
503	$REGEX_OBJ,
504	$UNDEF,
505	],
506	},
507	FileHandle => {
508	accept => [
509	$FH,
510	$FH_OBJECT,
511	],
512	reject => [
513	$ZERO,
514	$ONE,
515	$INT,
516	$NEG_INT,
517	$NUM,
518	$NEG_NUM,
519	$EMPTY_STRING,
520	$STRING,
521	$NUM_IN_STRING,
522	$SCALAR_REF,
523	$SCALAR_REF_REF,
524	$ARRAY_REF,
525	$HASH_REF,
526	$CODE_REF,
527	$GLOB,
528	$GLOB_REF,
529	$OBJECT,
530	$REGEX,
531	$REGEX_OBJ,
532	$UNDEF,
533	],
534	},
535	Object => {
536	accept => [
537	$FH_OBJECT,
538	$REGEX,
539	$REGEX_OBJ,
540	$OBJECT,
541	],
542	reject => [
543	$ZERO,
544	$ONE,
545	$INT,
546	$NEG_INT,
547	$NUM,
548	$NEG_NUM,
549	$EMPTY_STRING,
550	$STRING,
551	$NUM_IN_STRING,
552	$SCALAR_REF,
553	$SCALAR_REF_REF,
554	$ARRAY_REF,
555	$HASH_REF,
556	$CODE_REF,
557	$GLOB,
558	$GLOB_REF,
559	$FH,
560	$UNDEF,
561	],
562	},
563	ClassName => {
564	accept => [
565	$CLASS_NAME,
566	$ROLE_NAME,
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	$FH_OBJECT,
587	$REGEX,
588	$REGEX_OBJ,
589	$OBJECT,
590	$UNDEF,
591	],
592	},
593	RoleName => {
594	accept => [
595	$ROLE_NAME,
596	],
597	reject => [
598	$CLASS_NAME,
599	$ZERO,
600	$ONE,
601	$INT,
602	$NEG_INT,
603	$NUM,
604	$NEG_NUM,
605	$EMPTY_STRING,
606	$STRING,
607	$NUM_IN_STRING,
608	$SCALAR_REF,
609	$SCALAR_REF_REF,
610	$ARRAY_REF,
611	$HASH_REF,
612	$CODE_REF,
613	$GLOB,
614	$GLOB_REF,
615	$FH,
616	$FH_OBJECT,
617	$REGEX,
618	$REGEX_OBJ,
619	$OBJECT,
620	$UNDEF,
621	],
622	},
623	);
624
625	for my $name ( sort keys %tests ) {
626	my $type = Moose::Util::TypeConstraints::find_type_constraint($name)
627	or BAIL_OUT("No such type $name!");
628
629	my $unoptimized
630	= $type->has_parent
631	? $type->_compile_subtype( $type->constraint )
632	: $type->_compile_type( $type->constraint );
633
634	my $inlined;
635	if ( $type->has_inlined_type_constraint ) {
636	local $@;
637	$inlined = eval 'sub { ( ' . $type->inlined->('$_[0]') . ' ) }';
638	die $@ if $@;
639	}
640
641	for my $accept ( @{ $tests{$name}{accept} \|\| [] } ) {
642	my $described = describe($accept);
643	ok(
644	$type->check($accept),
645	"$name accepts $described using ->check"
646	);
647	ok(
648	$unoptimized->($accept),
649	"$name accepts $described using unoptimized constraint"
650	);
651	if ($inlined) {
652	ok(
653	$inlined->($accept),
654	"$name accepts $described using inlined constraint"
655	);
656	}
657	}
658
659	for my $reject ( @{ $tests{$name}{reject} \|\| [] } ) {
660	my $described = describe($reject);
661	ok(
662	!$type->check($reject),
663	"$name rejects $described using ->check"
664	);
665	ok(
666	!$unoptimized->($reject),
667	"$name rejects $described using unoptimized constraint"
668	);
669	if ($inlined) {
670	ok(
671	!$inlined->($reject),
672	"$name rejects $described using inlined constraint"
673	);
674	}
675	}
676	}
677
678	# Test how $_ is used in XS implementation
7c29582b	679	{
94ab1609	680	local $_ = qr/./;
	681	ok(
	682	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	683	'$_ is RegexpRef'
	684	);
	685	ok(
	686	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
	687	'$_ is not read when param provided'
	688	);
	689
	690	$_ = bless qr/./, 'Blessed';
	691
	692	ok(
	693	Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	694	'$_ is RegexpRef'
	695	);
	696
	697	$_ = 42;
	698	ok(
	699	!Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
	700	'$_ is not RegexpRef'
	701	);
	702	ok(
	703	Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
	704	'$_ is not read when param provided'
	705	);
7c29582b	706	}
7c29582b	707
94ab1609	708	close $FH
	709	or warn "Could not close the filehandle $0 for test";
	710	$FH_OBJECT->close
	711	or warn "Could not close the filehandle $0 for test";
a28e50e4	712
a28e50e4	713	done_testing;
94ab1609	714
	715	sub describe {
	716	my $val = shift;
	717
	718	return 'undef' unless defined $val;
	719
	720	if ( !ref $val ) {
	721	return q{''} if $val eq q{};
	722	}
	723
	724	return $val unless ref $val;
	725
	726	return 'open filehandle'
	727	if openhandle $val && !blessed $val;
	728
	729	return ( ref $val ) . ' reference';
	730	}