├── .github ├── CONTRIBUTING.md ├── FUNDING.yml ├── README.md ├── SECURITY.md └── workflows │ ├── ci.ini │ └── ci.yml ├── .hgtags ├── CONTRIBUTING ├── NEWS ├── devel.maint-scripts ├── add-tests.pl └── type-index.pl ├── dist.ini ├── examples ├── benchmarking │ ├── benchmark-coercions.pl │ ├── benchmark-constraints.pl │ ├── benchmark-named-param-validation.pl │ ├── benchmark-param-validation.pl │ └── versus-scalar-validation.pl ├── datetime-coercions.pl ├── jsoncapable.pl ├── nonempty.pl └── page-numbers.pl ├── inc ├── Test │ ├── Fatal.pm │ └── Requires.pm ├── Try │ └── Tiny.pm ├── archaic │ └── Test │ │ ├── Builder.pm │ │ ├── Builder │ │ ├── IO │ │ │ └── Scalar.pm │ │ ├── Module.pm │ │ ├── Tester.pm │ │ └── Tester │ │ │ └── Color.pm │ │ ├── More.pm │ │ └── Simple.pm └── boolean.pm ├── lib ├── Devel │ └── TypeTiny │ │ └── Perl58Compat.pm ├── Error │ ├── TypeTiny.pm │ └── TypeTiny │ │ ├── Assertion.pm │ │ ├── Compilation.pm │ │ └── WrongNumberOfParameters.pm ├── Eval │ ├── TypeTiny.pm │ └── TypeTiny │ │ └── CodeAccumulator.pm ├── Reply │ └── Plugin │ │ └── TypeTiny.pm ├── Test │ └── TypeTiny.pm ├── Type │ ├── Coercion.pm │ ├── Coercion │ │ ├── FromMoose.pm │ │ └── Union.pm │ ├── Library.pm │ ├── Params.pm │ ├── Params │ │ ├── Alternatives.pm │ │ ├── Parameter.pm │ │ └── Signature.pm │ ├── Parser.pm │ ├── Registry.pm │ ├── Tie.pm │ ├── Tiny.pm │ ├── Tiny │ │ ├── Bitfield.pm │ │ ├── Class.pm │ │ ├── ConstrainedObject.pm │ │ ├── Duck.pm │ │ ├── Enum.pm │ │ ├── Intersection.pm │ │ ├── Manual.pod │ │ ├── Manual │ │ │ ├── AllTypes.pod │ │ │ ├── Coercions.pod │ │ │ ├── Contributing.pod │ │ │ ├── Installation.pod │ │ │ ├── Libraries.pod │ │ │ ├── NonOO.pod │ │ │ ├── Optimization.pod │ │ │ ├── Params.pod │ │ │ ├── Policies.pod │ │ │ ├── UsingWithClassTiny.pod │ │ │ ├── UsingWithMite.pod │ │ │ ├── UsingWithMoo.pod │ │ │ ├── UsingWithMoo2.pod │ │ │ ├── UsingWithMoo3.pod │ │ │ ├── UsingWithMoose.pod │ │ │ ├── UsingWithMouse.pod │ │ │ ├── UsingWithOther.pod │ │ │ └── UsingWithTestMore.pod │ │ ├── Role.pm │ │ ├── Union.pm │ │ ├── _DeclaredType.pm │ │ └── _HalfOp.pm │ └── Utils.pm └── Types │ ├── Common.pm │ ├── Common │ ├── Numeric.pm │ └── String.pm │ ├── Standard.pm │ ├── Standard │ ├── ArrayRef.pm │ ├── CycleTuple.pm │ ├── Dict.pm │ ├── HashRef.pm │ ├── Map.pm │ ├── ScalarRef.pm │ ├── StrMatch.pm │ ├── Tied.pm │ └── Tuple.pm │ └── TypeTiny.pm ├── meta ├── DYNAMIC_CONFIG.PL ├── changes.pret ├── doap.pret ├── makefile.pret ├── people.pret ├── rights.pret ├── rt-bugs.ttl └── testcases.pret ├── t ├── 00-begin.t ├── 01-compile.t ├── 02-api.t ├── 03-leak.t ├── 20-modules │ ├── Devel-TypeTiny-Perl58Compat │ │ └── basic.t │ ├── Error-TypeTiny-Assertion │ │ └── basic.t │ ├── Error-TypeTiny-Compilation │ │ └── basic.t │ ├── Error-TypeTiny-WrongNumberOfParameters │ │ └── basic.t │ ├── Error-TypeTiny │ │ ├── basic.t │ │ └── stacktrace.t │ ├── Eval-TypeTiny-CodeAccumulator │ │ ├── basic.t │ │ └── callback.t │ ├── Eval-TypeTiny │ │ ├── aliases-devel-lexalias.t │ │ ├── aliases-native.t │ │ ├── aliases-padwalker.t │ │ ├── aliases-tie.t │ │ ├── basic.t │ │ └── lexical-subs.t │ ├── Test-TypeTiny │ │ ├── basic.t │ │ ├── extended.t │ │ └── matchfor.t │ ├── Type-Coercion-FromMoose │ │ ├── basic.t │ │ └── errors.t │ ├── Type-Coercion-Union │ │ └── basic.t │ ├── Type-Coercion │ │ ├── basic.t │ │ ├── esoteric.t │ │ ├── frozen.t │ │ ├── inlining.t │ │ ├── parameterized.t │ │ ├── smartmatch.t │ │ └── typetiny-constructor.t │ ├── Type-Library │ │ ├── assert.t │ │ ├── declared-types.t │ │ ├── deprecation.t │ │ ├── errors.t │ │ ├── exportables-duplicated.t │ │ ├── exportables.t │ │ ├── import-params.t │ │ ├── inheritance.t │ │ ├── is.t │ │ ├── own-registry.t │ │ ├── recursive-type-definitions.t │ │ ├── remove-type.t │ │ ├── to.t │ │ └── types.t │ ├── Type-Params-Signature │ │ └── basic.t │ ├── Type-Params │ │ ├── alias.t │ │ ├── badsigs.t │ │ ├── carping.t │ │ ├── clone.t │ │ ├── coerce.t │ │ ├── compile-named-avoidcallbacks.t │ │ ├── compile-named-bless.t │ │ ├── compile-named-oo-pp.t │ │ ├── compile-named-oo.t │ │ ├── compile-named.t │ │ ├── defaults.t │ │ ├── goto_next.t │ │ ├── hashorder.t │ │ ├── methods.t │ │ ├── mixednamed.t │ │ ├── multisig-custom-message.t │ │ ├── multisig-gotonext.t │ │ ├── multisig.t │ │ ├── named-to-list.t │ │ ├── named.t │ │ ├── noninline.t │ │ ├── on-die.t │ │ ├── optional.t │ │ ├── positional.t │ │ ├── slurpy.t │ │ ├── strictness.t │ │ ├── v2-allowdash.t │ │ ├── v2-default-on-undef.t │ │ ├── v2-defaults.t │ │ ├── v2-delayed-compilation.t │ │ ├── v2-exceptions.t │ │ ├── v2-fallback.t │ │ ├── v2-listtonamed.t │ │ ├── v2-multi.t │ │ ├── v2-named-backcompat.t │ │ ├── v2-named-plus-slurpy.t │ │ ├── v2-named.t │ │ ├── v2-positional-backcompat.t │ │ ├── v2-positional-plus-slurpy.t │ │ ├── v2-positional.t │ │ ├── v2-returns.t │ │ ├── v2-shortcuts.t │ │ ├── v2-warnings.t │ │ ├── v2-wrap-inherited-method.t │ │ └── wrap.t │ ├── Type-Parser │ │ ├── basic.t │ │ └── moosextypes.t │ ├── Type-Registry │ │ ├── automagic.t │ │ ├── basic.t │ │ ├── methods.t │ │ ├── moosextypes.t │ │ ├── mousextypes.t │ │ ├── parent.t │ │ └── refcount.t │ ├── Type-Tie │ │ ├── 01basic.t │ │ ├── 02moosextypes.t │ │ ├── 03prototypicalweirdness.t │ │ ├── 04nots.t │ │ ├── 05typetiny.t │ │ ├── 06clone.t │ │ ├── 06storable.t │ │ ├── basic.t │ │ └── very-minimal.t │ ├── Type-Tiny-Bitfield │ │ ├── basic.t │ │ ├── errors.t │ │ ├── import-options.t │ │ └── plus.t │ ├── Type-Tiny-Class │ │ ├── basic.t │ │ ├── errors.t │ │ ├── exporter.t │ │ ├── exporter_with_options.t │ │ └── plus-constructors.t │ ├── Type-Tiny-ConstrainedObject │ │ └── basic.t │ ├── Type-Tiny-Duck │ │ ├── basic.t │ │ ├── cmp.t │ │ ├── errors.t │ │ └── exporter.t │ ├── Type-Tiny-Enum │ │ ├── basic.t │ │ ├── cmp.t │ │ ├── errors.t │ │ ├── exporter.t │ │ ├── exporter_lexical.t │ │ ├── sorter.t │ │ └── union_intersection.t │ ├── Type-Tiny-Intersection │ │ ├── basic.t │ │ ├── cmp.t │ │ ├── constrainedobject.t │ │ └── errors.t │ ├── Type-Tiny-Role │ │ ├── basic.t │ │ ├── errors.t │ │ └── exporter.t │ ├── Type-Tiny-Union │ │ ├── basic.t │ │ ├── constrainedobject.t │ │ ├── errors.t │ │ └── relationships.t │ ├── Type-Tiny-_HalfOp │ │ ├── double-union.t │ │ ├── extra-params.t │ │ └── overload-precedence.t │ ├── Type-Tiny │ │ ├── arithmetic.t │ │ ├── basic.t │ │ ├── cmp.t │ │ ├── coercion-modifiers.t │ │ ├── constraint-strings.t │ │ ├── custom-exception-classes.t │ │ ├── definition-context.t │ │ ├── deprecation.t │ │ ├── esoteric.t │ │ ├── inline-assert.t │ │ ├── list-methods.t │ │ ├── my-methods.t │ │ ├── parameterization.t │ │ ├── refcount.t │ │ ├── shortcuts.t │ │ ├── smartmatch.t │ │ ├── strictmode-off.t │ │ ├── strictmode-on.t │ │ ├── syntax.t │ │ ├── to-moose.t │ │ ├── to-mouse.t │ │ └── type_default.t │ ├── Type-Utils │ │ ├── auto-registry.t │ │ ├── classifier.t │ │ ├── dwim-both.t │ │ ├── dwim-moose.t │ │ ├── dwim-mouse.t │ │ ├── is.t │ │ ├── match-on-type.t │ │ └── warnings.t │ ├── Types-Common-Numeric │ │ ├── basic.t │ │ ├── immutable.t │ │ └── ranges.t │ ├── Types-Common-String │ │ ├── basic.t │ │ ├── coerce.t │ │ ├── immutable.t │ │ ├── strlength.t │ │ └── unicode.t │ ├── Types-Common │ │ ├── basic.t │ │ └── immutable.t │ ├── Types-Standard-ArrayRef │ │ └── exporter.t │ ├── Types-Standard-CycleTuple │ │ └── exporter.t │ ├── Types-Standard-Dict │ │ └── exporter.t │ ├── Types-Standard-HashRef │ │ └── exporter.t │ ├── Types-Standard-Map │ │ └── exporter.t │ ├── Types-Standard-ScalarRef │ │ └── exporter.t │ ├── Types-Standard-StrMatch │ │ └── exporter.t │ ├── Types-Standard-Tuple │ │ └── exporter.t │ ├── Types-Standard │ │ ├── arrayreflength.t │ │ ├── basic.t │ │ ├── cycletuple.t │ │ ├── deep-coercions.t │ │ ├── filehandle.t │ │ ├── immutable.t │ │ ├── lockdown.t │ │ ├── mxtmlb-alike.t │ │ ├── optlist.t │ │ ├── overload.t │ │ ├── strmatch-allow-callbacks.t │ │ ├── strmatch-avoid-callbacks.t │ │ ├── strmatch.t │ │ ├── structured.t │ │ └── tied.t │ └── Types-TypeTiny │ │ ├── basic.t │ │ ├── coercion.t │ │ ├── meta.t │ │ ├── moosemouse.t │ │ ├── progressiveexporter.t │ │ └── type-puny.t ├── 21-types │ ├── Any.t │ ├── ArrayLike.t │ ├── ArrayRef.t │ ├── Bool.t │ ├── BoolLike.t │ ├── ClassName.t │ ├── CodeLike.t │ ├── CodeRef.t │ ├── ConsumerOf.t │ ├── CycleTuple.t │ ├── Defined.t │ ├── DelimitedStr.t │ ├── Dict.t │ ├── Enum.t │ ├── FileHandle.t │ ├── GlobRef.t │ ├── HasMethods.t │ ├── HashLike.t │ ├── HashRef.t │ ├── InstanceOf.t │ ├── Int.t │ ├── IntRange.t │ ├── Item.t │ ├── LaxNum.t │ ├── LowerCaseSimpleStr.t │ ├── LowerCaseStr.t │ ├── Map.t │ ├── Maybe.t │ ├── NegativeInt.t │ ├── NegativeNum.t │ ├── NegativeOrZeroInt.t │ ├── NegativeOrZeroNum.t │ ├── NonEmptySimpleStr.t │ ├── NonEmptyStr.t │ ├── Num.t │ ├── NumRange.t │ ├── NumericCode.t │ ├── Object.t │ ├── OptList.t │ ├── Optional.t │ ├── Overload.t │ ├── Password.t │ ├── PositiveInt.t │ ├── PositiveNum.t │ ├── PositiveOrZeroInt.t │ ├── PositiveOrZeroNum.t │ ├── Ref.t │ ├── RegexpRef.t │ ├── RoleName.t │ ├── ScalarRef.t │ ├── SimpleStr.t │ ├── SingleDigit.t │ ├── Slurpy.t │ ├── Str.t │ ├── StrLength.t │ ├── StrMatch-more.t │ ├── StrMatch.t │ ├── StrictNum.t │ ├── StringLike.t │ ├── StrongPassword.t │ ├── Tied.t │ ├── Tuple.t │ ├── TypeTiny.t │ ├── Undef.t │ ├── UpperCaseSimpleStr.t │ ├── UpperCaseStr.t │ ├── Value.t │ └── _ForeignTypeConstraint.t ├── 30-external │ ├── Class-InsideOut │ │ └── basic.t │ ├── Class-Plain │ │ ├── basic.t │ │ └── multisig.t │ ├── Data-Constraint │ │ └── basic.t │ ├── Exporter-Tiny │ │ ├── basic.t │ │ ├── installer.t │ │ └── role-conflict.t │ ├── Function-Parameters │ │ └── basic.t │ ├── JSON-PP │ │ └── basic.t │ ├── Kavorka │ │ ├── 80returntype.t │ │ └── basic.t │ ├── Moo │ │ ├── basic.t │ │ ├── coercion-inlining-avoidance.t │ │ ├── coercion.t │ │ ├── exceptions.t │ │ ├── inflation.t │ │ └── inflation2.t │ ├── Moops │ │ ├── basic.t │ │ └── library-keyword.t │ ├── Moose │ │ ├── accept-moose-types.t │ │ ├── basic.t │ │ ├── coercion-more.t │ │ ├── coercion.t │ │ ├── inflate-then-inline.t │ │ ├── native-attribute-traits.t │ │ └── parameterized.t │ ├── MooseX-Getopt │ │ └── coercion.t │ ├── MooseX-Types │ │ ├── basic.t │ │ ├── extending.t │ │ └── more.t │ ├── Mouse │ │ ├── basic.t │ │ ├── coercion.t │ │ └── parameterized.t │ ├── MouseX-Types │ │ ├── basic.t │ │ └── extending.t │ ├── Object-Accessor │ │ └── basic.t │ ├── Return-Type │ │ └── basic.t │ ├── Specio │ │ ├── basic.t │ │ └── library.t │ ├── Sub-Quote │ │ ├── basic.t │ │ ├── delayed-quoting.t │ │ ├── unquote-coercions.t │ │ └── unquote-constraints.t │ ├── Switcheroo │ │ └── basic.t │ ├── Type-Library-Compiler │ │ └── basic.t │ ├── Types-ReadOnly │ │ └── basic.t │ ├── Validation-Class-Simple │ │ ├── archaic.t │ │ └── basic.t │ └── match-simple │ │ └── basic.t ├── 40-bugs │ ├── 73f51e2d.pl │ ├── 73f51e2d.t │ ├── gh1.t │ ├── gh14.t │ ├── gh140.t │ ├── gh143.t │ ├── gh158.t │ ├── gh80.t │ ├── gh96.t │ ├── hg166.t │ ├── rt102748.t │ ├── rt104154.t │ ├── rt121763.t │ ├── rt125132.t │ ├── rt125765.t │ ├── rt129729.t │ ├── rt130823.t │ ├── rt131401.t │ ├── rt131576.t │ ├── rt133141.t │ ├── rt85911.t │ ├── rt86004.t │ ├── rt86233.t │ ├── rt86239.t │ ├── rt90096-2.t │ ├── rt90096.t │ ├── rt92571-2.t │ ├── rt92571.t │ ├── rt92591.t │ ├── rt94196.t │ ├── rt97684.t │ ├── rt98113.t │ └── ttxs-gh1.t ├── 98-param-eg-from-docs.t ├── 99-moose-std-types-test.t ├── README ├── lib │ ├── BiggerLib.pm │ ├── CompiledLib.pm │ ├── DemoLib.pm │ └── Type │ │ └── Puny.pm ├── mk-test-manifest.pl └── not-covered.pl └── xt ├── rt86172.t └── synopsis.t /.github/CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to Type-Tiny 2 | 3 | General guide to contributing to my open-source projects: 4 | https://toby.ink/open-source/contributing 5 | 6 | Pull request link: 7 | https://github.com/tobyink/p5-type-tiny/pulls 8 | 9 | Issue tracker link: 10 | https://rt.cpan.org/Dist/Display.html?Queue=Type-Tiny 11 | -------------------------------------------------------------------------------- /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: tobyink 2 | ko_fi: tobyink 3 | custom: ['https://paypal.me/tobyink'] 4 | -------------------------------------------------------------------------------- /.github/README.md: -------------------------------------------------------------------------------- 1 | # Type-Tiny 2 | 3 | [![MetaCPAN](https://img.shields.io/cpan/v/Type-Tiny.svg)](https://metacpan.org/release/Type-Tiny) 4 | [![Licence](https://img.shields.io/cpan/l/Type-Tiny)](https://metacpan.org/dist/Type-Tiny/source/LICENSE) 5 | [![Issues](https://img.shields.io/github/issues/tobyink/p5-type-tiny)](https://github.com/tobyink/p5-type-tiny/issues) 6 | [![CI](https://github.com/tobyink/p5-type-tiny/workflows/CI/badge.svg)](https://github.com/tobyink/p5-type-tiny/actions) 7 | [![Coveralls](https://coveralls.io/repos/tobyink/p5-type-tiny/badge.svg?branch=master&service=github)](https://coveralls.io/github/tobyink/p5-type-tiny) 8 | [![Codecov](https://codecov.io/gh/tobyink/p5-type-tiny/branch/master/graph/badge.svg)](https://codecov.io/gh/tobyink/p5-type-tiny) 9 | 10 | Perl 5 distribution Type-Tiny; see [homepage](https://typetiny.toby.ink/) 11 | for downloads and documentation. 12 | 13 | Directly installing from GitHub is not recommened; download the distribution 14 | from the CPAN. 15 | 16 | ## Issues 17 | 18 | Please report any issues via [GitHub Issues](https://github.com/tobyink/p5-type-tiny/issues). 19 | 20 | ## Contributing 21 | 22 | [Contributing guidelines](https://toby.ink/open-source/contributing/). 23 | 24 | ## Support this project 25 | 26 | [Sponsor tobyink on GitHub Sponsors](https://github.com/sponsors/tobyink). 27 | -------------------------------------------------------------------------------- /.github/SECURITY.md: -------------------------------------------------------------------------------- 1 | # Type-Tiny Security Policy 2 | 3 | The [latest stable release on CPAN](https://metacpan.org/release/Type-Tiny) 4 | is supported for security updates. (By convention, releases with an underscore 5 | in their version number are not considered to be stable releases.) 6 | 7 | If you are using an older release, you are advised to upgrade. 8 | 9 | A list of changes between versions can be found in 10 | [the Changes file on CPAN](https://metacpan.org/changes/distribution/Type-Tiny) 11 | with security-related changes tagged "SECURITY" in capital letters. 12 | 13 | ## Reporting a Vulnerability 14 | 15 | Please report any issues via [GitHub Issues](https://github.com/tobyink/p5-type-tiny/issues). 16 | 17 | If you are concerned that some of the details of your report may lead to an 18 | exploit being made public, then keep your issue report vague, and email the 19 | details to me directly. My email address can be found on my 20 | [GitHub profile](https://github.com/tobyink). 21 | -------------------------------------------------------------------------------- /CONTRIBUTING: -------------------------------------------------------------------------------- 1 | See lib/Type/Tiny/Manual/Contributing.pod 2 | -------------------------------------------------------------------------------- /devel.maint-scripts/add-tests.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Path::Tiny qw( path ); 6 | 7 | # bleh => 'regexp' => qr/./, 8 | my $new = <<'NEW_LINES'; 9 | fail => 'boolean::false' => boolean::false, 10 | fail => 'boolean::true' => boolean::true, 11 | fail => 'builtin::false' => do { builtin->can('false') ? builtin::false() : !!0 }, 12 | fail => 'builtin::true' => do { builtin->can('true') ? builtin::true() : !!1 }, 13 | NEW_LINES 14 | 15 | my $dir = path('t/21-types/'); 16 | for my $file ($dir->children) { 17 | my @lines = map { 18 | $_ =~ /^#TESTS/ ? ($new, $_) : $_ 19 | } $file->lines_utf8; 20 | $file->spew_utf8(@lines); 21 | } 22 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | ;; class = 'Dist::Inkt::Profile::TOBYINK' 2 | ;; name = 'Type-Tiny' 3 | ;; source_for_readme = 'lib/Type/Tiny/Manual.pod' 4 | -------------------------------------------------------------------------------- /examples/jsoncapable.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use feature 'say'; 4 | 5 | BEGIN { 6 | package My::Types; 7 | use Type::Library 1.012 8 | -utils, 9 | -extends => [ 'Types::Standard' ], 10 | -declare => 'JSONCapable'; 11 | 12 | declare JSONCapable, 13 | as Undef 14 | | ScalarRef[ Enum[ 0..1 ] ] 15 | | Num 16 | | Str 17 | | ArrayRef[ JSONCapable ] 18 | | HashRef[ JSONCapable ] 19 | ; 20 | } 21 | 22 | use My::Types 'is_JSONCapable'; 23 | 24 | my $var = { 25 | foo => 1, 26 | bar => [ \0, "baz", [] ], 27 | }; 28 | 29 | say is_JSONCapable $var; 30 | -------------------------------------------------------------------------------- /examples/nonempty.pl: -------------------------------------------------------------------------------- 1 | use v5.14; 2 | use strict; 3 | use warnings; 4 | 5 | package Example1 { 6 | use Moo; 7 | use Sub::Quote 'quote_sub'; 8 | use Types::Standard -types; 9 | 10 | has my_string => ( 11 | is => 'ro', 12 | isa => Str->where( 'length($_) > 0' ), 13 | ); 14 | 15 | has my_array => ( 16 | is => 'ro', 17 | isa => ArrayRef->where( '@$_ > 0' ), 18 | ); 19 | 20 | has my_hash => ( 21 | is => 'ro', 22 | isa => HashRef->where( 'keys(%$_) > 0' ), 23 | ); 24 | } 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | is( 30 | exception { Example1::->new( my_string => 'u' ) }, 31 | undef, 32 | 'non-empty string, okay', 33 | ); 34 | 35 | isa_ok( 36 | exception { Example1::->new( my_string => '' ) }, 37 | 'Error::TypeTiny', 38 | 'result of empty string', 39 | ); 40 | 41 | is( 42 | exception { Example1::->new( my_array => [undef] ) }, 43 | undef, 44 | 'non-empty arrayref, okay', 45 | ); 46 | 47 | isa_ok( 48 | exception { Example1::->new( my_array => [] ) }, 49 | 'Error::TypeTiny', 50 | 'result of empty arrayref', 51 | ); 52 | 53 | is( 54 | exception { Example1::->new( my_hash => { '' => undef } ) }, 55 | undef, 56 | 'non-empty hashref, okay', 57 | ); 58 | 59 | isa_ok( 60 | exception { Example1::->new( my_hash => +{} ) }, 61 | 'Error::TypeTiny', 62 | 'result of empty hashref', 63 | ); 64 | 65 | done_testing; 66 | -------------------------------------------------------------------------------- /inc/Test/Fatal.pm: -------------------------------------------------------------------------------- 1 | #line 1 2 | use strict; 3 | use warnings; 4 | package Test::Fatal; 5 | { 6 | $Test::Fatal::VERSION = '0.010'; 7 | } 8 | # ABSTRACT: incredibly simple helpers for testing code with exceptions 9 | 10 | 11 | use Carp (); 12 | use Try::Tiny 0.07; 13 | 14 | use base 'Exporter'; 15 | 16 | our @EXPORT = qw(exception); 17 | our @EXPORT_OK = qw(exception success dies_ok lives_ok); 18 | 19 | 20 | sub exception (&) { 21 | my $code = shift; 22 | 23 | return try { 24 | $code->(); 25 | return undef; 26 | } catch { 27 | return $_ if $_; 28 | 29 | my $problem = defined $_ ? 'false' : 'undef'; 30 | Carp::confess("$problem exception caught by Test::Fatal::exception"); 31 | }; 32 | } 33 | 34 | 35 | sub success (&;@) { 36 | my $code = shift; 37 | return finally( sub { 38 | return if @_; # <-- only run on success 39 | $code->(); 40 | }, @_ ); 41 | } 42 | 43 | 44 | my $Tester; 45 | 46 | # Signature should match that of Test::Exception 47 | sub dies_ok (&;$) { 48 | my $code = shift; 49 | my $name = shift; 50 | 51 | require Test::Builder; 52 | $Tester ||= Test::Builder->new; 53 | 54 | my $ok = $Tester->ok( exception( \&$code ), $name ); 55 | $ok or $Tester->diag( "expected an exception but none was raised" ); 56 | return $ok; 57 | } 58 | 59 | sub lives_ok (&;$) { 60 | my $code = shift; 61 | my $name = shift; 62 | 63 | require Test::Builder; 64 | $Tester ||= Test::Builder->new; 65 | 66 | my $ok = $Tester->ok( !exception( \&$code ), $name ); 67 | $ok or $Tester->diag( "expected return but an exception was raised" ); 68 | return $ok; 69 | } 70 | 71 | 1; 72 | 73 | __END__ 74 | #line 212 75 | 76 | -------------------------------------------------------------------------------- /inc/archaic/Test/Builder/Tester/Color.pm: -------------------------------------------------------------------------------- 1 | package Test::Builder::Tester::Color; 2 | 3 | use strict; 4 | our $VERSION = "1.22"; 5 | 6 | require Test::Builder::Tester; 7 | 8 | 9 | =head1 NAME 10 | 11 | Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester 12 | 13 | =head1 SYNOPSIS 14 | 15 | When running a test script 16 | 17 | perl -MTest::Builder::Tester::Color test.t 18 | 19 | =head1 DESCRIPTION 20 | 21 | Importing this module causes the subroutine color in Test::Builder::Tester 22 | to be called with a true value causing colour highlighting to be turned 23 | on in debug output. 24 | 25 | The sole purpose of this module is to enable colour highlighting 26 | from the command line. 27 | 28 | =cut 29 | 30 | sub import { 31 | Test::Builder::Tester::color(1); 32 | } 33 | 34 | =head1 AUTHOR 35 | 36 | Copyright Mark Fowler Emark@twoshortplanks.comE 2002. 37 | 38 | This program is free software; you can redistribute it 39 | and/or modify it under the same terms as Perl itself. 40 | 41 | =head1 BUGS 42 | 43 | This module will have no effect unless Term::ANSIColor is installed. 44 | 45 | =head1 SEE ALSO 46 | 47 | L, L 48 | 49 | =cut 50 | 51 | 1; 52 | -------------------------------------------------------------------------------- /lib/Devel/TypeTiny/Perl58Compat.pm: -------------------------------------------------------------------------------- 1 | # INTERNAL MODULE: Perl 5.8 compatibility for Type::Tiny. 2 | 3 | package Devel::TypeTiny::Perl58Compat; 4 | 5 | use 5.008; 6 | use strict; 7 | use warnings; 8 | 9 | our $AUTHORITY = 'cpan:TOBYINK'; 10 | our $VERSION = '2.008002'; 11 | 12 | $VERSION =~ tr/_//d; 13 | 14 | #### re doesn't provide is_regexp in Perl < 5.10 15 | 16 | eval 'require re'; 17 | 18 | unless ( exists &re::is_regexp ) { 19 | require B; 20 | *re::is_regexp = sub { 21 | eval { B::svref_2object( $_[0] )->MAGIC->TYPE eq 'r' }; 22 | }; 23 | } 24 | 25 | #### Done! 26 | 27 | 5.8; 28 | -------------------------------------------------------------------------------- /meta/DYNAMIC_CONFIG.PL: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | no warnings 'uninitialized'; 4 | 5 | # Old versions of Perl come with old versions of Exporter. 6 | # Not that we use Exporter a whole lot anyway. 7 | if ( $] lt 5.009001 ) { 8 | $meta->{prereqs}{runtime}{requires}{'Exporter'} = '5.57'; 9 | } 10 | 11 | my $extended_testing = 0; 12 | if ( $ENV{EXTENDED_TESTING} and $] ge '5.008009' ) { 13 | ++$extended_testing if $meta->{version} =~ /_/; 14 | ++$extended_testing if $ENV{TRAVIS}; 15 | } 16 | 17 | if ( $ENV{MINIMAL_INSTALL} ) { 18 | $extended_testing = 0; 19 | for my $stage ( qw( runtime test ) ) { 20 | delete $meta->{prereqs}{$stage}{recommends}; 21 | delete $meta->{prereqs}{$stage}{suggests}; 22 | } 23 | } 24 | 25 | if ( $extended_testing ) { 26 | $meta->{prereqs}{test}{requires}{'Moose'} = '2.0600'; 27 | $meta->{prereqs}{test}{requires}{$_} = '0' 28 | for qw( 29 | bareword::filehandles 30 | Class::InsideOut 31 | Class::XSAccessor 32 | Devel::LexAlias 33 | Devel::Refcount 34 | indirect 35 | match::simple 36 | Moo 37 | MooseX::Getopt 38 | MooseX::Types::Common 39 | Mouse 40 | MouseX::Types::Common 41 | multidimensional 42 | Object::Accessor 43 | PadWalker 44 | Return::Type 45 | strictures 46 | Test::Fatal 47 | Test::LeakTrace 48 | Test::Requires 49 | Test::Tester 50 | Test::Warnings 51 | ); 52 | if ( $] ge '5.028' ) { 53 | $meta->{prereqs}{test}{requires}{$_} = '0' 54 | for qw( 55 | Validation::Class::Simple 56 | ); 57 | } 58 | } 59 | 60 | if ( $ENV{AUTOMATED_TESTING} and "$^V" =~ /c$/ ) { 61 | print "cperl unsupported by test suite (the vast majority of the distribution should still work)\n"; 62 | exit(0); 63 | } 64 | -------------------------------------------------------------------------------- /meta/doap.pret: -------------------------------------------------------------------------------- 1 | # This file contains general metadata about the project. 2 | 3 | @prefix : . 4 | @prefix cpant: . 5 | 6 | `Type-Tiny` 7 | :programming-language "Perl" ; 8 | :shortdesc "tiny, yet Moo(se)-compatible type constraint"; 9 | :homepage ; 10 | :download-page ; 11 | :bug-database ; 12 | :repository [ a :GitRepository; :browse ]; 13 | :created 2013-03-23; 14 | :license ; 15 | :maintainer cpan:TOBYINK; 16 | :developer cpan:TOBYINK; 17 | foaf:page 18 | , 19 | , 20 | , 21 | , 22 | , 23 | , 24 | , 25 | , 26 | ; 27 | :category 28 | [ label "Moo" ], 29 | [ label "Moose" ], 30 | [ label "Mouse" ], 31 | [ label "Type Constraint" ], 32 | [ label "Type Coercion" ], 33 | [ label "Type Library" ], 34 | [ label "Schema" ], 35 | [ label "Parameter Validation" ], 36 | [ label "Parameter Checking" ], 37 | [ label "Argument Validation" ], 38 | [ label "Argument Checking" ], 39 | [ label "Validation" ]. 40 | 41 | 42 | dc:title "the same terms as the perl 5 programming language system itself". 43 | -------------------------------------------------------------------------------- /t/01-compile.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that Type::Tiny, Type::Library, etc compile. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use Test::More; 26 | 27 | use_ok("Eval::TypeTiny"); 28 | use_ok("Test::TypeTiny"); 29 | use_ok("Type::Coercion"); 30 | use_ok("Type::Coercion::Union"); 31 | use_ok("Error::TypeTiny"); 32 | use_ok("Error::TypeTiny::Assertion"); 33 | use_ok("Error::TypeTiny::Compilation"); 34 | use_ok("Error::TypeTiny::WrongNumberOfParameters"); 35 | use_ok("Type::Library"); 36 | use_ok("Types::Standard"); 37 | use_ok("Types::TypeTiny"); 38 | use_ok("Type::Tiny"); 39 | use_ok("Type::Tiny::Class"); 40 | use_ok("Type::Tiny::Duck"); 41 | use_ok("Type::Tiny::Enum"); 42 | use_ok("Type::Tiny::Intersection"); 43 | use_ok("Type::Tiny::Role"); 44 | use_ok("Type::Tiny::Union"); 45 | use_ok("Type::Utils"); 46 | use_ok("Type::Params"); 47 | 48 | BAIL_OUT("Further tests rely on all modules compiling.") 49 | unless "Test::Builder"->new->is_passing; 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks C<< re::is_regexp() >> works. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Types::Standard; 28 | 29 | ok( 30 | +re::is_regexp(qr{foo}), 31 | 're::is_regexp(qr{foo})', 32 | ); 33 | 34 | ok( 35 | +re::is_regexp(bless qr{foo}, "Foo"), 36 | 're::is_regexp(bless qr{foo}, "Foo")', 37 | ); 38 | 39 | done_testing; 40 | -------------------------------------------------------------------------------- /t/20-modules/Error-TypeTiny/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests for basic L functionality. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | use Error::TypeTiny; 29 | 30 | #line 31 "basic.t" 31 | my $e1 = exception { 'Error::TypeTiny'->throw() }; 32 | 33 | is($e1->message, 'An exception has occurred', '$e1->message (default)'); 34 | is($e1->context->{package}, 'main', '$e1->context->{main}'); 35 | is($e1->context->{line}, '31', '$e1->context->{line}'); 36 | is($e1->context->{file}, 'basic.t', '$e1->context->{file}'); 37 | 38 | my $e2 = exception { 'Error::TypeTiny'->throw(message => 'oh dear') }; 39 | 40 | is($e2->message, 'oh dear', '$e2->message'); 41 | 42 | my $e3 = exception { Error::TypeTiny::croak('oh %s', 'drat') }; 43 | 44 | is($e3->message, 'oh drat', '$e3->message (set by croak)'); 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/20-modules/Error-TypeTiny/stacktrace.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests that L is capable of providing stack traces. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires L; skipped otherwise. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Error::TypeTiny (); 31 | local $Error::TypeTiny::StackTrace; 32 | 33 | use Test::More; 34 | use Test::Fatal; 35 | use Test::Requires { "Devel::StackTrace" => 0 }; 36 | 37 | use Types::Standard (); 38 | 39 | { 40 | package Local::Guts; 41 | 42 | sub foo { 43 | local $Error::TypeTiny::StackTrace = 1; 44 | local $Error::TypeTiny::CarpInternal{'Local::Guts'} = 1; 45 | Types::Standard::Int->( @_ ); 46 | } 47 | } 48 | 49 | sub bar { 50 | Local::Guts::foo( @_ ); 51 | } 52 | 53 | sub baz { 54 | bar( @_ ); 55 | } 56 | 57 | my $e = exception { baz(undef) }; 58 | 59 | my $subs = [ 60 | map 61 | $e->stack_trace->frame( $_ )->subroutine, 62 | 0 .. 2 63 | ]; 64 | 65 | is_deeply( 66 | $subs, 67 | [ 'Local::Guts::foo', 'main::bar', 'main::baz' ], 68 | ) or diag explain( $subs ); 69 | 70 | done_testing; 71 | -------------------------------------------------------------------------------- /t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | ok( require Eval::TypeTiny::CodeAccumulator ); 27 | 28 | my $make_adder = 'Eval::TypeTiny::CodeAccumulator'->new( 29 | description => 'adder', 30 | ); 31 | 32 | my $n = 40; 33 | my $varname = $make_adder->add_variable( '$addend' => \$n ); 34 | 35 | is $varname, '$addend'; 36 | is $make_adder->add_variable( '$addend' => \999 ), '$addend_2'; 37 | 38 | $make_adder->add_line( 'sub {' ); 39 | $make_adder->increase_indent; 40 | $make_adder->add_placeholder( 'unpack-args' ); 41 | $make_adder->add_placeholder( 'dummy' ); 42 | $make_adder->add_gap; 43 | $make_adder->add_line( 'return ' . $varname . ' + $other_addend;' ); 44 | $make_adder->decrease_indent; 45 | $make_adder->add_line( '}' ); 46 | 47 | $make_adder->fill_placeholder( 'unpack-args', 'my $other_addend = shift;' ); 48 | 49 | my $adder = $make_adder->compile; 50 | 51 | note( $make_adder->code ); 52 | 53 | is $adder->( 2 ), 42; 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L using the callback returned from 8 | C. 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster Etobyink@cpan.orgE. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2022-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use Test::More; 26 | 27 | ok( require Eval::TypeTiny::CodeAccumulator ); 28 | 29 | my $make_adder = 'Eval::TypeTiny::CodeAccumulator'->new( 30 | description => 'adder', 31 | ); 32 | 33 | my $n = 40; 34 | my $varname = $make_adder->add_variable( '$addend' => \$n ); 35 | 36 | is $varname, '$addend'; 37 | is $make_adder->add_variable( '$addend' => \999 ), '$addend_2'; 38 | 39 | $make_adder->add_line( 'sub {' ); 40 | $make_adder->increase_indent; 41 | my $ph_1 = $make_adder->add_placeholder( 'unpack-args' ); 42 | my $ph_2 = $make_adder->add_placeholder( 'dummy' ); 43 | $make_adder->add_gap; 44 | $make_adder->add_line( 'return ' . $varname . ' + $other_addend;' ); 45 | $make_adder->decrease_indent; 46 | $make_adder->add_line( '}' ); 47 | 48 | $ph_1->( 'my $other_addend = shift;' ); 49 | 50 | my $adder = $make_adder->compile; 51 | 52 | note( $make_adder->code ); 53 | 54 | is $adder->( 2 ), 42; 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/20-modules/Test-TypeTiny/extended.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L works when the C<< $EXTENDED_TESTING >> 8 | environment variable is true. 9 | 10 | Note that L appears to have issues with subtests, 11 | so currently C and C are not tested. 12 | 13 | =head1 DEPENDENCIES 14 | 15 | Requires L 0.109. 16 | 17 | =head1 AUTHOR 18 | 19 | Toby Inkster Etobyink@cpan.orgE. 20 | 21 | =head1 COPYRIGHT AND LICENCE 22 | 23 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 24 | 25 | This is free software; you can redistribute it and/or modify it under 26 | the same terms as the Perl 5 programming language system itself. 27 | 28 | =cut 29 | 30 | use strict; 31 | use warnings; 32 | 33 | BEGIN 34 | { 35 | $ENV{EXTENDED_TESTING} = 1; 36 | 37 | if (eval { require Test::Tester }) 38 | { 39 | Test::Tester->import(tests => 16); 40 | } 41 | else 42 | { 43 | require Test::More; 44 | Test::More->import(skip_all => 'requires Test::Tester'); 45 | } 46 | } 47 | 48 | use Test::TypeTiny; 49 | use Types::Standard qw( Int Num ); 50 | 51 | check_test( 52 | sub { ok_subtype(Num, Int) }, 53 | { 54 | ok => 1, 55 | name => 'Num subtype: Int', 56 | diag => '', 57 | type => '', 58 | }, 59 | 'successful ok_subtype', 60 | ); 61 | 62 | check_test( 63 | sub { ok_subtype(Int, Num) }, 64 | { 65 | ok => 0, 66 | name => 'Int subtype: Num', 67 | diag => '', 68 | type => '', 69 | }, 70 | 'unsuccessful ok_subtype', 71 | ); 72 | -------------------------------------------------------------------------------- /t/20-modules/Type-Coercion/esoteric.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks various undocumented Type::Coercion methods. 8 | 9 | The fact that these are tested here should not be construed to mean tht 10 | they are any any way a stable, supported part of the Type::Coercion API. 11 | 12 | =head1 AUTHOR 13 | 14 | Toby Inkster Etobyink@cpan.orgE. 15 | 16 | =head1 COPYRIGHT AND LICENCE 17 | 18 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 19 | 20 | This is free software; you can redistribute it and/or modify it under 21 | the same terms as the Perl 5 programming language system itself. 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | use lib qw( ./lib ./t/lib ../inc ./inc ); 28 | 29 | use Test::More; 30 | use Test::Fatal; 31 | use Test::TypeTiny; 32 | 33 | use Type::Coercion; 34 | use Types::Standard -types; 35 | 36 | my $type = Int->create_child_type; 37 | $type->coercion->add_type_coercions( Num, q[int($_)] ); 38 | 39 | like( 40 | exception { $type->coercion->meta }, 41 | qr/^Not really a Moose::Meta::TypeCoercion/, 42 | '$type->coercion->meta', 43 | ); 44 | 45 | $type->coercion->_compiled_type_coercion( 46 | Type::Coercion->new( 47 | type_coercion_map => [ ArrayRef, q[666] ], 48 | ), 49 | ); 50 | 51 | $type->coercion->_compiled_type_coercion( 52 | sub { 999 }, 53 | ); 54 | 55 | is($type->coerce(3.1), 3, '$type->coercion->add_type_coercions(TYPE, STR)'); 56 | is($type->coerce([]), 666, '$type->coercion->_compiled_type_coercion(OBJECT)'); 57 | is($type->coerce(undef), 999, '$type->coercion->_compiled_type_coercion(CODE)'); 58 | 59 | my $J = Types::Standard::Join; 60 | is("$J", 'Join'); 61 | like($J->_stringify_no_magic, qr/^Type::Coercion=HASH\(0x[0-9a-f]+\)$/i); 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/20-modules/Type-Coercion/inlining.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Coercion can be inlined. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires JSON::PP 2.27105. Test is skipped if this module is not present. 12 | Note that this is bundled with Perl v5.13.11 and above. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | 31 | use Test::Requires { "JSON::PP" => "2.27105" }; 32 | 33 | use Test::More; 34 | use Test::Fatal; 35 | 36 | { 37 | package T; 38 | 39 | require JSON::PP; 40 | 41 | use Type::Library -base, -declare => qw/ JsonHash JsonArray /; 42 | use Type::Utils; 43 | use Types::Standard -types; 44 | 45 | declare JsonHash, as HashRef; 46 | declare JsonArray, as ArrayRef; 47 | 48 | coerce JsonHash, 49 | from Str, 'JSON::PP::decode_json($_)'; 50 | 51 | coerce JsonArray, 52 | from Str, 'JSON::PP::decode_json($_)'; 53 | 54 | __PACKAGE__->meta->make_immutable; 55 | } 56 | 57 | my $code = T::JsonArray->coercion->inline_coercion('$::foo'); 58 | 59 | our $foo = "[3,2,1]"; 60 | 61 | is_deeply( 62 | eval $code, 63 | [3,2,1], 64 | 'inlined coercion works', 65 | ); 66 | 67 | $foo = [5,4,3]; 68 | 69 | is_deeply( 70 | eval $code, 71 | [5,4,3], 72 | 'no coercion necessary', 73 | ); 74 | 75 | $foo = {foo => "bar"}; 76 | 77 | is_deeply( 78 | eval $code, 79 | {foo => "bar"}, 80 | 'no coercion possible', 81 | ); 82 | 83 | done_testing; 84 | -------------------------------------------------------------------------------- /t/20-modules/Type-Coercion/smartmatch.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Coercion overload of C<< ~~ >>. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Type::Tiny (); 28 | 29 | BEGIN { 30 | Type::Tiny::SUPPORT_SMARTMATCH 31 | or plan skip_all => 'smartmatch support not available for this version or Perl'; 32 | } 33 | 34 | use Types::Standard qw( Num Int ); 35 | 36 | my $type = Int->plus_coercions( Num, sub{+int} ); 37 | 38 | no warnings; #!! 39 | 40 | ok ( 3.1 ~~ $type->coercion ); 41 | ok not ( [ ] ~~ $type->coercion ); 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/20-modules/Type-Coercion/typetiny-constructor.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks proper Type::Coercion objects are automatically created by the 8 | Type::Tiny constructor. 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster Etobyink@cpan.orgE. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use lib qw( ./lib ./t/lib ../inc ./inc ); 26 | 27 | use Test::More; 28 | use Test::Fatal; 29 | 30 | use Type::Tiny; 31 | use Types::Standard qw( Int Num Any ); 32 | 33 | subtest "coercion => ARRAY" => sub 34 | { 35 | my $type = Type::Tiny->new( 36 | name => 'Test', 37 | parent => Int, 38 | coercion => [ Num, sub { int($_) } ], 39 | ); 40 | 41 | ok $type->has_coercion; 42 | is $type->coercion->type_coercion_map->[0], Num; 43 | is $type->coerce(3.2), 3; 44 | }; 45 | 46 | subtest "coercion => CODE" => sub 47 | { 48 | my $type = Type::Tiny->new( 49 | name => 'Test', 50 | parent => Int, 51 | coercion => sub { int($_) }, 52 | ); 53 | 54 | ok $type->has_coercion; 55 | is $type->coercion->type_coercion_map->[0], Any; 56 | is $type->coerce(3.2), 3; 57 | }; 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/assert.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks that the assertion functions exported by a type library work as expected. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Fatal; 32 | 33 | use BiggerLib qw( :assert ); 34 | 35 | ok assert_String("rats"), "assert_String works (value that should pass)"; 36 | like( 37 | exception { assert_String([]) }, 38 | qr{^is not a string}, 39 | "assert_String works (value that should fail)" 40 | ); 41 | 42 | ok BiggerLib::assert_String("rats"), "BiggerLib::assert_String works (value that should pass)"; 43 | like( 44 | exception { BiggerLib::assert_String([]) }, 45 | qr{^is not a string}, 46 | "BiggerLib::assert_String works (value that should fail)" 47 | ); 48 | 49 | ok assert_SmallInteger(5), "assert_SmallInteger works (value that should pass)"; 50 | like( 51 | exception { assert_SmallInteger([]) }, 52 | qr{^ARRAY\(\w+\) is too big}, 53 | "assert_SmallInteger works (value that should fail)" 54 | ); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/declared-types.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests that placeholder objects generated by C<< -declare >> work. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::TypeTiny; 26 | 27 | BEGIN { 28 | package MyTypes; 29 | 30 | use Type::Library -base, -declare => 'MyHashRef'; 31 | use Types::Standard -types; 32 | 33 | my $tmp = MyHashRef; 34 | my $coderef = \&MyHashRef; 35 | sub get_tmp { $tmp } 36 | sub get_coderef { $coderef } 37 | 38 | __PACKAGE__->add_type( 39 | name => MyHashRef, 40 | parent => HashRef[ Int | MyHashRef ], 41 | ); 42 | }; 43 | 44 | should_pass( { foo => 1, bar => { quux => 2 } }, MyTypes->get_tmp ); 45 | should_fail( { foo => 1, bar => { quux => 2.1 } }, MyTypes->get_tmp ); 46 | 47 | should_pass( { foo => 1, bar => { quux => 2 } }, MyTypes->get_coderef->() ); 48 | should_fail( { foo => 1, bar => { quux => 2.1 } }, MyTypes->get_coderef->() ); 49 | 50 | isnt( MyTypes->get_coderef, \&MyTypes::MyHashRef, 'coderef got redefined' ); 51 | 52 | note( MyTypes->get_tmp->inline_check(q/$xyz/) ); 53 | note( MyTypes->get_coderef->()->inline_check(q/$xyz/) ); 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/errors.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests errors thrown by L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | use Type::Library -base; 30 | use Type::Tiny; 31 | 32 | my $e1 = exception { 33 | my $m = __PACKAGE__->meta; 34 | $m->add_type(name => 'Foo'); 35 | $m->add_type(name => 'Foo'); 36 | }; 37 | 38 | like( 39 | $e1, 40 | qr/^Type Foo already exists in this library/, 41 | 'cannot add same type constraint twice', 42 | ); 43 | 44 | my $e2 = exception { 45 | my $m = __PACKAGE__->meta; 46 | $m->add_type(constraint => sub { 0 }); 47 | }; 48 | 49 | like( 50 | $e2, 51 | qr/^Cannot add anonymous type to a library/, 52 | 'cannot add an anonymous type constraint to a library', 53 | ); 54 | 55 | my $e3 = exception { 56 | my $m = __PACKAGE__->meta; 57 | $m->add_coercion(name => 'Foo'); 58 | }; 59 | 60 | like( 61 | $e3, 62 | qr/^Coercion Foo conflicts with type of same name/, 63 | 'cannot add a coercion with same name as a constraint', 64 | ); 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/exportables-duplicated.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests type libraries can detect two types trying to export the same functions. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | 27 | my $e = do { 28 | package My::Types; 29 | use Type::Library -base, -utils; 30 | 31 | # This should create constants ABC_DEF_GHI and ABC_DEF_JKL 32 | enum( 'Abc_Def', [qw/ ghi jkl /] ); 33 | 34 | local $@; 35 | eval { 36 | # This should also create constant ABC_DEF_GHI 37 | enum( 'Abc', [qw/ def_ghi /] ); 38 | 1; 39 | }; 40 | $@; 41 | }; 42 | 43 | like $e, qr/Function ABC_DEF_GHI is provided by types Abc_Def and Abc/; 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/is.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks that the check functions exported by a type library work as expected. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | 32 | use BiggerLib qw( :is ); 33 | 34 | ok is_String("rats"), "is_String works (value that should pass)"; 35 | ok !is_String([]), "is_String works (value that should fail)"; 36 | ok is_Number(5.5), "is_Number works (value that should pass)"; 37 | ok !is_Number("rats"), "is_Number works (value that should fail)"; 38 | ok is_Integer(5), "is_Integer works (value that should pass)"; 39 | ok !is_Integer(5.5), "is_Integer works (value that should fail)"; 40 | ok is_SmallInteger(5), "is_SmallInteger works (value that should pass)"; 41 | ok !is_SmallInteger(12), "is_SmallInteger works (value that should fail)"; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/own-registry.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks type libraries put types in their own type registries. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | 28 | BEGIN { 29 | package Local::Library; 30 | use Type::Library -base; 31 | use Type::Tiny; 32 | my $t1 = Type::Tiny->new(name => "Base"); 33 | my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1); 34 | my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1); 35 | my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3); 36 | my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0); 37 | __PACKAGE__->meta->add_type($_) for $t1, $t2, $t3, $t4, $t5; 38 | }; 39 | 40 | require Type::Registry; 41 | is_deeply( 42 | [ sort keys %{ Type::Registry->for_class( 'Local::Library' ) } ], 43 | [ sort qw( Base Derived_1 Derived_2 Double_Derived_1 Double_Derived_2 ) ], 44 | 'Type libraries automatically put types into their own registry', 45 | ); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/remove-type.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests Type::Library's hidden C<_remove_type> method. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::Requires 'namespace::clean'; 25 | use Test::More; 26 | 27 | use Types::Standard (); 28 | 29 | # hack 30 | delete( Types::Standard->meta->{immutable} ); 31 | 32 | # do it! 33 | Types::Standard->_remove_type( Types::Standard::Str() ); 34 | 35 | ok !Types::Standard->can('Str'); 36 | ok !Types::Standard->can('is_Str'); 37 | ok !Types::Standard->can('assert_Str'); 38 | ok !Types::Standard->can('to_Str'); 39 | 40 | my %h; 41 | Types::Standard->import( { into => \%h } ); 42 | 43 | ok !exists $h{Str}; 44 | ok !exists $h{is_Str}; 45 | ok !exists $h{assert_Str}; 46 | ok !exists $h{to_Str}; 47 | 48 | ok eval 'use Types::Standard -all; 1'; 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/20-modules/Type-Library/to.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks that the coercion functions exported by a type library work as expected. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Fatal qw(dies_ok); 32 | 33 | use BiggerLib qw(:to); 34 | 35 | is( 36 | to_BigInteger(8), 37 | 18, 38 | 'to_BigInteger converts a small integer OK' 39 | ); 40 | 41 | is( 42 | to_BigInteger(17), 43 | 17, 44 | 'to_BigInteger leaves an existing BigInteger OK' 45 | ); 46 | 47 | is( 48 | to_BigInteger(3.14), 49 | 3.14, 50 | 'to_BigInteger ignores something it cannot coerce' 51 | ); 52 | 53 | dies_ok { to_Str [] } "no coercion for Str - should die"; 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params-Signature/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Basic tests that C<< Type::Params::Signature->new_from_compile >> works. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | 27 | use Types::Standard -types; 28 | use Type::Params::Signature; 29 | 30 | my $sig = 'Type::Params::Signature'->new_from_compile( 31 | named => ( 32 | { head => [ Any ], quux => 123 }, 33 | { quux => 'xyzzy' }, 34 | foo => Int, { quux => 123 }, 35 | bar => Str, 36 | ), 37 | ); 38 | 39 | is( $sig->{quux}, 'xyzzy' ); 40 | 41 | ok( not $sig->head->[0]->has_name ); 42 | ok( $sig->head->[0]->has_type ); 43 | is( $sig->head->[0]->name, undef ); 44 | is( $sig->head->[0]->type, Any ); 45 | 46 | ok( $sig->has_parameters ); 47 | is( scalar( @{ $sig->parameters } ), 2 ); 48 | 49 | ok( $sig->parameters->[0]->has_name ); 50 | ok( $sig->parameters->[0]->has_type ); 51 | is( $sig->parameters->[0]->name, 'foo' ); 52 | is( $sig->parameters->[0]->type, Int ); 53 | is( $sig->parameters->[0]->{quux}, 123 ); 54 | 55 | ok( $sig->parameters->[1]->has_name ); 56 | ok( $sig->parameters->[1]->has_type ); 57 | is( $sig->parameters->[1]->name, 'bar' ); 58 | is( $sig->parameters->[1]->type, Str ); 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/badsigs.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that people doing silly things with Test::Params get 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | use Type::Params qw( compile ); 30 | use Types::Standard qw( Optional Int ArrayRef slurpy ); 31 | 32 | like( 33 | exception { compile(Optional[Int], Int) }, 34 | qr{^Non-Optional parameter following Optional parameter}, 35 | "Cannot follow an optional parameter with a required parameter", 36 | ); 37 | 38 | like( 39 | exception { compile(slurpy ArrayRef[Int], Optional[Int]) }, 40 | qr{^Parameter following slurpy parameter}, 41 | "Cannot follow a slurpy parameter with anything", 42 | ); 43 | 44 | is( 45 | exception { compile(slurpy Int) }, 46 | undef, 47 | "This makes no sense, but no longer throws an exception", 48 | ); 49 | 50 | done_testing; 51 | 52 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/carping.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L' interaction with L: 8 | 9 | use Type::Params compile => { confess => 1 }; 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | 28 | use Test::More; 29 | use Test::Fatal; 30 | 31 | use Type::Params compile => { confess => 1 }; 32 | use Types::Standard qw(Int); 33 | 34 | my $check; 35 | 36 | 37 | 38 | #line 1 "testsub1.chunk" 39 | sub testsub1 40 | { 41 | $check ||= compile(Int); 42 | [ $check->(@_) ]; 43 | } 44 | 45 | #line 1 "testsub2.chunk" 46 | sub testsub2 47 | { 48 | testsub1(@_); 49 | } 50 | 51 | #line 52 "params-carping.t" 52 | my $e = exception { 53 | testsub2(1.1); 54 | }; 55 | 56 | isa_ok($e, 'Error::TypeTiny'); 57 | 58 | like( 59 | $e, 60 | qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)}, 61 | ); 62 | 63 | done_testing; 64 | 65 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/clone.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test C and C support autocloned parameters. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use Test::More; 23 | use Test::Requires 'Storable'; 24 | use Test::Fatal; 25 | use Types::Standard -types; 26 | use Type::Params qw( compile compile_named ); 27 | use Scalar::Util qw( refaddr ); 28 | 29 | my $arr = []; 30 | 31 | { 32 | my $check = compile( ArrayRef, { clone => 0 } ); 33 | my ( $got ) = $check->( $arr ); 34 | is( refaddr( $got ), refaddr( $arr ), 'compile with clone => 0' ); 35 | } 36 | 37 | { 38 | my $check = compile( ArrayRef, { clone => 1 } ); 39 | my ( $got ) = $check->( $arr ); 40 | isnt( refaddr( $got ), refaddr( $arr ), 'compile with clone => 1' ); 41 | } 42 | 43 | { 44 | my $check = compile_named( xxx => ArrayRef, { clone => 0 } ); 45 | my ( $got ) = $check->( xxx => $arr ); 46 | is( refaddr( $got->{xxx} ), refaddr( $arr ), 'compile_named with clone => 0' ); 47 | } 48 | 49 | { 50 | my $check = compile_named( xxx => ArrayRef, { clone => 1 } ); 51 | my ( $got ) = $check->( xxx => $arr ); 52 | isnt( refaddr( $got->{xxx} ), refaddr( $arr ), 'compile_named with clone => 1' ); 53 | } 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/mixednamed.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L usage with mix of positional and named parameters. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | use Type::Params qw(compile); 30 | use Types::Standard -types, "slurpy"; 31 | 32 | my $chk = compile(ClassName, slurpy Dict[ 33 | foo => Int, 34 | bar => Str, 35 | baz => ArrayRef, 36 | ]); 37 | 38 | is_deeply( 39 | [ $chk->("Type::Tiny", foo => 1, bar => "Hello", baz => []) ], 40 | [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] 41 | ); 42 | 43 | is_deeply( 44 | [ $chk->("Type::Tiny", bar => "Hello", baz => [], foo => 1) ], 45 | [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] 46 | ); 47 | 48 | like( 49 | exception { $chk->("Type::Tiny", foo => 1, bar => "Hello") }, 50 | qr{did not pass type constraint "Dict}, 51 | ); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/named.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L usage with named parameters. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | use Type::Params qw(compile); 30 | use Types::Standard -types, "slurpy"; 31 | 32 | my $chk = compile slurpy Dict[ 33 | foo => Int, 34 | bar => Str, 35 | baz => ArrayRef, 36 | ]; 37 | 38 | is_deeply( 39 | [ $chk->(foo => 1, bar => "Hello", baz => []) ], 40 | [ { foo => 1, bar => "Hello", baz => [] } ] 41 | ); 42 | 43 | is_deeply( 44 | [ $chk->(bar => "Hello", baz => [], foo => 1) ], 45 | [ { foo => 1, bar => "Hello", baz => [] } ] 46 | ); 47 | 48 | like( 49 | exception { $chk->(foo => 1, bar => "Hello") }, 50 | qr{did not pass type constraint "Dict}, 51 | ); 52 | 53 | my $chk2 = compile slurpy Dict[ 54 | foo => Int, 55 | bar => Str, 56 | baz => Optional[ArrayRef], 57 | ]; 58 | 59 | is_deeply( 60 | [ $chk2->(foo => 1, bar => "Hello") ], 61 | [ { foo => 1, bar => "Hello" } ] 62 | ); 63 | 64 | like( 65 | exception { $chk2->(foo => 1, bar => "Hello", zab => []) }, 66 | qr{did not pass type constraint "Dict}, 67 | ); 68 | 69 | done_testing; 70 | 71 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/on-die.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L support for C. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | use Type::Params qw( compile compile_named ); 29 | use Types::Standard -types, "slurpy"; 30 | 31 | subtest "compile" => sub { 32 | my ( $E, @R ); 33 | my $coderef = compile( 34 | { on_die => sub { $E = shift; 'XXX' } }, 35 | Int, 36 | ); 37 | 38 | is( 39 | exception { @R = $coderef->("foo") }, 40 | undef, 41 | 'No exception thrown', 42 | ); 43 | 44 | is_deeply( 45 | \@R, 46 | [ 'XXX' ], 47 | 'Correct value returned', 48 | ); 49 | 50 | is( 51 | $E->type->name, 52 | 'Int', 53 | 'Passed exception to callback', 54 | ); 55 | }; 56 | 57 | subtest "compile_named" => sub { 58 | my ( $E, @R ); 59 | my $coderef = compile_named( 60 | { on_die => sub { $E = shift; 'XXX' } }, 61 | foo => Int, 62 | ); 63 | 64 | is( 65 | exception { @R = $coderef->(foo => "foo") }, 66 | undef, 67 | 'No exception thrown', 68 | ); 69 | 70 | is_deeply( 71 | \@R, 72 | [ 'XXX' ], 73 | 'Correct value returned', 74 | ); 75 | 76 | is( 77 | $E->type->name, 78 | 'Int', 79 | 'Passed exception to callback', 80 | ); 81 | }; 82 | 83 | done_testing; 84 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-default-on-undef.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests that Type::Params supports C. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | use Types::Common -types; 29 | use Type::Params -sigs; 30 | 31 | signature_for foo1 => ( pos => [ Optional, { default => 42 } ], next => sub { shift } ); 32 | signature_for foo2 => ( pos => [ Optional, { default => 42, default_on_undef => !!1 } ], next => sub { shift } ); 33 | 34 | is foo1(60), 60; 35 | is foo1(42), 42; 36 | is foo1(), 42; 37 | is foo1(undef), undef; 38 | is foo1(''), ''; 39 | 40 | is foo2(60), 60; 41 | is foo2(42), 42; 42 | is foo2(), 42; 43 | is foo2(undef), 42; 44 | is foo2(''), ''; 45 | 46 | signature_for foo3 => ( named => [ foo => Optional, { default => 42 } ], next => sub { shift->foo } ); 47 | signature_for foo4 => ( named => [ foo => Optional, { default => 42, default_on_undef => !!1 } ], next => sub { shift->foo } ); 48 | 49 | is foo3(foo=>60), 60; 50 | is foo3(foo=>42), 42; 51 | is foo3(), 42; 52 | is foo3(foo=>undef), undef; 53 | is foo3(foo=>''), ''; 54 | 55 | is foo4(foo=>60), 60; 56 | is foo4(foo=>42), 42; 57 | is foo4(), 42; 58 | is foo4(foo=>undef), 42; 59 | is foo4(foo=>''), ''; 60 | 61 | done_testing; 62 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-defaults.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that Type::Params v2 default coderefs get passed an invocant. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | 29 | { 30 | package Local::FooBar; 31 | use Types::Common -types, -sigs; 32 | sub foo { 42 } 33 | my $check; 34 | sub bar { 35 | $check ||= signature( 36 | method => 1, 37 | positional => [ 38 | Int, { default => sub { shift->foo } }, 39 | ], 40 | ); 41 | my ( $self, $num ) = &$check; 42 | return $num / 2; 43 | } 44 | } 45 | 46 | my $object = bless {}, 'Local::FooBar'; 47 | 48 | is( $object->bar, 21 ); 49 | 50 | is( $object->bar(666), 333 ); 51 | 52 | done_testing; 53 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-delayed-compilation.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests that Type::Params v2 C delays signature compilation. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | use Types::Common -types; 29 | use Type::Params -sigs; 30 | 31 | my $compiled = 0; 32 | 33 | my $MyStr = Str->create_child_type( 34 | name => 'MyStr', 35 | constraint => sub { 1 }, 36 | inlined => sub { 37 | ++$compiled; 38 | Str->inline_check( pop ); 39 | }, 40 | ); 41 | 42 | signature_for xyz => ( pos => [ $MyStr ] ); 43 | 44 | sub xyz { 45 | my $got = shift; 46 | return scalar reverse $got; 47 | } 48 | 49 | is( 50 | $compiled, 51 | 0, 52 | 'type constraint has not been compiled yet', 53 | ); 54 | 55 | is( xyz('foo'), 'oof', 'function worked' ); 56 | 57 | is( 58 | $compiled, 59 | 1, 60 | 'type constraint has been compiled', 61 | ); 62 | 63 | is( xyz('bar'), 'rab', 'function worked' ); 64 | 65 | is( 66 | $compiled, 67 | 1, 68 | 'type constraint has not been re-compiled', 69 | ); 70 | 71 | done_testing; 72 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-fallback.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test the C<< fallback >> option for modern Type::Params v2 API. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | use Types::Common -types; 29 | use Type::Params -sigs; 30 | 31 | sub xyz { 32 | return 666; 33 | } 34 | 35 | signature_for [ 'xyz' ] => ( 36 | pos => [ Int, Int ], 37 | fallback => sub { $_[0] + $_[1] }, 38 | ); 39 | 40 | is( xyz( 40, 2 ), 666 ); 41 | 42 | signature_for [ 'abc' ] => ( 43 | pos => [ Int, Int ], 44 | fallback => sub { $_[0] + $_[1] }, 45 | ); 46 | 47 | is( abc( 40, 2 ), 42 ); 48 | 49 | done_testing; 50 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-named-plus-slurpy.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Named slurpy parameter tests for modern Type::Params v2 API. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Common -sigs, -types; 27 | 28 | my $sig = signature( 29 | named => [ 30 | in => Str, 31 | out => Str, 32 | options => Any, { slurpy => 1 }, 33 | ], 34 | ); 35 | 36 | my ( $arg ) = $sig->( 37 | in => 'IN', 38 | out => 'OUT', 39 | foo => 'FOO', 40 | bar => 'BAR', 41 | ); 42 | 43 | is( $arg->in, 'IN' ); 44 | is( $arg->out, 'OUT' ); 45 | is_deeply( 46 | $arg->options, 47 | { foo => 'FOO', bar => 'BAR' }, 48 | ); 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-positional-plus-slurpy.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Named slurpy parameter tests for modern Type::Params v2 API. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Common -sigs, -types; 28 | 29 | my $sig = signature( 30 | positional => [ 31 | Str, 32 | Str, 33 | Any, { slurpy => 1 }, 34 | ], 35 | ); 36 | 37 | my ( $in, $out, $slurpy ) = $sig->( qw/ IN OUT FOO BAR / ); 38 | 39 | is( $in, 'IN' ); 40 | is( $out, 'OUT' ); 41 | is_deeply( $slurpy, [ 'FOO', 'BAR' ] ); 42 | 43 | my $sig2; 44 | my $e = exception { 45 | $sig2 = signature pos => [ Int, { slurpy => 1 } ]; 46 | $sig2->( 42 ); 47 | }; 48 | isnt $e, undef; 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/20-modules/Type-Params/v2-wrap-inherited-method.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that Type::Params v2 C can find methods to wrap using 8 | inheritance. 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster Etobyink@cpan.orgE. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2022-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | 29 | { 30 | package Local::Base; 31 | sub new { 32 | my $class = shift; 33 | bless [], $class; 34 | } 35 | sub add_nums { 36 | return $_[1] + $_[2]; 37 | } 38 | } 39 | 40 | { 41 | package Local::Derived; 42 | use Types::Common -sigs, -types; 43 | our @ISA = 'Local::Base'; 44 | 45 | signature_for add_nums => ( 46 | method => 1, 47 | positional => [ Int, Int ], 48 | ); 49 | } 50 | 51 | my $o = Local::Derived->new; 52 | 53 | is( $o->add_nums( 2, 40 ), 42 ); 54 | 55 | like( 56 | exception { $o->add_nums( 40.6, 1.6 ) }, 57 | qr/did not pass type constraint "Int"/, 58 | ); 59 | 60 | my $o2 = Local::Base->new; 61 | is( 62 | int( $o2->add_nums( 40.6, 1.6 ) ), 63 | 42, 64 | ); 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/20-modules/Type-Parser/moosextypes.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Parser can pick up MooseX::Types type constraints. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires L 2.0201 and L 0.001004; 12 | skipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | 31 | use Test::More; 32 | use Test::Requires { 'Moose' => '2.0201' }; 33 | use Test::Requires { 'MooseX::Types::Common' => '0.001004' }; 34 | use Test::TypeTiny; 35 | use Test::Fatal; 36 | 37 | use Type::Parser qw(_std_eval parse); 38 | use Types::Standard qw(-types slurpy); 39 | use Type::Utils; 40 | 41 | my $type = _std_eval("ArrayRef[MooseX::Types::Common::Numeric::PositiveInt]"); 42 | 43 | should_pass([1,2,3], $type); 44 | should_pass([], $type); 45 | should_fail([1,-2,3], $type); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/20-modules/Type-Registry/automagic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Registry->for_class is automagically populated. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Types::Common::Numeric 28 | PositiveOrZeroInt => { -as => 'NonNegativeInt' }; 29 | 30 | ok( 31 | !$INC{'Type/Registry.pm'}, 32 | 'Type::Registry is not automatically loaded', 33 | ); 34 | 35 | require Type::Registry; 36 | my $reg = Type::Registry->for_me; 37 | 38 | ok( 39 | $reg->lookup('NonNegativeInt') == NonNegativeInt, 40 | 'Type::Registry was auto-populated', 41 | ); 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/20-modules/Type-Registry/moosextypes.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Registry works with MooseX::Types. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires L 2.0201 and L 0.001004; 12 | kipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | 31 | use Test::More; 32 | use Test::Requires { 'Moose' => '2.0201' }; 33 | use Test::Requires { 'MooseX::Types::Common' => '0.001004' }; 34 | use Test::TypeTiny; 35 | use Test::Fatal; 36 | 37 | use Type::Registry 't'; 38 | 39 | t->add_types(-Standard); 40 | 41 | my $ucstrs = t->lookup('ArrayRef[MooseX::Types::Common::String::UpperCaseStr]'); 42 | should_pass([], $ucstrs); 43 | should_pass(['FOO', 'BAR'], $ucstrs); 44 | should_fail(['FOO', 'Bar'], $ucstrs); 45 | 46 | t->add_types('MooseX::Types::Common::Numeric'); 47 | 48 | should_pass(8, t->SingleDigit); 49 | should_pass(9, t->SingleDigit); 50 | should_fail(10, t->SingleDigit); 51 | should_pass(10, t->PositiveInt); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/20-modules/Type-Registry/mousextypes.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Registry works with MouseX::Types. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires L 0.001000; skipped otherwise. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Requires { 'MouseX::Types::Common' => '0.001000' }; 32 | use Test::TypeTiny; 33 | use Test::Fatal; 34 | 35 | use Type::Registry 't'; 36 | 37 | t->add_types(-Standard); 38 | 39 | my $nestr = t->lookup('ArrayRef[MouseX::Types::Common::String::NonEmptyStr]'); 40 | should_pass([], $nestr); 41 | should_pass(['FOO', 'BAR'], $nestr); 42 | should_fail(['FOO', ''], $nestr); 43 | 44 | t->add_types('MouseX::Types::Common::Numeric'); 45 | 46 | should_pass(8, t->SingleDigit); 47 | should_pass(9, t->SingleDigit); 48 | should_fail(10, t->SingleDigit); 49 | should_pass(10, t->PositiveInt); 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/20-modules/Type-Registry/parent.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check the Type::Registrys can have parents. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::TypeTiny; 28 | use Test::Fatal; 29 | 30 | use Types::Standard; 31 | 32 | { 33 | package Local::Pkg1; 34 | use Type::Registry "t"; 35 | t->add_type(Types::Standard::Int); 36 | t->alias_type( 'Int' => 'Integer' ); 37 | } 38 | 39 | { 40 | package Local::Pkg2; 41 | use Type::Registry "t"; 42 | t->add_type(Types::Standard::ArrayRef); 43 | t->alias_type( 'ArrayRef' => 'List' ); 44 | t->set_parent( 'Local::Pkg1' ); 45 | } 46 | 47 | my $reg = Type::Registry->for_class('Local::Pkg2'); 48 | my $type = $reg->lookup('List[Integer]'); 49 | 50 | should_pass([1,2,3], $type); 51 | should_fail([1,2,3.1], $type); 52 | 53 | $reg->clear_parent; 54 | 55 | ok ! $reg->get_parent; 56 | 57 | my $e = exception { 58 | $reg->lookup('List[Integer]'); 59 | }; 60 | 61 | like( $e, qr/Integer is not a known type constraint/, 'after clearing parent, do not know parent registry types' ); 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/20-modules/Type-Registry/refcount.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Registry refcount stuff. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Requires 'Devel::Refcount'; 27 | use Devel::Refcount 'refcount'; 28 | use Types::Standard qw( Int ); 29 | use Type::Registry; 30 | 31 | my $orig_count = refcount( Int ); 32 | note "COUNT: $orig_count"; 33 | 34 | { 35 | my $reg = Type::Registry->new; 36 | $reg->add_types(qw/ -Standard /); 37 | 38 | is refcount( Int ), 1 + $orig_count; 39 | } 40 | 41 | is refcount( Int ), $orig_count; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tie/03prototypicalweirdness.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that C prototype works. 8 | 9 | Test case suggested by Graham Knop (HAARG). 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2014, 2018-2019, 2022-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | use Test::More; 28 | 29 | use Type::Tie; 30 | use Types::Standard qw( ArrayRef Num ); 31 | 32 | ttie my $foo, ArrayRef[Num], [1,2,3]; 33 | 34 | is_deeply( 35 | $foo, 36 | [1..3], 37 | ); 38 | 39 | done_testing; 40 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tie/06clone.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that Type::Tie works with Clone::clone 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Requires 'Clone'; 28 | use Test::Fatal; 29 | 30 | use Type::Tie; 31 | 32 | use Types::Standard qw( Int ); 33 | use Clone qw(clone); 34 | 35 | # Hashes 36 | 37 | ttie my %hash, Int; 38 | 39 | my $ref = \%hash; 40 | my $hashDclone = clone(\%hash); 41 | 42 | eval { 43 | $hashDclone->{a} = 1; 44 | }; 45 | ok(! $@); 46 | 47 | eval { 48 | $hashDclone->{a} = 'a'; 49 | }; 50 | ok($@); 51 | 52 | # Arrays 53 | 54 | ttie my @array, Int; 55 | 56 | my $arrayDclone = clone(\@array); 57 | 58 | eval { 59 | push @$arrayDclone, 1; 60 | }; 61 | ok(! $@); 62 | 63 | eval { 64 | push @$arrayDclone, 'a'; 65 | }; 66 | ok($@); 67 | 68 | # Scalar 69 | 70 | my $scalarContainer = [ '' ]; 71 | 72 | ttie $scalarContainer->[0], Int; 73 | 74 | my $scalarContainerDclone = clone($scalarContainer); 75 | 76 | eval { 77 | $scalarContainerDclone->[0] = 1; 78 | }; 79 | ok(! $@); 80 | 81 | eval { 82 | $scalarContainerDclone->[0] = 'a'; 83 | }; 84 | ok($@); 85 | 86 | done_testing(); 87 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tie/06storable.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that Type::Tie works with Storable::dclone 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | use Test::Requires 'Storable'; 28 | use Test::Fatal; 29 | 30 | use Type::Tie; 31 | 32 | use Types::Standard qw( Int ); 33 | use Storable qw(dclone); 34 | 35 | # Hashes 36 | 37 | ttie my %hash, Int; 38 | 39 | my $ref = \%hash; 40 | my $hashDclone = dclone(\%hash); 41 | 42 | eval { 43 | $hashDclone->{a} = 1; 44 | }; 45 | ok(! $@); 46 | 47 | eval { 48 | $hashDclone->{a} = 'a'; 49 | }; 50 | ok($@); 51 | 52 | # Arrays 53 | 54 | ttie my @array, Int; 55 | 56 | my $arrayDclone = dclone(\@array); 57 | 58 | eval { 59 | push @$arrayDclone, 1; 60 | }; 61 | ok(! $@); 62 | 63 | eval { 64 | push @$arrayDclone, 'a'; 65 | }; 66 | ok($@); 67 | 68 | # Scalar 69 | 70 | my $scalarContainer = [ '' ]; 71 | 72 | ttie $scalarContainer->[0], Int; 73 | 74 | my $scalarContainerDclone = dclone($scalarContainer); 75 | 76 | eval { 77 | $scalarContainerDclone->[0] = 1; 78 | }; 79 | ok(! $@); 80 | 81 | eval { 82 | $scalarContainerDclone->[0] = 'a'; 83 | }; 84 | ok($@); 85 | 86 | done_testing(); 87 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tie/very-minimal.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test Type::Tie with a very minimal object, with only a C method. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Fatal; 27 | 28 | use Type::Tie; 29 | use Scalar::Util qw( looks_like_number ); 30 | 31 | sub Local::TypeConstraint::check { 32 | my $coderef = shift; 33 | &$coderef; 34 | }; 35 | 36 | my $Num = bless( 37 | sub { looks_like_number $_[0] }, 38 | 'Local::TypeConstraint', 39 | ); 40 | 41 | ttie my($x), $Num, 0; 42 | 43 | $x = 1; 44 | 45 | is $x, 1; 46 | 47 | like( 48 | exception { $x = 'Foo' }, 49 | qr/^Value "Foo" does not meet type constraint/, 50 | ); 51 | 52 | done_testing; 53 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Bitfield/errors.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use Test::Fatal; 5 | 6 | use Type::Tiny::Bitfield; 7 | use Types::Common qw( ArrayRef ); 8 | 9 | like( 10 | exception { 11 | Type::Tiny::Bitfield->new( parent => ArrayRef, values => {} ), 12 | }, 13 | qr/cannot have a parent constraint passed to the constructor/i, 14 | ); 15 | 16 | like( 17 | exception { 18 | Type::Tiny::Bitfield->new( constraint => sub { 0 }, values => {} ), 19 | }, 20 | qr/cannot have a constraint coderef passed to the constructor/i, 21 | ); 22 | 23 | like( 24 | exception { 25 | Type::Tiny::Bitfield->new( inlined => sub { 0 }, values => {} ), 26 | }, 27 | qr/cannot have a inlining coderef passed to the constructor/i, 28 | ); 29 | 30 | like( 31 | exception { 32 | Type::Tiny::Bitfield->new(), 33 | }, 34 | qr/Need to supply hashref of values/i, 35 | ); 36 | 37 | like( 38 | exception { 39 | Type::Tiny::Bitfield->new( values => { foo => 2 } ), 40 | }, 41 | qr/Not an all-caps name in a bitfield/i, 42 | ); 43 | 44 | like( 45 | exception { 46 | Type::Tiny::Bitfield->new( values => { FOO => 3 } ), 47 | }, 48 | qr/Not a positive power of 2 in a bitfield/i, 49 | ); 50 | 51 | like( 52 | exception { 53 | Type::Tiny::Bitfield->new( values => { FOO => 1, BAR => 1 } ), 54 | }, 55 | qr/Duplicate value in a bitfield/i, 56 | ); 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Bitfield/import-options.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | use Type::Tiny::Bitfield ( 6 | Colour => { RED => 0x01, BLUE => 0x02, GREEN => 0x04, -prefix => 'My' }, 7 | ); 8 | 9 | is( MyColour->display_name, 'Colour' ); 10 | 11 | is( MyCOLOUR_RED, 1 ); 12 | 13 | done_testing; 14 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Class/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Class can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Type::Tiny::Class 'HTTP::Tiny'; 27 | 28 | isa_ok HTTPTiny, 'Type::Tiny', 'HTTPTiny'; 29 | 30 | ok is_HTTPTiny( bless {}, 'HTTP::Tiny' ); 31 | 32 | require Type::Registry; 33 | is( 'Type::Registry'->for_me->{'HTTPTiny'}, HTTPTiny ); 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Class/exporter_with_options.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Class can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Type::Tiny::Class HT => { class => 'HTTP::Tiny' }; 27 | 28 | isa_ok HT, 'Type::Tiny', 'HT'; 29 | 30 | ok is_HT( bless {}, 'HTTP::Tiny' ); 31 | 32 | require Type::Registry; 33 | is( 'Type::Registry'->for_me->{'HT'}, HT ); 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Duck/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks duck type constraints work. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::TypeTiny; 32 | 33 | use BiggerLib qw( :types ); 34 | 35 | isa_ok(CanFooBar, "Type::Tiny", "CanFooBar"); 36 | isa_ok(CanFooBaz, "Type::Tiny::Duck", "CanFooBar"); 37 | 38 | should_pass("Foo::Bar"->new, CanFooBar); 39 | should_fail("Foo::Bar"->new, CanFooBaz); 40 | should_pass("Foo::Baz"->new, CanFooBar); 41 | should_pass("Foo::Baz"->new, CanFooBaz); 42 | 43 | should_fail(undef, CanFooBar); 44 | should_fail({}, CanFooBar); 45 | should_fail(FooBar, CanFooBar); 46 | should_fail(FooBaz, CanFooBar); 47 | should_fail(CanFooBar, CanFooBar); 48 | should_fail("Foo::Bar", CanFooBar); 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Duck/cmp.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test new type comparison stuff with Type::Tiny::Duck objects. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2018-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::TypeTiny; 28 | use Type::Utils qw(duck_type); 29 | 30 | my $type1 = duck_type Type1 => [qw( foo bar )]; 31 | my $type2 = duck_type Type2 => [qw( bar foo )]; 32 | my $type3 = duck_type Type3 => [qw( foo bar baz )]; 33 | 34 | ok_subtype($type1 => $type2, $type3); 35 | ok_subtype($type2 => $type1, $type3); 36 | ok($type1->equals($type2)); 37 | ok($type2->equals($type1)); 38 | ok($type3->is_subtype_of($type2)); 39 | ok($type2->is_supertype_of($type3)); 40 | 41 | ok($type1->equals($type2->create_child_type)); 42 | ok($type2->equals($type1->create_child_type)); 43 | ok($type3->is_subtype_of($type2->create_child_type)); 44 | ok($type2->is_supertype_of($type3->create_child_type)); 45 | 46 | ok($type1->create_child_type->equals($type2)); 47 | ok($type2->create_child_type->equals($type1)); 48 | ok($type3->create_child_type->is_subtype_of($type2)); 49 | ok($type2->create_child_type->is_supertype_of($type3)); 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Duck/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Duck can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | { 27 | package Local::Agent; 28 | sub get {}; 29 | sub post {}; 30 | } 31 | 32 | use Type::Tiny::Duck HttpClient => [ 'get', 'post' ]; 33 | 34 | isa_ok HttpClient, 'Type::Tiny', 'HttpClient'; 35 | 36 | ok is_HttpClient( bless {}, 'Local::Agent' ); 37 | 38 | require Type::Registry; 39 | is( 'Type::Registry'->for_me->{'HttpClient'}, HttpClient ); 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Enum/errors.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks enum type constraints throw sane error messages. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | use Types::Standard qw(Int); 29 | use Type::Tiny::Enum; 30 | 31 | like( 32 | exception { Type::Tiny::Enum->new(parent => Int) }, 33 | qr/^Enum type constraints cannot have a parent constraint/, 34 | ); 35 | 36 | like( 37 | exception { Type::Tiny::Enum->new(constraint => sub { 1 }) }, 38 | qr/^Enum type constraints cannot have a constraint coderef/, 39 | ); 40 | 41 | like( 42 | exception { Type::Tiny::Enum->new(inlined => sub { 1 }) }, 43 | qr/^Enum type constraints cannot have a inlining coderef/, 44 | ); 45 | 46 | like( 47 | exception { Type::Tiny::Enum->new() }, 48 | qr/^Need to supply list of values/, 49 | ); 50 | 51 | ok( 52 | !exception { Type::Tiny::Enum->new(values => [qw/foo bar/]) }, 53 | ); 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Enum/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Enum can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Type::Tiny::Enum Status => [ 'alive', 'dead' ]; 27 | 28 | isa_ok Status, 'Type::Tiny', 'Status'; 29 | 30 | ok is_Status( STATUS_DEAD ); 31 | ok is_Status( STATUS_ALIVE ); 32 | 33 | require Type::Registry; 34 | is( 'Type::Registry'->for_me->{'Status'}, Status ); 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Enum/exporter_lexical.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Enum can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::Requires { 'Exporter::Tiny' => '1.006000' }; 26 | 27 | BEGIN { 28 | Exporter::Tiny::_HAS_NATIVE_LEXICAL_SUB or 29 | Exporter::Tiny::_HAS_MODULE_LEXICAL_SUB or 30 | plan skip_all => "This test requires Exporter::Tiny support for exporting lexical subs"; 31 | }; 32 | 33 | use Type::Tiny::Enum -lexical, Status => [ 'alive', 'dead' ]; 34 | 35 | isa_ok Status, 'Type::Tiny', 'Status'; 36 | 37 | ok is_Status( STATUS_DEAD ); 38 | ok is_Status( STATUS_ALIVE ); 39 | 40 | require Type::Registry; 41 | ok( ! 'Type::Registry'->for_me->{'Status'}, 'nothing added to registry' ); 42 | 43 | ok( ! __PACKAGE__->can( $_ ), "no $_ function in symbol table" ) 44 | for qw( Status is_Status assert_Status to_Status STATUS_DEAD STATUS_ALIVE ); 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Enum/sorter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Enum's sorter. 8 | 9 | =head1 REQUIREMENTS 10 | 11 | Requires Perl 5.8 because earlier versions of Perl didn't have stable sort. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2020-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Test::Requires '5.008'; 30 | use Test::Fatal; 31 | 32 | use Type::Tiny::Enum; 33 | 34 | my $enum = 'Type::Tiny::Enum'->new( 35 | name => 'FooBarBaz', 36 | values => [qw/ foo bar baz /], 37 | ); 38 | 39 | is_deeply( 40 | [ $enum->sort(qw/ xyzzy bar quux baz foo bar quuux /) ], 41 | [ qw/ foo bar bar baz xyzzy quux quuux / ], 42 | 'sorted', 43 | ); 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Enum/union_intersection.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks enums form natural unions and intersections. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard qw( Enum ); 27 | 28 | my $foo = Enum[ 1, 2, 3 ]; 29 | my $bar = Enum[ 1, 4, 5 ]; 30 | 31 | isa_ok( 32 | ( my $foo_union_bar = $foo | $bar ), 33 | 'Type::Tiny::Enum', 34 | '$foo_union_bar', 35 | ); 36 | 37 | is_deeply( 38 | $foo_union_bar->unique_values, 39 | [ 1 .. 5 ], 40 | '$foo_union_bar->unique_values', 41 | ); 42 | 43 | isa_ok( 44 | ( my $foo_intersect_bar = $foo & $bar ), 45 | 'Type::Tiny::Enum', 46 | '$foo_intersect_bar', 47 | ); 48 | 49 | is_deeply( 50 | $foo_intersect_bar->unique_values, 51 | [ 1 ], 52 | '$foo_intersect_bar->unique_values', 53 | ); 54 | 55 | done_testing; -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Role/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks role type constraints work. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::TypeTiny; 32 | 33 | use BiggerLib qw( :types ); 34 | 35 | isa_ok(DoesQuux, "Type::Tiny", "DoesQuux"); 36 | isa_ok(DoesQuux, "Type::Tiny::Role", "DoesQuux"); 37 | 38 | should_fail("Foo::Bar"->new, DoesQuux); 39 | should_pass("Foo::Baz"->new, DoesQuux); 40 | 41 | should_fail(undef, DoesQuux); 42 | should_fail({}, DoesQuux); 43 | should_fail(FooBar, DoesQuux); 44 | should_fail(FooBaz, DoesQuux); 45 | should_fail(DoesQuux, DoesQuux); 46 | should_fail("Quux", DoesQuux); 47 | 48 | is( 49 | 'Type::Tiny::Role'->new( role => 'Xyzzy' )->inline_check('$x'), 50 | 'Type::Tiny::Role'->new({ role => 'Xyzzy' })->inline_check('$x'), 51 | 'constructor can be passed a hash or hashref', 52 | ); 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Role/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny::Role can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Type::Tiny::Role 'Local::Foo'; 27 | 28 | { 29 | package Local::Bar; 30 | sub DOES { 1 } 31 | } 32 | 33 | isa_ok LocalFoo, 'Type::Tiny', 'LocalFoo'; 34 | 35 | ok is_LocalFoo( bless {}, 'Local::Bar' ); 36 | 37 | require Type::Registry; 38 | is( 'Type::Registry'->for_me->{'LocalFoo'}, LocalFoo ); 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-Union/relationships.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks union type constraint subtype/supertype relationships. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Uses the bundled BiggerLib.pm type library. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::TypeTiny; 32 | 33 | use BiggerLib qw( :types ); 34 | use Type::Utils qw( union class_type ); 35 | use Types::Standard Object => { -as => "Blessed" }; 36 | 37 | { my $x; sub FooBarOrDoesQuux () { $x ||= union(FooBarOrDoesQuux => [FooBar, DoesQuux]) } } 38 | 39 | ok( 40 | FooBarOrDoesQuux->is_a_type_of(FooBarOrDoesQuux), 41 | ); 42 | 43 | ok( 44 | FooBarOrDoesQuux->is_supertype_of(FooBar), 45 | ); 46 | 47 | ok( 48 | FooBarOrDoesQuux->is_supertype_of(DoesQuux), 49 | ); 50 | 51 | ok( 52 | FooBarOrDoesQuux->is_a_type_of(Blessed), 53 | ); 54 | 55 | ok( 56 | ! FooBarOrDoesQuux->is_supertype_of(Blessed), 57 | ); 58 | 59 | ok( 60 | ! FooBarOrDoesQuux->is_subtype_of(FooBarOrDoesQuux), 61 | ); 62 | 63 | ok( 64 | FooBarOrDoesQuux->is_subtype_of(Blessed), 65 | ); 66 | 67 | done_testing; 68 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-_HalfOp/double-union.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Ensure that the following works: 8 | 9 | ArrayRef[Str] | Undef | Str 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2017-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | use strict; 25 | use warnings FATAL => 'all'; 26 | use Test::More; 27 | 28 | use Types::Standard -all; 29 | 30 | my $union = eval { ArrayRef[Str] | Undef | Str }; 31 | 32 | SKIP: { 33 | ok $union or skip 'broken type', 6; 34 | ok $union->check([qw/ a b /]); 35 | ok !$union->check([[]]); 36 | ok $union->check(undef); 37 | ok $union->check("a"); 38 | ok !$union->check([undef]); 39 | ok !$union->check({}); 40 | } 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-_HalfOp/extra-params.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Ensure that the following works consistently on all supported Perls: 8 | 9 | HashRef[Int]|Undef, @extra_parameters 10 | 11 | =head1 AUTHOR 12 | 13 | Graham Knop Ehaarg@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2020-2025 by Graham Knop. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | use strict; 25 | use warnings FATAL => 'all'; 26 | use Test::More; 27 | 28 | use Types::Standard -all; 29 | 30 | my $union = eval { Dict[ welp => HashRef[Int]|Undef, guff => ArrayRef[Int] ] }; 31 | 32 | SKIP: { 33 | ok $union or skip 'broken type', 6; 34 | ok $union->check({welp => {blorp => 1}, guff => [2]}); 35 | ok $union->check({welp => undef, guff => [2]}); 36 | ok $union->check({welp => {}, guff => []}); 37 | ok !$union->check({welp => {}, guff => {}}); 38 | ok !$union->check({welp => {blorp => 1}}); 39 | ok !$union->check({guff => [2]}); 40 | } 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Ensure that the following works consistently on all supported Perls: 8 | 9 | ArrayRef[Int] | HashRef[Int] 10 | 11 | =head1 AUTHOR 12 | 13 | Graham Knop Ehaarg@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2014, 2017-2025 by Graham Knop. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | use strict; 25 | use warnings FATAL => 'all'; 26 | use Test::More; 27 | 28 | use Types::Standard -all; 29 | 30 | my $union = eval { ArrayRef[Int] | HashRef[Int] }; 31 | 32 | SKIP: { 33 | ok $union or skip 'broken type', 6; 34 | ok $union->check({welp => 1}); 35 | ok !$union->check({welp => 1.4}); 36 | ok !$union->check({welp => "guff"}); 37 | ok $union->check([1]); 38 | ok !$union->check([1.4]); 39 | ok !$union->check(["guff"]); 40 | } 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/constraint-strings.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny works accepts strings of Perl code as constraints. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Types::Standard -types; 25 | 26 | my $Str = Str->where( 'length($_) > 0' ); 27 | my $Arr = ArrayRef->where( '@$_ > 0' ); 28 | my $Hash = HashRef->where( 'keys(%$_) > 0' ); 29 | 30 | use Test::More; 31 | use Test::Fatal; 32 | 33 | is( 34 | exception { $Str->assert_valid( 'u' ) }, 35 | undef, 36 | 'non-empty string, okay', 37 | ); 38 | 39 | isa_ok( 40 | exception { $Str->assert_valid( '' ) }, 41 | 'Error::TypeTiny', 42 | 'result of empty string', 43 | ); 44 | 45 | is( 46 | exception { $Arr->assert_valid( [undef] ) }, 47 | undef, 48 | 'non-empty arrayref, okay', 49 | ); 50 | 51 | isa_ok( 52 | exception { $Arr->assert_valid( [] ) }, 53 | 'Error::TypeTiny', 54 | 'result of empty arrayref', 55 | ); 56 | 57 | is( 58 | exception { $Hash->assert_valid( { '' => undef } ) }, 59 | undef, 60 | 'non-empty hashref, okay', 61 | ); 62 | 63 | isa_ok( 64 | exception { $Hash->assert_valid( +{} ) }, 65 | 'Error::TypeTiny', 66 | 'result of empty hashref', 67 | ); 68 | 69 | done_testing; 70 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/custom-exception-classes.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test Type::Tiny's C attribute. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2023-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Standard qw( Int ); 28 | 29 | { 30 | package Custom::Exception; 31 | use base 'Error::TypeTiny::Assertion'; 32 | } 33 | 34 | my $type1 = Int->create_child_type( 35 | constraint => q{ $_ > 3 }, 36 | exception_class => 'Custom::Exception', 37 | ); 38 | 39 | my $type2 = $type1->create_child_type( 40 | constraint => q{ $_ < 5 }, 41 | ); 42 | 43 | $type1->assert_valid( 4 ); 44 | $type2->assert_valid( 4 ); 45 | 46 | { 47 | my $e = exception { 48 | $type1->assert_valid( 2 ); 49 | }; 50 | isa_ok( $e, 'Custom::Exception' ); 51 | } 52 | 53 | { 54 | my $e = exception { 55 | $type2->assert_valid( 6 ); 56 | }; 57 | isa_ok( $e, 'Custom::Exception' ); 58 | } 59 | 60 | # The inlined code includes the exception_class. 61 | note( $type2->inline_assert( '$value' ) ); 62 | 63 | done_testing; 64 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/definition-context.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks the C method. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | 27 | use Types::Common qw( -types t ); 28 | use Type::Utils; 29 | 30 | # line 31 "definition-context.t" 31 | declare 'SmallInt', as Int, where { $_ >= 0 and $_ < 10 }; 32 | 33 | is_deeply( 34 | t->SmallInt->definition_context, 35 | { 36 | 'package' => 'main', 37 | 'line' => 31, 38 | 'file' => 'definition-context.t', 39 | }, 40 | 'expected definition context', 41 | ); 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/deprecation.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny's C attribute works. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2018-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | use Test::TypeTiny; 29 | 30 | use Type::Tiny; 31 | 32 | my $t1 = Type::Tiny->new(name => "Base"); 33 | my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1); 34 | my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1); 35 | my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3); 36 | my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0); 37 | 38 | ok not $t1->deprecated; 39 | ok not $t2->deprecated; 40 | ok $t3->deprecated; 41 | ok $t4->deprecated; 42 | ok not $t5->deprecated; 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/my-methods.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny's C attribute. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | use Test::More; 26 | 27 | use Types::Standard qw(Num); 28 | 29 | my $type = Num->create_child_type( 30 | name => 'Number', 31 | my_methods => { round_off => sub { int($_[1]) } } 32 | ); 33 | 34 | my $type2 = $type->create_child_type(name => 'Number2'); 35 | 36 | can_ok($_, 'my_round_off') for $type, $type2; 37 | is($_->my_round_off(42.3), 42, "$_ my_round_off works") for $type, $type2; 38 | 39 | ok(!$_->can('my_smirnoff'), "$_ cannot my_smirnoff") for $type, $type2; 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/refcount.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny refcount stuff. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | 25 | use Test::More; 26 | use Test::Requires 'Devel::Refcount'; 27 | use Devel::Refcount 'refcount'; 28 | use Test::TypeTiny; 29 | use Type::Tiny; 30 | use Type::Registry; 31 | 32 | my $ref = []; 33 | my $orig_count = refcount( $ref ); 34 | note "COUNT: $orig_count"; 35 | 36 | { 37 | my $type = 'Type::Tiny'->new( 38 | name => 'AnswerToLifeTheUniverseAndEverything', 39 | constraint => sub { $_ eq 42 }, 40 | inlined => sub { my $var = pop; "$var eq 42" }, 41 | dummy_attr => $ref, 42 | ); 43 | 44 | is refcount( $ref ), 1 + $orig_count; 45 | 46 | should_fail( 41, $type ); 47 | should_pass( 42, $type ); 48 | 49 | is refcount( $ref ), 1 + $orig_count; 50 | } 51 | 52 | is refcount( $ref ), $orig_count; 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/shortcuts.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test the C<< ->of >> and C<< ->where >> shortcut methods. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::TypeTiny -all; 28 | 29 | use Types::Standard -types; 30 | 31 | my $p1 = ArrayRef->parameterize( Int ); 32 | my $p2 = ArrayRef->of( Int ); 33 | 34 | is($p1->{uniq}, $p2->{uniq}, "->of method works same as ->parameterize"); 35 | 36 | my $p3 = ArrayRef->where(sub { $_->[0] eq 'Bob' }); 37 | 38 | should_pass ['Bob', 'Alice'], $p3; 39 | should_fail ['Alice', 'Bob'], $p3; 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/smartmatch.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny works with the smartmatch operator. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use lib qw( ./lib ./t/lib ../inc ./inc ); 24 | 25 | use Test::More; 26 | use Type::Tiny (); 27 | 28 | BEGIN { 29 | Type::Tiny::SUPPORT_SMARTMATCH 30 | or plan skip_all => 'smartmatch support not available for this version or Perl'; 31 | } 32 | 33 | use Types::Standard -all; 34 | 35 | no warnings; # !! 36 | 37 | ok( 42 ~~ Int ); 38 | ok( 42 ~~ Num ); 39 | ok not( 42 ~~ ArrayRef ); 40 | 41 | ok( 42 ~~ \&is_Int ); 42 | ok not( 42 ~~ \&is_ArrayRef ); 43 | 44 | TODO: { 45 | use feature qw(switch); 46 | given (4) { 47 | when ( \&is_RegexpRef ) { fail('regexpref') } 48 | when ( \&is_Int ) { pass('int') } 49 | default { fail('default') } 50 | } 51 | 52 | local $TODO = 'this would be nice, but probably requires changes to perl'; 53 | given (4) { 54 | when ( RegexpRef ) { fail('regexpref') } 55 | when ( Int ) { pass('int') } 56 | default { fail('default') } 57 | } 58 | }; 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/strictmode-off.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check Type::Tiny C<< / >> overload in lax mode. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | BEGIN { 23 | $ENV{$_} = 0 for qw( 24 | EXTENDED_TESTING 25 | AUTHOR_TESTING 26 | RELEASE_TESTING 27 | PERL_STRICT 28 | ); 29 | }; 30 | 31 | use strict; 32 | use warnings; 33 | use Test::More; 34 | use Test::TypeTiny; 35 | 36 | use Types::Standard -types; 37 | 38 | subtest "Type constraint object overloading /" => sub { 39 | my $type = ArrayRef[ Int / Str ]; 40 | 41 | should_pass( [] => $type ); 42 | should_pass( [ 1 .. 3 ] => $type ); 43 | should_pass( [ "foo", "bar" ] => $type ); 44 | should_fail( [ {} ] => $type ); 45 | should_fail( {} => $type ); 46 | }; 47 | 48 | subtest "Type::Parser support for /" => sub { 49 | use Type::Registry qw( t ); 50 | my $type = t( 'ArrayRef[ Int / Str ]' ); 51 | 52 | should_pass( [] => $type ); 53 | should_pass( [ 1 .. 3 ] => $type ); 54 | should_pass( [ "foo", "bar" ] => $type ); 55 | should_fail( [ {} ] => $type ); 56 | should_fail( {} => $type ); 57 | }; 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/strictmode-on.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check Type::Tiny C<< / >> overload in strict mode. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | BEGIN { 23 | $ENV{$_} = 0 for qw( 24 | EXTENDED_TESTING 25 | AUTHOR_TESTING 26 | RELEASE_TESTING 27 | PERL_STRICT 28 | ); 29 | $ENV{PERL_STRICT} = 1; 30 | }; 31 | 32 | use strict; 33 | use warnings; 34 | use Test::More; 35 | use Test::TypeTiny; 36 | 37 | use Types::Standard -types; 38 | 39 | subtest "Type constraint object overloading /" => sub { 40 | my $type = ArrayRef[ Int / Str ]; 41 | 42 | should_pass( [] => $type ); 43 | should_pass( [ 1 .. 3 ] => $type ); 44 | should_fail( [ "foo", "bar" ] => $type ); 45 | should_fail( [ {} ] => $type ); 46 | should_fail( {} => $type ); 47 | }; 48 | 49 | subtest "Type::Parser support for /" => sub { 50 | use Type::Registry qw( t ); 51 | my $type = t( 'ArrayRef[ Int / Str ]' ); 52 | 53 | should_pass( [] => $type ); 54 | should_pass( [ 1 .. 3 ] => $type ); 55 | should_fail( [ "foo", "bar" ] => $type ); 56 | should_fail( [ {} ] => $type ); 57 | should_fail( {} => $type ); 58 | }; 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/to-moose.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny objects can be converted to Moose type constraint objects. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires Moose 2.0000; skipped otherwise. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Requires { 'Moose' => '2.0000' }; 32 | use Test::TypeTiny; 33 | 34 | use Type::Tiny; 35 | 36 | my $Any = "Type::Tiny"->new(name => "Anything"); 37 | my $Int = $Any->create_child_type( 38 | name => "Integer", 39 | constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, 40 | ); 41 | 42 | my $mAny = $Any->moose_type; 43 | my $mInt = $Int->moose_type; 44 | 45 | isa_ok($mAny, 'Moose::Meta::TypeConstraint', '$mAny'); 46 | isa_ok($mInt, 'Moose::Meta::TypeConstraint', '$mInt'); 47 | is($mInt->parent, $mAny, 'type constraint inheritance seems right'); 48 | 49 | should_pass(42, $mAny); 50 | should_pass([], $mAny); 51 | should_pass(42, $mInt); 52 | should_fail([], $mInt); 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/20-modules/Type-Tiny/to-mouse.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny objects can be converted to Mouse type constraint objects. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Requires { 'Mouse' => '1.00' }; 28 | use Test::TypeTiny; 29 | 30 | use Type::Tiny; 31 | 32 | my $Any = "Type::Tiny"->new(name => "Anything"); 33 | my $Int = $Any->create_child_type( 34 | name => "Integer", 35 | constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, 36 | ); 37 | 38 | my $mAny = $Any->mouse_type; 39 | my $mInt = $Int->mouse_type; 40 | 41 | isa_ok($mAny, 'Mouse::Meta::TypeConstraint', '$mAny'); 42 | isa_ok($mInt, 'Mouse::Meta::TypeConstraint', '$mInt'); 43 | is($mInt->parent, $mAny, 'type constraint inheritance seems right'); 44 | 45 | should_pass(42, $mAny); 46 | should_pass([], $mAny); 47 | should_pass(42, $mInt); 48 | should_fail([], $mInt); 49 | 50 | done_testing; 51 | -------------------------------------------------------------------------------- /t/20-modules/Type-Utils/auto-registry.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Utils declaration functions put types in the caller type registry. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | 28 | BEGIN { 29 | package Local::Package; 30 | use Type::Utils -all; 31 | 32 | declare 'Reference', 33 | where { ref $_ }; 34 | }; 35 | 36 | require Type::Registry; 37 | is_deeply( 38 | [ sort keys %{ Type::Registry->for_class( 'Local::Package' ) } ], 39 | [ sort qw( Reference ) ], 40 | 'Declaration functions add types to registries', 41 | ); 42 | 43 | ok( Type::Registry->for_class( 'Local::Package' )->Reference->check( [] ) ); 44 | ok( Type::Registry->for_class( 'Local::Package' )->Reference->check( {} ) ); 45 | ok( not Type::Registry->for_class( 'Local::Package' )->Reference->check( 42 ) ); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/20-modules/Type-Utils/classifier.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L C function. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use Test::More; 27 | 28 | use Type::Utils qw( classifier ); 29 | use Types::Standard -types; 30 | 31 | my $classify = classifier(Num, Str, Int, Ref, ArrayRef, HashRef, Any, InstanceOf['Type::Tiny']); 32 | 33 | sub classified ($$) 34 | { 35 | my $got = $classify->($_[0]); 36 | my $expected = $_[1]; 37 | local $Test::Builder::Level = $Test::Builder::Level + 1; 38 | is( 39 | $got->name, 40 | $expected->name, 41 | sprintf("%s classified as %s", Type::Tiny::_dd($_[0]), $expected), 42 | ); 43 | } 44 | 45 | classified(42, Int); 46 | classified(1.1, Num); 47 | classified("Hello world", Str); 48 | classified("42", Int); 49 | classified("1.1", Num); 50 | classified((\(my $x)), Ref); 51 | classified([], ArrayRef); 52 | classified({}, HashRef); 53 | classified(undef, Any); 54 | classified(Num, InstanceOf['Type::Tiny']); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/20-modules/Type-Utils/dwim-both.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks sane behaviour of C from L when both 8 | Moose and Mouse are loaded. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Mouse 1.00 and Moose 2.0000; skipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | 30 | use Test::More; 31 | { package AAA; use Test::Requires { "Mouse" => "1.00" } }; 32 | { package BBB; use Test::Requires { "Moose" => "2.0000" } }; 33 | 34 | { 35 | package Minnie; 36 | use Mouse; 37 | use Mouse::Util::TypeConstraints qw(:all); 38 | subtype "FortyFive", as "Int", where { $_ == 40 or $_ == 5 }; 39 | } 40 | 41 | { 42 | package Bulwinkle; 43 | use Moose; 44 | use Moose::Util::TypeConstraints qw(:all); 45 | subtype "FortyFive", as "Int", where { $_ == 45 }; 46 | } 47 | 48 | use Test::TypeTiny; 49 | use Type::Utils 0.015 qw(dwim_type); 50 | 51 | my $mouse = dwim_type "FortyFive", for => "Minnie"; 52 | should_fail 2, $mouse; 53 | should_pass 5, $mouse; 54 | should_pass 40, $mouse; 55 | should_fail 45, $mouse; 56 | should_fail 99, $mouse; 57 | 58 | my $moose = dwim_type "FortyFive", for => "Bulwinkle"; 59 | should_fail 2, $moose; 60 | should_fail 5, $moose; 61 | should_fail 40, $moose; 62 | should_pass 45, $moose; 63 | should_fail 99, $moose; 64 | 65 | done_testing; 66 | -------------------------------------------------------------------------------- /t/20-modules/Type-Utils/is.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L C function. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use Test::More; 26 | use Test::Requires { 'Test::Warnings' => 0.005 }; 27 | use Test::Warnings ':all'; 28 | use Test::Fatal; 29 | 30 | use Type::Utils "is" => { -as => "isntnt" }, "assert"; 31 | use Types::Standard "Str"; 32 | 33 | ok ! isntnt(Str, undef); 34 | ok isntnt(Str, ''); 35 | ok ! isntnt('Str', undef); 36 | ok isntnt('Str', ''); 37 | 38 | my @warnings = warnings { 39 | ok ! isntnt( undef, undef ); 40 | }; 41 | 42 | like( 43 | $warnings[0], 44 | qr/Expected type, but got undef/, 45 | 'warning from is(undef, $value)' 46 | ); 47 | 48 | @warnings = warnings { 49 | ok ! isntnt( [], undef ); 50 | }; 51 | 52 | like( 53 | $warnings[0], 54 | qr/Expected type, but got reference \[/, 55 | 'warning from is([], $value)' 56 | ); 57 | 58 | is assert(Str, 'foo'), 'foo'; 59 | like exception { assert(Str, []) }, qr/did not pass type constraint/; 60 | like exception { assert('*', []) }, qr/Expected type, but got value/; 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/20-modules/Type-Utils/warnings.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests warnings raised by L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires Perl 5.14 and L; skipped otherwise. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Requires '5.014'; 32 | use Test::Requires { 'Test::Warnings' => 0.005 }; #warnings added in this version 33 | use Test::Warnings qw( :no_end_test warnings ); 34 | 35 | use Type::Library -base, -declare => qw/WholeNumber/; 36 | use Type::Utils -all; 37 | use Types::Standard qw/Int/; 38 | 39 | my @warnings = warnings { 40 | declare WholeNumber as Int; 41 | }; 42 | 43 | like( 44 | $warnings[0], 45 | qr/^Possible missing comma after 'declare WholeNumber'/, 46 | 'warning for missing comma', 47 | ); 48 | 49 | done_testing; 50 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common-Numeric/immutable.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L cannot be added to! 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings FATAL => 'all'; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Common::Numeric; 28 | 29 | my $e = exception { 30 | Types::Common::Numeric->add_type( { name => 'Boomerang' } ); 31 | }; 32 | 33 | like $e, qr/Type library is immutable/; 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common-String/coerce.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests coercions for L. 8 | 9 | These tests are based on tests from L. 10 | 11 | =head1 AUTHORS 12 | 13 | =over 4 14 | 15 | =item * 16 | 17 | Matt S Trout - mst (at) shadowcatsystems.co.uk (L) 18 | 19 | =item * 20 | 21 | K. James Cheetham 22 | 23 | =item * 24 | 25 | Guillermo Roditi 26 | 27 | =back 28 | 29 | =head1 COPYRIGHT AND LICENCE 30 | 31 | This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). 32 | 33 | This is free software; you can redistribute it and/or modify it under 34 | the same terms as the Perl 5 programming language system itself. 35 | 36 | =cut 37 | 38 | use strict; 39 | use warnings FATAL => 'all'; 40 | use Test::More; 41 | 42 | use Types::Common::String qw( 43 | +LowerCaseSimpleStr 44 | +UpperCaseSimpleStr 45 | +LowerCaseStr 46 | +UpperCaseStr 47 | +NumericCode 48 | ); 49 | 50 | is(to_UpperCaseSimpleStr('foo'), 'FOO', 'uppercase str' ); 51 | is(to_LowerCaseSimpleStr('BAR'), 'bar', 'lowercase str' ); 52 | 53 | is(to_UpperCaseStr('foo'), 'FOO', 'uppercase str' ); 54 | is(to_LowerCaseStr('BAR'), 'bar', 'lowercase str' ); 55 | 56 | is(to_NumericCode('4111-1111-1111-1111'), '4111111111111111', 'numeric code' ); 57 | is(to_NumericCode('+1 (800) 555-01-23'), '18005550123', 'numeric code' ); 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common-String/immutable.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L cannot be added to! 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings FATAL => 'all'; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Common::String; 28 | 29 | my $e = exception { 30 | Types::Common::String->add_type( { name => 'Boomerang' } ); 31 | }; 32 | 33 | like $e, qr/Type library is immutable/; 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common-String/strlength.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests constraints for L's 8 | Ctring 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2018-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use utf8; 24 | use strict; 25 | use warnings FATAL => 'all'; 26 | use Test::More; 27 | use Test::TypeTiny; 28 | 29 | use Types::Common::String -all; 30 | 31 | my $type = StrLength[5,10]; 32 | 33 | should_fail($_, $type) for ([], {}, sub { 3 }, undef, "", 123, "Hiya", "Hello World"); 34 | should_pass($_, $type) for ("Hello", "Hello!", " " x 8, "HelloWorld"); 35 | 36 | my $type2 = StrLength[4,4]; 37 | 38 | should_pass("café", $type2); 39 | should_pass("™ķ⁹—", $type2); 40 | 41 | my $type3 = StrLength[4]; 42 | should_fail($_, $type3) for ([], {}, sub { 3 }, undef, "", 123); 43 | should_pass($_, $type3) for ("Hello", "Hello!", " " x 8, "HelloWorld", "Hiya", "Hello World"); 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings FATAL => 'all'; 24 | use Test::More; 25 | 26 | { 27 | my %imported; 28 | use Types::Common { into => \%imported }, -all; 29 | 30 | my @libs = qw( 31 | Types::Standard 32 | Types::Common::Numeric 33 | Types::Common::String 34 | Types::TypeTiny 35 | ); 36 | my @types = map $_->type_names, @libs; 37 | my @coercions = map $_->coercion_names, @libs; 38 | 39 | is_deeply( 40 | [ sort keys %imported ], 41 | [ sort { $a cmp $b } ( 42 | @types, 43 | map( "assert_$_", @types ), 44 | map( "is_$_", @types ), 45 | map( "to_$_", @types ), 46 | @coercions, 47 | @{ $Type::Params::EXPORT_TAGS{sigs} || [] }, 48 | qw( t ), 49 | ) ], 50 | 'correct imports', 51 | ); 52 | 53 | ok( $imported{t}->( 'Str' ) == Types::Standard::Str(), 't() is preloaded' ); 54 | } 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/20-modules/Types-Common/immutable.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L cannot be added to! 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings FATAL => 'all'; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Common; 28 | 29 | my $e = exception { 30 | Types::Common->add_type( { name => 'Boomerang' } ); 31 | }; 32 | 33 | like $e, qr/Type library is immutable/; 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-ArrayRef/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::ArrayRef can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::ArrayRef ( 28 | Ints => { type => Int }, 29 | Nums => { of => 'Num' }, 30 | ); 31 | 32 | is Ints->name, "Ints"; 33 | is Nums->name, "Nums"; 34 | 35 | ok is_Ints [ 1 .. 5 ]; 36 | ok is_Nums [ 1 .. 5 ]; 37 | ok !is_Ints [ undef ]; 38 | ok !is_Nums [ undef ]; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'Ints'}, Ints ); 42 | is( 'Type::Registry'->for_me->{'Nums'}, Nums ); 43 | 44 | use Types::Standard::ArrayRef TwoInts => { 45 | of => Int->where( q{ $_ > 0 } ), 46 | where => q{ @$_ == 2 }, 47 | }; 48 | 49 | ok is_TwoInts [ 1, 5 ]; 50 | ok !is_TwoInts [ 1 .. 5 ]; 51 | ok !is_TwoInts [ -1, 0 ]; 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-CycleTuple/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::CycleTuple can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::CycleTuple ( 28 | IntAndStr1 => { of => [ Int, Str ] }, 29 | IntAndStr2 => { of => [ 'Int', 'Str' ] }, 30 | ); 31 | 32 | is IntAndStr1->name, "IntAndStr1"; 33 | is IntAndStr2->name, "IntAndStr2"; 34 | 35 | ok is_IntAndStr1 [ 1 => 'one', 2 => 'two' ]; 36 | ok is_IntAndStr2 [ 1 => 'one', 2 => 'two' ]; 37 | ok !is_IntAndStr1 [ one => 1 ]; 38 | ok !is_IntAndStr2 [ two => 2 ]; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'IntAndStr1'}, IntAndStr1 ); 42 | is( 'Type::Registry'->for_me->{'IntAndStr2'}, IntAndStr2 ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-Dict/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::Dict can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | 28 | use Types::Standard::Dict ( 29 | Credentials => { of => [ 30 | username => Str, 31 | password => Str, 32 | ] }, 33 | Headers => { of => [ 34 | 'Content-Type' => Optional[Str], 35 | 'Accept' => Optional[Str], 36 | 'User-Agent' => Optional[Str], 37 | ] }, 38 | ); 39 | 40 | use Types::Standard::Dict ( 41 | HttpRequestData => { of => [ 42 | credentials => Credentials, 43 | headers => Headers, 44 | url => Str, 45 | method => Enum[ qw( OPTIONS HEAD GET POST PUT DELETE PATCH ) ], 46 | ] }, 47 | ); 48 | 49 | ok is_HttpRequestData( { 50 | credentials => { username => 'bob', password => 's3cr3t' }, 51 | headers => { 'Accept' => 'application/json' }, 52 | url => 'http://example.net/api/v1/stuff', 53 | method => 'GET', 54 | } ); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-HashRef/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::HashRef can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::HashRef ( 28 | IntHash => { type => Int }, 29 | NumHash => { of => 'Num' }, 30 | ); 31 | 32 | is IntHash->name, "IntHash"; 33 | is NumHash->name, "NumHash"; 34 | 35 | ok is_IntHash { one => 1 }; 36 | ok is_NumHash { one => 1.1 }; 37 | ok !is_IntHash [ undef ]; 38 | ok !is_NumHash [ undef ]; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'IntHash'}, IntHash ); 42 | is( 'Type::Registry'->for_me->{'NumHash'}, NumHash ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-Map/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::Map can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::Map ( 28 | IntMap1 => { keys => Int, values => Str }, 29 | IntMap2 => { of => [ 'Int', 'Str' ] }, 30 | ); 31 | 32 | is IntMap1->name, "IntMap1"; 33 | is IntMap2->name, "IntMap2"; 34 | 35 | ok is_IntMap1 { 1 => 'one' }; 36 | ok is_IntMap2 { 2 => 'two' }; 37 | ok !is_IntMap1 { one => 1 }; 38 | ok !is_IntMap2 { two => 2 }; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'IntMap1'}, IntMap1 ); 42 | is( 'Type::Registry'->for_me->{'IntMap2'}, IntMap2 ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-ScalarRef/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::ScalarRef can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::ScalarRef ( 28 | IntRef => { type => Int }, 29 | NumRef => { of => 'Num' }, 30 | ); 31 | 32 | is IntRef->name, "IntRef"; 33 | is NumRef->name, "NumRef"; 34 | 35 | ok is_IntRef \1; 36 | ok is_NumRef \1.1; 37 | ok !is_IntRef \1.1; 38 | ok !is_NumRef \"foo"; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'IntRef'}, IntRef ); 42 | is( 'Type::Registry'->for_me->{'NumRef'}, NumRef ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-StrMatch/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::StrMatch can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::StrMatch ( 28 | Aaa => { of => qr/\A[Aa]+\z/ }, 29 | Bbb => { re => qr/\A[Bb]+\z/ }, 30 | ); 31 | 32 | is Aaa->name, "Aaa"; 33 | is Bbb->name, "Bbb"; 34 | 35 | ok is_Aaa 'AaaaaaaAAAAaaAaAAAaaaA'; 36 | ok is_Bbb 'BbbbBbbBbBbBBBbBBBB'; 37 | ok !is_Aaa \1.1; 38 | ok !is_Bbb "a"; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'Aaa'}, Aaa ); 42 | is( 'Type::Registry'->for_me->{'Bbb'}, Bbb ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard-Tuple/exporter.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Types::Standard::Tuple can export. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Types::Standard -types; 27 | use Types::Standard::Tuple ( 28 | IntAndStr1 => { of => [ Int, Str ] }, 29 | IntAndStr2 => { of => [ 'Int', 'Str' ] }, 30 | ); 31 | 32 | is IntAndStr1->name, "IntAndStr1"; 33 | is IntAndStr2->name, "IntAndStr2"; 34 | 35 | ok is_IntAndStr1 [ 1 => 'one' ]; 36 | ok is_IntAndStr2 [ 2 => 'two' ]; 37 | ok !is_IntAndStr1 [ one => 1 ]; 38 | ok !is_IntAndStr2 [ two => 2 ]; 39 | 40 | require Type::Registry; 41 | is( 'Type::Registry'->for_me->{'IntAndStr1'}, IntAndStr1 ); 42 | is( 'Type::Registry'->for_me->{'IntAndStr2'}, IntAndStr2 ); 43 | 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/arrayreflength.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks the new ArrayRef[$type, $min, $max] from Types::Standard. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2018-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( . ./t ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Fatal; 28 | use Test::TypeTiny; 29 | 30 | use Types::Standard qw(ArrayRef Int Any); 31 | 32 | my $type = ArrayRef[Int, 2]; 33 | should_fail([], $type); 34 | should_fail([0], $type); 35 | should_pass([0..1], $type); 36 | should_pass([0..2], $type); 37 | should_pass([0..3], $type); 38 | should_pass([0..4], $type); 39 | should_pass([0..5], $type); 40 | should_pass([0..6], $type); 41 | should_fail([0..1, "nope"], $type); 42 | should_fail(["nope", 0..1], $type); 43 | 44 | $type = ArrayRef[Int, 2, 4]; 45 | should_fail([], $type); 46 | should_fail([0], $type); 47 | should_pass([0..1], $type); 48 | should_pass([0..2], $type); 49 | should_pass([0..3], $type); 50 | should_fail([0..4], $type); 51 | should_fail([0..5], $type); 52 | should_fail([0..6], $type); 53 | should_fail([0..1, "nope"], $type); 54 | should_fail(["nope", 0..1], $type); 55 | 56 | unlike(ArrayRef->of(Any), qr/for/, 'ArrayRef[Any] optimization'); 57 | unlike(ArrayRef->of(Any, 2), qr/for/, 'ArrayRef[Any,2] optimization'); 58 | unlike(ArrayRef->of(Any, 2, 4), qr/for/, 'ArrayRef[Any,2,4] optimization'); 59 | 60 | # diag ArrayRef->of(Any, 2, 4)->inline_check('$XXX'); 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/filehandle.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks various values against C from Types::Standard. 8 | 9 | =head1 SEE ALSO 10 | 11 | L 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2018-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::TypeTiny; 32 | use Test::Requires qw( IO::String ); 33 | 34 | use Types::Standard qw( FileHandle ); 35 | 36 | should_pass('IO::String'->new, FileHandle); 37 | should_fail('IO::String', FileHandle); 38 | 39 | done_testing; 40 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/immutable.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L cannot be added to! 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2022-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings FATAL => 'all'; 24 | use Test::More; 25 | use Test::Fatal; 26 | 27 | use Types::Standard; 28 | 29 | my $e = exception { 30 | Types::Standard->add_type( { name => 'Boomerang' } ); 31 | }; 32 | 33 | like $e, qr/Type library is immutable/; 34 | 35 | done_testing; 36 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/lockdown.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =head1 PURPOSE 4 | 5 | OK, we need to bite the bullet and lock down coercions on core type 6 | constraints and parameterized type constraints. 7 | 8 | =head1 SEE ALSO 9 | 10 | L. 11 | 12 | =head1 AUTHOR 13 | 14 | Toby Inkster Etobyink@cpan.orgE. 15 | 16 | =head1 COPYRIGHT AND LICENCE 17 | 18 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 19 | 20 | This is free software; you can redistribute it and/or modify it under 21 | the same terms as the Perl 5 programming language system itself. 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | 28 | use Test::More; 29 | use Test::Fatal; 30 | 31 | use Types::Standard -types; 32 | use Types::Common::Numeric -types; 33 | 34 | my $frozen = qr/\AAttempt to add coercion code to a Type::Coercion/; 35 | 36 | like( 37 | exception { 38 | Str->coercion->add_type_coercions(ArrayRef, sub { "@$_" }); 39 | }, 40 | $frozen, 41 | 'Types::Standard core types are frozen', 42 | ); 43 | 44 | like( 45 | exception { 46 | PositiveInt->coercion->add_type_coercions(NegativeInt, sub { -$_ }); 47 | }, 48 | $frozen, 49 | 'Types::Common types are frozen', 50 | ); 51 | 52 | like( 53 | exception { 54 | InstanceOf->of("Foo")->coercion->add_type_coercions(HashRef, sub { bless $_, "Foo" }); 55 | }, 56 | $frozen, 57 | 'Parameterized types are frozen', 58 | ); 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/overload.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks various values against C from Types::Standard. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::TypeTiny; 28 | 29 | use Types::Standard qw( Any Item Defined Ref ArrayRef Object Overload ); 30 | 31 | my $o = bless [] => do { 32 | package Local::Class; 33 | use overload q[&] => sub { 1 }, fallback => 1; 34 | __PACKAGE__; 35 | }; 36 | 37 | should_pass($o, Any); 38 | should_pass($o, Item); 39 | should_pass($o, Defined); 40 | should_pass($o, Ref); 41 | should_pass($o, Ref["ARRAY"]); 42 | should_pass($o, Object); 43 | should_pass($o, Overload); 44 | should_pass($o, Overload["&"]); 45 | 46 | should_fail($o, Ref["HASH"]); 47 | should_fail($o, Overload["|"]); 48 | should_fail("Local::Class", Overload); 49 | should_fail([], Overload); 50 | 51 | ok_subtype($_, Overload["&"]) 52 | for Item, Defined, Ref, Object, Overload; 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/strmatch-allow-callbacks.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks various values against C from Types::Standard 8 | when C<< $Type::Tiny::AvoidCallbacks >> is false. 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster Etobyink@cpan.orgE. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2019-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use lib qw( . ./t ../inc ./inc ); 26 | use Test::More; 27 | use Test::Requires '5.020'; 28 | 29 | use Types::Standard 'StrMatch'; 30 | 31 | BEGIN { eval q{ use Test::Warnings } unless "$^V" =~ /c$/ }; 32 | 33 | $Type::Tiny::AvoidCallbacks = 0; 34 | 35 | my $z; 36 | my $complex = StrMatch->of(qr/x(?{$z})/); # closure so can't be easily inlined 37 | ok($complex->can_be_inlined, "using callbacks, this complex regexp can be inlined"); 38 | like($complex->inline_check('$_'), qr/Types::Standard::StrMatch/, '... and looks okay'); 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/20-modules/Types-Standard/strmatch-avoid-callbacks.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks various values against C from Types::Standard 8 | when C<< $Type::Tiny::AvoidCallbacks >> is true. 9 | 10 | =head1 AUTHOR 11 | 12 | Toby Inkster Etobyink@cpan.orgE. 13 | 14 | =head1 COPYRIGHT AND LICENCE 15 | 16 | This software is copyright (c) 2019-2025 by Toby Inkster. 17 | 18 | This is free software; you can redistribute it and/or modify it under 19 | the same terms as the Perl 5 programming language system itself. 20 | 21 | =cut 22 | 23 | use strict; 24 | use warnings; 25 | use lib qw( . ./t ../inc ./inc ); 26 | use Test::More; 27 | 28 | BEGIN { 29 | plan skip_all => "cperl's `shadow` warnings catgeory breaks this test; skipping" 30 | if "$^V" =~ /c$/; 31 | }; 32 | 33 | use Test::Requires '5.020'; 34 | use Test::Requires 'Test::Warnings'; 35 | 36 | use Types::Standard 'StrMatch'; 37 | use Test::Warnings 'warning'; 38 | 39 | $Type::Tiny::AvoidCallbacks = 1; 40 | 41 | my $z; 42 | my $complex = StrMatch->of(qr/x(?{$z})/); # closure so can't be easily inlined 43 | my $warning = warning { $z = $complex->inline_check('$VALUE') }; 44 | 45 | like($z, qr/Types::Standard::StrMatch::expressions/); 46 | like($warning, qr/without callbacks/); 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/20-modules/Types-TypeTiny/meta.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test the L introspection methods. Types::TypeTiny doesn't 8 | inherit from L (because bootstrapping), so provides 9 | independent re-implementations of the most important introspection stuff. 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | use strict; 25 | use warnings; 26 | use lib qw( ./lib ./t/lib ../inc ./inc ); 27 | 28 | use Test::More; 29 | use Test::TypeTiny -all; 30 | use Types::TypeTiny; 31 | 32 | my $meta = Types::TypeTiny->meta; 33 | 34 | is_deeply( 35 | [ sort $meta->type_names ], 36 | [ sort qw( BoolLike CodeLike ArrayLike StringLike HashLike TypeTiny _ForeignTypeConstraint ) ], 37 | 'type_names', 38 | ); 39 | 40 | ok( 41 | $meta->has_type('HashLike'), 42 | 'has_type(HashLike)', 43 | ); 44 | 45 | ok( 46 | $meta->get_type('HashLike')->equals(Types::TypeTiny::HashLike()), 47 | 'get_type(HashLike)', 48 | ); 49 | 50 | ok( 51 | !$meta->has_type('MonkeyNuts'), 52 | 'has_type(MonkeyNuts)', 53 | ); 54 | 55 | ok( 56 | !defined( $meta->get_type('MonkeyNuts') ), 57 | 'get_type(MonkeyNuts)', 58 | ); 59 | 60 | is_deeply( 61 | [ sort $meta->coercion_names ], 62 | [], 63 | 'coercion_names', 64 | ); 65 | 66 | ok( 67 | !$meta->has_coercion('MonkeyNuts'), 68 | 'has_coercion(MonkeyNuts)', 69 | ); 70 | 71 | ok( 72 | !defined( $meta->get_coercion('MonkeyNuts') ), 73 | 'get_coercion(MonkeyNuts)', 74 | ); 75 | 76 | done_testing; 77 | -------------------------------------------------------------------------------- /t/20-modules/Types-TypeTiny/moosemouse.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Stuff that was originally in basic.t but was split out to avoid basic.t 8 | requiring Moose and Mouse. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | This test requires L 2.0000 and L 1.00. Otherwise, it is 13 | skipped. 14 | 15 | =head1 AUTHOR 16 | 17 | Toby Inkster Etobyink@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use lib qw( ./lib ./t/lib ../inc ./inc ); 31 | 32 | # Test::Requires calls ->import on Moose/Mouse, so be sure 33 | # to import them into dummy packages. 34 | { package XXX; use Test::Requires { Moose => '2.0000' } }; 35 | { package YYY; use Test::Requires { Mouse => '1.00' } }; 36 | 37 | use Test::More; 38 | use Test::TypeTiny -all; 39 | use Types::TypeTiny -all; 40 | use Moose::Util::TypeConstraints qw(find_type_constraint); 41 | 42 | subtest "TypeTiny" => sub 43 | { 44 | my $type = TypeTiny; 45 | should_pass( ArrayLike, $type, 'Type::Tiny constraint object passes type constraint TypeTiny' ); 46 | should_fail( {}, $type ); 47 | should_fail( sub { 42 }, $type ); 48 | should_fail( find_type_constraint("Int"), $type, 'Moose constraint object fails type constraint TypeTiny' ); 49 | should_fail( Mouse::Util::TypeConstraints::find_type_constraint("Int"), $type, 'Mouse constraint object fails type constraint TypeTiny' ); 50 | should_fail( undef, $type ); 51 | }; 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/20-modules/Types-TypeTiny/progressiveexporter.t: -------------------------------------------------------------------------------- 1 | # HARNESS-NO-PRELOAD 2 | 3 | =pod 4 | 5 | =encoding utf-8 6 | 7 | =head1 PURPOSE 8 | 9 | Checks that Types::TypeTiny avoids loading Exporter::Tiny. 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2018-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | use strict; 25 | use warnings; 26 | use lib qw( ./lib ./t/lib ../inc ./inc ); 27 | 28 | use Test::More; 29 | 30 | require Types::TypeTiny; 31 | 32 | ok !Exporter::Tiny->can('mkopt'); 33 | 34 | Types::TypeTiny->import(); 35 | 36 | ok !Exporter::Tiny->can('mkopt'); 37 | 38 | Types::TypeTiny->import('HashLike'); 39 | 40 | ok Exporter::Tiny->can('mkopt'); 41 | 42 | done_testing; 43 | -------------------------------------------------------------------------------- /t/30-external/Class-Plain/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraints work with L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Test is skipped if Class::Plain 0.02 is not available. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2022-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | 29 | use Test::More; 30 | use Test::Fatal; 31 | 32 | use Test::Requires '5.026'; 33 | use Test::Requires { "Class::Plain" => 0.02 }; 34 | 35 | use experimental 'signatures'; 36 | use Class::Plain; 37 | 38 | class Point { 39 | use Types::Common -types, -sigs; 40 | 41 | field x :reader; 42 | field y :reader; 43 | 44 | signature_for new => ( 45 | method => 1, 46 | bless => 0, 47 | named => [ 48 | x => Int, 49 | y => Int, 50 | ], 51 | ); 52 | 53 | method as_arrayref () { 54 | return [ $self->x, $self->y ]; 55 | } 56 | } 57 | 58 | my $point = Point->new( x => 42, y => 666 ); 59 | 60 | is_deeply( 61 | $point->as_arrayref, 62 | [ 42, 666 ], 63 | ); 64 | 65 | like( 66 | exception { Point->new( x => 42, y => [] ) }, 67 | qr/did not pass type constraint "Int"/, 68 | ); 69 | 70 | done_testing; 71 | -------------------------------------------------------------------------------- /t/30-external/Data-Constraint/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests integration with L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2020-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::TypeTiny; 26 | use Test::Fatal; 27 | 28 | use Test::Requires 'Data::Constraint'; 29 | use Types::TypeTiny qw( to_TypeTiny ); 30 | 31 | 'Data::Constraint'->add_constraint( 32 | 'FortyTwo', 33 | 'run' => sub { defined $_[1] and not ref $_[1] and $_[1] eq 42 }, 34 | 'description' => 'True if the value reveals the answer to life, the universe, and everything', 35 | ); 36 | 37 | my $type = to_TypeTiny( 'Data::Constraint'->get_by_name( 'FortyTwo' ) ); 38 | 39 | should_pass( 42, $type ); 40 | should_fail( "42.0", $type ); 41 | should_fail( [ 42 ], $type ); 42 | should_fail( undef, $type ); 43 | 44 | my $e = exception { $type->(43) }; 45 | 46 | like $e, qr/Value "43" did not pass type constraint "FortyTwo"/, 'error message'; 47 | 48 | done_testing; 49 | -------------------------------------------------------------------------------- /t/30-external/Exporter-Tiny/installer.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests L libraries work with Sub::Exporter plugins. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::Requires { "Sub::Exporter::Lexical" => "0.092291" }; 27 | use Test::More; 28 | use Test::Fatal; 29 | 30 | { 31 | use Sub::Exporter::Lexical qw( lexical_installer ); 32 | use Types::Standard { installer => lexical_installer }, qw( ArrayRef ); 33 | 34 | ArrayRef->( [] ); 35 | } 36 | ok(!eval q{ ArrayRef->( [] ) }, 'the ArrayRef function was cleaned away'); 37 | ok(!__PACKAGE__->can("ArrayRef"), 'ArrayRef does not appear to be a method'); 38 | 39 | done_testing; 40 | -------------------------------------------------------------------------------- /t/30-external/Exporter-Tiny/role-conflict.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests exporting to two roles; tries to avoid reporting conflicts. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires L 5.59 and L 1.000000; 12 | test skipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 THANKS 19 | 20 | This test case is based on a script provided by Kevin Dawson. 21 | 22 | =head1 COPYRIGHT AND LICENCE 23 | 24 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 25 | 26 | This is free software; you can redistribute it and/or modify it under 27 | the same terms as the Perl 5 programming language system itself. 28 | 29 | =cut 30 | 31 | use strict; 32 | use warnings; 33 | use lib qw( ./lib ./t/lib ../inc ./inc ); 34 | 35 | use Test::Requires { "Exporter" => 5.59 }; 36 | use Test::Requires { "Role::Tiny" => 1.000000 }; 37 | use Test::More; 38 | use Test::Fatal; 39 | 40 | { 41 | package Local::Role1; 42 | use Role::Tiny; 43 | use Types::Standard "Str"; 44 | } 45 | 46 | { 47 | package Local::Role2; 48 | use Role::Tiny; 49 | use Types::Standard "Str"; 50 | } 51 | 52 | my $e = exception { 53 | package Local::Class1; 54 | use Role::Tiny::With; 55 | with qw( Local::Role1 Local::Role2 ); 56 | }; 57 | 58 | is($e, undef, 'no exception when trying to compose two roles that use type constraints'); 59 | 60 | use Scalar::Util "refaddr"; 61 | note refaddr(\&Local::Role1::Str); 62 | note refaddr(\&Local::Role2::Str); 63 | 64 | done_testing; 65 | -------------------------------------------------------------------------------- /t/30-external/Function-Parameters/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraints work with L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires Function::Parameters 1.0103, and either Moo 1.000000 12 | or Moose 2.0000; skipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | 31 | use Test::More; 32 | use Test::Requires { "Function::Parameters" => "1.0103" }; 33 | use Test::Fatal; 34 | 35 | BEGIN { 36 | eval 'use Moo 1.000000; 1' 37 | or eval 'use Moose 2.0000; 1' 38 | or plan skip_all => "this test requires Moo 1.000000 or Moose 2.0000"; 39 | }; 40 | 41 | BEGIN { plan skip_all => 'Devel::Cover' if $INC{'Devel/Cover.pm'} }; 42 | 43 | use Types::Standard -types; 44 | use Function::Parameters qw(:strict); 45 | 46 | fun foo ((Int) $x) 47 | { 48 | return $x; 49 | } 50 | 51 | is( 52 | foo(4), 53 | 4, 54 | 'foo(4) works', 55 | ); 56 | 57 | isnt( 58 | exception { foo(4.1) }, 59 | undef, 60 | 'foo(4.1) throws', 61 | ); 62 | 63 | my $info = Function::Parameters::info(\&foo); 64 | my ($x) = $info->positional_required; 65 | is($x->name, '$x', '$x->name'); 66 | ok($x->type == Int, '$x->type'); 67 | 68 | done_testing; 69 | -------------------------------------------------------------------------------- /t/30-external/JSON-PP/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check B and B type constraints against JSON::PP's bools. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires JSON::PP. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2023-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Test::Requires { "JSON::PP" => "4.00" }; 30 | use Test::TypeTiny; 31 | 32 | use Types::Common qw( Bool BoolLike ); 33 | 34 | should_pass( $_, Bool ) for 0, 1, "", undef; 35 | should_fail( $_, Bool ) for $JSON::PP::true, $JSON::PP::false, \0, \1; 36 | 37 | is( Bool->coerce($JSON::PP::true), !!1, 'Bool coercion of JSON::PP::true' ); 38 | is( Bool->coerce($JSON::PP::false), !!0, 'Bool coercion of JSON::PP::false' ); 39 | 40 | should_pass( $_, BoolLike ) for 0, 1, "", undef, $JSON::PP::true, $JSON::PP::false; 41 | should_fail( $_, Bool ) for \0, \1; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/30-external/Kavorka/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny works with L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Requires 'Kavorka'; 28 | use Test::Fatal; 29 | 30 | use Kavorka; 31 | use Types::Standard qw(Int Num); 32 | 33 | fun xyz ( 34 | Int $x, 35 | (Int) $y, 36 | (Int->plus_coercions(Num, 'int($_)')) $z does coerce 37 | ) { 38 | $x * $y * $z; 39 | } 40 | 41 | is( 42 | exception { 43 | is( 44 | xyz(2,3,4), 45 | 24, 46 | 'easy sub call; all type constraints should pass', 47 | ); 48 | is( 49 | xyz(2,3,4.2), 50 | 24, 51 | 'easy sub call; all type constraints should pass or coerce', 52 | ); 53 | }, 54 | undef, 55 | '... neither raise an exception', 56 | ); 57 | 58 | isnt( 59 | exception { xyz(2.1,3,4) }, 60 | undef, 61 | 'failed type constraint with no coercion raises an exception', 62 | ); 63 | 64 | done_testing; 65 | -------------------------------------------------------------------------------- /t/30-external/Moo/inflation2.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | A test for type constraint inflation from L to L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Requires Moo 1.003000 and Moose 2.0800; skipped otherwise. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Test::Fatal; 30 | use Test::Requires { 'Moo' => '1.003000' }; 31 | use Test::Requires { 'Moose' => '2.0800' }; 32 | 33 | use Types::Standard qw/Str HashRef/; 34 | my $type = HashRef[Str]; 35 | 36 | { 37 | package AAA; 38 | BEGIN { $INC{'AAA.pm'} = __FILE__ }; 39 | use Moo::Role; 40 | has foo => ( 41 | is => 'ro', 42 | isa => $type, 43 | traits => ['Hash'], 44 | ); 45 | } 46 | 47 | { 48 | package BBB; 49 | use Moose; 50 | with 'AAA'; 51 | } 52 | 53 | ok not exception { 54 | 'BBB'->new( 55 | foo => { 56 | a => 'b' 57 | } 58 | ); 59 | }; 60 | 61 | done_testing; 62 | -------------------------------------------------------------------------------- /t/30-external/Moops/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that type constraints work in L. 8 | 9 | This file is borrowed from the Moops test suite, where it is called 10 | C<< 31types.t >>. 11 | 12 | =head1 AUTHOR 13 | 14 | Toby Inkster Etobyink@cpan.orgE. 15 | 16 | =head1 COPYRIGHT AND LICENCE 17 | 18 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 19 | 20 | This is free software; you can redistribute it and/or modify it under 21 | the same terms as the Perl 5 programming language system itself. 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | use Test::More; 28 | use Test::Requires 'Moops'; 29 | use Test::Fatal; 30 | 31 | use Moops; 32 | 33 | class Foo { 34 | has num => (is => 'rw', isa => Num); 35 | method add ( Num $addition ) { 36 | $self->num( $self->num + $addition ); 37 | } 38 | } 39 | 40 | my $foo = 'Foo'->new(num => 20); 41 | is($foo->num, 20); 42 | is($foo->num(40), 40); 43 | is($foo->num, 40); 44 | is($foo->add(2), 42); 45 | is($foo->num, 42); 46 | 47 | isnt( 48 | exception { $foo->num("Hello") }, 49 | undef, 50 | ); 51 | 52 | isnt( 53 | exception { $foo->add("Hello") }, 54 | undef, 55 | ); 56 | 57 | isnt( 58 | exception { 'Foo'->new(num => "Hello") }, 59 | undef, 60 | ); 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/30-external/Moops/library-keyword.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that type libraries can be declared with L. 8 | 9 | This file is borrowed from the Moops test suite, where it is called 10 | C<< 71library.t >>. 11 | 12 | =head1 AUTHOR 13 | 14 | Toby Inkster Etobyink@cpan.orgE. 15 | 16 | =head1 COPYRIGHT AND LICENCE 17 | 18 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 19 | 20 | This is free software; you can redistribute it and/or modify it under 21 | the same terms as the Perl 5 programming language system itself. 22 | 23 | =cut 24 | 25 | use strict; 26 | use warnings; 27 | use Test::More; 28 | use Test::Requires { 'Moops' => '0.018' }; 29 | use Test::Fatal; 30 | use Test::TypeTiny; 31 | 32 | use Moops; 33 | 34 | library MyTypes extends Types::Standard declares RainbowColour 35 | { 36 | declare RainbowColour, 37 | as Enum[qw/ red orange yellow green blue indigo violet /]; 38 | } 39 | 40 | should_pass('indigo', MyTypes::RainbowColour); 41 | should_fail('magenta', MyTypes::RainbowColour); 42 | 43 | class MyClass types MyTypes { 44 | method capitalize_colour ( $class: RainbowColour $r ) { 45 | return uc($r); 46 | } 47 | } 48 | 49 | is('MyClass'->capitalize_colour('indigo'), 'INDIGO'); 50 | 51 | ok exception { 'MyClass'->capitalize_colour('magenta') }; 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/30-external/Moose/coercion-more.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test for the good old "You cannot coerce an attribute unless its 8 | type has a coercion" error. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Uses the bundled BiggerLib.pm type library. 13 | 14 | Test is skipped if Moose 2.1200 is not available. 15 | 16 | =head1 AUTHOR 17 | 18 | Toby Inkster Etobyink@cpan.orgE. 19 | 20 | =head1 COPYRIGHT AND LICENCE 21 | 22 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 23 | 24 | This is free software; you can redistribute it and/or modify it under 25 | the same terms as the Perl 5 programming language system itself. 26 | 27 | =cut 28 | 29 | use strict; 30 | use warnings; 31 | use lib qw( ./lib ./t/lib ../inc ./inc ); 32 | 33 | use Test::More; 34 | use Test::Requires { Moose => '2.1200' }; 35 | use Test::Fatal; 36 | use Test::TypeTiny qw( matchfor ); 37 | 38 | my $e; 39 | 40 | { 41 | package Local::Class; 42 | 43 | use Moose; 44 | use BiggerLib -all; 45 | 46 | ::isa_ok(BigInteger, "Moose::Meta::TypeConstraint"); 47 | 48 | has small => (is => "rw", isa => SmallInteger, coerce => 1); 49 | has big => (is => "rw", isa => BigInteger, coerce => 1); 50 | 51 | $e = ::exception { 52 | has big_nc => (is => "rw", isa => BigInteger->no_coercions, coerce => 1); 53 | }; 54 | } 55 | 56 | like( 57 | $e, 58 | qr{^You cannot coerce an attribute .?big_nc.? unless its type .?\w+.? has a coercion}, 59 | "no_coercions and friends available on Moose type constraint objects", 60 | ); 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/30-external/Moose/inflate-then-inline.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraint inlining works with L in strange edge 8 | cases where we need to inflate Type::Tiny constraints into full 9 | L objects. 10 | 11 | =head1 DEPENDENCIES 12 | 13 | Test is skipped if Moose 2.1210 is not available. 14 | 15 | =head1 AUTHOR 16 | 17 | Toby Inkster Etobyink@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More 0.96; 31 | use Test::Requires { 'Moose' => '2.1005' }; 32 | 33 | use Type::Tiny; 34 | 35 | my $type1 = Type::Tiny->new; 36 | my $type2 = $type1->create_child_type( 37 | constraint => sub { !!2 }, 38 | inlined => sub { 39 | my ($self, $var) = @_; 40 | $self->parent->inline_check($var) . " && !!2"; 41 | }, 42 | ); 43 | 44 | like( 45 | $type2->inline_check('$XXX'), 46 | qr/\(\(?!!1\)? && !!2\)/, 47 | '$type2->inline_check' 48 | ); 49 | 50 | like( 51 | $type2->moose_type->_inline_check('$XXX'), 52 | qr/\(\(?!!1\)? && !!2\)/, 53 | '$type2->moose_type->_inline_check' 54 | ); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/30-external/Moose/parameterized.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that parameterizable Moose types are still parameterizable 8 | when they are converted to Type::Tiny. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Test is skipped if Moose is not available. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2019-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Test::Requires 'Moose::Util::TypeConstraints'; 31 | use Types::TypeTiny 'to_TypeTiny'; 32 | use Test::TypeTiny; 33 | 34 | ## We want to prevent Types::TypeTiny from noticing we've loaded a 35 | ## core type, because then it will just steal from Types::Standard. 36 | ## and bypass making a new type constraint. 37 | ## 38 | sub Types::Standard::get_type { return() } 39 | $INC{'Types/Standard.pm'} = 1; 40 | 41 | my $mt_ArrayRef = Moose::Util::TypeConstraints::find_type_constraint('ArrayRef'); 42 | my $mt_Int = Moose::Util::TypeConstraints::find_type_constraint('Int'); 43 | my $tt_ArrayRef = to_TypeTiny($mt_ArrayRef); 44 | my $tt_Int = to_TypeTiny($mt_Int); 45 | 46 | ok $tt_ArrayRef->is_parameterizable; 47 | 48 | my $tt_ArrayRef_of_Int = $tt_ArrayRef->of($tt_Int); 49 | 50 | should_pass [qw/1 2 3/], $tt_ArrayRef_of_Int; 51 | should_fail [qw/a b c/], $tt_ArrayRef_of_Int; 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/30-external/Mouse/parameterized.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that parameterizable Mouse types are still parameterizable 8 | when they are converted to Type::Tiny. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Test is skipped if Mouse is not available. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2019-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Test::Requires 'Mouse::Util::TypeConstraints'; 31 | use Types::TypeTiny 'to_TypeTiny'; 32 | use Test::TypeTiny; 33 | 34 | ## We want to prevent Types::TypeTiny from noticing we've loaded a 35 | ## core type, because then it will just steal from Types::Standard. 36 | ## and bypass making a new type constraint. 37 | ## 38 | sub Types::Standard::get_type { return() } 39 | $INC{'Types/Standard.pm'} = 1; 40 | 41 | my $mt_ArrayRef = Mouse::Util::TypeConstraints::find_type_constraint('ArrayRef'); 42 | my $mt_Int = Mouse::Util::TypeConstraints::find_type_constraint('Int'); 43 | my $tt_ArrayRef = to_TypeTiny($mt_ArrayRef); 44 | my $tt_Int = to_TypeTiny($mt_Int); 45 | 46 | ok $tt_ArrayRef->is_parameterizable; 47 | 48 | my $tt_ArrayRef_of_Int = $tt_ArrayRef->of($tt_Int); 49 | 50 | should_pass [qw/1 2 3/], $tt_ArrayRef_of_Int; 51 | should_fail [qw/a b c/], $tt_ArrayRef_of_Int; 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/30-external/MouseX-Types/extending.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that L can extend an existing L 8 | type constraint library. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | MouseX::Types 0.06; skipped otherwise. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | 30 | use Test::More; 31 | use Test::Requires { "MouseX::Types" => "0.06" }; 32 | use Test::TypeTiny; 33 | use Test::Fatal; 34 | 35 | BEGIN { 36 | package MyTypes; 37 | use Type::Library -base, -declare => qw(NonEmptyStr); 38 | use Type::Utils -all; 39 | BEGIN { extends 'MouseX::Types::Moose', 'Types::TypeTiny' }; 40 | 41 | declare NonEmptyStr, as Str, where { length($_) }; 42 | 43 | $INC{'MyTypes.pm'} = __FILE__; 44 | }; 45 | 46 | use MyTypes -types; 47 | 48 | should_pass("foo", Str); 49 | should_pass("", Str); 50 | should_pass("foo", NonEmptyStr); 51 | should_fail("", NonEmptyStr); 52 | should_pass({}, HashLike); 53 | should_fail([], HashLike); 54 | 55 | { 56 | package MyDummy; 57 | use Mouse; 58 | $INC{'MyDummy.pm'} = __FILE__; 59 | 60 | package MoreTypes; 61 | use Type::Library -base; 62 | 63 | ::like( 64 | ::exception { Type::Utils::extends 'MyDummy' }, 65 | qr/not a type constraint library/, 66 | 'cannot extend non-type-library', 67 | ); 68 | } 69 | 70 | done_testing; 71 | -------------------------------------------------------------------------------- /t/30-external/Object-Accessor/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraints work with L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Test is skipped if Object::Accessor 0.30 is not available. 12 | 13 | =head1 CAVEATS 14 | 15 | As of Perl 5.17.x, the Object::Accessor module is being de-cored, so will 16 | issue deprecation warnings. These can safely be ignored for the purposes 17 | of this test case. Object::Accessor from CPAN does not have these warnings. 18 | 19 | =head1 AUTHOR 20 | 21 | Toby Inkster Etobyink@cpan.orgE. 22 | 23 | =head1 COPYRIGHT AND LICENCE 24 | 25 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 26 | 27 | This is free software; you can redistribute it and/or modify it under 28 | the same terms as the Perl 5 programming language system itself. 29 | 30 | =cut 31 | 32 | use strict; 33 | use warnings; 34 | use lib qw( ./lib ./t/lib ../inc ./inc ); 35 | 36 | # Avoid warnings about core version of Object::Accessor in Perl 5.18 37 | no warnings qw(deprecated); 38 | 39 | use Test::More; 40 | use Test::Requires { "Object::Accessor" => 0.30 }; 41 | use Test::Fatal; 42 | 43 | use Types::Standard "Int"; 44 | use Object::Accessor; 45 | 46 | my $obj = Object::Accessor->new; 47 | $obj->mk_accessors( 48 | { foo => Int->compiled_check }, 49 | ); 50 | 51 | $obj->foo(12); 52 | is($obj->foo, 12, 'write then read on accessor works'); 53 | 54 | my $e = exception { 55 | local $Object::Accessor::FATAL = 1; 56 | $obj->foo("Hello"); 57 | }; 58 | isnt($e, undef, 'exception thrown for bad value'); 59 | 60 | done_testing; 61 | -------------------------------------------------------------------------------- /t/30-external/Specio/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that Specio type constraints can be converted to Type::Tiny 8 | with inlining support. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Test is skipped if Specio is not available. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2019-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Test::Requires 'Specio'; 31 | use Specio::Library::Builtins; 32 | use Types::TypeTiny 'to_TypeTiny'; 33 | 34 | my $Int = to_TypeTiny t('Int'); 35 | 36 | ok $Int->check('4'); 37 | ok !$Int->check('4.1'); 38 | ok $Int->can_be_inlined; 39 | 40 | my $check_x = $Int->inline_check('$x'); 41 | 42 | ok do { my $x = '4'; eval $check_x }; 43 | ok do { my $x = '4.1'; !eval $check_x }; 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/30-external/Specio/library.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check that Specio type libraries can be extended by Type::Library. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2019-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | use Test::TypeTiny; 26 | use Test::Requires 'Specio::Library::Builtins'; 27 | 28 | BEGIN { 29 | package Local::MyTypes; 30 | use Type::Library -base; 31 | use Type::Utils; 32 | Type::Utils::extends 'Specio::Library::Builtins'; 33 | $INC{'Local/MyTypes.pm'} = __FILE__; # allow `use` to work 34 | }; 35 | 36 | use Local::MyTypes qw(Int ArrayRef); 37 | 38 | should_pass 1, Int; 39 | should_pass [], ArrayRef; 40 | should_fail 1, ArrayRef; 41 | should_fail [], Int; 42 | 43 | done_testing; 44 | -------------------------------------------------------------------------------- /t/30-external/Sub-Quote/delayed-quoting.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraints can be made inlinable using L even if 8 | Sub::Quote is loaded late. 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Some parts are skipped if Sub::Quote is not available. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2018-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | 31 | use Test::More; 32 | use Test::TypeTiny; 33 | 34 | use Types::Standard qw( ArrayRef Int ); 35 | 36 | my $type = ArrayRef[Int]; 37 | my $coderef1 = $type->_overload_coderef; 38 | my $coderef2 = $type->_overload_coderef; 39 | 40 | is($coderef1, $coderef2, 'overload coderef gets cached instead of being rebuilt'); 41 | 42 | eval { require Sub::Quote } or do { 43 | note "Sub::Quote required for further testing"; 44 | done_testing; 45 | exit(0); 46 | }; 47 | 48 | my $coderef3 = $type->_overload_coderef; 49 | 50 | isnt($coderef3, $coderef1, 'loading Sub::Quote triggers rebuilding overload coderef'); 51 | 52 | my $coderef4 = $type->_overload_coderef; 53 | 54 | is($coderef3, $coderef4, 'overload coderef gets cached again instead of being rebuilt'); 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/30-external/Sub-Quote/unquote-constraints.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check type constraints can be unquoted L. 8 | 9 | =head1 DEPENDENCIES 10 | 11 | Test is skipped if Sub::Quote is not available. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use lib qw( ./lib ./t/lib ../inc ./inc ); 29 | 30 | use Test::More; 31 | use Test::Requires "Sub::Quote"; 32 | use Test::Fatal; 33 | 34 | use Sub::Quote; 35 | use Type::Tiny; 36 | use Types::Standard qw( Int ); 37 | 38 | my $type = Int; 39 | 40 | my ($name, $code, $captures, $compiled_sub) = @{ 41 | Sub::Quote::quoted_from_sub( \&$type ); 42 | }; 43 | 44 | ok(defined($code), 'Got back code from Sub::Quote'); 45 | 46 | my $coderef = eval "sub { $code }"; 47 | 48 | is(ref($coderef), 'CODE', '... which compiles OK'); 49 | 50 | ok($coderef->(42), '... and seems to work'); 51 | 52 | like( 53 | exception { $coderef->([]) }, 54 | qr/\AReference \[\] did not pass type constraint "Int"/, 55 | '... and throws exceptions properly', 56 | ); 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/30-external/Switcheroo/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny works with L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Requires 'Switcheroo'; 28 | use Test::Fatal; 29 | 30 | use Types::Standard -all; 31 | use Switcheroo; 32 | 33 | sub what_is { 34 | my $var = shift; 35 | switch ($var) { 36 | case ArrayRef: 'ARRAY'; 37 | case HashRef: 'HASH'; 38 | default: undef; 39 | } 40 | } 41 | 42 | is( 43 | what_is([]), 44 | 'ARRAY', 45 | ); 46 | 47 | is( 48 | what_is({}), 49 | 'HASH', 50 | ); 51 | 52 | is( 53 | what_is(42), 54 | undef, 55 | ); 56 | 57 | is( 58 | what_is(\(42)), 59 | undef, 60 | ); 61 | 62 | done_testing; 63 | -------------------------------------------------------------------------------- /t/30-external/Types-ReadOnly/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | L does some frickin weird stuff with parameterization. 8 | Check it all works! 9 | 10 | =head1 DEPENDENCIES 11 | 12 | Test is skipped if Types::ReadOnly 0.003 is not available. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2019-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use lib qw( ./lib ./t/lib ../inc ./inc ); 30 | use Test::More; 31 | use Test::Requires { "Types::ReadOnly" => '0.003' }; 32 | use Test::Fatal; 33 | 34 | use Types::Standard -types; 35 | use Types::ReadOnly -types; 36 | 37 | my $UnitHash = Dict->of( 38 | magnitude => Num, 39 | unit => Optional[Str], 40 | )->plus_coercions( 41 | Str ,=> q{ do { my($m,$u) = split / /; { magnitude => $m, unit => $u } } }, 42 | ); 43 | 44 | my $LockedUnitHash = Locked[$UnitHash]; 45 | 46 | my $thirtymetres = $LockedUnitHash->coerce('30 m'); 47 | is($thirtymetres->{magnitude}, 30); 48 | is($thirtymetres->{unit}, 'm'); 49 | 50 | my $e = exception { $thirtymetres->{shizzle}++ }; 51 | like($e, qr/disallowed key/); 52 | 53 | done_testing; 54 | -------------------------------------------------------------------------------- /t/30-external/match-simple/basic.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Checks Type::Tiny works with L. 8 | 9 | =head1 AUTHOR 10 | 11 | Toby Inkster Etobyink@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Toby Inkster. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use lib qw( ./lib ./t/lib ../inc ./inc ); 25 | 26 | use Test::More; 27 | use Test::Requires 'match::simple'; 28 | use Test::Fatal; 29 | 30 | use Types::Standard -all; 31 | use match::simple { replace => 1 }; 32 | 33 | ok( 42 |M| Int ); 34 | ok( 42 |M| Num ); 35 | ok not( 42 |M| ArrayRef ); 36 | 37 | ok( 42 |M| \&is_Int ); 38 | ok not( 42 |M| \&is_ArrayRef ); 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/40-bugs/73f51e2d.pl: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Helper file for C<< 73f51e2d.t >>. 8 | 9 | =head1 AUTHOR 10 | 11 | Graham Knop Ehaarg@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Graham Knop. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use threads; 23 | use strict; 24 | use warnings; 25 | use Type::Tiny; 26 | 27 | my $int = Type::Tiny->new( 28 | name => "Integer", 29 | constraint => sub { /^(?:-?[1-9][0-9]*|0)$|/ }, 30 | message => sub { "$_ isn't an integer" }, 31 | ); 32 | 33 | threads->create(sub { 34 | my $type = $int; 35 | 1; 36 | })->join; 37 | -------------------------------------------------------------------------------- /t/40-bugs/73f51e2d.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Possible issue causing segfaults on threaded Perl 5.18.x. 8 | 9 | =head1 AUTHOR 10 | 11 | Graham Knop Ehaarg@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Graham Knop. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | use Config; 27 | BEGIN { 28 | if ( $] < 5.020 29 | and defined $ENV{RUNNER_OS} 30 | and $ENV{RUNNER_OS} =~ /windows/i ) { 31 | plan skip_all => "skipping on CI due to known issues!"; 32 | } 33 | elsif ( not $Config{useithreads} ) { 34 | plan skip_all => "ithreads only test"; 35 | } 36 | }; 37 | 38 | (my $script = __FILE__) =~ s/t\z/pl/; 39 | 40 | for (1..100) 41 | { 42 | my $out = system $^X, (map {; '-I', $_ } @INC), $script; 43 | is($out, 0); 44 | } 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/40-bugs/gh1.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that subtypes of Type::Tiny::Class work. 8 | 9 | =head1 SEE ALSO 10 | 11 | L, 12 | L. 13 | 14 | =head1 AUTHOR 15 | 16 | Richard Simões Ersimoes@cpan.orgE. 17 | 18 | (Minor changes by Toby Inkster Etobyink@cpan.orgE.) 19 | 20 | =head1 COPYRIGHT AND LICENCE 21 | 22 | This software is copyright (c) 2013-2014, 2017-2025 by Richard Simões. 23 | 24 | This is free software; you can redistribute it and/or modify it under 25 | the same terms as the Perl 5 programming language system itself. 26 | 27 | =cut 28 | 29 | use strict; 30 | use warnings; 31 | 32 | use Test::More; 33 | use Test::TypeTiny; 34 | 35 | use Type::Utils; 36 | use Math::BigFloat; 37 | 38 | my $pc = declare as class_type({ class => 'Math::BigFloat' }), where { 1 }; 39 | my $value = Math::BigFloat->new(0.5); 40 | 41 | ok $pc->($value); 42 | 43 | should_pass($value, $pc); 44 | should_fail(0.5, $pc); 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /t/40-bugs/gh14.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test for non-inlined coercions in Moo. 8 | 9 | The issue that prompted this test was actually invalid, caused by a typo 10 | in the bug reporter's code. But I wrote the test case, so I might as well 11 | include it. 12 | 13 | =head1 SEE ALSO 14 | 15 | L. 16 | 17 | =head1 AUTHOR 18 | 19 | Toby Inkster Etobyink@cpan.orgE. 20 | 21 | =head1 COPYRIGHT AND LICENCE 22 | 23 | This software is copyright (c) 2017-2025 by Toby Inkster. 24 | 25 | This is free software; you can redistribute it and/or modify it under 26 | the same terms as the Perl 5 programming language system itself. 27 | 28 | =cut 29 | 30 | use strict; 31 | use warnings; 32 | use Test::More; 33 | use Test::Fatal; 34 | use Test::Requires { Moo => '1.006' }; 35 | 36 | { 37 | package FinancialTypes; 38 | use Type::Library -base; 39 | use Type::Utils -all; 40 | BEGIN { extends "Types::Standard" }; 41 | 42 | declare 'BankAccountNo', 43 | as Str, 44 | where { 45 | /^\d{26}$/ 46 | or /^[A-Z]{2}\d{18,26}$/ 47 | or /^\d{8}-\d+(-\d+)+$/ 48 | }, 49 | message { "Bad account: $_"}; 50 | 51 | coerce 'BankAccountNo', 52 | from Str, via { 53 | $_ =~ s{\s+}{}g; 54 | $_; 55 | }; 56 | } 57 | 58 | { 59 | package BankAccount; 60 | use Moo; 61 | has account_number => ( 62 | is => 'ro', 63 | required => !!1, 64 | isa => FinancialTypes::BankAccountNo(), 65 | coerce => FinancialTypes::BankAccountNo()->coercion, 66 | ); 67 | } 68 | 69 | my $x; 70 | my $e = exception { 71 | $x = BankAccount::->new( account_number => "10 2030 4050 1111 2222 3333 4444" ); 72 | }; 73 | is($e, undef); 74 | is($x->account_number, "10203040501111222233334444"); 75 | done_testing(); 76 | -------------------------------------------------------------------------------- /t/40-bugs/gh140.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Type::Params's C and C together. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | XSven L. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2023-2025 by XSven. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Types::Common -types, -sigs; 30 | 31 | use Test::Requires { 'Test::Warnings' => 0.005 }; 32 | use Test::Warnings ':all'; 33 | 34 | my $sig; 35 | sub add_nums { 36 | $sig ||= signature( 37 | positional => [ 38 | Num, 39 | ArrayRef[Num,1], { optional => !!1, slurpy => !!1 }, 40 | ], 41 | ); 42 | my ( $first_num, $other_nums ) = $sig->( @_ ); 43 | 44 | my $sum = $first_num; 45 | $sum += $_ for @$other_nums; 46 | 47 | return $sum; 48 | } 49 | 50 | my $w = warning { 51 | is add_nums( 1, 0 ), 1; 52 | }; 53 | 54 | like $w, qr/^Warning: the optional for the slurpy parameter will be ignored, continuing anyway/; 55 | 56 | done_testing; 57 | -------------------------------------------------------------------------------- /t/40-bugs/gh143.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test initializing tied variables. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2024-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Types::Common -types; 30 | 31 | use Test::Requires { 'Test::Warnings' => 0.005 }; 32 | use Test::Warnings ':all'; 33 | 34 | { 35 | tie my $x, Int, 143; 36 | is $x, 143; 37 | } 38 | 39 | { 40 | tie my @x, Int, 1 .. 3; 41 | is_deeply \@x, [ 1 .. 3 ]; 42 | } 43 | 44 | { 45 | tie my %x, Int, foo => 666, bar => 999; 46 | is_deeply \%x, { foo => 666, bar => 999 }; 47 | } 48 | 49 | { 50 | tie my $x, Int; 51 | is $x, 0; 52 | } 53 | 54 | done_testing; 55 | -------------------------------------------------------------------------------- /t/40-bugs/gh158.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Ensure no warning on certain shallow stack traces. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Diab Jerius L. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2024-2025 by Diab Jerius. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Types::Common -types, -sigs; 30 | 31 | use Test::Requires { 'Test::Warnings' => 0.005 }; 32 | use Test::Warnings ':all'; 33 | 34 | my $e; 35 | 36 | signature_for get_products => ( 37 | named => [ bar => Optional[Str] ], 38 | on_die => sub { $e = shift }, 39 | ); 40 | 41 | sub get_products {} 42 | 43 | get_products( rs => 3 ); 44 | 45 | like( $e->message, qr/^Unrecognized parameter/ ); 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/40-bugs/gh80.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that stringifying Error::TypeTiny doesn't clobber $@. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE based on code by @bokutin 16 | L. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2021-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Type::Tiny; 31 | 32 | my $Type1 = Type::Tiny->new( name => "Type1", constraint => sub { 0 } ); 33 | 34 | eval { $Type1->('val1') }; 35 | 36 | isa_ok( $@, 'Error::TypeTiny', '$@' ); 37 | my $x1 = "$@"; 38 | my $x2 = "$@"; 39 | like( "$@", qr/did not pass type/, '$@ is still defined and stringifies properly' ); 40 | 41 | done_testing; 42 | -------------------------------------------------------------------------------- /t/40-bugs/gh96.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Type::Tiny's C should never wrap lines! 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2022-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Types::Standard qw( StrMatch ); 30 | 31 | my $UUID_RE = qr{ 32 | ^ 33 | [0-9a-fA-F]{8}- 34 | [0-9a-fA-F]{4}- 35 | [0-9a-fA-F]{4}- 36 | [0-9a-fA-F]{4}- 37 | [0-9a-fA-F]{12} 38 | $ 39 | }sxm; 40 | 41 | my $type = StrMatch[ $UUID_RE ]; 42 | 43 | unlike $type->display_name, qr/\n/sm, "don't include linebreaks!"; 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/40-bugs/hg166.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Ensure that stringifying L doesn't clobber C<< $@ >>. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Karen Etheridge L. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2025 by Karen Etheridge. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | 30 | use Types::Standard 'Str'; 31 | my $type = Str; 32 | eval { $type->({}); }; 33 | 34 | like "### e string: '$@'\n", qr{did not pass type constraint}; 35 | like "### e string: '$@'\n", qr{did not pass type constraint}; 36 | 37 | done_testing; 38 | -------------------------------------------------------------------------------- /t/40-bugs/rt102748.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Tests inheriting from a MooseX::Types library that uses 8 | L and 9 | L. 10 | 11 | =head1 SEE ALSO 12 | 13 | L. 14 | 15 | =head1 AUTHOR 16 | 17 | Toby Inkster Etobyink@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2019-2025 by Toby Inkster. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More; 31 | use Test::Fatal; 32 | { package Local::XYZ1; use Test::Requires 'MooseX::Types'; } 33 | { package Local::XYZ2; use Test::Requires 'MooseX::Types::DBIx::Class'; } 34 | 35 | my $e = exception { 36 | package MyApp::Types; 37 | use namespace::autoclean; 38 | use Type::Library -base; 39 | use Type::Utils 'extends'; 40 | extends 'MooseX::Types::DBIx::Class'; 41 | }; 42 | 43 | is($e, undef); 44 | done_testing; 45 | -------------------------------------------------------------------------------- /t/40-bugs/rt121763.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test to make sure C keeps a reference to all the types that 8 | get compiled, to avoid them going away before exceptions can be thrown 9 | for them. 10 | 11 | =head1 SEE ALSO 12 | 13 | L. 14 | 15 | =head1 AUTHOR 16 | 17 | Toby Inkster Etobyink@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2019-2025 by Toby Inkster. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More; 31 | use Test::Fatal; 32 | 33 | use Types::Standard -types; 34 | use Type::Params qw(compile); 35 | 36 | my $x; 37 | my $sub; 38 | my $check; 39 | my $e = exception { 40 | $sub = sub { 41 | $check = compile(Dict[key => Int]); 42 | $check->(@_); 43 | }; 44 | $sub->({key => 'yeah'}); 45 | }; 46 | 47 | is($e->type->display_name, 'Dict[key=>Int]'); 48 | 49 | done_testing; 50 | -------------------------------------------------------------------------------- /t/40-bugs/rt125765.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check weird error doesn't happen with deep explain. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | KB Jørgensen . 16 | 17 | Some modifications by Toby Inkster . 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2018-2025 by KB Jørgensen. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More; 31 | use Test::Fatal; 32 | use Types::Standard qw(Dict Tuple Any); 33 | 34 | BEGIN { 35 | plan skip_all => "cperl's `shadow` warnings catgeory breaks this test; skipping" 36 | if "$^V" =~ /c$/; 37 | }; 38 | 39 | my @warnings; 40 | $SIG{__WARN__} = sub { push @warnings, $_[0]; }; 41 | 42 | my $type = Dict->of(foo => Any); 43 | 44 | my $e = exception { 45 | $type->assert_valid({ foo => 1, asd => 1 }); 46 | }; 47 | 48 | like($e, qr/Reference .+ did not pass type constraint/, "got correct error for Dict"); 49 | 50 | is_deeply(\@warnings, [], 'no warnings') 51 | or diag explain \@warnings; 52 | 53 | @warnings = (); 54 | 55 | $type = Tuple->of(Any); 56 | 57 | $e = exception { 58 | $type->assert_valid([1, 2]); 59 | }; 60 | 61 | like($e, qr/Reference .+ did not pass type constraint/, "got correct error for Tuple"); 62 | 63 | is_deeply(\@warnings, [], 'no warnings') 64 | or diag explain \@warnings; 65 | 66 | done_testing; 67 | -------------------------------------------------------------------------------- /t/40-bugs/rt129729.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that Enum types containing hyphens work. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster Etobyink@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2019-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings; 28 | use Test::More; 29 | use Test::TypeTiny; 30 | 31 | use Types::Standard qw[ Bool Enum ]; 32 | 33 | my $x = Bool | Enum [ 'start-end', 'end' ]; 34 | 35 | should_pass 1, $x; 36 | should_pass 0, $x; 37 | should_fail 2, $x; 38 | should_pass 'end', $x; 39 | should_fail 'bend', $x; 40 | should_fail 'start', $x; 41 | should_fail 'start-', $x; 42 | should_fail '-end', $x; 43 | should_pass 'start-end', $x; 44 | 45 | done_testing; 46 | -------------------------------------------------------------------------------- /t/40-bugs/rt130823.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Check for memory cycles. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Toby Inkster . 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2019-2025 by Toby Inkster. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Test::Requires 'Test::Memory::Cycle'; 31 | use Test::Memory::Cycle; 32 | use Types::Standard qw(Bool); 33 | 34 | memory_cycle_ok(Bool, 'Bool has no cycles'); 35 | 36 | done_testing; 37 | -------------------------------------------------------------------------------- /t/40-bugs/rt131401.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Make sure that L loads L early enough for 8 | bareword constants to be okay. 9 | 10 | =head1 SEE ALSO 11 | 12 | L. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2020-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings FATAL=> 'all'; 29 | use Test::More tests => 1; 30 | 31 | use Type::Tiny::Class; 32 | 33 | ok 1; 34 | 35 | -------------------------------------------------------------------------------- /t/40-bugs/rt131576.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that inlined type checks don't generate issuing warning when compiled 8 | in packages that override built-ins. 9 | 10 | =head1 SEE ALSO 11 | 12 | L. 13 | 14 | =head1 AUTHOR 15 | 16 | Toby Inkster Etobyink@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2020-2025 by Toby Inkster. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings; 29 | use Test::More; 30 | use Test::Requires { 'Test::Warnings' => 0.005 }; 31 | use Test::Warnings; 32 | 33 | { 34 | package Local::Dummy1; 35 | use Test::Requires 'Moo'; 36 | use Test::Requires 'MooX::TypeTiny'; 37 | } 38 | 39 | BEGIN { $ENV{PERL_ONLY} = 1 }; # no XS 40 | 41 | { 42 | package Foo; 43 | use Moo; 44 | use MooX::TypeTiny; 45 | use Types::Standard qw(HashRef Str); 46 | has _data => ( 47 | is => 'ro', 48 | isa => HashRef[Str], 49 | required => 1, 50 | init_arg => 'data', 51 | ); 52 | sub values { 53 | @_==1 or die 'too many parameters'; 54 | CORE::values %{shift->_data}; 55 | } 56 | sub keys { 57 | @_==1 or die 'too many parameters'; 58 | CORE::keys %{shift->_data}; 59 | } 60 | } 61 | 62 | my $obj = Foo->new(data => {foo => 42}); 63 | print "$_\n" for $obj->values; 64 | 65 | ok 1; 66 | 67 | done_testing; 68 | -------------------------------------------------------------------------------- /t/40-bugs/rt85911.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test L with deep Dict coercion. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Diab Jerius Edjerius@cpan.orgE. 16 | 17 | (Minor changes by Toby Inkster Etobyink@cpan.orgE.) 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | 27 | =cut 28 | 29 | use strict; 30 | use warnings; 31 | 32 | use Test::More; 33 | 34 | BEGIN { 35 | package MyTypes; 36 | 37 | use Type::Library 38 | -base, 39 | -declare => qw[ StrList ]; 40 | use Type::Utils; 41 | use Types::Standard qw[ ArrayRef Str ]; 42 | declare StrList, as ArrayRef[Str]; 43 | coerce StrList, from Str, via { [$_] }; 44 | } 45 | 46 | use Type::Params qw[ compile ]; 47 | use Types::Standard qw[ Dict slurpy Optional ]; 48 | 49 | sub foo { 50 | my $check = compile( slurpy Dict [ foo => MyTypes::StrList ] ); 51 | return [ $check->( @_ ) ]; 52 | } 53 | 54 | sub bar { 55 | my $check = compile( MyTypes::StrList ); 56 | return [ $check->( @_ ) ]; 57 | } 58 | 59 | is_deeply( 60 | bar( 'b' ), 61 | [ ["b"] ], 62 | ); 63 | 64 | is_deeply( 65 | foo( foo => 'a' ), 66 | [ { foo=>["a"] } ], 67 | ); 68 | 69 | done_testing; 70 | 71 | -------------------------------------------------------------------------------- /t/40-bugs/rt86233.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Fix: "Cannot inline type constraint check" error with compile and Dict. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Vyacheslav Matyukhin Emmcleric@cpan.orgE. 16 | 17 | (Minor changes by Toby Inkster Etobyink@cpan.orgE.) 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2013-2014, 2017-2025 by Vyacheslav Matyukhin. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | 31 | use Test::More; 32 | use Test::Fatal; 33 | 34 | BEGIN { 35 | package Types; 36 | 37 | use Type::Library 38 | -base, 39 | -declare => qw[ Login ]; 40 | use Type::Utils; 41 | use Types::Standard qw[ Str ]; 42 | 43 | declare Login, 44 | as Str, 45 | where { /^\w+$/ }; 46 | }; 47 | 48 | use Type::Params qw[ compile ]; 49 | use Types::Standard qw[ Dict ]; 50 | 51 | my $type = Dict[login => Types::Login]; 52 | 53 | ok not( $type->can_be_inlined ); 54 | 55 | ok not( $type->coercion->can_be_inlined ); 56 | 57 | is(exception { compile($type) }, undef); 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/40-bugs/rt86239.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Fix: Optional constraints ignored if wrapped in Dict. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Vyacheslav Matyukhin Emmcleric@cpan.orgE. 16 | 17 | (Minor changes by Toby Inkster Etobyink@cpan.orgE.) 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2013-2014, 2017-2025 by Vyacheslav Matyukhin. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | 31 | use Test::More; 32 | use Test::Fatal; 33 | use Type::Params qw(validate compile); 34 | use Types::Standard qw(ArrayRef Dict Optional Str); 35 | 36 | my $i = 0; 37 | sub announce { note sprintf("Test %d ########", ++$i) } 38 | sub got { note "got: " . join ", ", explain(@_) } 39 | 40 | sub f { 41 | announce(); 42 | got validate( 43 | \@_, 44 | Optional[Str], 45 | ); 46 | } 47 | 48 | is exception { f("foo") }, undef; 49 | is exception { f() }, undef; 50 | like exception { f(["abc"]) }, qr/type constraint/; 51 | 52 | sub g { 53 | announce(); 54 | got validate( 55 | \@_, 56 | Dict[foo => Optional[Str]], 57 | ); 58 | } 59 | 60 | is exception { g({ foo => "foo" }) }, undef; 61 | is exception { g({}) }, undef; 62 | like exception { g({ foo => ["abc"] }) }, qr/type constraint/; 63 | 64 | done_testing; 65 | -------------------------------------------------------------------------------- /t/40-bugs/rt90096-2.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Additional tests related to RT#90096. 8 | 9 | Make sure that L localizes C<< $_ >>. 10 | 11 | =head1 SEE ALSO 12 | 13 | L. 14 | 15 | =head1 AUTHOR 16 | 17 | Diab Jerius Edjerius@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More; 31 | 32 | use Type::Params qw[ compile ]; 33 | use Types::Standard -all; 34 | 35 | { 36 | my $check = compile( Dict [ a => Num ] ); 37 | grep { $_->( { a => 3 } ) } $check; 38 | is( ref $check, 'CODE', "check is still code" ); 39 | } 40 | 41 | { 42 | my $check = compile( slurpy Dict [ a => Num ] ); 43 | grep { $_->( a => 3 ) } $check; 44 | is( ref $check, 'CODE', "slurpy check is still code" ); 45 | } 46 | 47 | done_testing; 48 | -------------------------------------------------------------------------------- /t/40-bugs/rt90096.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Make sure that L localizes C<< $_ >>. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Samuel Kaufman Eskaufman@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2013-2014, 2017-2025 by Samuel Kaufman. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings FATAL=> 'all'; 28 | 29 | use Test::More tests => 3; 30 | use Type::Params qw[ compile ]; 31 | use Types::Standard qw[ slurpy Dict Bool ]; 32 | 33 | my $check = compile slurpy Dict [ with_connection => Bool ]; 34 | 35 | for (qw[ 1 2 3 ]) { # $_ is read-only in here 36 | ok $check->( with_connection => 1 ); 37 | } 38 | -------------------------------------------------------------------------------- /t/40-bugs/rt92571-2.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Make sure that the weakening of the reference from a Type::Coercion::Union 8 | object back to its "owner" type constraint does not break functionality. 9 | 10 | =head1 SEE ALSO 11 | 12 | L. 13 | 14 | =head1 AUTHOR 15 | 16 | Diab Jerius Edjerius@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2014, 2017-2025 by Diab Jerius. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings FATAL=> 'all'; 29 | use Test::More; 30 | 31 | use Types::Standard -all; 32 | 33 | my $sub = (Str | Str)->coercion; 34 | 35 | is( 36 | $sub->('x'), 37 | 'x', 38 | ); 39 | 40 | done_testing; 41 | -------------------------------------------------------------------------------- /t/40-bugs/rt92571.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Make sure that the weakening of the reference from a Type::Coercion 8 | object back to its "owner" type constraint does not break functionality. 9 | 10 | =head1 SEE ALSO 11 | 12 | L. 13 | 14 | =head1 AUTHOR 15 | 16 | Diab Jerius Edjerius@cpan.orgE. 17 | 18 | =head1 COPYRIGHT AND LICENCE 19 | 20 | This software is copyright (c) 2014, 2017-2025 by Diab Jerius. 21 | 22 | This is free software; you can redistribute it and/or modify it under 23 | the same terms as the Perl 5 programming language system itself. 24 | 25 | =cut 26 | 27 | use strict; 28 | use warnings FATAL=> 'all'; 29 | use Test::More; 30 | 31 | use Type::Library -base, -declare => qw[ ArrayRefFromAny ]; 32 | use Types::Standard -all; 33 | use Type::Utils -all; 34 | 35 | declare_coercion ArrayRefFromAny, 36 | to_type ArrayRef, 37 | from Any, via { [$_] } 38 | ; 39 | 40 | my $x = ArrayRef->plus_coercions(ArrayRefFromAny); 41 | is_deeply( 42 | $x->coerce( ['a'] ), 43 | ['a'], 44 | ); 45 | 46 | # types hang around until after the coerce method is run 47 | is_deeply( 48 | ArrayRef->plus_coercions(ArrayRefFromAny)->coerce( ['a'] ), 49 | ['a'], 50 | ); 51 | 52 | # types go away after generation of coercion sub, breaking it 53 | my $coerce = ArrayRef->plus_coercions(ArrayRefFromAny)->coercion; 54 | is_deeply( 55 | $coerce->( ['a'] ), 56 | ['a'], 57 | ) or diag explain($coerce->( ['a'] )); 58 | 59 | done_testing; 60 | -------------------------------------------------------------------------------- /t/40-bugs/rt92591.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Make sure that C works outside type libraries. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Diab Jerius Edjerius@cpan.orgE. 16 | 17 | Some additions by Toby Inkster Etobyink@cpan.orgE. 18 | 19 | =head1 COPYRIGHT AND LICENCE 20 | 21 | This software is copyright (c) 2014, 2017-2025 by Diab Jerius. 22 | 23 | This is free software; you can redistribute it and/or modify it under 24 | the same terms as the Perl 5 programming language system itself. 25 | 26 | =cut 27 | 28 | use strict; 29 | use warnings FATAL=> 'all'; 30 | use Test::More; 31 | 32 | { 33 | package Local::TypeLib; 34 | 35 | use Type::Library -base; 36 | use Types::Standard -all; 37 | use Type::Utils -all; 38 | 39 | my $foo = declare_coercion to_type ArrayRef, from Any, via { [$_] }; 40 | 41 | ::is( 42 | $foo->type_constraint, 43 | 'ArrayRef', 44 | "Type library, coercion target", 45 | ); 46 | 47 | ::is( 48 | $foo->type_coercion_map->[0], 49 | 'Any', 50 | "Type library, coercion type map", 51 | ); 52 | } 53 | 54 | { 55 | package Local::NotTypeLib; 56 | 57 | use Types::Standard -all; 58 | use Type::Utils -all; 59 | 60 | my $foo = declare_coercion to_type ArrayRef, from Any, via { [$_] }; 61 | 62 | ::is( 63 | $foo->type_constraint, 64 | 'ArrayRef', 65 | "Not type library, coercion target", 66 | ); 67 | 68 | ::is( 69 | $foo->type_coercion_map->[0], 70 | 'Any', 71 | "Not type library, coercion type map", 72 | ); 73 | } 74 | 75 | done_testing; 76 | -------------------------------------------------------------------------------- /t/40-bugs/rt94196.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Problematic inlining using C<< $_ >>. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Diab Jerius Edjerius@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2014, 2017-2025 by Diab Jerius. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | use strict; 27 | use warnings FATAL=> 'all'; 28 | use Test::More; 29 | use Test::Fatal; 30 | 31 | use Type::Params qw( validate ); 32 | use Types::Standard qw( -types slurpy ); 33 | 34 | { 35 | package Foo; 36 | sub new { bless {}, shift } 37 | sub send { } 38 | }; 39 | 40 | my $type = Dict[ encoder => HasMethods ['send'] ]; 41 | 42 | is( 43 | exception { 44 | my @params = ( encoder => Foo->new ); 45 | validate(\@params, slurpy($type)); 46 | }, 47 | undef, 48 | "slurpy Dict w/ HasMethods", 49 | ) or note( $type->inline_check('$_') ); 50 | 51 | done_testing; 52 | -------------------------------------------------------------------------------- /t/40-bugs/rt97684.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | The "too few arguments for type constraint check functions" error. 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 AUTHOR 14 | 15 | Diab Jerius Edjerius@cpan.orgE. 16 | 17 | =head1 COPYRIGHT AND LICENCE 18 | 19 | This software is copyright (c) 2014, 2017-2025 by Diab Jerius. 20 | 21 | This is free software; you can redistribute it and/or modify it under 22 | the same terms as the Perl 5 programming language system itself. 23 | 24 | =cut 25 | 26 | BEGIN { $ENV{'DEVEL_HIDE_VERBOSE'} = 0 }; 27 | 28 | use strict; 29 | use warnings; 30 | use Test::More; 31 | use Test::Requires 'Devel::Hide'; 32 | use Test::Requires { Mouse => '1.0000' }; 33 | 34 | use Devel::Hide qw(Type::Tiny::XS); 35 | 36 | { 37 | package Local::Class; 38 | use Mouse; 39 | } 40 | 41 | { 42 | package Local::Types; 43 | use Type::Library -base, -declare => qw( Coord ExistingCoord ); 44 | use Type::Utils -all; 45 | use Types::Standard -all; 46 | 47 | declare ExistingCoord, as Str, where { 0 }; 48 | 49 | declare Coord, as Str; 50 | } 51 | 52 | use Types::Standard -all; 53 | use Type::Params qw( validate ); 54 | 55 | validate( 56 | [], 57 | slurpy Dict[ with => Optional[Local::Types::ExistingCoord] ], 58 | ); 59 | 60 | ok 1; 61 | done_testing; 62 | -------------------------------------------------------------------------------- /t/40-bugs/rt98113.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test overload fallback 8 | 9 | =head1 SEE ALSO 10 | 11 | L. 12 | 13 | =head1 DEPENDENCIES 14 | 15 | Uses the bundled BiggerLib.pm type library. 16 | 17 | =head1 AUTHOR 18 | 19 | Dagfinn Ilmari Mannsåker Eilmari@ilmari.orgE. 20 | 21 | =head1 COPYRIGHT AND LICENCE 22 | 23 | This software is copyright (c) 2014, 2017-2025 by Dagfinn Ilmari Mannsåker 24 | 25 | This is free software; you can redistribute it and/or modify it under 26 | the same terms as the Perl 5 programming language system itself. 27 | 28 | 29 | =cut 30 | 31 | use strict; 32 | use warnings; 33 | use lib qw( ./lib ./t/lib ../inc ./inc ); 34 | 35 | use Test::More; 36 | use Test::Fatal; 37 | 38 | use BiggerLib -types, -coercions; 39 | 40 | is( 41 | exception { no warnings 'numeric'; BigInteger + 42 }, 42 | undef, 43 | 'Type::Tiny overload fallback works', 44 | ); 45 | 46 | is( 47 | exception { BigInteger->coercion eq '1' }, 48 | undef, 49 | 'Type::Coercion overload fallback works', 50 | ); 51 | 52 | done_testing; 53 | -------------------------------------------------------------------------------- /t/40-bugs/ttxs-gh1.t: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Test that was failing with Type::Tiny::XS prior to 0.009. 8 | 9 | =head1 AUTHOR 10 | 11 | Jed Lund Ejandrew@cpan.orgE. 12 | 13 | =head1 COPYRIGHT AND LICENCE 14 | 15 | This software is copyright (c) 2014, 2017-2025 by Jed Lund. 16 | 17 | This is free software; you can redistribute it and/or modify it under 18 | the same terms as the Perl 5 programming language system itself. 19 | 20 | =cut 21 | 22 | use strict; 23 | use warnings; 24 | use Test::More; 25 | 26 | { 27 | package MyTest; 28 | use Type::Utils 0.046 -all; 29 | use Type::Library 0.046 30 | -base, 31 | -declare => qw(TestDictionary SuperClassesList NameSpace); 32 | use Types::Standard 0.046 -types; 33 | 34 | declare NameSpace, 35 | as Str, 36 | where { $_ =~ /^[A-Za-z:]+$/ }, 37 | # inline_as { undef, "$_ =~ /^[A-Za-z:]+\$/" }, 38 | message { "-$_- does not match: " . qr/^[A-Za-z:]+$/ }; 39 | 40 | declare SuperClassesList, 41 | as ArrayRef[ ClassName ], 42 | # inline_as { undef, "\@{$_} > 0" }, 43 | where { scalar( @$_ ) > 0 }; 44 | 45 | declare TestDictionary, as Dict[ 46 | package => Optional[ NameSpace ], 47 | superclasses => Optional[ SuperClassesList ], 48 | ]; 49 | } 50 | 51 | ok( 52 | MyTest::TestDictionary->check( { package => 'My::Package' } ), 53 | "Test TestDictionary" 54 | ); 55 | 56 | #diag MyTest::TestDictionary->inline_check('$dict'); 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/README: -------------------------------------------------------------------------------- 1 | Running the test suite 2 | ====================== 3 | 4 | In the main directory for the distribution (i.e. the directory containing 5 | dist.ini), run the following command: 6 | 7 | prove -lr -Iinc "t" 8 | 9 | 10 | 11 | Test suite structure 12 | ==================== 13 | 14 | Each test should contain its own documentation in pod format. 15 | 16 | t/20-modules/ 17 | - tests for each module in the distribution 18 | 19 | t/21-types/ 20 | - tests for each type in every bundled type library 21 | 22 | t/30-external/ 23 | - tests for using Type-Tiny with other software 24 | - these should be skipped if the other software is not available 25 | 26 | t/40-bugs/ 27 | - tests related to specific bug reports 28 | 29 | t/lib/ 30 | - support files for test cases. 31 | 32 | t/*.t 33 | - miscellaneous other tests 34 | 35 | t/*.pl 36 | - support files for managing test cases 37 | -------------------------------------------------------------------------------- /t/lib/DemoLib.pm: -------------------------------------------------------------------------------- 1 | =pod 2 | 3 | =encoding utf-8 4 | 5 | =head1 PURPOSE 6 | 7 | Type library used in several test cases. 8 | 9 | Defines types C, C and C. 10 | 11 | =head1 AUTHOR 12 | 13 | Toby Inkster Etobyink@cpan.orgE. 14 | 15 | =head1 COPYRIGHT AND LICENCE 16 | 17 | This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. 18 | 19 | This is free software; you can redistribute it and/or modify it under 20 | the same terms as the Perl 5 programming language system itself. 21 | 22 | =cut 23 | 24 | package DemoLib; 25 | 26 | use strict; 27 | use warnings; 28 | 29 | use Scalar::Util "looks_like_number"; 30 | use Type::Utils; 31 | 32 | use Type::Library -base; 33 | 34 | declare "String", 35 | where { no warnings; not ref $_ } 36 | message { "is not a string" }; 37 | 38 | declare "Number", 39 | as "String", 40 | where { no warnings; looks_like_number $_ }, 41 | message { "'$_' doesn't look like a number" }; 42 | 43 | declare "Integer", 44 | as "Number", 45 | where { no warnings; $_ eq int($_) }; 46 | 47 | 1; 48 | -------------------------------------------------------------------------------- /t/not-covered.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use v5.014; 4 | use Path::Tiny; 5 | use Path::Iterator::Rule; 6 | 7 | use constant LIB_DIR => path(path(__FILE__)->absolute->dirname)->parent->child('lib'); 8 | use constant TEST_DIR => path(path(__FILE__)->absolute->dirname)->parent->child('t/20-modules'); 9 | 10 | my $rule = Path::Iterator::Rule->new->file->perl_module; 11 | my $iter = $rule->iter( LIB_DIR ); 12 | 13 | while (my $file = $iter->()) 14 | { 15 | my $module = path($file)->relative(LIB_DIR); 16 | $module =~ s{.pm$}{}; 17 | $module =~ s{/}{::}g; 18 | 19 | TEST_DIR->child($module =~ s/::/-/gr)->exists 20 | or ($module =~ /^Types::Standard::/) # helper module 21 | or say $module; 22 | } 23 | -------------------------------------------------------------------------------- /xt/synopsis.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval { require Test::Synopsis } 3 | or plan(skip_all => "Test::Synopsis required for testing"); 4 | eval { require Test::Tabs } 5 | or plan(skip_all => "Test::Tabs required for testing"); 6 | 7 | Test::Synopsis::synopsis_ok( 8 | Test::Tabs::_all_perl_files(qw/ lib /) 9 | ); 10 | 11 | done_testing; 12 | --------------------------------------------------------------------------------