The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;
use Test::More;
use Test::Fatal;

eval q{
	package Local::TypeLibrary;
	use Exporter 'import';
	use MooX::Types::MooseLike ();
	MooX::Types::MooseLike::register_types([{
		name    => 'Flibble',
		test    => sub { $_[0] =~ /^flibble$/i },
		message => sub { 'Unflibble' },
		inflate => sub {
			return Moose::Meta::TypeConstraint->new(
				name       => 'MooseFlibble',
				constraint => sub { $_[0] =~ /^flibble$/i },
			);
		},
	}], __PACKAGE__);
	$INC{'Local/TypeLibrary.pm'} = __FILE__;
	1;
} or die $@;

eval q{
	package Local::TestClass;
	use Moo;
	use Local::TypeLibrary 'Flibble';
	has flibble => (is => 'ro', isa => Flibble);
	1;
} or die $@;

is(
  exception { Local::TestClass->new(flibble => 'fliBBle') },
  undef,
  'value which should not violate type constraint',
  );

like(
  exception { Local::TestClass->new(flibble => 'monkey') },
  qr{^isa check for "flibble" failed: Unflibble},
  'value which should violate type constraint',
  );

eval q{ require Moose } or do {
  note "Moose not available; skipping actual inflation tests";
  done_testing;
  exit;
  };

is(
  exception { Local::TestClass->new(flibble => 'fliBBle') },
  undef,
  'Moose loaded; value which should not violate type constraint',
  );

like(
  exception { Local::TestClass->new(flibble => 'monkey') },
  qr{^isa check for "flibble" failed: Unflibble},
  'Moose loaded; value which should violate type constraint',
  );

my $tc = do {

  # Suppress distracting warnings from within Moose
  local $SIG{__WARN__} = sub { 0 };
  Local::TestClass->meta->get_attribute('flibble')->type_constraint;
  };

is(
  $tc->name,
  'MooseFlibble',
  'type constraint inflation results in custom type',
  );

ok($tc->check('Flibble'), 'Moose::Meta::TypeConstraint works (1)');
ok($tc->check('FLIBBLE'), 'Moose::Meta::TypeConstraint works (2)');
ok(!$tc->check('Monkey'), 'Moose::Meta::TypeConstraint works (3)');
ok(!$tc->check([]), 'Moose::Meta::TypeConstraint works (4)');

done_testing;