9 use Moose::Util::TypeConstraints ();
10 use Scalar::Util qw( blessed openhandle );
19 my $EMPTY_STRING = q{};
21 my $NUM_IN_STRING = 'has 42 in it';
23 my $SCALAR_REF = \( my $var );
24 my $SCALAR_REF_REF = \$SCALAR_REF;
27 my $CODE_REF = sub { };
29 no warnings 'once'; # << I *hates* that warning ...
31 my $GLOB_REF = \$GLOB;
33 open my $FH, '<', $0 or die "Could not open $0 for the test";
35 my $FH_OBJECT = IO::File->new( $0, 'r' )
36 or die "Could not open $0 for the test";
39 my $REGEX_OBJ = bless qr/../, 'BlessedQR';
41 my $OBJECT = bless {}, 'Foo';
51 my $CLASS_NAME = 'Thing';
60 my $ROLE_NAME = 'Role';
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!");
631 ? $type->_compile_subtype( $type->constraint )
632 : $type->_compile_type( $type->constraint );
635 if ( $type->has_inlined_type_constraint ) {
637 $inlined = eval 'sub { ( ' . $type->inlined->('$_[0]') . ' ) }';
641 for my $accept ( @{ $tests{$name}{accept} || [] } ) {
642 my $described = describe($accept);
644 $type->check($accept),
645 "$name accepts $described using ->check"
648 $unoptimized->($accept),
649 "$name accepts $described using unoptimized constraint"
654 "$name accepts $described using inlined constraint"
659 for my $reject ( @{ $tests{$name}{reject} || [] } ) {
660 my $described = describe($reject);
662 !$type->check($reject),
663 "$name rejects $described using ->check"
666 !$unoptimized->($reject),
667 "$name rejects $described using unoptimized constraint"
671 !$inlined->($reject),
672 "$name rejects $described using inlined constraint"
678 # Test how $_ is used in XS implementation
682 Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
686 !Moose::Util::TypeConstraints::Builtins::_RegexpRef(1),
687 '$_ is not read when param provided'
690 $_ = bless qr/./, 'Blessed';
693 Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
699 !Moose::Util::TypeConstraints::Builtins::_RegexpRef(),
700 '$_ is not RegexpRef'
703 Moose::Util::TypeConstraints::Builtins::_RegexpRef(qr/./),
704 '$_ is not read when param provided'
709 or warn "Could not close the filehandle $0 for test";
711 or warn "Could not close the filehandle $0 for test";
718 return 'undef' unless defined $val;
721 return q{''} if $val eq q{};
724 return $val unless ref $val;
726 return 'open filehandle'
727 if openhandle $val && !blessed $val;
729 return ( ref $val ) . ' reference';