view release on metacpan or  search on metacpan

lib/Types/TypeTiny.pm  view on Meta::CPAN

				my $paramname = Type::Tiny::XS::is_known( $check );
				$xsubname = defined($paramname)
					? Type::Tiny::XS::get_subname_for( "ArrayLike[$paramname]" )
					: undef;
			}
			sub {
				my $var  = pop;
				return "$xsubname($var)" if $xsubname && !$Type::Tiny::AvoidCallbacks;
				my $code = sprintf(
					'do { my $ok=1; for my $v (@{%s}) { ($ok=0,next) unless (%s) }; $ok }',
					$var,
					$param->inline_check( '$v' ),
				);
				return ( undef, $code );
			};
		},
		coercion_generator => sub {
			my ( $parent, $child, $param ) = @_;
			return unless $param->has_coercion;
			my $coercible = $param->coercion->_source_type_union->compiled_check;
			my $C         = "Type::Coercion"->new( type_constraint => $child );
			$C->add_type_coercions(
				$parent => sub {
					my $origref = @_ ? $_[0] : $_;
					my @orig    = @$origref;
					my @new;
					for my $v ( @orig ) {
						return $origref unless $coercible->( $v );
						push @new, $param->coerce( $v );
					}
					\@new;
				},
			);
			return $C;
		},
	);
	if ( __XS ) {
		my $xsub     = Type::Tiny::XS::get_coderef_for( 'ArrayLike' );
		my $xsubname = Type::Tiny::XS::get_subname_for( 'ArrayLike' );
		my $inlined  = $common{inlined};
		$cache{ArrayLike} = "Type::Tiny"->new(
			%common,
			compiled_type_constraint => $xsub,
			inlined                  => sub {
			
				# uncoverable subroutine
				( $Type::Tiny::AvoidCallbacks or not $xsubname )
					? goto( $inlined )
					: qq/$xsubname($_[1])/    # uncoverable statement
			},
		);
		_reinstall_subs $cache{ArrayLike};
	} #/ if ( __XS )
	else {
		$cache{ArrayLike} = "Type::Tiny"->new( %common );
	}
	
	@_ ? $cache{ArrayLike}->parameterize( @{ $_[0] } ) : $cache{ArrayLike};
} #/ sub ArrayLike (;@)

if ( $] ge '5.014' ) {
	&Scalar::Util::set_prototype( $_, ';$' ) for \&HashLike, \&ArrayLike;
}

sub CodeLike () {
	return $cache{CodeLike} if $cache{CodeLike};
	require Type::Tiny;
	my %common = (
		name       => "CodeLike",
		constraint => sub {
			ref( $_ ) eq q[CODE]
				or blessed( $_ ) && _check_overload( $_, q[&{}] );
		},
		inlined => sub {
			qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\&{}])/;
		},
		type_default => sub { return sub {} },
		library => __PACKAGE__,
	);
	if ( __XS ) {
		my $xsub     = Type::Tiny::XS::get_coderef_for( 'CodeLike' );
		my $xsubname = Type::Tiny::XS::get_subname_for( 'CodeLike' );
		my $inlined  = $common{inlined};
		$cache{CodeLike} = "Type::Tiny"->new(
			%common,
			compiled_type_constraint => $xsub,
			inlined                  => sub {
			
				# uncoverable subroutine
				( $Type::Tiny::AvoidCallbacks or not $xsubname )
					? goto( $inlined )
					: qq/$xsubname($_[1])/    # uncoverable statement
			},
		);
		_reinstall_subs $cache{CodeLike};
	} #/ if ( __XS )
	else {
		$cache{CodeLike} = "Type::Tiny"->new( %common );
	}
} #/ sub CodeLike

sub BoolLike () {
	return $cache{BoolLike} if $cache{BoolLike};
	require Type::Tiny;
	$cache{BoolLike} = "Type::Tiny"->new(
		name       => "BoolLike",
		constraint => sub {
			!defined( $_ )
				or !ref( $_ ) && ( $_ eq '' || $_ eq '0' || $_ eq '1' )
				or blessed( $_ ) && (
					_check_overload( $_, q[bool] )
					or _check_overload( $_, q[0+] ) && do { my $n = sprintf('%d', $_); $n==0 or $n==1 }
					or do { my $d = $_->can('DOES') || $_->can('isa'); $_->$d('boolean') }
				)
		},
		inlined => sub {
			qq/do {
				local \$_ = $_;
				!defined()
					or !ref() && ( \$_ eq '' || \$_ eq '0' || \$_ eq '1' )
					or Scalar::Util::blessed(\$_) && (