CONTRIBUTING000664001750001750 5215111656240 14202 0ustar00taitai000000000000Type-Tiny-2.008006See lib/Type/Tiny/Manual/Contributing.pod COPYRIGHT000664001750001750 5347415111656240 13743 0ustar00taitai000000000000Type-Tiny-2.008006Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: Type-Tiny Upstream-Contact: Toby Inkster (TOBYINK) Source: https://typetiny.toby.ink/ Files: lib/Error/TypeTiny.pm lib/Error/TypeTiny/Assertion.pm lib/Error/TypeTiny/Compilation.pm lib/Error/TypeTiny/WrongNumberOfParameters.pm lib/Eval/TypeTiny.pm lib/Reply/Plugin/TypeTiny.pm lib/Test/TypeTiny.pm lib/Type/Coercion.pm lib/Type/Coercion/FromMoose.pm lib/Type/Coercion/Union.pm lib/Type/Library.pm lib/Type/Params.pm lib/Type/Parser.pm lib/Type/Registry.pm lib/Type/Tiny.pm lib/Type/Tiny/Class.pm lib/Type/Tiny/Duck.pm lib/Type/Tiny/Enum.pm lib/Type/Tiny/Intersection.pm lib/Type/Tiny/Manual.pod lib/Type/Tiny/Manual/AllTypes.pod lib/Type/Tiny/Manual/Coercions.pod lib/Type/Tiny/Manual/Contributing.pod lib/Type/Tiny/Manual/Installation.pod lib/Type/Tiny/Manual/Libraries.pod lib/Type/Tiny/Manual/NonOO.pod lib/Type/Tiny/Manual/Optimization.pod lib/Type/Tiny/Manual/Params.pod lib/Type/Tiny/Manual/Policies.pod lib/Type/Tiny/Manual/UsingWithClassTiny.pod lib/Type/Tiny/Manual/UsingWithMoo.pod lib/Type/Tiny/Manual/UsingWithMoo2.pod lib/Type/Tiny/Manual/UsingWithMoo3.pod lib/Type/Tiny/Manual/UsingWithMoose.pod lib/Type/Tiny/Manual/UsingWithMouse.pod lib/Type/Tiny/Manual/UsingWithOther.pod lib/Type/Tiny/Manual/UsingWithTestMore.pod lib/Type/Tiny/Role.pm lib/Type/Tiny/Union.pm lib/Type/Utils.pm lib/Types/Common/Numeric.pm lib/Types/Common/String.pm lib/Types/Standard.pm lib/Types/TypeTiny.pm t/00-begin.t t/01-compile.t t/02-api.t t/03-leak.t t/20-modules/Error-TypeTiny-Assertion/basic.t t/20-modules/Error-TypeTiny-Compilation/basic.t t/20-modules/Error-TypeTiny-WrongNumberOfParameters/basic.t t/20-modules/Error-TypeTiny/basic.t t/20-modules/Error-TypeTiny/stacktrace.t t/20-modules/Eval-TypeTiny/aliases-devel-lexalias.t t/20-modules/Eval-TypeTiny/aliases-native.t t/20-modules/Eval-TypeTiny/aliases-padwalker.t t/20-modules/Eval-TypeTiny/aliases-tie.t t/20-modules/Eval-TypeTiny/basic.t t/20-modules/Eval-TypeTiny/lexical-subs.t t/20-modules/Type-Coercion-Union/basic.t t/20-modules/Type-Coercion/basic.t t/20-modules/Type-Coercion/frozen.t t/20-modules/Type-Coercion/inlining.t t/20-modules/Type-Coercion/parameterized.t t/20-modules/Type-Library/assert.t t/20-modules/Type-Library/errors.t t/20-modules/Type-Library/inheritance.t t/20-modules/Type-Library/is.t t/20-modules/Type-Library/to.t t/20-modules/Type-Library/types.t t/20-modules/Type-Params/badsigs.t t/20-modules/Type-Params/carping.t t/20-modules/Type-Params/coerce.t t/20-modules/Type-Params/compile-named-bless.t t/20-modules/Type-Params/compile-named.t t/20-modules/Type-Params/hashorder.t t/20-modules/Type-Params/methods.t t/20-modules/Type-Params/mixednamed.t t/20-modules/Type-Params/multisig.t t/20-modules/Type-Params/named.t t/20-modules/Type-Params/noninline.t t/20-modules/Type-Params/optional.t t/20-modules/Type-Params/positional.t t/20-modules/Type-Params/slurpy.t t/20-modules/Type-Parser/basic.t t/20-modules/Type-Parser/moosextypes.t t/20-modules/Type-Registry/basic.t t/20-modules/Type-Registry/moosextypes.t t/20-modules/Type-Registry/mousextypes.t t/20-modules/Type-Tiny-Class/basic.t t/20-modules/Type-Tiny-Class/errors.t t/20-modules/Type-Tiny-Class/plus-constructors.t t/20-modules/Type-Tiny-Duck/basic.t t/20-modules/Type-Tiny-Enum/basic.t t/20-modules/Type-Tiny-Intersection/basic.t t/20-modules/Type-Tiny-Role/basic.t t/20-modules/Type-Tiny-Role/errors.t t/20-modules/Type-Tiny-Union/basic.t t/20-modules/Type-Tiny-Union/relationships.t t/20-modules/Type-Tiny/arithmetic.t t/20-modules/Type-Tiny/basic.t t/20-modules/Type-Tiny/coercion-modifiers.t t/20-modules/Type-Tiny/parameterization.t t/20-modules/Type-Tiny/syntax.t t/20-modules/Type-Utils/dwim-moose.t t/20-modules/Type-Utils/dwim-mouse.t t/20-modules/Type-Utils/match-on-type.t t/20-modules/Types-Standard/basic.t t/20-modules/Types-Standard/deep-coercions.t t/20-modules/Types-Standard/mxtmlb-alike.t t/20-modules/Types-Standard/optlist.t t/20-modules/Types-Standard/overload.t t/20-modules/Types-Standard/strmatch.t t/20-modules/Types-Standard/structured.t t/20-modules/Types-Standard/tied.t t/30-external/Exporter-Tiny/basic.t t/30-external/Exporter-Tiny/installer.t t/30-external/Exporter-Tiny/role-conflict.t t/30-external/Function-Parameters/basic.t t/30-external/Kavorka/80returntype.t t/30-external/Moo/basic.t t/30-external/Moo/coercion.t t/30-external/Moo/exceptions.t t/30-external/Moo/inflation.t t/30-external/Moo/inflation2.t t/30-external/Moops/basic.t t/30-external/Moops/library-keyword.t t/30-external/Moose/accept-moose-types.t t/30-external/Moose/basic.t t/30-external/Moose/coercion-more.t t/30-external/Moose/coercion.t t/30-external/Moose/native-attribute-traits.t t/30-external/MooseX-Types/basic.t t/30-external/MooseX-Types/extending.t t/30-external/MooseX-Types/more.t t/30-external/Mouse/basic.t t/30-external/Mouse/coercion.t t/30-external/MouseX-Types/basic.t t/30-external/MouseX-Types/extending.t t/30-external/Object-Accessor/basic.t t/30-external/Sub-Quote/basic.t t/30-external/Validation-Class-Simple/archaic.t t/30-external/Validation-Class-Simple/basic.t t/lib/BiggerLib.pm t/lib/DemoLib.pm Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Tiny/ConstrainedObject.pm t/20-modules/Type-Library/import-params.t t/20-modules/Type-Params/named-to-list.t t/20-modules/Type-Params/wrap.t t/20-modules/Type-Tiny-ConstrainedObject/basic.t t/20-modules/Type-Tiny-Intersection/cmp.t t/20-modules/Type-Tiny-Intersection/constrainedobject.t t/20-modules/Type-Tiny-Union/constrainedobject.t t/20-modules/Type-Tiny/inline-assert.t t/20-modules/Types-Standard/strmatch-allow-callbacks.t t/20-modules/Types-Standard/strmatch-avoid-callbacks.t t/21-types/Any.t t/21-types/ArrayLike.t t/21-types/ArrayRef.t t/21-types/Bool.t t/21-types/ClassName.t t/21-types/CodeLike.t t/21-types/CodeRef.t t/21-types/ConsumerOf.t t/21-types/CycleTuple.t t/21-types/Defined.t t/21-types/Dict.t t/21-types/Enum.t t/21-types/FileHandle.t t/21-types/GlobRef.t t/21-types/HasMethods.t t/21-types/HashLike.t t/21-types/HashRef.t t/21-types/InstanceOf.t t/21-types/Int.t t/21-types/IntRange.t t/21-types/Item.t t/21-types/LaxNum.t t/21-types/LowerCaseSimpleStr.t t/21-types/LowerCaseStr.t t/21-types/Map.t t/21-types/Maybe.t t/21-types/NegativeInt.t t/21-types/NegativeNum.t t/21-types/NegativeOrZeroInt.t t/21-types/NegativeOrZeroNum.t t/21-types/NonEmptySimpleStr.t t/21-types/NonEmptyStr.t t/21-types/Num.t t/21-types/NumRange.t t/21-types/NumericCode.t t/21-types/Object.t t/21-types/OptList.t t/21-types/Optional.t t/21-types/Overload.t t/21-types/Password.t t/21-types/PositiveInt.t t/21-types/PositiveNum.t t/21-types/PositiveOrZeroInt.t t/21-types/PositiveOrZeroNum.t t/21-types/Ref.t t/21-types/RegexpRef.t t/21-types/RoleName.t t/21-types/ScalarRef.t t/21-types/SimpleStr.t t/21-types/SingleDigit.t t/21-types/Slurpy.t t/21-types/Str.t t/21-types/StrLength.t t/21-types/StrMatch-more.t t/21-types/StrMatch.t t/21-types/StrictNum.t t/21-types/StrongPassword.t t/21-types/Tied.t t/21-types/Tuple.t t/21-types/TypeTiny.t t/21-types/Undef.t t/21-types/UpperCaseSimpleStr.t t/21-types/UpperCaseStr.t t/21-types/Value.t t/30-external/Moose/parameterized.t t/30-external/Mouse/parameterized.t t/30-external/Specio/basic.t t/30-external/Specio/library.t t/30-external/Types-ReadOnly/basic.t t/40-bugs/rt102748.t t/40-bugs/rt104154.t t/40-bugs/rt121763.t t/40-bugs/rt129729.t t/40-bugs/rt130823.t t/98-param-eg-from-docs.t Copyright: This software is copyright (c) 2019-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Eval/TypeTiny/CodeAccumulator.pm lib/Type/Tiny/Manual/UsingWithMite.pod lib/Types/Common.pm t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t t/20-modules/Type-Library/exportables-duplicated.t t/20-modules/Type-Library/exportables.t t/20-modules/Type-Library/own-registry.t t/20-modules/Type-Library/remove-type.t t/20-modules/Type-Params-Signature/basic.t t/20-modules/Type-Params/alias.t t/20-modules/Type-Params/clone.t t/20-modules/Type-Params/goto_next.t t/20-modules/Type-Params/on-die.t t/20-modules/Type-Params/strictness.t t/20-modules/Type-Params/v2-defaults.t t/20-modules/Type-Params/v2-delayed-compilation.t t/20-modules/Type-Params/v2-exceptions.t t/20-modules/Type-Params/v2-fallback.t t/20-modules/Type-Params/v2-multi.t t/20-modules/Type-Params/v2-named-backcompat.t t/20-modules/Type-Params/v2-named-plus-slurpy.t t/20-modules/Type-Params/v2-named.t t/20-modules/Type-Params/v2-positional-backcompat.t t/20-modules/Type-Params/v2-positional-plus-slurpy.t t/20-modules/Type-Params/v2-positional.t t/20-modules/Type-Params/v2-warnings.t t/20-modules/Type-Params/v2-wrap-inherited-method.t t/20-modules/Type-Tie/06clone.t t/20-modules/Type-Tie/very-minimal.t t/20-modules/Type-Tiny-Class/exporter.t t/20-modules/Type-Tiny-Class/exporter_with_options.t t/20-modules/Type-Tiny-Duck/exporter.t t/20-modules/Type-Tiny-Enum/exporter.t t/20-modules/Type-Tiny-Enum/exporter_lexical.t t/20-modules/Type-Tiny-Enum/union_intersection.t t/20-modules/Type-Tiny-Role/exporter.t t/20-modules/Type-Tiny/definition-context.t t/20-modules/Type-Tiny/strictmode-off.t t/20-modules/Type-Tiny/strictmode-on.t t/20-modules/Type-Tiny/type_default.t t/20-modules/Type-Utils/auto-registry.t t/20-modules/Types-Common-Numeric/immutable.t t/20-modules/Types-Common-String/immutable.t t/20-modules/Types-Common/basic.t t/20-modules/Types-Common/immutable.t t/20-modules/Types-Standard/immutable.t t/20-modules/Types-TypeTiny/type-puny.t t/21-types/DelimitedStr.t t/30-external/Class-Plain/basic.t t/30-external/Class-Plain/multisig.t t/30-external/Type-Library-Compiler/basic.t t/40-bugs/gh96.t Copyright: This software is copyright (c) 2022-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t t/20-modules/Test-TypeTiny/basic.t t/20-modules/Test-TypeTiny/extended.t t/20-modules/Test-TypeTiny/matchfor.t t/20-modules/Type-Coercion-FromMoose/basic.t t/20-modules/Type-Coercion-FromMoose/errors.t t/20-modules/Type-Coercion/esoteric.t t/20-modules/Type-Coercion/smartmatch.t t/20-modules/Type-Coercion/typetiny-constructor.t t/20-modules/Type-Registry/automagic.t t/20-modules/Type-Registry/methods.t t/20-modules/Type-Tie/basic.t t/20-modules/Type-Tiny-Duck/errors.t t/20-modules/Type-Tiny-Enum/errors.t t/20-modules/Type-Tiny-Intersection/errors.t t/20-modules/Type-Tiny-Union/errors.t t/20-modules/Type-Tiny/esoteric.t t/20-modules/Type-Tiny/my-methods.t t/20-modules/Type-Tiny/shortcuts.t t/20-modules/Type-Tiny/smartmatch.t t/20-modules/Type-Tiny/to-moose.t t/20-modules/Type-Tiny/to-mouse.t t/20-modules/Type-Utils/classifier.t t/20-modules/Type-Utils/dwim-both.t t/20-modules/Type-Utils/warnings.t t/20-modules/Types-Standard/lockdown.t t/20-modules/Types-TypeTiny/basic.t t/20-modules/Types-TypeTiny/coercion.t t/20-modules/Types-TypeTiny/meta.t t/20-modules/Types-TypeTiny/moosemouse.t t/30-external/Kavorka/basic.t t/30-external/Moo/coercion-inlining-avoidance.t t/30-external/Moose/inflate-then-inline.t t/30-external/Return-Type/basic.t t/30-external/Sub-Quote/unquote-coercions.t t/30-external/Sub-Quote/unquote-constraints.t t/30-external/Switcheroo/basic.t t/30-external/match-simple/basic.t Copyright: This software is copyright (c) 2014, 2017-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: META.json META.yml NEWS doap.ttl lib/Devel/TypeTiny/Perl58Compat.pm lib/Types/Standard/Tied.pm t/20-modules/Type-Tiny-Bitfield/basic.t t/20-modules/Type-Tiny-Bitfield/errors.t t/20-modules/Type-Tiny-Bitfield/import-options.t t/20-modules/Type-Tiny-Bitfield/plus.t t/README t/lib/CompiledLib.pm t/lib/Type/Puny.pm t/mk-test-manifest.pl t/not-covered.pl Copyright: Copyright 2025 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Library/deprecation.t t/20-modules/Type-Params/compile-named-oo-pp.t t/20-modules/Type-Params/compile-named-oo.t t/20-modules/Type-Params/defaults.t t/20-modules/Type-Tiny-Duck/cmp.t t/20-modules/Type-Tiny-Enum/cmp.t t/20-modules/Type-Tiny/cmp.t t/20-modules/Type-Tiny/deprecation.t t/20-modules/Types-Common-Numeric/ranges.t t/20-modules/Types-Common-String/strlength.t t/20-modules/Types-Standard/arrayreflength.t t/20-modules/Types-Standard/filehandle.t t/20-modules/Types-TypeTiny/progressiveexporter.t t/30-external/Sub-Quote/delayed-quoting.t Copyright: This software is copyright (c) 2018-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Params/v2-allowdash.t t/20-modules/Type-Params/v2-default-on-undef.t t/20-modules/Type-Params/v2-listtonamed.t t/20-modules/Type-Params/v2-shortcuts.t t/20-modules/Type-Tiny-Enum/use_eq.t t/20-modules/Types-Standard-ArrayRef/exporter.t t/20-modules/Types-Standard-CycleTuple/exporter.t t/20-modules/Types-Standard-Dict/exporter.t t/20-modules/Types-Standard-HashRef/exporter.t t/20-modules/Types-Standard-Map/exporter.t t/20-modules/Types-Standard-ScalarRef/exporter.t t/20-modules/Types-Standard-StrMatch/exporter.t t/20-modules/Types-Standard-Tuple/exporter.t Copyright: This software is copyright (c) 2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Library/declared-types.t t/20-modules/Type-Library/recursive-type-definitions.t t/20-modules/Type-Registry/parent.t t/20-modules/Type-Registry/refcount.t t/20-modules/Type-Tiny-Enum/sorter.t t/20-modules/Type-Tiny/list-methods.t t/20-modules/Type-Tiny/refcount.t t/20-modules/Type-Utils/is.t t/21-types/_ForeignTypeConstraint.t t/30-external/Data-Constraint/basic.t t/40-bugs/rt131401.t t/40-bugs/rt131576.t Copyright: This software is copyright (c) 2020-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Params/Alternatives.pm lib/Type/Params/Parameter.pm lib/Type/Params/Signature.pm lib/Type/Tiny/Bitfield.pm t/20-modules/Type-Params/compile-named-avoidcallbacks.t t/20-modules/Type-Params/multisig-gotonext.t t/20-modules/Type-Tiny/custom-exception-classes.t t/21-types/BoolLike.t t/30-external/JSON-PP/basic.t Copyright: This software is copyright (c) 2023-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Tiny/_DeclaredType.pm lib/Types/Standard/ArrayRef.pm lib/Types/Standard/CycleTuple.pm lib/Types/Standard/Dict.pm lib/Types/Standard/HashRef.pm lib/Types/Standard/Map.pm lib/Types/Standard/ScalarRef.pm lib/Types/Standard/StrMatch.pm lib/Types/Standard/Tuple.pm Copyright: This software is copyright (c) 2013-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: examples/benchmarking/benchmark-constraints.pl examples/benchmarking/benchmark-named-param-validation.pl examples/benchmarking/benchmark-param-validation.pl examples/benchmarking/versus-scalar-validation.pl examples/datetime-coercions.pl examples/jsoncapable.pl examples/nonempty.pl examples/page-numbers.pl Copyright: Copyright 2024 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: CREDITS Changes INSTALL LICENSE Makefile.PL README Copyright: Copyright 1970 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt92571-2.t t/40-bugs/rt92571.t t/40-bugs/rt92591.t t/40-bugs/rt94196.t t/40-bugs/rt97684.t Copyright: This software is copyright (c) 2014, 2017-2025 by Diab Jerius. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Tie.pm t/20-modules/Type-Tie/01basic.t t/20-modules/Type-Tie/02moosextypes.t t/20-modules/Type-Tie/04nots.t t/20-modules/Type-Tie/05typetiny.t Copyright: This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Tiny/_HalfOp.pm t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t t/40-bugs/73f51e2d.pl t/40-bugs/73f51e2d.t Copyright: This software is copyright (c) 2014, 2017-2025 by Graham Knop. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Tiny-_HalfOp/double-union.t t/20-modules/Type-Tiny/constraint-strings.t t/20-modules/Types-Standard/cycletuple.t t/40-bugs/gh14.t Copyright: This software is copyright (c) 2017-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Types-Common-Numeric/basic.t t/20-modules/Types-Common-String/basic.t t/20-modules/Types-Common-String/coerce.t t/20-modules/Types-Common-String/unicode.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt85911.t t/40-bugs/rt86004.t t/40-bugs/rt90096-2.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt86233.t t/40-bugs/rt86239.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Vyacheslav Matyukhin. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Params/v2-returns.t t/40-bugs/gh143.t Copyright: This software is copyright (c) 2024-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: CONTRIBUTING dist.ini Copyright: Copyright 2022 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT SIGNATURE Copyright: None License: public-domain Files: inc/archaic/Test/More.pm inc/archaic/Test/Simple.pm Copyright: Copyright 2001-2008 by Michael G Schwern . License: GPL-1.0+ or Artistic-1.0 Files: t/21-types/StringLike.t Copyright: This software is copyright (c) 20192025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh80.t Copyright: This software is copyright (c) 2021-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Tester.pm Copyright: Copyright 2024 Richard Clamp. License: GPL-1.0+ or Artistic-1.0 Files: t/30-external/MooseX-Getopt/coercion.t Copyright: This software is copyright (c) 2014, 2017-2025 by Alexander Hartmaier. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Module.pm Copyright: Copyright 2024 Chromatic. License: GPL-1.0+ or Artistic-1.0 Files: t/99-moose-std-types-test.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Infinity Interactive, Inc.. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Tie/06storable.t Copyright: This software is copyright (c) 2013-2014, 2022-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/boolean.pm Copyright: Copyright 2025 Ingy döt Net. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh140.t Copyright: This software is copyright (c) 2023-2025 by XSven. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt133141.t Copyright: This software is copyright (c) 2020-2025 by Andrew Ruder. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Tiny-_HalfOp/extra-params.t Copyright: This software is copyright (c) 2020-2025 by Graham Knop. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh158.t Copyright: This software is copyright (c) 2024-2025 by Diab Jerius. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt125765.t Copyright: This software is copyright (c) 2018-2025 by KB Jørgensen. License: GPL-1.0+ or Artistic-1.0 Files: examples/benchmarking/benchmark-coercions.pl Copyright: This software is copyright (c) 2013-2014, 2017-2024 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Tie/03prototypicalweirdness.t Copyright: This software is copyright (c) 2014, 2018-2019, 2022-2025 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/Try/Tiny.pm Copyright: Copyright 2024 Yuval Kogman. License: GPL-1.0+ or Artistic-1.0 Files: inc/Test/Requires.pm Copyright: Copyright 2024 MATSUNO Tokuhiro. License: GPL-1.0+ or Artistic-1.0 Files: inc/Test/Fatal.pm Copyright: Copyright 2024 Ricardo Signes. License: GPL-1.0+ or Artistic-1.0 Files: t/30-external/Class-InsideOut/basic.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by David Golden, Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh180.t Copyright: This software is copyright (c) 2025 by Robert Moore. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/hg166.t Copyright: This software is copyright (c) 2025 by Karen Etheridge. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt98113.t Copyright: This software is copyright (c) 2014, 2017-2025 by Dagfinn Ilmari MannsÃ¥ker. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh1.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Richard Simões. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder.pm Copyright: Copyright 2002-2008 by chromatic and. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt90096.t Copyright: This software is copyright (c) 2013-2014, 2017-2025 by Samuel Kaufman. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt125132.t Copyright: This software is copyright (c) 2018-2025 by Marc Ballarin. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/IO/Scalar.pm Copyright: Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. License: GPL-1.0+ or Artistic-1.0 Files: t/20-modules/Type-Params/multisig-custom-message.t Copyright: This software is copyright (c) 2018-2025 by Benct Philip Jonsson. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/ttxs-gh1.t Copyright: This software is copyright (c) 2014, 2017-2025 by Jed Lund. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Tester/Color.pm Copyright: Copyright 2024 Mark Fowler. License: GPL-1.0+ or Artistic-1.0 License: Artistic-1.0 This software is Copyright (c) 2025 by the copyright holder(s). This is free software, licensed under: The Artistic License 1.0 License: GPL-1.0 This software is Copyright (c) 2025 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 551615111656240 13442 0ustar00taitai000000000000Type-Tiny-2.008006Maintainer: - Toby Inkster (TOBYINK) Contributor: - Alexander Hartmaier (ABRAXXA) - Alexandr Ciornii - Andrew Ruder (AERUDER) - Benct Philip Jonsson - Dagfinn Ilmari Mannsåker (ILMARI) - David Steinbrunner - Denis Ibaev - Diab Jerius (DJERIUS) - Florian Schlichting - Gianni Ceccarelli (DAKKAR) - Graham Knop (HAARG) - Hauke D (HAUKEX) - James E Keenan (JKEENAN) - Jonas B Nielsen (JONASBN) - Karen Etheridge (ETHER) - Lucas Buchala (LSBUCHALA) - Lucas Tiago de Moraes (LUCAS) - Mark Stosberg (MARKSTOS) - Meredith Howard (MHOWARD) - Nelo Onyiah - Peter Flanigan (PJFL) - Peter Karman (KARMAN) - Peter Valdemar Mørch - Philippe Bruhat (BOOK) - Pierre Masci - Robert Rothenberg (RRWO) - Samuel Kaufman (SKAUFMAN) - Sandor Patocs (SPATOCS) - Thomas Sibley (TSIBLEY) - Vyacheslav Matyukhin (MMCLERIC) - Windymelt - Yoshikazu Sawa - ZAKI MUGHAL - Zoffix Znet Thanks: - Andreas J König (ANDK) - André Walker - Aran Clary Deltac (BLUEFEET) - BOKUTIN - Branislav Zahradník (BARNEY) - Brendan Byrd (BBYRD) - Caleb Cushing (XENO) - Chromatic (CHROMATIC) - DANIEL MITA - Daniel Schröer (SCHROEER) - David Golden (DAGOLDEN) - Hugo van der Sanden - Ingy döt Net (INGY) - Ivanov Anton - JSF116 - James Wright - Jason R Mash (JRMASH) - Jon Portnoy (AVENJ) - KB Jørgensen - Kevin Dawson (BOWTIE) - MATSUNO Tokuhiro (TOKUHIROM) - Marcel Montes (SPICEMAN) - Marcel Timmerman (MARTIMM) - Mark Fowler (MARKF) - Matt Phillips (MATTP) - Matt S Trout (MSTROUT) - Michael G Schwern (MSCHWERN) - Peter Rabbitson (RIBASUSHI) - Ricardo Signes (RJBS) - Richard Clamp (RCLAMP) - Richard Simões (RSIMOES) - Robert Moore (RMOORE) - SBUGGLES - Shlomi Fish (SHLOMIF) - Slaven Rezić (SREZIC) - Steven Lee (STEVENL) - Szymon Nieznański (SNEZ) - Tim Bunce (TIMB) - XSVEN - Yuval Kogman (NUFFIN) - ZHTWN Changes000664001750001750 5223615111656240 13736 0ustar00taitai000000000000Type-Tiny-2.008006Type-Tiny ========= Created: 2013-03-23 Home page: Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 2.008006 2025-11-26 - Minor optimization for non-XS type check code for Enum types: if there are only a small number of valid strings (five or under), check using `eq` and `or` operators instead of compiling a regexp to check against them all at once. This can be controlled by passing the `use_eq` attribute to the Type::Tiny::Enum constructor, but is otherwise automatic. 2.008005 2025-11-20 - Minor optimization for Type::Params: sometimes it would construct an arrayref of hashref from the slurpy arguments to a function and then check that they arrayref it created was an arrayref, or check the hashref it created was a hashref. Those checks seem unnecessary; if they had ever failed it would indicate something deeply wrong with Perl itself. These superfluous checks are now avoided. - Minor optimization for Type::Params: sometimes it would wrap a `goto` in a `do` block for no reason. That could potentially slow down the call as Perl might create a new lexical context unnecessarily. It is unlikely to make a measurable difference. 2.008004 2025-10-17 [ Documentation ] - Type::Tiny pod syntax fix. [ Other ] - Added: Type::Tiny::Duck (used by HasMethods) now includes a new_intersection constructor. 2.008003 2025-09-02 [ Bug Fixes ] - Make sure methods fake-inherited from Moose (if it's loaded) are a last resort. Robert Moore++ [ Other ] - Slightly streamlined `Type::Tiny::can` and `Type::Tiny::AUTOLOAD`. - When dumping structures via Data::Dumper (mostly in error messages) suppress any warnings Data::Dumper would emit. Diab Jerius++ 2.008002 2025-04-30 [ Bug Fixes ] - MooseX-Types 0.51 broke Type::Tiny's ability to reliably detect if Moose types were being used. This release fixes that. Graham Knop++ 2.008001 2025-04-15 [ Bug Fixes ] - The Optional type constraint on its own, will now be treated the same as Optional[Any]. Previously when used for named parameters, it would fail to generate predicate methods. 2.008000 2025-03-31 [ Packaging ] - Repackaged with a stable version number. 2.007_010 2025-03-23 [ Bug Fixes ] - Warnings for unknown Type::Params signature options introduced in 2.007_008 broke Mite, which passes it a `is_wrapper` option and checks no warnings are thrown in its test suite. That option is now silently allowed, even though Type::Params makes no use of it. 2.007_009 2025-03-21 [ Bug Fixes ] - Warnings for unknown Type::Params signature options introduced in 2.007_008 broke Mite, which passes it a `mite_signature` option and checks no warnings are thrown in its test suite. That option is now silently allowed, even though Type::Params makes no use of it. [ Documentation ] - Fix documentation for the coercion_generator attribute of Type::Tiny. [ Other ] - Added: Type::Params now has a per-parameter `default_on_undef` option. - Added: Types::Standard::ArrayRef can now export shortcuts for parameterized versions of the ArrayRef type constraint. - Added: Types::Standard::CycleTuple can now export shortcuts for parameterized versions of the CycleTuple type constraint. - Added: Types::Standard::Dict can now export shortcuts for parameterized versions of the Dict type constraint. - Added: Types::Standard::HashRef can now export shortcuts for parameterized versions of the HashRef type constraint. - Added: Types::Standard::Map can now export shortcuts for parameterized versions of the Map type constraint. - Added: Types::Standard::ScalarRef can now export shortcuts for parameterized versions of the ScalarRef type constraint. - Added: Types::Standard::StrMatch can now export shortcuts for parameterized versions of the StrMatch type constraint. - Added: Types::Standard::Tuple can now export shortcuts for parameterized versions of the Tuple type constraint. - Added: When creating 'multi' signatures with Type::Params, the different alternatives can now be given a string identifier. 2.007_008 2025-03-20 [ Bug Fixes ] - Expressing return types for Type::Params as strings now works as documented. [ Documentation ] - Use Perl's new `try` feature instead of Try::Tiny in SYNOPSIS for Error::TypeTiny. [ Test Suite ] - Improved tests for the `ArgsObject` type constraint which is optionally exported by Type::Params. - Improved tests for the `goto_next` feature of Type::Params. [ Other ] - Added: Error::TypeTiny::WrongNumberOfParameters now has a `target` attribute indicating what thing you provided the wrong number of parameters for. - Added: There's now a Type::Tiny::check_parameter_count_for_parameterized_type utility function intended to be used for parameterizable types to throw an error when parameterized with the wrong number of parameters. - Parameterizable types defined by Types::Standard, Types::Common::String, Types::Common::Numeric, and Type::Params will throw an Error::TypeTiny::WrongNumberOfParameters exception if parameterized with the wrong number of parameters. - Passing unknown options to Type::Params functions will now result in warnings. 2.007_007 2025-03-18 [ Bug Fixes ] - Localize $@ before stringifying Error::TypeTiny objects. Karen Etheridge++ 2.007_006 2025-03-14 - Added: Types::Standard::Dict::combine() function. Branislav Zahradník++ - Type::Params named_to_list option now accepts blessed boolean objects. Certain other options should be more permissive accepting them too. XSven++ - Types::TypeTiny::BoolLike now accepts boolean.pm's bools. Benct Philip Jonsson++ 2.007_005 2025-03-07 [ Documentation ] - Minor fixes and improvements for `Type::Params` documentation. 2.007_004 2025-03-07 [ Bug Fixes ] - Avoid the `//` operator in `Type::Params::Parameter` as it isn't supported in Perl 5.8. Fixes bug introduced in 2.007_003. - Use `List::Util::sum` instead of `List::Util::sum0` which doesn't exist in some older versions of List::Util. Fixes bug introduced in 2.007_003. [ Documentation ] - Major rewrite of `Type::Params` documentation to prioritize `signature_for` and modern Perl, and some corresponding adjustments to `Type::Tiny::Manual`. [ Other ] - The `goto_next` option in `Type::Params` is now just called `next`. The original name is still supported for backwards compatibility. 2.007_003 2025-03-06 [ Documentation ] - Minor pod fixed and improvements. - Update copyright dates to 2025. [ Other ] - Added: New Type::Params feature allow_dash automatically supports `-foo` as an alias for `foo`. - Added: New Type::Params feature list_to_named automatically extracts named parameters from a list of positional arguments. - Added: Type::Params optionally exports two shortcut keywords: `signature_for_func` and `signature_for_method`. The exact behaviour of these may change in the future. 2.007_002 2024-12-23 [ Documentation ] - Update most examples to use features (postfix derefs, sub signatures) from more modern versions of Perl that allow for cleaner, tidier code. 2.007_001 2024-11-24 [ Bug Fixes ] - If Perl has been built with -Dusequadmath then cowardly refuse to use Type::Tiny::XS's implementation of is_Int. Andreas J König++ 2.007_000 2024-10-20 - Added: The `signature_for` function in Type::Params now includes most of the functionality of Return::Type (a separate CPAN distribution not bundled with Type::Tiny). - Added: The `signature_for` function in Type::Params now returns a value, though in most contexts you'll probably want to call it in void context anyway. 2.006000 2024-09-24 [ Documentation ] - Update NEWS. [ Packaging ] - Repackage as stable. (See also the changelog for 2.005_001 and 2.005_002.) 2.005_002 2024-09-08 [ Bug Fixes ] - Fix uninitialized warning messages from Error::TypeTiny when processing very shallow stack traces. Diab Jerius++ [ Documentation ] - Fix minor typo in documentation for named parameters in `Type::Params`. - Update copyright notices in files to 2024. [ Other ] - Improved initialization of variables when they are tied to a type constraint; initialization to explicit values will work even when not tied via the `ttie` wrapper function; if no explicit values are provided, tied scalars will be initialized to the type's `type_default`. So for example, `tie( my $title, Str )` will initialize `$title` to the empty string instead of undef, and `tie( my $title, Str, 'Foo' )` will initialize the variable to 'Foo' as was already implied by documentation. Daniel Mita++ XSven++ - Inlining `Int` now calls the XS implementation when available. (The speed improvement is negligible, but it also may result in small memory savings.) Zaki Mughal++ - Removed: Support for the ${^TYPE_PARAMS_MULTISIG} global variable has been dropped. Using this global variable was deprecated in trial version 1.999_010 and stable version 2.000000, both of which are nearly two years old. Use ${^_TYPE_PARAMS_MULTISIG} instead. 2.005_001 2024-09-07 [ Documentation ] - Fixes for various typos. Yoshikazu Sawa++ - Improve documentation for the initialization of the `coercion` attribute for `Type::Tiny`. Diab Jerius++ [ Other ] - Updated: Smartmatch discontinued beginning perl-5.41.3; Type::Tiny will no longer attempt to support smartmatch if the Perl version is too high. James E Keenan++ 2.004000 2023-04-05 [ Documentation ] - Document that the `BoolLike` type is unstable. - Minor pod changes to Types::Standard. [ Packaging ] - Summarized the change log for versions prior to Type::Tiny 2.000000. If you need more information, see the Changes file included with Type::Tiny 2.002001. 2.003_000 2023-04-02 [ Documentation ] - Add SYNOPSIS for Type::Tiny::Class. - Add SYNOPSIS for Type::Tiny::Duck. - Add SYNOPSIS for Type::Tiny::Enum. - Add SYNOPSIS for Type::Tiny::Intersection. - Add SYNOPSIS for Type::Tiny::Role. - Add SYNOPSIS for Type::Tiny::Union. - Add documentation and tests for the combination of the `goto_next` and `multiple` options when used with `signature_for`. - Add example of `signature_for` applying a signature to multiple functions at once. - Document changes to `make_immutable` in Type::Library v2.x. [ Other ] - Added: Type::Tiny now has an `exception_class` attribute, allowing a type to throw exceptions using a custom class. These classes should usually be a subclass of Error::TypeTiny::Assertion. - Added: Type::Tiny::Bitfield class. - Added: Types::TypeTiny::BoolLike type constraint. 2.002001 2023-01-20 [ Bug Fixes ] - Bugfix for Type::Tie+Storable issue affecting 32-bit builds of Perl. 2.002000 2023-01-01 Happy Fibonacci Day! 1/1/23 [ Bug Fixes ] - When Foo is a parameterized StrMatch type, ensure is_Foo always returns a single boolean value, even in list context. Diab Jerius++ [ Documentation ] - Update NEWS. - Update copyright dates to 2023. [ Packaging ] - Repackage as stable. 2.001_002 2022-12-03 [ Test Suite ] - Test `t/20-modules/Type-Tiny-Enum/exporter_lexical.t` will now run on older versions of Perl, provided Lexical::Sub is installed. [ Packaging ] - Depend on Exporter::Tiny 1.006000 which offers lexical export support for older versions of Perl, provided Lexical::Sub is installed. [ Other ] - If Type::Params signatures receive multiple unrecognized named arguments, the error message now lists them using Type::Utils::english_list() instead of just joining them with commas. This means that the error message will include 'and' before the last unrecognized named argument. If Type::Tiny::AvoidCallbacks is set to true while the signature is compiled, the old behaviour will be retained. - Type::Params no longer attempts to figure out the maximum number of expected arguments to functions which take key-value pairs. This allows `yourfunc(y=>1,y=>2)` to behave more intuitively, with the function just seeing the second value for `y`, instead of it throwing an exception complaining about too many arguments. 2.001_001 2022-10-19 [ Documentation ] - Typo fix in Type::Tiny::Manual::UsingWithMoo. [ Other ] - Type::Library will better detect if two types result in functions with the same name. - Type::Tiny::XS will now provide XS implementations of some parameterized ArrayLike/HashLike types. - When importing `use Type::Library -util`, Type::Library will now pass some relevant import options to Type::Utils. 2.001_000 2022-09-29 [ Bug Fixes ] - Avoid uninitialized warnings when creating a union between an Enum type and a non-Enum type. Diab Jerius++ [ Documentation ] - Clearer documentation of Types::TypeTiny::to_TypeTiny. [ Test Suite ] - No longer report Type::Tie version at start of test suite, as Type::Tie is now bundled. [ Other ] - Added: Type::Library now has an undocumented, but tested and hopefully stable `_remove_type` method. - Added: Type::Tiny now has a `definition_context` attribute/method indicating the file and line number where a type constraint was first defined. - The list of packages Type::Tiny considers to be 'internal' has been moved from Error::TypeTiny to Type::Tiny. - Type::Tiny will now mark particular parts of its guts as readonly. Currently this is mainly used to prevent people pushing to and popping from type constraints which overload `@{}`. 2.000001 2022-09-29 [ Bug Fixes ] - Avoid uninitialized warnings when creating a union between an Enum type and a non-Enum type. Diab Jerius++ [ Documentation ] - Clearer documentation of Types::TypeTiny::to_TypeTiny. [ Test Suite ] - No longer report Type::Tie version at start of test suite, as Type::Tie is now bundled. 2.000000 2022-09-23 [ Test Suite ] - Minor fix for Class::Plain-related tests. [ Packaging ] - Repackage Type-Tiny 1.999_013 as a stable release. 1.999_013 2022-09-23 Type::Tiny 2.0 Preview N 1.999_012 2022-09-21 Type::Tiny 2.0 Preview M 1.999_011 2022-09-20 Type::Tiny 2.0 Preview L 1.999_010 2022-09-18 Type::Tiny 2.0 Preview K 1.999_009 2022-09-16 Type::Tiny 2.0 Preview J 1.999_008 2022-09-14 Type::Tiny 2.0 Preview I 1.999_007 2022-09-13 Type::Tiny 2.0 Preview H 1.999_006 2022-09-12 Type::Tiny 2.0 Preview G 1.999_005 2022-09-11 Type::Tiny 2.0 Preview F 1.999_004 2022-09-09 Type::Tiny 2.0 Preview E 1.999_003 2022-09-09 Type::Tiny 2.0 Preview D 1.999_002 2022-09-07 Type::Tiny 2.0 Preview C 1.999_001 2022-09-05 Type::Tiny 2.0 Preview B 1.999_000 2022-09-04 Type::Tiny 2.0 Preview A 1.016010 2022-08-31 1.016009 2022-08-27 1.016008 2022-08-14 1.016007 2022-08-04 1.016006 2022-07-25 1.016005 2022-07-23 1.016004 2022-07-22 1.016003 2022-07-22 1.016002 2022-07-19 1.016001 2022-07-18 1.016000 2022-07-16 1.015_003 2022-07-16 1.015_002 2022-07-16 1.015_001 2022-07-16 1.015_000 2022-07-16 1.014000 2022-06-27 1.013_001 2022-06-23 1.013_000 2022-06-09 1.012005 2022-06-07 1.012004 2021-07-29 1.012003 2021-05-09 1.012002 2021-05-02 1.012001 2021-01-10 1.012000 2020-10-28 1.011_011 2020-10-16 1.011_010 2020-10-16 1.011_009 2020-10-09 1.011_008 2020-10-07 1.011_007 2020-10-06 1.011_006 2020-10-02 1.011_005 2020-09-30 1.011_004 2020-09-30 1.011_003 2020-09-25 1.011_002 2020-09-22 1.011_001 2020-09-21 1.011_000 2020-09-15 1.010006 2020-09-04 1.010005 2020-08-26 1.010004 2020-08-18 1.010003 2020-08-08 The Crazy 88 1.010002 2020-05-01 Mayday 1.010001 2020-03-16 1.010000 2020-02-19 1.009_003 2020-02-11 1.009_002 2020-02-11 1.009_001 2020-02-06 1.009_000 2020-02-04 1.008005 2020-01-30 1.008004 2020-01-29 1.008003 2020-01-13 1.008002 2020-01-11 1.008001 2019-12-28 1.008000 2019-12-11 1.007_015 2019-12-10 1.007_014 2019-12-10 1.007_013 2019-12-10 1.007_012 2019-12-10 1.007_011 2019-12-09 1.007_010 2019-12-08 1.007_009 2019-12-06 1.007_008 2019-12-05 1.007_007 2019-12-03 1.007_006 2019-12-02 1.007_005 2019-12-01 1.007_004 2019-11-30 1.007_003 2019-11-27 1.007_002 2019-11-26 1.007_001 2019-11-23 1.007_000 2019-11-17 1.006000 2019-11-12 1.005_004 2019-11-11 1.005_003 2019-02-26 1.005_002 2019-01-29 1.005_001 2019-01-23 1.005_000 2019-01-20 1.004004 2019-01-08 1.004003 2019-01-08 1.004002 2018-07-29 1.004001 2018-07-28 1.004000 2018-07-27 1.003_010 2018-07-25 1.003_009 2018-07-24 1.003_008 2018-07-16 1.003_007 2018-07-12 1.003_006 2018-07-08 1.003_005 2018-07-05 1.003_004 2018-06-12 1.003_003 2018-06-10 1.003_002 2018-05-28 1.003_001 2018-05-22 1.003_000 2018-05-20 1.002001 2017-06-08 1.002000 2017-06-01 1.001_016 2017-05-30 1.001_015 2017-05-20 1.001_014 2017-05-19 1.001_013 2017-05-18 Kittiversary 1.001_012 2017-05-17 1.001_011 2017-05-17 1.001_010 2017-05-16 Puppiversary 1.001_009 2017-05-13 1.001_008 2017-05-10 1.001_007 2017-05-04 May the fourth be with you 1.001_006 2017-04-30 1.001_005 2017-04-19 1.001_004 2017-02-06 1.001_003 2017-02-02 1.001_002 2014-10-25 1.001_001 2014-09-19 1.001_000 2014-09-07 1.000006 2017-01-30 1.000005 2014-10-25 1.000004 2014-09-02 1.000003 2014-08-28 1.000002 2014-08-18 1.000001 2014-08-18 1.000000 2014-08-16 Happy CPAN Day! 0.047_09 2014-08-12 0.047_08 2014-08-05 Sanity++ 0.047_07 2014-08-04 0.047_06 2014-07-31 What made the Queen go all ice crazy? 0.047_05 2014-07-29 Sanity++ 0.047_04 2014-07-28 The 98% Coverage Release 0.047_03 2014-07-26 The 96% Coverage Release 0.047_02 2014-07-23 The 92% Coverage Release 0.047_01 2014-07-21 The 87% Coverage Release 0.046 2014-07-18 0.045_05 2014-07-18 0.045_04 2014-07-15 0.045_03 2014-07-11 0.045_02 2014-07-10 0.045_01 2014-06-30 0.044 2014-06-03 0.043_05 2014-05-21 0.043_04 2014-05-21 0.043_03 2014-05-06 0.043_02 2014-04-11 0.043_01 2014-04-06 0.042 2014-04-02 0.041_04 2014-03-31 0.041_03 2014-03-28 0.041_02 2014-03-26 0.041_01 2014-03-17 0.040 2014-03-17 0.039_13 2014-03-15 0.039_12 2014-03-12 0.039_11 2014-03-11 0.039_10 2014-03-10 0.039_09 2014-02-25 0.039_08 2014-02-24 0.039_07 2014-02-17 0.039_06 2014-02-17 0.039_05 2014-02-15 0.039_04 2014-02-05 0.039_03 2014-02-05 0.039_02 2014-01-25 0.039_01 2014-01-21 0.038 2014-01-01 0.037_03 2013-12-30 0.037_02 2013-12-29 0.037_01 2013-12-24 0.036 2013-12-21 0.035_01 2013-12-17 0.034 2013-12-09 0.033_04 2013-12-06 0.033_03 2013-11-26 0.033_02 2013-11-26 0.033_01 2013-11-07 0.032 2013-11-05 Remember, remember the fifth of November 0.031_05 2013-11-04 0.031_04 2013-11-03 0.031_03 2013-11-03 0.031_02 2013-11-03 0.031_01 2013-10-28 0.030 2013-10-18 0.029_04 2013-10-17 0.029_03 2013-10-17 0.029_02 2013-10-11 0.029_01 2013-09-26 0.028 2013-09-26 0.027_09 2013-09-20 0.027_08 2013-09-19 0.027_07 2013-09-18 0.027_06 2013-09-18 0.027_05 2013-09-15 0.027_04 2013-09-09 0.027_03 2013-09-09 0.027_02 2013-09-08 0.027_01 2013-09-07 0.026 2013-09-05 0.025_03 2013-09-04 0.025_02 2013-09-02 0.025_01 2013-09-02 0.024 2013-08-27 0.023_03 2013-08-23 0.023_02 2013-08-23 0.023_01 2013-08-16 0.022 2013-08-06 0.021_04 2013-07-30 0.021_03 2013-07-30 0.021_02 2013-07-26 0.021_01 2013-07-24 0.020 2013-07-23 0.019_01 2013-07-23 0.018 2013-07-21 0.017_02 2013-07-20 0.017_01 2013-07-19 0.016 2013-07-16 0.015_05 2013-07-15 0.015_04 2013-07-13 0.015_03 2013-07-08 0.015_02 2013-07-06 0.015_01 2013-07-05 0.014 2013-06-28 0.013_01 2013-06-27 0.012 2013-06-25 0.011_03 2013-06-25 0.011_02 2013-06-25 0.011_01 2013-06-25 0.010 2013-06-24 0.009_07 2013-06-24 0.009_06 2013-06-23 0.009_05 2013-06-23 0.009_04 2013-06-23 0.009_03 2013-06-22 0.009_02 2013-06-22 0.009_01 2013-06-21 0.008 2013-06-21 0.007_10 2013-06-21 0.007_09 2013-06-18 0.007_08 2013-06-17 0.007_07 2013-06-16 0.007_06 2013-06-16 0.007_05 2013-06-12 0.007_04 2013-06-09 0.007_03 2013-06-08 0.007_02 2013-06-04 0.007_01 2013-06-01 Happy birthday to me... 0.006 2013-05-28 0.005_08 2013-05-28 0.005_07 2013-05-28 0.005_06 2013-05-26 0.005_05 2013-05-24 0.005_04 2013-05-17 0.005_03 2013-05-14 0.005_02 2013-05-14 0.005_01 2013-05-07 0.004 2013-05-06 0.003_16 2013-05-05 0.003_15 2013-05-03 0.003_14 2013-05-03 0.003_13 2013-05-03 0.003_12 2013-05-01 0.003_11 2013-04-30 0.003_10 2013-04-29 0.003_09 2013-04-28 0.003_08 2013-04-26 0.003_07 2013-04-26 0.003_06 2013-04-25 0.003_05 2013-04-19 0.003_04 2013-04-18 0.003_03 2013-04-17 0.003_02 2013-04-16 0.003_01 2013-04-16 0.002 2013-04-26 0.001 2013-04-15 First public release 0.000_12 2013-04-12 0.000_11 2013-04-11 0.000_10 2013-04-09 0.000_09 2013-04-08 0.000_08 2013-04-07 0.000_07 2013-04-06 0.000_06 2013-04-05 0.000_05 2013-04-04 0.000_04 2013-04-03 0.000_03 2013-04-03 0.000_02 2013-04-02 0.000_01 2013-04-02 Developer preview INSTALL000664001750001750 165315111656240 13451 0ustar00taitai000000000000Type-Tiny-2.008006 Installing Type-Tiny should be straightforward. INSTALLATION WITH CPANMINUS If you have cpanm, you only need one line: % cpanm Type::Tiny If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S Type::Tiny INSTALLATION WITH THE CPAN SHELL Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Type::Tiny MANUAL INSTALLATION As a last resort, you can manually install it. Download the tarball and unpack it. Consult the file META.json for a list of pre-requisites. Install these first. To build Type-Tiny: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install LICENSE000664001750001750 4642715111656240 13455 0ustar00taitai000000000000Type-Tiny-2.008006This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2025 by Toby Inkster. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Perl Artistic License 1.0 --- This software is Copyright (c) 2025 by Toby Inkster. This is free software, licensed under: The Perl Artistic License 1.0 The "Artistic License" Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder as specified below. "Copyright Holder" is whoever is named in the copyright or copyrights for the package. "You" is you, if you're thinking about copying or distributing this Package. "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as uunet.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) give non-standard executables non-standard names, and clearly document the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. You may embed this Package's interpreter within an executable of yours (by linking); this shall be construed as a mere form of aggregation, provided that the complete Standard Version of the interpreter is so embedded. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whoever generated them, and may be sold commercially, and may be aggregated with this Package. If such scripts or library files are aggregated with this Package via the so-called "undump" or "unexec" methods of producing a binary executable image, then distribution of such an image shall neither be construed as a distribution of this Package nor shall it fall under the restrictions of Paragraphs 3 and 4, provided that you do not represent such an executable image as a Standard Version of this Package. 7. C subroutines (or comparably compiled subroutines in other languages) supplied by you and linked into this Package in order to emulate subroutines and variables of the language defined by this Package shall not be considered part of this Package, but are the equivalent of input as in Paragraph 6, provided these subroutines do not change the language in any way that would cause it to fail the regression tests for the language. 8. Aggregation of this Package with a commercial distribution is always permitted provided that the use of this Package is embedded; that is, when no overt attempt is made to make this Package's interfaces visible to the end user of the commercial distribution. Such use shall not be construed as a distribution of this Package. 9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End MANIFEST000664001750001750 3621615111656240 13574 0ustar00taitai000000000000Type-Tiny-2.008006CONTRIBUTING COPYRIGHT CREDITS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL NEWS README SIGNATURE dist.ini doap.ttl examples/benchmarking/benchmark-coercions.pl examples/benchmarking/benchmark-constraints.pl examples/benchmarking/benchmark-named-param-validation.pl examples/benchmarking/benchmark-param-validation.pl examples/benchmarking/versus-scalar-validation.pl examples/datetime-coercions.pl examples/jsoncapable.pl examples/nonempty.pl examples/page-numbers.pl inc/Test/Fatal.pm inc/Test/Requires.pm inc/Try/Tiny.pm inc/archaic/Test/Builder.pm inc/archaic/Test/Builder/IO/Scalar.pm inc/archaic/Test/Builder/Module.pm inc/archaic/Test/Builder/Tester.pm inc/archaic/Test/Builder/Tester/Color.pm inc/archaic/Test/More.pm inc/archaic/Test/Simple.pm inc/boolean.pm lib/Devel/TypeTiny/Perl58Compat.pm lib/Error/TypeTiny.pm lib/Error/TypeTiny/Assertion.pm lib/Error/TypeTiny/Compilation.pm lib/Error/TypeTiny/WrongNumberOfParameters.pm lib/Eval/TypeTiny.pm lib/Eval/TypeTiny/CodeAccumulator.pm lib/Reply/Plugin/TypeTiny.pm lib/Test/TypeTiny.pm lib/Type/Coercion.pm lib/Type/Coercion/FromMoose.pm lib/Type/Coercion/Union.pm lib/Type/Library.pm lib/Type/Params.pm lib/Type/Params/Alternatives.pm lib/Type/Params/Parameter.pm lib/Type/Params/Signature.pm lib/Type/Parser.pm lib/Type/Registry.pm lib/Type/Tie.pm lib/Type/Tiny.pm lib/Type/Tiny/Bitfield.pm lib/Type/Tiny/Class.pm lib/Type/Tiny/ConstrainedObject.pm lib/Type/Tiny/Duck.pm lib/Type/Tiny/Enum.pm lib/Type/Tiny/Intersection.pm lib/Type/Tiny/Manual.pod lib/Type/Tiny/Manual/AllTypes.pod lib/Type/Tiny/Manual/Coercions.pod lib/Type/Tiny/Manual/Contributing.pod lib/Type/Tiny/Manual/Installation.pod lib/Type/Tiny/Manual/Libraries.pod lib/Type/Tiny/Manual/NonOO.pod lib/Type/Tiny/Manual/Optimization.pod lib/Type/Tiny/Manual/Params.pod lib/Type/Tiny/Manual/Policies.pod lib/Type/Tiny/Manual/UsingWithClassTiny.pod lib/Type/Tiny/Manual/UsingWithMite.pod lib/Type/Tiny/Manual/UsingWithMoo.pod lib/Type/Tiny/Manual/UsingWithMoo2.pod lib/Type/Tiny/Manual/UsingWithMoo3.pod lib/Type/Tiny/Manual/UsingWithMoose.pod lib/Type/Tiny/Manual/UsingWithMouse.pod lib/Type/Tiny/Manual/UsingWithOther.pod lib/Type/Tiny/Manual/UsingWithTestMore.pod lib/Type/Tiny/Role.pm lib/Type/Tiny/Union.pm lib/Type/Tiny/_DeclaredType.pm lib/Type/Tiny/_HalfOp.pm lib/Type/Utils.pm lib/Types/Common.pm lib/Types/Common/Numeric.pm lib/Types/Common/String.pm lib/Types/Standard.pm lib/Types/Standard/ArrayRef.pm lib/Types/Standard/CycleTuple.pm lib/Types/Standard/Dict.pm lib/Types/Standard/HashRef.pm lib/Types/Standard/Map.pm lib/Types/Standard/ScalarRef.pm lib/Types/Standard/StrMatch.pm lib/Types/Standard/Tied.pm lib/Types/Standard/Tuple.pm lib/Types/TypeTiny.pm t/00-begin.t t/01-compile.t t/02-api.t t/03-leak.t t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t t/20-modules/Error-TypeTiny-Assertion/basic.t t/20-modules/Error-TypeTiny-Compilation/basic.t t/20-modules/Error-TypeTiny-WrongNumberOfParameters/basic.t t/20-modules/Error-TypeTiny/basic.t t/20-modules/Error-TypeTiny/stacktrace.t t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t t/20-modules/Eval-TypeTiny/aliases-devel-lexalias.t t/20-modules/Eval-TypeTiny/aliases-native.t t/20-modules/Eval-TypeTiny/aliases-padwalker.t t/20-modules/Eval-TypeTiny/aliases-tie.t t/20-modules/Eval-TypeTiny/basic.t t/20-modules/Eval-TypeTiny/lexical-subs.t t/20-modules/Test-TypeTiny/basic.t t/20-modules/Test-TypeTiny/extended.t t/20-modules/Test-TypeTiny/matchfor.t t/20-modules/Type-Coercion-FromMoose/basic.t t/20-modules/Type-Coercion-FromMoose/errors.t t/20-modules/Type-Coercion-Union/basic.t t/20-modules/Type-Coercion/basic.t t/20-modules/Type-Coercion/esoteric.t t/20-modules/Type-Coercion/frozen.t t/20-modules/Type-Coercion/inlining.t t/20-modules/Type-Coercion/parameterized.t t/20-modules/Type-Coercion/smartmatch.t t/20-modules/Type-Coercion/typetiny-constructor.t t/20-modules/Type-Library/assert.t t/20-modules/Type-Library/declared-types.t t/20-modules/Type-Library/deprecation.t t/20-modules/Type-Library/errors.t t/20-modules/Type-Library/exportables-duplicated.t t/20-modules/Type-Library/exportables.t t/20-modules/Type-Library/import-params.t t/20-modules/Type-Library/inheritance.t t/20-modules/Type-Library/is.t t/20-modules/Type-Library/own-registry.t t/20-modules/Type-Library/recursive-type-definitions.t t/20-modules/Type-Library/remove-type.t t/20-modules/Type-Library/to.t t/20-modules/Type-Library/types.t t/20-modules/Type-Params-Signature/basic.t t/20-modules/Type-Params/alias.t t/20-modules/Type-Params/badsigs.t t/20-modules/Type-Params/carping.t t/20-modules/Type-Params/clone.t t/20-modules/Type-Params/coerce.t t/20-modules/Type-Params/compile-named-avoidcallbacks.t t/20-modules/Type-Params/compile-named-bless.t t/20-modules/Type-Params/compile-named-oo-pp.t t/20-modules/Type-Params/compile-named-oo.t t/20-modules/Type-Params/compile-named.t t/20-modules/Type-Params/defaults.t t/20-modules/Type-Params/goto_next.t t/20-modules/Type-Params/hashorder.t t/20-modules/Type-Params/methods.t t/20-modules/Type-Params/mixednamed.t t/20-modules/Type-Params/multisig-custom-message.t t/20-modules/Type-Params/multisig-gotonext.t t/20-modules/Type-Params/multisig.t t/20-modules/Type-Params/named-to-list.t t/20-modules/Type-Params/named.t t/20-modules/Type-Params/noninline.t t/20-modules/Type-Params/on-die.t t/20-modules/Type-Params/optional.t t/20-modules/Type-Params/positional.t t/20-modules/Type-Params/slurpy.t t/20-modules/Type-Params/strictness.t t/20-modules/Type-Params/v2-allowdash.t t/20-modules/Type-Params/v2-default-on-undef.t t/20-modules/Type-Params/v2-defaults.t t/20-modules/Type-Params/v2-delayed-compilation.t t/20-modules/Type-Params/v2-exceptions.t t/20-modules/Type-Params/v2-fallback.t t/20-modules/Type-Params/v2-listtonamed.t t/20-modules/Type-Params/v2-multi.t t/20-modules/Type-Params/v2-named-backcompat.t t/20-modules/Type-Params/v2-named-plus-slurpy.t t/20-modules/Type-Params/v2-named.t t/20-modules/Type-Params/v2-positional-backcompat.t t/20-modules/Type-Params/v2-positional-plus-slurpy.t t/20-modules/Type-Params/v2-positional.t t/20-modules/Type-Params/v2-returns.t t/20-modules/Type-Params/v2-shortcuts.t t/20-modules/Type-Params/v2-warnings.t t/20-modules/Type-Params/v2-wrap-inherited-method.t t/20-modules/Type-Params/wrap.t t/20-modules/Type-Parser/basic.t t/20-modules/Type-Parser/moosextypes.t t/20-modules/Type-Registry/automagic.t t/20-modules/Type-Registry/basic.t t/20-modules/Type-Registry/methods.t t/20-modules/Type-Registry/moosextypes.t t/20-modules/Type-Registry/mousextypes.t t/20-modules/Type-Registry/parent.t t/20-modules/Type-Registry/refcount.t t/20-modules/Type-Tie/01basic.t t/20-modules/Type-Tie/02moosextypes.t t/20-modules/Type-Tie/03prototypicalweirdness.t t/20-modules/Type-Tie/04nots.t t/20-modules/Type-Tie/05typetiny.t t/20-modules/Type-Tie/06clone.t t/20-modules/Type-Tie/06storable.t t/20-modules/Type-Tie/basic.t t/20-modules/Type-Tie/very-minimal.t t/20-modules/Type-Tiny-Bitfield/basic.t t/20-modules/Type-Tiny-Bitfield/errors.t t/20-modules/Type-Tiny-Bitfield/import-options.t t/20-modules/Type-Tiny-Bitfield/plus.t t/20-modules/Type-Tiny-Class/basic.t t/20-modules/Type-Tiny-Class/errors.t t/20-modules/Type-Tiny-Class/exporter.t t/20-modules/Type-Tiny-Class/exporter_with_options.t t/20-modules/Type-Tiny-Class/plus-constructors.t t/20-modules/Type-Tiny-ConstrainedObject/basic.t t/20-modules/Type-Tiny-Duck/basic.t t/20-modules/Type-Tiny-Duck/cmp.t t/20-modules/Type-Tiny-Duck/errors.t t/20-modules/Type-Tiny-Duck/exporter.t t/20-modules/Type-Tiny-Enum/basic.t t/20-modules/Type-Tiny-Enum/cmp.t t/20-modules/Type-Tiny-Enum/errors.t t/20-modules/Type-Tiny-Enum/exporter.t t/20-modules/Type-Tiny-Enum/exporter_lexical.t t/20-modules/Type-Tiny-Enum/sorter.t t/20-modules/Type-Tiny-Enum/union_intersection.t t/20-modules/Type-Tiny-Enum/use_eq.t t/20-modules/Type-Tiny-Intersection/basic.t t/20-modules/Type-Tiny-Intersection/cmp.t t/20-modules/Type-Tiny-Intersection/constrainedobject.t t/20-modules/Type-Tiny-Intersection/errors.t t/20-modules/Type-Tiny-Role/basic.t t/20-modules/Type-Tiny-Role/errors.t t/20-modules/Type-Tiny-Role/exporter.t t/20-modules/Type-Tiny-Union/basic.t t/20-modules/Type-Tiny-Union/constrainedobject.t t/20-modules/Type-Tiny-Union/errors.t t/20-modules/Type-Tiny-Union/relationships.t t/20-modules/Type-Tiny-_HalfOp/double-union.t t/20-modules/Type-Tiny-_HalfOp/extra-params.t t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t t/20-modules/Type-Tiny/arithmetic.t t/20-modules/Type-Tiny/basic.t t/20-modules/Type-Tiny/cmp.t t/20-modules/Type-Tiny/coercion-modifiers.t t/20-modules/Type-Tiny/constraint-strings.t t/20-modules/Type-Tiny/custom-exception-classes.t t/20-modules/Type-Tiny/definition-context.t t/20-modules/Type-Tiny/deprecation.t t/20-modules/Type-Tiny/esoteric.t t/20-modules/Type-Tiny/inline-assert.t t/20-modules/Type-Tiny/list-methods.t t/20-modules/Type-Tiny/my-methods.t t/20-modules/Type-Tiny/parameterization.t t/20-modules/Type-Tiny/refcount.t t/20-modules/Type-Tiny/shortcuts.t t/20-modules/Type-Tiny/smartmatch.t t/20-modules/Type-Tiny/strictmode-off.t t/20-modules/Type-Tiny/strictmode-on.t t/20-modules/Type-Tiny/syntax.t t/20-modules/Type-Tiny/to-moose.t t/20-modules/Type-Tiny/to-mouse.t t/20-modules/Type-Tiny/type_default.t t/20-modules/Type-Utils/auto-registry.t t/20-modules/Type-Utils/classifier.t t/20-modules/Type-Utils/dwim-both.t t/20-modules/Type-Utils/dwim-moose.t t/20-modules/Type-Utils/dwim-mouse.t t/20-modules/Type-Utils/is.t t/20-modules/Type-Utils/match-on-type.t t/20-modules/Type-Utils/warnings.t t/20-modules/Types-Common-Numeric/basic.t t/20-modules/Types-Common-Numeric/immutable.t t/20-modules/Types-Common-Numeric/ranges.t t/20-modules/Types-Common-String/basic.t t/20-modules/Types-Common-String/coerce.t t/20-modules/Types-Common-String/immutable.t t/20-modules/Types-Common-String/strlength.t t/20-modules/Types-Common-String/unicode.t t/20-modules/Types-Common/basic.t t/20-modules/Types-Common/immutable.t t/20-modules/Types-Standard-ArrayRef/exporter.t t/20-modules/Types-Standard-CycleTuple/exporter.t t/20-modules/Types-Standard-Dict/exporter.t t/20-modules/Types-Standard-HashRef/exporter.t t/20-modules/Types-Standard-Map/exporter.t t/20-modules/Types-Standard-ScalarRef/exporter.t t/20-modules/Types-Standard-StrMatch/exporter.t t/20-modules/Types-Standard-Tuple/exporter.t t/20-modules/Types-Standard/arrayreflength.t t/20-modules/Types-Standard/basic.t t/20-modules/Types-Standard/cycletuple.t t/20-modules/Types-Standard/deep-coercions.t t/20-modules/Types-Standard/filehandle.t t/20-modules/Types-Standard/immutable.t t/20-modules/Types-Standard/lockdown.t t/20-modules/Types-Standard/mxtmlb-alike.t t/20-modules/Types-Standard/optlist.t t/20-modules/Types-Standard/overload.t t/20-modules/Types-Standard/strmatch-allow-callbacks.t t/20-modules/Types-Standard/strmatch-avoid-callbacks.t t/20-modules/Types-Standard/strmatch.t t/20-modules/Types-Standard/structured.t t/20-modules/Types-Standard/tied.t t/20-modules/Types-TypeTiny/basic.t t/20-modules/Types-TypeTiny/coercion.t t/20-modules/Types-TypeTiny/meta.t t/20-modules/Types-TypeTiny/moosemouse.t t/20-modules/Types-TypeTiny/progressiveexporter.t t/20-modules/Types-TypeTiny/type-puny.t t/21-types/Any.t t/21-types/ArrayLike.t t/21-types/ArrayRef.t t/21-types/Bool.t t/21-types/BoolLike.t t/21-types/ClassName.t t/21-types/CodeLike.t t/21-types/CodeRef.t t/21-types/ConsumerOf.t t/21-types/CycleTuple.t t/21-types/Defined.t t/21-types/DelimitedStr.t t/21-types/Dict.t t/21-types/Enum.t t/21-types/FileHandle.t t/21-types/GlobRef.t t/21-types/HasMethods.t t/21-types/HashLike.t t/21-types/HashRef.t t/21-types/InstanceOf.t t/21-types/Int.t t/21-types/IntRange.t t/21-types/Item.t t/21-types/LaxNum.t t/21-types/LowerCaseSimpleStr.t t/21-types/LowerCaseStr.t t/21-types/Map.t t/21-types/Maybe.t t/21-types/NegativeInt.t t/21-types/NegativeNum.t t/21-types/NegativeOrZeroInt.t t/21-types/NegativeOrZeroNum.t t/21-types/NonEmptySimpleStr.t t/21-types/NonEmptyStr.t t/21-types/Num.t t/21-types/NumRange.t t/21-types/NumericCode.t t/21-types/Object.t t/21-types/OptList.t t/21-types/Optional.t t/21-types/Overload.t t/21-types/Password.t t/21-types/PositiveInt.t t/21-types/PositiveNum.t t/21-types/PositiveOrZeroInt.t t/21-types/PositiveOrZeroNum.t t/21-types/Ref.t t/21-types/RegexpRef.t t/21-types/RoleName.t t/21-types/ScalarRef.t t/21-types/SimpleStr.t t/21-types/SingleDigit.t t/21-types/Slurpy.t t/21-types/Str.t t/21-types/StrLength.t t/21-types/StrMatch-more.t t/21-types/StrMatch.t t/21-types/StrictNum.t t/21-types/StringLike.t t/21-types/StrongPassword.t t/21-types/Tied.t t/21-types/Tuple.t t/21-types/TypeTiny.t t/21-types/Undef.t t/21-types/UpperCaseSimpleStr.t t/21-types/UpperCaseStr.t t/21-types/Value.t t/21-types/_ForeignTypeConstraint.t t/30-external/Class-InsideOut/basic.t t/30-external/Class-Plain/basic.t t/30-external/Class-Plain/multisig.t t/30-external/Data-Constraint/basic.t t/30-external/Exporter-Tiny/basic.t t/30-external/Exporter-Tiny/installer.t t/30-external/Exporter-Tiny/role-conflict.t t/30-external/Function-Parameters/basic.t t/30-external/JSON-PP/basic.t t/30-external/Kavorka/80returntype.t t/30-external/Kavorka/basic.t t/30-external/Moo/basic.t t/30-external/Moo/coercion-inlining-avoidance.t t/30-external/Moo/coercion.t t/30-external/Moo/exceptions.t t/30-external/Moo/inflation.t t/30-external/Moo/inflation2.t t/30-external/Moops/basic.t t/30-external/Moops/library-keyword.t t/30-external/Moose/accept-moose-types.t t/30-external/Moose/basic.t t/30-external/Moose/coercion-more.t t/30-external/Moose/coercion.t t/30-external/Moose/inflate-then-inline.t t/30-external/Moose/native-attribute-traits.t t/30-external/Moose/parameterized.t t/30-external/MooseX-Getopt/coercion.t t/30-external/MooseX-Types/basic.t t/30-external/MooseX-Types/extending.t t/30-external/MooseX-Types/more.t t/30-external/Mouse/basic.t t/30-external/Mouse/coercion.t t/30-external/Mouse/parameterized.t t/30-external/MouseX-Types/basic.t t/30-external/MouseX-Types/extending.t t/30-external/Object-Accessor/basic.t t/30-external/Return-Type/basic.t t/30-external/Specio/basic.t t/30-external/Specio/library.t t/30-external/Sub-Quote/basic.t t/30-external/Sub-Quote/delayed-quoting.t t/30-external/Sub-Quote/unquote-coercions.t t/30-external/Sub-Quote/unquote-constraints.t t/30-external/Switcheroo/basic.t t/30-external/Type-Library-Compiler/basic.t t/30-external/Types-ReadOnly/basic.t t/30-external/Validation-Class-Simple/archaic.t t/30-external/Validation-Class-Simple/basic.t t/30-external/match-simple/basic.t t/40-bugs/73f51e2d.pl t/40-bugs/73f51e2d.t t/40-bugs/gh1.t t/40-bugs/gh14.t t/40-bugs/gh140.t t/40-bugs/gh143.t t/40-bugs/gh158.t t/40-bugs/gh180.t t/40-bugs/gh80.t t/40-bugs/gh96.t t/40-bugs/hg166.t t/40-bugs/rt102748.t t/40-bugs/rt104154.t t/40-bugs/rt121763.t t/40-bugs/rt125132.t t/40-bugs/rt125765.t t/40-bugs/rt129729.t t/40-bugs/rt130823.t t/40-bugs/rt131401.t t/40-bugs/rt131576.t t/40-bugs/rt133141.t t/40-bugs/rt85911.t t/40-bugs/rt86004.t t/40-bugs/rt86233.t t/40-bugs/rt86239.t t/40-bugs/rt90096-2.t t/40-bugs/rt90096.t t/40-bugs/rt92571-2.t t/40-bugs/rt92571.t t/40-bugs/rt92591.t t/40-bugs/rt94196.t t/40-bugs/rt97684.t t/40-bugs/rt98113.t t/40-bugs/ttxs-gh1.t t/98-param-eg-from-docs.t t/99-moose-std-types-test.t t/README t/lib/BiggerLib.pm t/lib/CompiledLib.pm t/lib/DemoLib.pm t/lib/Type/Puny.pm t/mk-test-manifest.pl t/not-covered.pl META.json000664001750001750 2507715111656240 14067 0ustar00taitai000000000000Type-Tiny-2.008006{ "abstract" : "tiny, yet Moo(se)-compatible type constraint", "author" : [ "Toby Inkster (TOBYINK) " ], "dynamic_config" : 1, "generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" : [ "Argument Checking", "Argument Validation", "Moo", "Moose", "Mouse", "Parameter Checking", "Parameter Validation", "Schema", "Type Coercion", "Type Constraint", "Type Library", "Validation" ], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Type-Tiny", "no_index" : { "directory" : [ "eg", "examples", "inc", "t", "xt" ] }, "optional_features" : {}, "prereqs" : { "configure" : { "recommends" : { "CPAN::Meta::Requirements" : "2.000" }, "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "develop" : { "recommends" : { "Test::Memory::Cycle" : "0" }, "suggests" : { "Dist::Inkt::Profile::TOBYINK" : "0" } }, "runtime" : { "conflicts" : { "Kavorka" : "<= 0.013", "Types::ReadOnly" : "<= 0.001" }, "recommends" : { "Class::XSAccessor" : "1.17", "Devel::LexAlias" : "0.05", "Devel::StackTrace" : "0", "Ref::Util::XS" : "0.100", "Regexp::Util" : "0.003", "Sub::Util" : "0", "Type::Tiny::XS" : "0.025", "perl" : "5.010001" }, "requires" : { "Exporter::Tiny" : "1.006000", "perl" : "5.008001" }, "suggests" : { "Moo" : "1.006000", "Moose" : "2.0000", "Mouse" : "1.00", "Reply" : "0" } }, "test" : { "recommends" : { "Test::Deep" : "0", "Test::Tester" : "0.109", "Test::Warnings" : "0" }, "requires" : { "Test::More" : "0.96" }, "suggests" : { "Test::Memory::Cycle" : "0" } } }, "provides" : { "Devel::TypeTiny::Perl58Compat" : { "file" : "lib/Devel/TypeTiny/Perl58Compat.pm", "version" : "2.008006" }, "Error::TypeTiny" : { "file" : "lib/Error/TypeTiny.pm", "version" : "2.008006" }, "Error::TypeTiny::Assertion" : { "file" : "lib/Error/TypeTiny/Assertion.pm", "version" : "2.008006" }, "Error::TypeTiny::Compilation" : { "file" : "lib/Error/TypeTiny/Compilation.pm", "version" : "2.008006" }, "Error::TypeTiny::WrongNumberOfParameters" : { "file" : "lib/Error/TypeTiny/WrongNumberOfParameters.pm", "version" : "2.008006" }, "Eval::TypeTiny" : { "file" : "lib/Eval/TypeTiny.pm", "version" : "2.008006" }, "Eval::TypeTiny::CodeAccumulator" : { "file" : "lib/Eval/TypeTiny/CodeAccumulator.pm", "version" : "2.008006" }, "Reply::Plugin::TypeTiny" : { "file" : "lib/Reply/Plugin/TypeTiny.pm", "version" : "2.008006" }, "Test::TypeTiny" : { "file" : "lib/Test/TypeTiny.pm", "version" : "2.008006" }, "Type::Coercion" : { "file" : "lib/Type/Coercion.pm", "version" : "2.008006" }, "Type::Coercion::FromMoose" : { "file" : "lib/Type/Coercion/FromMoose.pm", "version" : "2.008006" }, "Type::Coercion::Union" : { "file" : "lib/Type/Coercion/Union.pm", "version" : "2.008006" }, "Type::Library" : { "file" : "lib/Type/Library.pm", "version" : "2.008006" }, "Type::Params" : { "file" : "lib/Type/Params.pm", "version" : "2.008006" }, "Type::Params::Alternatives" : { "file" : "lib/Type/Params/Alternatives.pm", "version" : "2.008006" }, "Type::Params::Parameter" : { "file" : "lib/Type/Params/Parameter.pm", "version" : "2.008006" }, "Type::Params::Signature" : { "file" : "lib/Type/Params/Signature.pm", "version" : "2.008006" }, "Type::Parser" : { "file" : "lib/Type/Parser.pm", "version" : "2.008006" }, "Type::Parser::AstBuilder" : { "file" : "lib/Type/Parser.pm", "version" : "2.008006" }, "Type::Parser::Token" : { "file" : "lib/Type/Parser.pm", "version" : "2.008006" }, "Type::Parser::TokenStream" : { "file" : "lib/Type/Parser.pm", "version" : "2.008006" }, "Type::Registry" : { "file" : "lib/Type/Registry.pm", "version" : "2.008006" }, "Type::Tie" : { "file" : "lib/Type/Tie.pm", "version" : "2.008006" }, "Type::Tie::ARRAY" : { "file" : "lib/Type/Tie.pm", "version" : "2.008006" }, "Type::Tie::BASE" : { "file" : "lib/Type/Tie.pm", "version" : "2.008006" }, "Type::Tie::HASH" : { "file" : "lib/Type/Tie.pm", "version" : "2.008006" }, "Type::Tie::SCALAR" : { "file" : "lib/Type/Tie.pm", "version" : "2.008006" }, "Type::Tiny" : { "file" : "lib/Type/Tiny.pm", "version" : "2.008006" }, "Type::Tiny::Bitfield" : { "file" : "lib/Type/Tiny/Bitfield.pm", "version" : "2.008006" }, "Type::Tiny::Class" : { "file" : "lib/Type/Tiny/Class.pm", "version" : "2.008006" }, "Type::Tiny::ConstrainedObject" : { "file" : "lib/Type/Tiny/ConstrainedObject.pm", "version" : "2.008006" }, "Type::Tiny::Duck" : { "file" : "lib/Type/Tiny/Duck.pm", "version" : "2.008006" }, "Type::Tiny::Enum" : { "file" : "lib/Type/Tiny/Enum.pm", "version" : "2.008006" }, "Type::Tiny::Intersection" : { "file" : "lib/Type/Tiny/Intersection.pm", "version" : "2.008006" }, "Type::Tiny::Role" : { "file" : "lib/Type/Tiny/Role.pm", "version" : "2.008006" }, "Type::Tiny::Union" : { "file" : "lib/Type/Tiny/Union.pm", "version" : "2.008006" }, "Type::Utils" : { "file" : "lib/Type/Utils.pm", "version" : "2.008006" }, "Types::Common" : { "file" : "lib/Types/Common.pm", "version" : "2.008006" }, "Types::Common::Numeric" : { "file" : "lib/Types/Common/Numeric.pm", "version" : "2.008006" }, "Types::Common::String" : { "file" : "lib/Types/Common/String.pm", "version" : "2.008006" }, "Types::Standard" : { "file" : "lib/Types/Standard.pm", "version" : "2.008006" }, "Types::Standard::ArrayRef" : { "file" : "lib/Types/Standard/ArrayRef.pm", "version" : "2.008006" }, "Types::Standard::CycleTuple" : { "file" : "lib/Types/Standard/CycleTuple.pm", "version" : "2.008006" }, "Types::Standard::Dict" : { "file" : "lib/Types/Standard/Dict.pm", "version" : "2.008006" }, "Types::Standard::HashRef" : { "file" : "lib/Types/Standard/HashRef.pm", "version" : "2.008006" }, "Types::Standard::Map" : { "file" : "lib/Types/Standard/Map.pm", "version" : "2.008006" }, "Types::Standard::ScalarRef" : { "file" : "lib/Types/Standard/ScalarRef.pm", "version" : "2.008006" }, "Types::Standard::StrMatch" : { "file" : "lib/Types/Standard/StrMatch.pm", "version" : "2.008006" }, "Types::Standard::Tied" : { "file" : "lib/Types/Standard/Tied.pm", "version" : "2.008006" }, "Types::Standard::Tuple" : { "file" : "lib/Types/Standard/Tuple.pm", "version" : "2.008006" }, "Types::TypeTiny" : { "file" : "lib/Types/TypeTiny.pm", "version" : "2.008006" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/tobyink/p5-type-tiny/issues" }, "homepage" : "https://typetiny.toby.ink/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/tobyink/p5-type-tiny.git", "web" : "https://github.com/tobyink/p5-type-tiny" }, "x_identifier" : "http://purl.org/NET/cpan-uri/dist/Type-Tiny/project" }, "version" : "2.008006", "x_breaks" : { "Kavorka" : "<= 0.013", "Types::ReadOnly" : "<= 0.001" }, "x_contributors" : [ "Vyacheslav Matyukhin (MMCLERIC) ", "Diab Jerius (DJERIUS) ", "Graham Knop (HAARG) ", "Peter Flanigan (PJFL) ", "Pierre Masci", "Mark Stosberg (MARKSTOS) ", "Dagfinn Ilmari Mannsåker (ILMARI) ", "Benct Philip Jonsson ", "David Steinbrunner ", "Samuel Kaufman (SKAUFMAN) ", "Peter Karman (KARMAN) ", "Alexander Hartmaier (ABRAXXA) ", "Gianni Ceccarelli (DAKKAR) ", "Thomas Sibley (TSIBLEY) ", "Karen Etheridge (ETHER) ", "Philippe Bruhat (BOOK) ", "Robert Rothenberg (RRWO) ", "Peter Valdemar Mørch ", "Zoffix Znet ", "Denis Ibaev ", "Alexandr Ciornii ", "Jonas B Nielsen (JONASBN) ", "Nelo Onyiah", "Lucas Buchala (LSBUCHALA) ", "Hauke D (HAUKEX) ", "Meredith Howard (MHOWARD) ", "Andrew Ruder (AERUDER) ", "Sandor Patocs (SPATOCS) ", "Windymelt", "Lucas Tiago de Moraes (LUCAS) ", "Florian Schlichting", "James E Keenan (JKEENAN) ", "Yoshikazu Sawa", "ZAKI MUGHAL" ], "x_serialization_backend" : "JSON::PP version 4.16" } META.yml000664001750001750 1610015111656240 13702 0ustar00taitai000000000000Type-Tiny-2.008006--- abstract: 'tiny, yet Moo(se)-compatible type constraint' author: - 'Toby Inkster (TOBYINK) ' build_requires: Test::More: '0.96' configure_requires: ExtUtils::MakeMaker: '6.17' conflicts: Kavorka: '<= 0.013' Types::ReadOnly: '<= 0.001' dynamic_config: 1 generated_by: 'Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010' keywords: - 'Argument Checking' - 'Argument Validation' - Moo - Moose - Mouse - 'Parameter Checking' - 'Parameter Validation' - Schema - 'Type Coercion' - 'Type Constraint' - 'Type Library' - Validation license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Type-Tiny no_index: directory: - eg - examples - inc - t - xt optional_features: {} provides: Devel::TypeTiny::Perl58Compat: file: lib/Devel/TypeTiny/Perl58Compat.pm version: '2.008006' Error::TypeTiny: file: lib/Error/TypeTiny.pm version: '2.008006' Error::TypeTiny::Assertion: file: lib/Error/TypeTiny/Assertion.pm version: '2.008006' Error::TypeTiny::Compilation: file: lib/Error/TypeTiny/Compilation.pm version: '2.008006' Error::TypeTiny::WrongNumberOfParameters: file: lib/Error/TypeTiny/WrongNumberOfParameters.pm version: '2.008006' Eval::TypeTiny: file: lib/Eval/TypeTiny.pm version: '2.008006' Eval::TypeTiny::CodeAccumulator: file: lib/Eval/TypeTiny/CodeAccumulator.pm version: '2.008006' Reply::Plugin::TypeTiny: file: lib/Reply/Plugin/TypeTiny.pm version: '2.008006' Test::TypeTiny: file: lib/Test/TypeTiny.pm version: '2.008006' Type::Coercion: file: lib/Type/Coercion.pm version: '2.008006' Type::Coercion::FromMoose: file: lib/Type/Coercion/FromMoose.pm version: '2.008006' Type::Coercion::Union: file: lib/Type/Coercion/Union.pm version: '2.008006' Type::Library: file: lib/Type/Library.pm version: '2.008006' Type::Params: file: lib/Type/Params.pm version: '2.008006' Type::Params::Alternatives: file: lib/Type/Params/Alternatives.pm version: '2.008006' Type::Params::Parameter: file: lib/Type/Params/Parameter.pm version: '2.008006' Type::Params::Signature: file: lib/Type/Params/Signature.pm version: '2.008006' Type::Parser: file: lib/Type/Parser.pm version: '2.008006' Type::Parser::AstBuilder: file: lib/Type/Parser.pm version: '2.008006' Type::Parser::Token: file: lib/Type/Parser.pm version: '2.008006' Type::Parser::TokenStream: file: lib/Type/Parser.pm version: '2.008006' Type::Registry: file: lib/Type/Registry.pm version: '2.008006' Type::Tie: file: lib/Type/Tie.pm version: '2.008006' Type::Tie::ARRAY: file: lib/Type/Tie.pm version: '2.008006' Type::Tie::BASE: file: lib/Type/Tie.pm version: '2.008006' Type::Tie::HASH: file: lib/Type/Tie.pm version: '2.008006' Type::Tie::SCALAR: file: lib/Type/Tie.pm version: '2.008006' Type::Tiny: file: lib/Type/Tiny.pm version: '2.008006' Type::Tiny::Bitfield: file: lib/Type/Tiny/Bitfield.pm version: '2.008006' Type::Tiny::Class: file: lib/Type/Tiny/Class.pm version: '2.008006' Type::Tiny::ConstrainedObject: file: lib/Type/Tiny/ConstrainedObject.pm version: '2.008006' Type::Tiny::Duck: file: lib/Type/Tiny/Duck.pm version: '2.008006' Type::Tiny::Enum: file: lib/Type/Tiny/Enum.pm version: '2.008006' Type::Tiny::Intersection: file: lib/Type/Tiny/Intersection.pm version: '2.008006' Type::Tiny::Role: file: lib/Type/Tiny/Role.pm version: '2.008006' Type::Tiny::Union: file: lib/Type/Tiny/Union.pm version: '2.008006' Type::Utils: file: lib/Type/Utils.pm version: '2.008006' Types::Common: file: lib/Types/Common.pm version: '2.008006' Types::Common::Numeric: file: lib/Types/Common/Numeric.pm version: '2.008006' Types::Common::String: file: lib/Types/Common/String.pm version: '2.008006' Types::Standard: file: lib/Types/Standard.pm version: '2.008006' Types::Standard::ArrayRef: file: lib/Types/Standard/ArrayRef.pm version: '2.008006' Types::Standard::CycleTuple: file: lib/Types/Standard/CycleTuple.pm version: '2.008006' Types::Standard::Dict: file: lib/Types/Standard/Dict.pm version: '2.008006' Types::Standard::HashRef: file: lib/Types/Standard/HashRef.pm version: '2.008006' Types::Standard::Map: file: lib/Types/Standard/Map.pm version: '2.008006' Types::Standard::ScalarRef: file: lib/Types/Standard/ScalarRef.pm version: '2.008006' Types::Standard::StrMatch: file: lib/Types/Standard/StrMatch.pm version: '2.008006' Types::Standard::Tied: file: lib/Types/Standard/Tied.pm version: '2.008006' Types::Standard::Tuple: file: lib/Types/Standard/Tuple.pm version: '2.008006' Types::TypeTiny: file: lib/Types/TypeTiny.pm version: '2.008006' recommends: Class::XSAccessor: '1.17' Devel::LexAlias: '0.05' Devel::StackTrace: '0' Ref::Util::XS: '0.100' Regexp::Util: '0.003' Sub::Util: '0' Type::Tiny::XS: '0.025' perl: '5.010001' requires: Exporter::Tiny: '1.006000' perl: '5.008001' resources: Identifier: http://purl.org/NET/cpan-uri/dist/Type-Tiny/project bugtracker: https://github.com/tobyink/p5-type-tiny/issues homepage: https://typetiny.toby.ink/ license: http://dev.perl.org/licenses/ repository: git://github.com/tobyink/p5-type-tiny.git version: '2.008006' x_breaks: Kavorka: '<= 0.013' Types::ReadOnly: '<= 0.001' x_contributors: - 'Vyacheslav Matyukhin (MMCLERIC) ' - 'Diab Jerius (DJERIUS) ' - 'Graham Knop (HAARG) ' - 'Peter Flanigan (PJFL) ' - 'Pierre Masci' - 'Mark Stosberg (MARKSTOS) ' - 'Dagfinn Ilmari Mannsåker (ILMARI) ' - 'Benct Philip Jonsson ' - 'David Steinbrunner ' - 'Samuel Kaufman (SKAUFMAN) ' - 'Peter Karman (KARMAN) ' - 'Alexander Hartmaier (ABRAXXA) ' - 'Gianni Ceccarelli (DAKKAR) ' - 'Thomas Sibley (TSIBLEY) ' - 'Karen Etheridge (ETHER) ' - 'Philippe Bruhat (BOOK) ' - 'Robert Rothenberg (RRWO) ' - 'Peter Valdemar Mørch ' - 'Zoffix Znet ' - 'Denis Ibaev ' - 'Alexandr Ciornii ' - 'Jonas B Nielsen (JONASBN) ' - 'Nelo Onyiah' - 'Lucas Buchala (LSBUCHALA) ' - 'Hauke D (HAUKEX) ' - 'Meredith Howard (MHOWARD) ' - 'Andrew Ruder (AERUDER) ' - 'Sandor Patocs (SPATOCS) ' - Windymelt - 'Lucas Tiago de Moraes (LUCAS) ' - 'Florian Schlichting' - 'James E Keenan (JKEENAN) ' - 'Yoshikazu Sawa' - 'ZAKI MUGHAL' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Makefile.PL000664001750001750 5035715111656240 14417 0ustar00taitai000000000000Type-Tiny-2.008006use strict; use ExtUtils::MakeMaker 6.17; my $EUMM = eval( $ExtUtils::MakeMaker::VERSION ); my $meta = { "abstract" => "tiny, yet Moo(se)-compatible type constraint", "author" => ["Toby Inkster (TOBYINK) "], "dynamic_config" => 1, "generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.024, CPAN::Meta::Converter version 2.150010", "keywords" => [ "Argument Checking", "Argument Validation", "Moo", "Moose", "Mouse", "Parameter Checking", "Parameter Validation", "Schema", "Type Coercion", "Type Constraint", "Type Library", "Validation", ], "license" => ["perl_5"], "meta-spec" => { url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec", version => 2, }, "name" => "Type-Tiny", "no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] }, "prereqs" => { configure => { recommends => { "CPAN::Meta::Requirements" => "2.000" }, requires => { "ExtUtils::MakeMaker" => 6.17 }, }, develop => { recommends => { "Test::Memory::Cycle" => 0 }, suggests => { "Dist::Inkt::Profile::TOBYINK" => 0 }, }, runtime => { conflicts => { "Kavorka" => "<= 0.013", "Types::ReadOnly" => "<= 0.001" }, recommends => { "Class::XSAccessor" => 1.17, "Devel::LexAlias" => 0.05, "Devel::StackTrace" => 0, "perl" => 5.010001, "Ref::Util::XS" => "0.100", "Regexp::Util" => 0.003, "Sub::Util" => 0, "Type::Tiny::XS" => 0.025, }, requires => { "Exporter::Tiny" => "1.006000", "perl" => 5.008001 }, suggests => { Moo => "1.006000", Moose => "2.0000", Mouse => "1.00", Reply => 0 }, }, test => { recommends => { "Test::Deep" => 0, "Test::Tester" => 0.109, "Test::Warnings" => 0 }, requires => { "Test::More" => 0.96 }, suggests => { "Test::Memory::Cycle" => 0 }, }, }, "provides" => { "Devel::TypeTiny::Perl58Compat" => { file => "lib/Devel/TypeTiny/Perl58Compat.pm", version => 2.008006 }, "Error::TypeTiny" => { file => "lib/Error/TypeTiny.pm", version => 2.008006 }, "Error::TypeTiny::Assertion" => { file => "lib/Error/TypeTiny/Assertion.pm", version => 2.008006 }, "Error::TypeTiny::Compilation" => { file => "lib/Error/TypeTiny/Compilation.pm", version => 2.008006 }, "Error::TypeTiny::WrongNumberOfParameters" => { file => "lib/Error/TypeTiny/WrongNumberOfParameters.pm", version => 2.008006, }, "Eval::TypeTiny" => { file => "lib/Eval/TypeTiny.pm", version => 2.008006 }, "Eval::TypeTiny::CodeAccumulator" => { file => "lib/Eval/TypeTiny/CodeAccumulator.pm", version => 2.008006 }, "Reply::Plugin::TypeTiny" => { file => "lib/Reply/Plugin/TypeTiny.pm", version => 2.008006 }, "Test::TypeTiny" => { file => "lib/Test/TypeTiny.pm", version => 2.008006 }, "Type::Coercion" => { file => "lib/Type/Coercion.pm", version => 2.008006 }, "Type::Coercion::FromMoose" => { file => "lib/Type/Coercion/FromMoose.pm", version => 2.008006 }, "Type::Coercion::Union" => { file => "lib/Type/Coercion/Union.pm", version => 2.008006 }, "Type::Library" => { file => "lib/Type/Library.pm", version => 2.008006 }, "Type::Params" => { file => "lib/Type/Params.pm", version => 2.008006 }, "Type::Params::Alternatives" => { file => "lib/Type/Params/Alternatives.pm", version => 2.008006 }, "Type::Params::Parameter" => { file => "lib/Type/Params/Parameter.pm", version => 2.008006 }, "Type::Params::Signature" => { file => "lib/Type/Params/Signature.pm", version => 2.008006 }, "Type::Parser" => { file => "lib/Type/Parser.pm", version => 2.008006 }, "Type::Parser::AstBuilder" => { file => "lib/Type/Parser.pm", version => 2.008006 }, "Type::Parser::Token" => { file => "lib/Type/Parser.pm", version => 2.008006 }, "Type::Parser::TokenStream" => { file => "lib/Type/Parser.pm", version => 2.008006 }, "Type::Registry" => { file => "lib/Type/Registry.pm", version => 2.008006 }, "Type::Tie" => { file => "lib/Type/Tie.pm", version => 2.008006 }, "Type::Tie::ARRAY" => { file => "lib/Type/Tie.pm", version => 2.008006 }, "Type::Tie::BASE" => { file => "lib/Type/Tie.pm", version => 2.008006 }, "Type::Tie::HASH" => { file => "lib/Type/Tie.pm", version => 2.008006 }, "Type::Tie::SCALAR" => { file => "lib/Type/Tie.pm", version => 2.008006 }, "Type::Tiny" => { file => "lib/Type/Tiny.pm", version => 2.008006 }, "Type::Tiny::Bitfield" => { file => "lib/Type/Tiny/Bitfield.pm", version => 2.008006 }, "Type::Tiny::Class" => { file => "lib/Type/Tiny/Class.pm", version => 2.008006 }, "Type::Tiny::ConstrainedObject" => { file => "lib/Type/Tiny/ConstrainedObject.pm", version => 2.008006 }, "Type::Tiny::Duck" => { file => "lib/Type/Tiny/Duck.pm", version => 2.008006 }, "Type::Tiny::Enum" => { file => "lib/Type/Tiny/Enum.pm", version => 2.008006 }, "Type::Tiny::Intersection" => { file => "lib/Type/Tiny/Intersection.pm", version => 2.008006 }, "Type::Tiny::Role" => { file => "lib/Type/Tiny/Role.pm", version => 2.008006 }, "Type::Tiny::Union" => { file => "lib/Type/Tiny/Union.pm", version => 2.008006 }, "Type::Utils" => { file => "lib/Type/Utils.pm", version => 2.008006 }, "Types::Common" => { file => "lib/Types/Common.pm", version => 2.008006 }, "Types::Common::Numeric" => { file => "lib/Types/Common/Numeric.pm", version => 2.008006 }, "Types::Common::String" => { file => "lib/Types/Common/String.pm", version => 2.008006 }, "Types::Standard" => { file => "lib/Types/Standard.pm", version => 2.008006 }, "Types::Standard::ArrayRef" => { file => "lib/Types/Standard/ArrayRef.pm", version => 2.008006 }, "Types::Standard::CycleTuple" => { file => "lib/Types/Standard/CycleTuple.pm", version => 2.008006 }, "Types::Standard::Dict" => { file => "lib/Types/Standard/Dict.pm", version => 2.008006 }, "Types::Standard::HashRef" => { file => "lib/Types/Standard/HashRef.pm", version => 2.008006 }, "Types::Standard::Map" => { file => "lib/Types/Standard/Map.pm", version => 2.008006 }, "Types::Standard::ScalarRef" => { file => "lib/Types/Standard/ScalarRef.pm", version => 2.008006 }, "Types::Standard::StrMatch" => { file => "lib/Types/Standard/StrMatch.pm", version => 2.008006 }, "Types::Standard::Tied" => { file => "lib/Types/Standard/Tied.pm", version => 2.008006 }, "Types::Standard::Tuple" => { file => "lib/Types/Standard/Tuple.pm", version => 2.008006 }, "Types::TypeTiny" => { file => "lib/Types/TypeTiny.pm", version => 2.008006 }, }, "release_status" => "stable", "resources" => { bugtracker => { web => "https://github.com/tobyink/p5-type-tiny/issues" }, homepage => "https://typetiny.toby.ink/", license => ["http://dev.perl.org/licenses/"], repository => { type => "git", url => "git://github.com/tobyink/p5-type-tiny.git", web => "https://github.com/tobyink/p5-type-tiny", }, x_identifier => "http://purl.org/NET/cpan-uri/dist/Type-Tiny/project", }, "version" => 2.008006, "x_breaks" => { "Kavorka" => "<= 0.013", "Types::ReadOnly" => "<= 0.001" }, "x_contributors" => [ "Vyacheslav Matyukhin (MMCLERIC) ", "Diab Jerius (DJERIUS) ", "Graham Knop (HAARG) ", "Peter Flanigan (PJFL) ", "Pierre Masci", "Mark Stosberg (MARKSTOS) ", "Dagfinn Ilmari Manns\xE5ker (ILMARI) ", "Benct Philip Jonsson ", "David Steinbrunner ", "Samuel Kaufman (SKAUFMAN) ", "Peter Karman (KARMAN) ", "Alexander Hartmaier (ABRAXXA) ", "Gianni Ceccarelli (DAKKAR) ", "Thomas Sibley (TSIBLEY) ", "Karen Etheridge (ETHER) ", "Philippe Bruhat (BOOK) ", "Robert Rothenberg (RRWO) ", "Peter Valdemar M\xF8rch ", "Zoffix Znet ", "Denis Ibaev ", "Alexandr Ciornii ", "Jonas B Nielsen (JONASBN) ", "Nelo Onyiah", "Lucas Buchala (LSBUCHALA) ", "Hauke D (HAUKEX) ", "Meredith Howard (MHOWARD) ", "Andrew Ruder (AERUDER) ", "Sandor Patocs (SPATOCS) ", "Windymelt", "Lucas Tiago de Moraes (LUCAS) ", "Florian Schlichting", "James E Keenan (JKEENAN) ", "Yoshikazu Sawa", "ZAKI MUGHAL", ], }; my %dynamic_config; do { use strict; use warnings; no warnings 'uninitialized'; # Old versions of Perl come with old versions of Exporter. # Not that we use Exporter a whole lot anyway. if ( $] lt 5.009001 ) { $meta->{prereqs}{runtime}{requires}{'Exporter'} = '5.57'; } my $extended_testing = 0; if ( $ENV{EXTENDED_TESTING} and $] ge '5.008009' ) { ++$extended_testing if $meta->{version} =~ /_/; ++$extended_testing if $ENV{TRAVIS}; } if ( $ENV{MINIMAL_INSTALL} ) { $extended_testing = 0; for my $stage ( qw( runtime test ) ) { delete $meta->{prereqs}{$stage}{recommends}; delete $meta->{prereqs}{$stage}{suggests}; } } if ( $extended_testing ) { $meta->{prereqs}{test}{requires}{'Moose'} = '2.0600'; $meta->{prereqs}{test}{requires}{$_} = '0' for qw( bareword::filehandles Class::InsideOut Class::XSAccessor Devel::LexAlias Devel::Refcount indirect match::simple Moo MooseX::Getopt MooseX::Types::Common Mouse MouseX::Types::Common multidimensional Object::Accessor PadWalker Return::Type strictures Test::Fatal Test::LeakTrace Test::Requires Test::Tester Test::Warnings ); if ( $] ge '5.028' ) { $meta->{prereqs}{test}{requires}{$_} = '0' for qw( Validation::Class::Simple ); } } if ( $ENV{AUTOMATED_TESTING} and "$^V" =~ /c$/ ) { print "cperl unsupported by test suite (the vast majority of the distribution should still work)\n"; exit(0); } }; for my $stage (keys %{$meta->{prereqs}}) { my $conflicts = $meta->{prereqs}{$stage}{conflicts} or next; eval { require CPAN::Meta::Requirements } or last; $conflicts = 'CPAN::Meta::Requirements'->from_string_hash($conflicts); for my $module ($conflicts->required_modules) { eval "require $module" or next; my $installed = eval(sprintf('$%s::VERSION', $module)); $conflicts->accepts_module($module, $installed) or next; my $message = "\n". "** This version of $meta->{name} conflicts with the version of\n". "** module $module ($installed) you have installed.\n"; die($message . "\n" . "Bailing out") if $stage eq 'build' || $stage eq 'configure'; $message .= "**\n". "** It's strongly recommended that you update it after\n". "** installing this version of $meta->{name}.\n"; warn("$message\n"); } } my %WriteMakefileArgs = ( ABSTRACT => $meta->{abstract}, AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]), DISTNAME => $meta->{name}, VERSION => $meta->{version}, EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ], NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n }, test => { TESTS => "t/*.t t/20-modules/Devel-TypeTiny-Perl58Compat/*.t t/20-modules/Error-TypeTiny-Assertion/*.t t/20-modules/Error-TypeTiny-Compilation/*.t t/20-modules/Error-TypeTiny-WrongNumberOfParameters/*.t t/20-modules/Error-TypeTiny/*.t t/20-modules/Eval-TypeTiny-CodeAccumulator/*.t t/20-modules/Eval-TypeTiny/*.t t/20-modules/Test-TypeTiny/*.t t/20-modules/Type-Coercion-FromMoose/*.t t/20-modules/Type-Coercion-Union/*.t t/20-modules/Type-Coercion/*.t t/20-modules/Type-Library/*.t t/20-modules/Type-Params-Signature/*.t t/20-modules/Type-Params/*.t t/20-modules/Type-Parser/*.t t/20-modules/Type-Registry/*.t t/20-modules/Type-Tie/*.t t/20-modules/Type-Tiny-Bitfield/*.t t/20-modules/Type-Tiny-Class/*.t t/20-modules/Type-Tiny-ConstrainedObject/*.t t/20-modules/Type-Tiny-Duck/*.t t/20-modules/Type-Tiny-Enum/*.t t/20-modules/Type-Tiny-Intersection/*.t t/20-modules/Type-Tiny-Role/*.t t/20-modules/Type-Tiny-Union/*.t t/20-modules/Type-Tiny-_HalfOp/*.t t/20-modules/Type-Tiny/*.t t/20-modules/Type-Utils/*.t t/20-modules/Types-Common-Numeric/*.t t/20-modules/Types-Common-String/*.t t/20-modules/Types-Common/*.t t/20-modules/Types-Standard-ArrayRef/*.t t/20-modules/Types-Standard-CycleTuple/*.t t/20-modules/Types-Standard-Dict/*.t t/20-modules/Types-Standard-HashRef/*.t t/20-modules/Types-Standard-Map/*.t t/20-modules/Types-Standard-ScalarRef/*.t t/20-modules/Types-Standard-StrMatch/*.t t/20-modules/Types-Standard-Tuple/*.t t/20-modules/Types-Standard/*.t t/20-modules/Types-TypeTiny/*.t t/21-types/*.t t/30-external/Class-InsideOut/*.t t/30-external/Class-Plain/*.t t/30-external/Data-Constraint/*.t t/30-external/Exporter-Tiny/*.t t/30-external/Function-Parameters/*.t t/30-external/JSON-PP/*.t t/30-external/Kavorka/*.t t/30-external/Moo/*.t t/30-external/Moops/*.t t/30-external/Moose/*.t t/30-external/MooseX-Getopt/*.t t/30-external/MooseX-Types/*.t t/30-external/Mouse/*.t t/30-external/MouseX-Types/*.t t/30-external/Object-Accessor/*.t t/30-external/Return-Type/*.t t/30-external/Specio/*.t t/30-external/Sub-Quote/*.t t/30-external/Switcheroo/*.t t/30-external/Type-Library-Compiler/*.t t/30-external/Types-ReadOnly/*.t t/30-external/Validation-Class-Simple/*.t t/30-external/match-simple/*.t t/40-bugs/*.t" }, %dynamic_config, ); $WriteMakefileArgs{LICENSE} = $meta->{license}[0] if $EUMM >= 6.3001; sub deps { my %r; for my $stage (@_) { for my $dep (keys %{$meta->{prereqs}{$stage}{requires}}) { next if $dep eq 'perl'; my $ver = $meta->{prereqs}{$stage}{requires}{$dep}; $r{$dep} = $ver if !exists($r{$dep}) || $ver >= $r{$dep}; } } \%r; } my ($build_requires, $configure_requires, $runtime_requires, $test_requires); if ($EUMM >= 6.6303) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{TEST_REQUIRES} ||= deps('test'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.5503) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build', 'test'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.52) { $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime', 'build', 'test'); } else { $WriteMakefileArgs{PREREQ_PM} ||= deps('configure', 'build', 'test', 'runtime'); } { my ($minperl) = reverse sort( grep defined && /^[0-9]+(\.[0-9]+)?$/, map $meta->{prereqs}{$_}{requires}{perl}, qw( configure build runtime ) ); if (defined($minperl)) { die "Installing $meta->{name} requires Perl >= $minperl" unless $] >= $minperl; $WriteMakefileArgs{MIN_PERL_VERSION} ||= $minperl if $EUMM >= 6.48; } } my $mm = WriteMakefile(%WriteMakefileArgs); sub FixMakefile { return unless -d 'inc'; my $file = shift; local *MAKEFILE; open MAKEFILE, "< $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; open MAKEFILE, "> $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; print MAKEFILE $makefile or die $!; close MAKEFILE or die $!; } FixMakefile($mm->{FIRST_MAKEFILE} || 'Makefile'); exit(0); NEWS000664001750001750 424115111656240 13113 0ustar00taitai000000000000Type-Tiny-2.008006======================================================================= This file contains a high-level summary of changes between recent stable releases of Type-Tiny. For a more detailed list, including changes in development releases, see the "Changes" file instead. ======================================================================= 2025-03-31 Type-Tiny version 2.008000 released! - Better sanity checking. - `Type::Params` now supports `returns` for return types. - `Type::Params` has some quality of life improvements. - `Types::Standard::HashRef` and friends can export shortcuts. - Update examples in pod to use more features of modern Perl. 2024-09-29 Type-Tiny version 2.006000 released! - Improvements to `tie( VAR, TYPE)`. - Fixed compatibility with Perl 5.41.x. 2023-04-05 Type-Tiny version 2.004000 released! - `Type::Tiny` objects have a `exception_class` attribute. - Added `Type::Tiny::Bitfield`. - `Types::TypeTiny` now provides a `BoolLike` type. 2023-01-01 Type-Tiny version 2.002000 released! - `Type::Tiny` objects have a `definition_context` method. - XS implementations for parameterized ArrayLike/HashLike types. - Improvements to Type::Params's handling of named parameters. 2022-09-23 Type-Tiny version 2.000000 released! - Improved API for `Type::Params`. - New `Types::Common` module. - `Type::Tie` which was a separate distribution, is now included. - Dropped support for versions of Perl older than Perl 5.8.1. - Uses `Exporter::Tiny 1.004` for lexical imports on Perl blead. - `Type::Tiny` now has a `type_default` method. - `Type::Tiny` now overloads the division (slash) operator. - `%Error::TypeTiny::CarpInternal` is now an alias for `%Carp::CarpInternal`. - Type::Tiny::{Class,Duck,Enum,Role} are now exporters. - Enum types now export constants for each value. - `Types::Common::String` now provides a `DelimitedStr` type. Test Suite Statistics: - Type-Tiny-0.001: > Files=31, Tests=657, 2 wallclock secs - Type-Tiny-1.000000: > Files=150, Tests=8316, 14 wallclock secs - Type-Tiny-1.016000: > Files=285, Tests=14294, 26 wallclock secs - Type-Tiny-2.000000: > Files=335, Tests=14890, 35 wallclock secs README000664001750001750 1602115111656240 13313 0ustar00taitai000000000000Type-Tiny-2.008006NAME Type::Tiny::Manual - an overview of Type::Tiny SYNOPSIS Type::Tiny is a small Perl class for writing type constraints, inspired by Moose's type constraint API and MooseX::Types. It has only one non-core dependency (and even that is simply a module that was previously distributed as part of Type::Tiny but has since been spun off), and can be used with Moose, Mouse, or Moo (or none of the above). Type::Tiny is used by over 1000 Perl distributions on the CPAN (Comprehensive Perl Archive Network) and can be considered a stable and mature framework for efficiently and reliably enforcing data types. Type::Tiny is bundled with Type::Library a framework for organizing type constraints into collections. Also bundled is Types::Standard, a Moose-inspired library of useful type constraints. Type::Params is also provided, to allow very fast checking and coercion of function and method parameters. The following example gives you an idea of some of the features of these modules. If you don't understand it all, that's fine; that's what the rest of the manual is for. Although the example uses Moo, the `use Moo` could be changed to `use Moose` or `use Mouse` and it would still work. use v5.36; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef InstanceOf ); use Type::Params qw( signature_for ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, required => 1, ); has gender => ( is => 'ro', isa => Enum[qw( f m )], ); has age => ( is => 'rw', isa => Int->where( '$_ >= 0' ), ); has children => ( is => 'ro', isa => ArrayRef[ InstanceOf['Horse'] ], default => sub { return [] }, ); signature_for add_child => ( method => Object, positional => [ InstanceOf['Horse'] ], ); sub add_child ( $self, $child ) { push $self->children->@*, $child; return $self; } } package main; my $boldruler = Horse->new( name => "Bold Ruler", gender => 'm', age => 16, ); my $secretariat = Horse->new( name => "Secretariat", gender => 'm', age => 0, ); $boldruler->add_child( $secretariat ); use Types::Standard qw( is_Object assert_Object ); # is_Object will return a boolean # if ( is_Object $boldruler ) { say $boldruler->name; } # assert_Object will return $secretariat or die # say assert_Object( $secretariat )->name; MANUAL Even if you are using Type::Tiny with other object-oriented programming toolkits (such as Moose or Mouse), you should start with the Moo sections of the manual. Most of the information is directly transferrable and the Moose and Mouse sections of the manual list the minor differences between using Type::Tiny with Moo and with them. In general, this manual assumes you use Perl 5.36 or above and may use examples that do not work on older versions of Perl. Type::Tiny does work on earlier versions of Perl, but not all the examples and features in the manual will run without adjustment. (For instance, you may need to replace `state` variables with lexical variables, avoid the `package NAME { BLOCK }` syntax, unpack @_ instead of using subroutine signatures, etc.) * Type::Tiny::Manual::Installation How to install Type::Tiny. If Type::Tiny is already installed, you can skip this. * Type::Tiny::Manual::UsingWithMoo Basic use of Type::Tiny with Moo, including attribute type constraints, parameterized type constraints, coercions, and method parameter checking. * Type::Tiny::Manual::UsingWithMoo2 Advanced use of Type::Tiny with Moo, including unions and intersections, `stringifies_to`, `numifies_to`, `with_attribute_values`, and `where`. * Type::Tiny::Manual::UsingWithMoo3 There's more than one way to do it! Alternative ways of using Type::Tiny, including type registries, exported functions, and `dwim_type`. * Type::Tiny::Manual::Libraries Defining your own type libraries, including extending existing libraries, defining new types, adding coercions, defining parameterizable types, and the declarative style. * Type::Tiny::Manual::UsingWithMoose How to use Type::Tiny with Moose, including the advantages of Type::Tiny over built-in type constraints, and Moose-specific features. * Type::Tiny::Manual::UsingWithMouse How to use Type::Tiny with Mouse, including the advantages of Type::Tiny over built-in type constraints, and Mouse-specific features. * Type::Tiny::Manual::UsingWithMite How to use Type::Tiny with Mite, including how to write an entire Perl project using clean Moose-like code and no non-core dependencies. (Not even dependencies on Mite or Type::Tiny!) * Type::Tiny::Manual::UsingWithClassTiny Including how to Type::Tiny in your object's `BUILD` method, and third-party shims between Type::Tiny and Class::Tiny. * Type::Tiny::Manual::UsingWithOther Using Type::Tiny with Class::InsideOut, Params::Check, and Object::Accessor. * Type::Tiny::Manual::UsingWithTestMore Type::Tiny for test suites. * Type::Tiny::Manual::Params Advanced information on Type::Params, and using Type::Tiny with other signature modules like Function::Parameters and Kavorka. * Type::Tiny::Manual::NonOO Type::Tiny in non-object-oriented code. * Type::Tiny::Manual::Optimization Squeeze the most out of your CPU. * Type::Tiny::Manual::Coercions Advanced information on coercions. * Type::Tiny::Manual::AllTypes An alphabetical list of all type constraints bundled with Type::Tiny. * Type::Tiny::Manual::Policies Policies related to Type::Tiny development. * Type::Tiny::Manual::Contributing Contributing to Type::Tiny development. BUGS Please report any bugs to . SEE ALSO The Type::Tiny homepage . AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. SIGNATURE000664001750001750 14215215111656240 13744 0ustar00taitai000000000000Type-Tiny-2.008006This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.88. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: RIPEMD160 SHA256 b995288fb503b0a64dd55a8caedd80e031e5b8f5a40b82aa884c81f72b2d069c CONTRIBUTING SHA256 64e1a003723ec04dc13df35d99299cfa2e51c783d170b3cdf2131c4ffa0ee0c7 COPYRIGHT SHA256 a7de49516c5a5e8538682ae2b3213392ca999ca95a4999f9184f203914d0144a CREDITS SHA256 212ae592004391c5791ab3aee037fefa8269cf3fa9b4af270a49506364518584 Changes SHA256 6a5ab06a68802a98172274d878229173c11a5229cdf14feaa4b88498cb3c05d7 INSTALL SHA256 8e7094312357a5a73b44c1b87d32fca39e6d2f6c5a5504bcbcd0f0cf34b7c9cc LICENSE SHA256 ee58ace04fb20ba84ae86b1effff7eec32c8eb67f08af6f23629164a542a5322 MANIFEST SHA256 8402cdfddf4fdec37df992d4b6924cb04696bb468f49d5d51c234d9c7f4803e4 META.json SHA256 90e0f13be595c00ab106c7937ca48bf84f7c46f867cfd304705621a9d10882d7 META.yml SHA256 097bc929b098723cefa2f8b2b790bb9cf1110c326b764c312fad190e8f75c8f0 Makefile.PL SHA256 99081947a86b90ce5301109b06fa42e639b09aa84ab5de7c505168033d0298d5 NEWS SHA256 97db8bbf27e6af33ec9f1dd5c34cf5badca1cad5d70c1132ced1da0ceb6c9cb3 README SHA256 cd8759458860e09c13d2be9509cef61689d8ee9738ef9d38ee1ca8add64312ba dist.ini SHA256 e1f5da7b77fbccf75a57a5e75f35d4b0b73a74b3e445a53d16465052329bd2a3 doap.ttl SHA256 efbb544b169bce7594e9b22ab92bef874477b4daf4f3711b47babfb255b47ff9 examples/benchmarking/benchmark-coercions.pl SHA256 c3c06fbce38489b211f2da1635846c5b39d160aac65ab2041697b9fd77a9d54b examples/benchmarking/benchmark-constraints.pl SHA256 03c32803ee76b57f65358c241283aec7c005963856f2a23f20963f721ae7aa86 examples/benchmarking/benchmark-named-param-validation.pl SHA256 679aa383b398ec2960e29dd0049bc2e4213d6b8354150432e19917eae2cefa78 examples/benchmarking/benchmark-param-validation.pl SHA256 734e61080079b084143d6305d0f5dc8c56a1acddcf4a777ab42b79637adb9df0 examples/benchmarking/versus-scalar-validation.pl SHA256 6b5b287faead4a4646e820899410736400a0eadab60053fd67977ddd8d8cc086 examples/datetime-coercions.pl SHA256 455b549a0f802bf5c488059d3ae8da24c030fad979ec8b8772c62509697ba3bc examples/jsoncapable.pl SHA256 6660315664c9b5678d91e273f1d9f3631563226883be0ba3482305d3dbdfe0e3 examples/nonempty.pl SHA256 18261dcc61931290c0e92a7a93f33b7ac2a1e2ff2c0b15579f64f5ab1998e905 examples/page-numbers.pl SHA256 c361b86d13c8fdfbe75840d11dbe6af488e44af27b0edb80fd1eea28c8e935d4 inc/Test/Fatal.pm SHA256 b8b2edfbb16b30d0e3b212a413c55a8de7ce929591d0a1029b70c47c8c0be11a inc/Test/Requires.pm SHA256 083292e0cefc5cd41c82975f7b9aadc6893065d4297dc153b7f13356c0c0a44c inc/Try/Tiny.pm SHA256 a93c5c677f44f7b00a7c414afeafaaa15ee7c7b72a47083936e1a8d37f0970b9 inc/archaic/Test/Builder.pm SHA256 fea307eee1d65187effaaaaf85663e55f1a23c2a25cd6a4963bada80c440075d inc/archaic/Test/Builder/IO/Scalar.pm SHA256 4da2ad5c38d41eb389393f111f01f8e3c885f3ae5c027e540f662ddf44d2895c inc/archaic/Test/Builder/Module.pm SHA256 71d019f6ac3467615dbec9c17aa85eec0f32a4cfd8824f25fda7176e0890de44 inc/archaic/Test/Builder/Tester.pm SHA256 ae528d9fc2962793e98af13f4d4e802fbf8d78b17b1c27a860728a16e8bf4a3a inc/archaic/Test/Builder/Tester/Color.pm SHA256 764f3ed1e0a314e7e9f8d803dff3d894e8c572e2a128d7ce14f2a80268e50543 inc/archaic/Test/More.pm SHA256 c4fd1410a9bd85a0e7700de08c1614fc5928c0d02151ba1ec7d06bd56407e0d5 inc/archaic/Test/Simple.pm SHA256 c08e24ed18bab509794a8d614ccef4915b73585fb0234b35a9dc78ec20d686b1 inc/boolean.pm SHA256 a0b643aa00a0deb89f11b81e6da3a58f7d071dc6f60c05343916e32c0cc0f920 lib/Devel/TypeTiny/Perl58Compat.pm SHA256 9b8be4c22ef8d47bd6c8b9888b879fcda870f379835b9883cc5f41dd1ff508af lib/Error/TypeTiny.pm SHA256 f973797e464b3729f81700e26023856e843e369a63c3dc00e14629dc6dfa6d9c lib/Error/TypeTiny/Assertion.pm SHA256 204004d9d052c792ae102dfb49140bc08deaf589564b4e8f394d4d1c58d82caf lib/Error/TypeTiny/Compilation.pm SHA256 9ecff13a8b9a137b8cc5d67ef9c534cd3f47658bdc2de36c0053338ff72efb4d lib/Error/TypeTiny/WrongNumberOfParameters.pm SHA256 8f3f83d7d46c6b2bb6b95b29293ae84f30ef27aec42a9c32b1b82400fd5c53c2 lib/Eval/TypeTiny.pm SHA256 c190745047e894542a9c58ea833e5b6798e7677f400053d81795159f4cbb2ebc lib/Eval/TypeTiny/CodeAccumulator.pm SHA256 3d41236938b06fa86f673a9f164383c0d057b8cfa7ef65f39a38b6fed5fe5a28 lib/Reply/Plugin/TypeTiny.pm SHA256 6ee76125b714b127a532841532b6390ca2595ca07936d929945208eedd2b22c6 lib/Test/TypeTiny.pm SHA256 02b32aa7d6395f4cdb34f295ce2b620a35d605aa5e6c71802233a03d1fb6ae4c lib/Type/Coercion.pm SHA256 b3dd77bd39201469197d7b870eac8c565555586cf74f4e79abe4c82e518256a7 lib/Type/Coercion/FromMoose.pm SHA256 1986f14bd7ed697e40a829b883c7ab1624b44d153fee0824fef2ddfd7c2a3b36 lib/Type/Coercion/Union.pm SHA256 96794eab547b1305df151f71466440e1c015e0985fb9016e11531cf4aeb1aaf0 lib/Type/Library.pm SHA256 5f34ec032f3005b5fcc25fde5c59bd327c759a1f746a2e7940d2131144c74e63 lib/Type/Params.pm SHA256 28c463c22d5664043a62a16dff7d32020f75ec766537ffdd632526f0182c7c04 lib/Type/Params/Alternatives.pm SHA256 db81ba4ffe6a0251357694f07715ac1b3e4877c19acdd57645f12cea42717afa lib/Type/Params/Parameter.pm SHA256 1e8fcc139579f5b108575faf320942ad05de399e523836ec24227f800cdbb7a2 lib/Type/Params/Signature.pm SHA256 1bda8be7b57ed64c1555256b5fb95cf11d87103ccaef09743abb39455fbc7362 lib/Type/Parser.pm SHA256 48394bf427547cb48e0780c4652095ad968abd39421267f23cf19ad2908684b2 lib/Type/Registry.pm SHA256 4f9b3f4395317abcf07b358d1e211fb741b70e5a8bbd29d06349e82b72e1a58f lib/Type/Tie.pm SHA256 5c654fa8212cd4fe51ed4cf71b1512ec124c12c95a1825b42d69e520b8d50300 lib/Type/Tiny.pm SHA256 48396ab79261e6c0280301b9db1db8e3ea42426b7774df6e7902423f7ed51634 lib/Type/Tiny/Bitfield.pm SHA256 daf01ff575389c3bac82a12bdd14d3e4f6dc8a0fd660d3c04b8820804068ed7a lib/Type/Tiny/Class.pm SHA256 640d3adf73a9787cde8de1a9205c55e362602b016efdbfff90af2dbc2c7c1c76 lib/Type/Tiny/ConstrainedObject.pm SHA256 6039474c1bfd89cae891b621d82745a8990a683eea19752bb141a8845fa9dc15 lib/Type/Tiny/Duck.pm SHA256 c75d58d28faeb9d7db3e30272deb897a23f2a58193aa91b3f62cf98984bf5e3e lib/Type/Tiny/Enum.pm SHA256 cdf71cb1f1db2926bd97bd96575f3944a122428460bd8b9690efe2ac440a6ce5 lib/Type/Tiny/Intersection.pm SHA256 16e43125075212670ce9a1ca39b0fc21e9391b1376ad5ccd49cb3431ada1ae0d lib/Type/Tiny/Manual.pod SHA256 fdc1378abb6f2437fdc24118624dc726ea29212ed2d6f34b02690f8a4f844335 lib/Type/Tiny/Manual/AllTypes.pod SHA256 cbba3500186c3f51fbaac47bc64ddf91ec778ed268c887d8342aa1344b258d8b lib/Type/Tiny/Manual/Coercions.pod SHA256 2a3c9cf5ed12e10ed7e00815494426140fcb2fd080e83a61eda6e460bf74ee74 lib/Type/Tiny/Manual/Contributing.pod SHA256 db25a0bff1483e52f9adc306c840f96543dc1a3c9d4f53eb9abcc92d20968aad lib/Type/Tiny/Manual/Installation.pod SHA256 1c692a073877d178723d177478a8770528076e881210331b01f05167d15d3424 lib/Type/Tiny/Manual/Libraries.pod SHA256 224cbb5c867de1ea75de802dffcb2afc1050ae56f7b817d6477a64e0261c4c93 lib/Type/Tiny/Manual/NonOO.pod SHA256 fac4b19c3d469778d4911c3bb6368245121ced97fbfd50db294bd38eb9d02412 lib/Type/Tiny/Manual/Optimization.pod SHA256 773cf5da912188de534e1818b733b4baff418604e55e574cabacc9d95623319f lib/Type/Tiny/Manual/Params.pod SHA256 f25e974e2f1c47f3342ea1b5a477c9b7fd19b6c09a283dea9ddfca494322b76f lib/Type/Tiny/Manual/Policies.pod SHA256 2bd76d485e6129aacdb7c571ec8e3bca58c2d018e69c393c1034b0a7ebaa4556 lib/Type/Tiny/Manual/UsingWithClassTiny.pod SHA256 996295f687213de1199160a6f59544c133b9e67c13294c60d53c76d303ba7b40 lib/Type/Tiny/Manual/UsingWithMite.pod SHA256 1a70fbf92006572db5a341ac190fab92a92aa0e0c46bf56b4d167818f313402b lib/Type/Tiny/Manual/UsingWithMoo.pod SHA256 3b1de41b3eceabcd990f0681e5de9aea36100756aed81af3bb1fb42b64a353dc lib/Type/Tiny/Manual/UsingWithMoo2.pod SHA256 8dd2577ea457f6015996ed7f2761af636b41ee46d8463f440794519d06d2b1cc lib/Type/Tiny/Manual/UsingWithMoo3.pod SHA256 1a5595b103401a2aab34c3fbe04654767998b83b38bebfa932b6bc9760c204c6 lib/Type/Tiny/Manual/UsingWithMoose.pod SHA256 b976c76579b13669fd07e1dee890731752d09ec54c2d9ef20443104cb3bf1f07 lib/Type/Tiny/Manual/UsingWithMouse.pod SHA256 e76fb46058922966833625c3789209463e8b2bb5ed711f6940a4d70da48fc89f lib/Type/Tiny/Manual/UsingWithOther.pod SHA256 41eaee9f68da37282be1f439e9c73455bc437cc2b376948790dd0d3c3fa726ec lib/Type/Tiny/Manual/UsingWithTestMore.pod SHA256 7463f99b645ddb2fab03f9ee1e62f2252d2e7f1fc589b0f469427aa90211d0f3 lib/Type/Tiny/Role.pm SHA256 abe2714853e8beb43efd8e8b03a1a14f2cb65d498e46dc8c7333d216b9cdfb71 lib/Type/Tiny/Union.pm SHA256 d6a209dbc9ef09c21d701a6000824016649e475560941a01b4d617a393784f5a lib/Type/Tiny/_DeclaredType.pm SHA256 64a9f094d0ff62f4ca63d0f22996065b14ac79af57cf60348986c162d13a2bd1 lib/Type/Tiny/_HalfOp.pm SHA256 0aedc3f8d12a9f090c85d8a2679583b12848a34dab4cbc9ad4c8a2703e250d01 lib/Type/Utils.pm SHA256 49c5339f668d1c57598dc12295ded83e1d5f58c72629fa775c52b7e9b6752350 lib/Types/Common.pm SHA256 a28d674c1d7da8fda48bf34987e4e3e68d8f11fd70b7857ffe28f306460a247c lib/Types/Common/Numeric.pm SHA256 95576de58cff051e9843282f64534bf4c2f62b7d3a2733600842f7b70dbab036 lib/Types/Common/String.pm SHA256 625b4226c60359b7908e3ebd024b6c87e4b4792bd0c1e4ec499270e41132959e lib/Types/Standard.pm SHA256 0fafb321f18fbc330ec63e7f2ce0c41d63a236bd769de85038d675792c37f91f lib/Types/Standard/ArrayRef.pm SHA256 a7ef6d32f94eabf02d6784501c4682d77c7903600e046ee81c6c1ae64ab1cd64 lib/Types/Standard/CycleTuple.pm SHA256 c837a8f15a1d3f8d81022002f7c86452b505a20de950d3c31b3504c74fd70376 lib/Types/Standard/Dict.pm SHA256 503efeea1373b9d68f8a143fa8eaca7fa29ed404f89b1b896f22aa4e139b4366 lib/Types/Standard/HashRef.pm SHA256 efd1acb3adf7e30c4e1b06b741ba881e045da463905635d15da21d88cfe30385 lib/Types/Standard/Map.pm SHA256 b900b3f5a88256ecbbfb968dfef433dc676c0fb77f11e2259ced276f245b710a lib/Types/Standard/ScalarRef.pm SHA256 ff9be7c6457b03d047640e6671f06547541320d77d6672ff816bc4990ab32636 lib/Types/Standard/StrMatch.pm SHA256 1f4786d8f90f1e1f068756e3e289d529b50b55fb4b379929811e4d73fbe55538 lib/Types/Standard/Tied.pm SHA256 d7d555929a455af518eef597c39ce435c452b22ab021b8d3989e71cee4034e72 lib/Types/Standard/Tuple.pm SHA256 5d6e086ddb5e2c219236304dd7cde8acc69f5a0bfc854f7b01fc49ddea0be5f3 lib/Types/TypeTiny.pm SHA256 9542a345d6ebabfb30d78ad5ce46c1664052a0ea408b556e081cd1aa746a4815 t/00-begin.t SHA256 229575b4546c7f074d6f6bd2937c24d824211bee7b316e9b50cda6f41ba6d1d6 t/01-compile.t SHA256 8e12825abad0da60050499f73e5a5377ccba824d8dc5546084d795bb82c580d0 t/02-api.t SHA256 1e70b32ac815578a6e51133abd2b53bb8e67f638838941f722aeb4d11dca8c10 t/03-leak.t SHA256 4ccafd3dd7d9ba4e1e8dd5cfa2b17265a00511eb9d7456a7bc835f5d46f3cf39 t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t SHA256 bf422b0186759516d83878cde1adc562ff148c4dc6d693293fd5b47754ce0522 t/20-modules/Error-TypeTiny-Assertion/basic.t SHA256 b5f3381eaf38e9f1559b5f81fd1dac2a26e971bec5d1801dc1ee9d72abf94beb t/20-modules/Error-TypeTiny-Compilation/basic.t SHA256 f5b56c1e62c2320073e87863006bdc2024b78a59f989742a35ad71c82b79f53e t/20-modules/Error-TypeTiny-WrongNumberOfParameters/basic.t SHA256 137fb81ebe0d4f3425fc4ec45937b7899e1a2b9101186bb114ae010566d0799f t/20-modules/Error-TypeTiny/basic.t SHA256 fc2918bca91c90e5ed8e9a131d4c9e0677a41ee4ee1014f26118ab076d52383f t/20-modules/Error-TypeTiny/stacktrace.t SHA256 c56dfe9da4c1f563fdc53745787f2a028a86c102f4a366a1d64e84b407484a6f t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t SHA256 af4fd8bf53aeba60dccdfb5dc07a48df451360aca11221a8d92fee41f40b53cb t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t SHA256 571c71bc9f551c0f5f39fd9e4c885f09fa4d392c1ec9862104e8df381fa2448a t/20-modules/Eval-TypeTiny/aliases-devel-lexalias.t SHA256 fd1285d64cc1c993f12e2839fec8c2207de0d18ebd55290471d19dfea8289a28 t/20-modules/Eval-TypeTiny/aliases-native.t SHA256 d84be6e089d75f01d143437efc1079ff94aecf628b73bb5f5c785a6bd6fc17d9 t/20-modules/Eval-TypeTiny/aliases-padwalker.t SHA256 215ba16752b31e9e665bc94f4fa1dc952c9e3403255951953aa76c7ab94b0a42 t/20-modules/Eval-TypeTiny/aliases-tie.t SHA256 1d4daccea15e27742a4097f12a05966caebcfddccf311344f92a2421ab352fce t/20-modules/Eval-TypeTiny/basic.t SHA256 c01577ff673a601a4168a0384b26316d9ec87117cae3094cb4c1cfd42e0fb0bd t/20-modules/Eval-TypeTiny/lexical-subs.t SHA256 b8d6917d98a7e46263c802413021a1e8f9d47dd37b0d29acdd097e4452f8c398 t/20-modules/Test-TypeTiny/basic.t SHA256 7421953183bc9ec888d3ed502f18e54e8527d862022909f2b626d27239480aa0 t/20-modules/Test-TypeTiny/extended.t SHA256 63aadc58971f95e3c8bf2515ebe809db51737fcbf090199c30fa1755a80702db t/20-modules/Test-TypeTiny/matchfor.t SHA256 add613e23613cbd0ea0ee2b26f77eec6382c468443ac29cdc9b20b1abbc13df7 t/20-modules/Type-Coercion-FromMoose/basic.t SHA256 903560bd65d222531ec5cfb08165e6b81ff5259a639de33f6bcff55c0738da84 t/20-modules/Type-Coercion-FromMoose/errors.t SHA256 c5db3be6faf6d7ecac267e90cfacd7dbc9a35ba8b8a37f7b1c972b6f86309c75 t/20-modules/Type-Coercion-Union/basic.t SHA256 4bff879dd33b03c1c292fcd9c3e75d42eb28a405a3c4a6772f4af1c5d2434614 t/20-modules/Type-Coercion/basic.t SHA256 ed42426a26955c7d6d79fdaaeb3d1de429ed313c40dbaa0d6145f9db787319d6 t/20-modules/Type-Coercion/esoteric.t SHA256 749615eab993298e35ee3f8693686099fd456fd3c632f13c974143daceafa577 t/20-modules/Type-Coercion/frozen.t SHA256 f491eedd77427f7d9e992992ce14e103f83b325f524ba5eb091d3ec517b38375 t/20-modules/Type-Coercion/inlining.t SHA256 7ef197e052fe007290071a5c05d5eb1609a9ead79c7635f098764da5f9a10224 t/20-modules/Type-Coercion/parameterized.t SHA256 c4f8455ef9b4d8642c8817c5c9fd92d8f23a0eeab372baff5fd11026d5a4e1ba t/20-modules/Type-Coercion/smartmatch.t SHA256 4dfb1160d3708f84d1907d1c43af9f320ab2bdf449172632e3294b00ba719c6a t/20-modules/Type-Coercion/typetiny-constructor.t SHA256 4e7d12a8e8bc5d3b1f5f2b8e3a4f5a349d66618d97a8664f12d343389aeebf1c t/20-modules/Type-Library/assert.t SHA256 51e80cb78443a03f33cc9d1109234844cbc7ce29c61127a12eedb79cd9a78996 t/20-modules/Type-Library/declared-types.t SHA256 10a5e541b4252cfa53b7a4906695665226241d1d63372b71e4fd94d2fa64e529 t/20-modules/Type-Library/deprecation.t SHA256 fcdffd93fa97168ecc86d1db02f63b7c5c7d7a80492119aaf9321fdc6c3ee368 t/20-modules/Type-Library/errors.t SHA256 1e2c032dfd68934c53849e69b06af8e084d0ab53ed65941af141466c5428b4d8 t/20-modules/Type-Library/exportables-duplicated.t SHA256 ca2a9db9bcf44293edeb62e27735229357d7c3182c40f4bd06a2657254ebf47c t/20-modules/Type-Library/exportables.t SHA256 3b0a3da210803884b8ccb750e9d181fac749a5437d8bc070d3564e3f28c37f9c t/20-modules/Type-Library/import-params.t SHA256 11e897e08c629a763152f7946ece31b0398a83cafd8ab3c54ec630c020959d4e t/20-modules/Type-Library/inheritance.t SHA256 032677b61ef532d2bbc4829033c1917a6c063ac20df2866338dbc8d5b9e8a6a0 t/20-modules/Type-Library/is.t SHA256 817d7c76f63acc5ed05c09313430aeca4e835efd1998ebeb97f77e7fa912f430 t/20-modules/Type-Library/own-registry.t SHA256 4e177014afd53b909b03eca904003ce176d2db87780a5562aeb28151b04e1403 t/20-modules/Type-Library/recursive-type-definitions.t SHA256 eaa279bfa5c72d81e0c43523c947237ceda95d7c5bb0bea66adcc31dbcb77c59 t/20-modules/Type-Library/remove-type.t SHA256 f61b1c8eb41917ef59cdd3b4220f8a9d8156d972dc57cbb3daaccb5850cc9e82 t/20-modules/Type-Library/to.t SHA256 5e2de98448b4554ec4078ff0ed175f62a01d5599c2adb0423ccfb6795277ce18 t/20-modules/Type-Library/types.t SHA256 6cc620bdc059c252ef0c23dd1d4a8a8b640190235e133258950f1c119ec6177b t/20-modules/Type-Params-Signature/basic.t SHA256 cbae2d6f17e9879debd55e054658271dcbedaa1435b488902f248c76dad12b27 t/20-modules/Type-Params/alias.t SHA256 c3e2eea563e45dd5cc669ad2532d55a8555e7d0aee45bb6261414c2abce28694 t/20-modules/Type-Params/badsigs.t SHA256 71042460fef7a3d707214f865cabb2d1cc37edad79d8cf5877f19bf241d7978b t/20-modules/Type-Params/carping.t SHA256 d41a98033d3794ca7204a9e61cf7a7a2bdc787941a1b1a612b3c5ae4d10dfcb2 t/20-modules/Type-Params/clone.t SHA256 b847b16bf9b6e9ddd70c6c7146963efcd06276586359f0556e13a359a374f169 t/20-modules/Type-Params/coerce.t SHA256 990f8a49dde6621da02eaa419f5b16d527216997906900ecaa1414b4b3a6b614 t/20-modules/Type-Params/compile-named-avoidcallbacks.t SHA256 39187b22f545c22b464ab4bcc0bf9a108f3b11109ce602ae1f2e8670c9992e1e t/20-modules/Type-Params/compile-named-bless.t SHA256 f86f84fb3f0233869c2d03d1870d33e53089bf4dce0ed2bf867ae75a146e6df4 t/20-modules/Type-Params/compile-named-oo-pp.t SHA256 5d5d078833052de8ee3822526355814402f8ce754bcad92dff491de92f347017 t/20-modules/Type-Params/compile-named-oo.t SHA256 5ff2ecf5510fd9a0d7afe2725d53c6e1dbde1ec8b52612a98db900ced0b84ffe t/20-modules/Type-Params/compile-named.t SHA256 85049fe42feac5df58669517d63a69f1dbede008f10ca1f7207a457cf9ffe442 t/20-modules/Type-Params/defaults.t SHA256 8bf080e80b6e3a3eac4889d63c83d1491a2a237c22373cd207ecdd14179fe78a t/20-modules/Type-Params/goto_next.t SHA256 f37b0ef2fcdae3f4d0bfa8374425b0cc16b322f22f7a68a65ff5532f84d25201 t/20-modules/Type-Params/hashorder.t SHA256 6d71fc3eac176e19f17eae1b6ca5e0ee98bc3e3b94e78044a8572e74376da765 t/20-modules/Type-Params/methods.t SHA256 3a9fb998f7761b273e1dd3e7f9517aef6b946a1a96abf722ade86b51924ff36d t/20-modules/Type-Params/mixednamed.t SHA256 52ee65f93077f9a7954908760b6face23010fd469a6bba5fba007235c8cfdec3 t/20-modules/Type-Params/multisig-custom-message.t SHA256 feb97029d0263ce0dd273dd91dc7ab4a7079018bf257fbdf9f8f483f05d18dd0 t/20-modules/Type-Params/multisig-gotonext.t SHA256 eae088f263c9baa866ca0ac366a9b5050433c221fcca78b2245c70b767f6bf86 t/20-modules/Type-Params/multisig.t SHA256 2cc01c40227a4d3adb43104edf1cc25898cb95b7a7b3d09dfcca19851e3ed7d4 t/20-modules/Type-Params/named-to-list.t SHA256 90095bebc8d283bbbc7c1d961e94acb698dda07543154dbdedb4359d972ee6b7 t/20-modules/Type-Params/named.t SHA256 b0dbb0e260c4b0c74a01be9f85f20d2be4f743b644e84d3e3740f027b0107786 t/20-modules/Type-Params/noninline.t SHA256 22ffd1726d636aeffd65e81e1d654eb9632d572188d64695963469472792a40f t/20-modules/Type-Params/on-die.t SHA256 744aaa64122254f20316947ad0692ffc39b1cb507fcba60e3b3221876e604213 t/20-modules/Type-Params/optional.t SHA256 bb20e61835336104092cf46278f54af8221111d0dafbaad783fb818949d691f3 t/20-modules/Type-Params/positional.t SHA256 903cdf934d3383232706afe60c75f79b53823ce642cb7ff1e243939784a52f11 t/20-modules/Type-Params/slurpy.t SHA256 cb7958f5a8de9a00a916ebcd03126c55d3dc63651a593361029fd21bda12d977 t/20-modules/Type-Params/strictness.t SHA256 be6fadbc5b27dcc519e7edaee695664da7b4825c42727fd9973fdcba4282ae04 t/20-modules/Type-Params/v2-allowdash.t SHA256 c368b2a1434cb4e8b669ec8cea5871f681ed823afa29b98bae4569387e86f28e t/20-modules/Type-Params/v2-default-on-undef.t SHA256 87212782cfc87507254b5ab2aaa76de1322ce08acac936bcb7ef1c7baeebb1fc t/20-modules/Type-Params/v2-defaults.t SHA256 98c50077214df602ac56205e68b78f00225db5247da91a05b2c7a47182b02c06 t/20-modules/Type-Params/v2-delayed-compilation.t SHA256 00a7fe8fc6db6ccb11dc5db495503fe2528f2cad66108b99181db66d99264fad t/20-modules/Type-Params/v2-exceptions.t SHA256 844c5df0bd81f73dd8b1858e78fb9b203e0ae05b5af2dc3d4c42d33a7102d8c4 t/20-modules/Type-Params/v2-fallback.t SHA256 02956ddeb771e74cf4638a76ee8882d71230ba9a0dd3d2f553cbe511386a4845 t/20-modules/Type-Params/v2-listtonamed.t SHA256 b887fe6b38c605c248ea1fc53f6716d2e4a6145cd93ede07c889b50e3b07eeb6 t/20-modules/Type-Params/v2-multi.t SHA256 fd14f60747e2fa394559f014f379bc6ad40db3f768dc15fc84a11b8cbbe860df t/20-modules/Type-Params/v2-named-backcompat.t SHA256 c0066eff8f5ecf9683c61bb380950fddca255ed2f827cbcdef06dab1429e8bdb t/20-modules/Type-Params/v2-named-plus-slurpy.t SHA256 8c0b431cfb50625b4342a916fd6d2a4e816c182db8383d625a1a031de4111705 t/20-modules/Type-Params/v2-named.t SHA256 124b9f60e56c7e53eda5e455127294159d996819cef6cab69cfe31e69ed85921 t/20-modules/Type-Params/v2-positional-backcompat.t SHA256 31943bd8efa26782d4b0926e9a6c1409cfa6f09c8c71061b47d70af624703c52 t/20-modules/Type-Params/v2-positional-plus-slurpy.t SHA256 62c715d645edc16e663d96d81864c6274187d20c022715d6a739bcab3bf23494 t/20-modules/Type-Params/v2-positional.t SHA256 c76379a1d5b3a9029e12dd5473e0700cb1a71f8b4d512019eb78cc1c9f9126ba t/20-modules/Type-Params/v2-returns.t SHA256 d3040b544c166c59442f84985b4e9df4d98d29f2b70d29bc636e88e6ea8ca33a t/20-modules/Type-Params/v2-shortcuts.t SHA256 7e0a699e3b6479e32ab315d5e1499918aa2400cf56c7bc7e2c5522b2a2ca88a7 t/20-modules/Type-Params/v2-warnings.t SHA256 6618954615b3e7cba72c00bd5cb045b042b619bc194afaa5f124026db57ef3e9 t/20-modules/Type-Params/v2-wrap-inherited-method.t SHA256 a500d80464e36f086d2d2798aca1d3a88b68cc114a9b0f273437cbeab8f0ce61 t/20-modules/Type-Params/wrap.t SHA256 6378e6a461b4cec65e5b9c62ce4aa4f1cfd19bbf5fc252ffe80c43ac799ab048 t/20-modules/Type-Parser/basic.t SHA256 f83810ac88f688bbc919b584dbeb9fabb429e4102d248796ef163f9d09ed660b t/20-modules/Type-Parser/moosextypes.t SHA256 5a2d62d683803df312d311c1635093d2dac3d7b7a1435770ac4b930db5881bf2 t/20-modules/Type-Registry/automagic.t SHA256 3cf6ec2f27f66730f19914034f4272409b14e7e5b920ee2c4d2523dd227ecfb2 t/20-modules/Type-Registry/basic.t SHA256 8d2d026b7125b9941b30548a48a8745f12393dc8a0d6bd683a38063ef2a7515a t/20-modules/Type-Registry/methods.t SHA256 0383f20011a55499c5b15b7652296ba3bbd7fd9ee99d7361418b5758d4d82d65 t/20-modules/Type-Registry/moosextypes.t SHA256 93266bae7b9eda61102acbe7159e0c7c9fb94f4d77f6205cac6ff57c869804f2 t/20-modules/Type-Registry/mousextypes.t SHA256 c1e8487f256a12f8e35d738d761da05ac376064557b0600a60dbff47866ec0e4 t/20-modules/Type-Registry/parent.t SHA256 5668a91ff81bd30d6ffd67be90ccd735d93892af7efbcad33be060884e3d32b8 t/20-modules/Type-Registry/refcount.t SHA256 3085056a2d86f62d9edd5300142a6dee6ed3ca81d0003959b3bdf277496ea7f5 t/20-modules/Type-Tie/01basic.t SHA256 ceadd2e7f5a6df3eaac92d60bc00802d4922fef663fa4332a395c2d35f2e0f62 t/20-modules/Type-Tie/02moosextypes.t SHA256 c05562241584ea63a25d3e2b89ff332830d5e2b541af5cd6cfbe1c8957bc4a40 t/20-modules/Type-Tie/03prototypicalweirdness.t SHA256 87fa7c65b9c369c065812d975d0c5e51a84b90a6188b37e694091e6522e4712c t/20-modules/Type-Tie/04nots.t SHA256 0bc62d52d815f1de1f7b9bedd059c8a313714379b305378600e229843f763507 t/20-modules/Type-Tie/05typetiny.t SHA256 13ed3279d402cced7ef4e95293fc23f440aeb8e379677c1fa28294762f5e02a6 t/20-modules/Type-Tie/06clone.t SHA256 e2d5d0b7c00288b2e370c782530ec41c6f326a6c1787fc965efadd28c0450743 t/20-modules/Type-Tie/06storable.t SHA256 4931f147f666064346772d7e57e1781e09b0974e7839a14ec6540da773df3e33 t/20-modules/Type-Tie/basic.t SHA256 d3014bde6c166ae5904f354b810e05db22fdede325ee950928be1e3e67bb48e1 t/20-modules/Type-Tie/very-minimal.t SHA256 ca7780142112efd766765f18695c0d0a700a922fc9131276a8ce86ee1d475937 t/20-modules/Type-Tiny-Bitfield/basic.t SHA256 82336edb76f6c83f2acd56c892ef5ffa628d3ab728a6027a59f5d5cda3bd1236 t/20-modules/Type-Tiny-Bitfield/errors.t SHA256 896cf7383d14aa7b60226c3afd9512f435ed5af50329f235be826bc6c7282294 t/20-modules/Type-Tiny-Bitfield/import-options.t SHA256 aa995be5fa2e4ce76f00a9a4bf96bdd9bd9593110ea7156b93790b38d21b74e2 t/20-modules/Type-Tiny-Bitfield/plus.t SHA256 7a0a411c4eb975f5c712ecc6543ac087b83a3ce5a59cf81a0417487a5fcdcf90 t/20-modules/Type-Tiny-Class/basic.t SHA256 61dd5c7d5f77b142443b2b25e294903c0d24843aef7838b38d4eb85b092b8a8d t/20-modules/Type-Tiny-Class/errors.t SHA256 f14e993aa7fe55001e779ab9103129cb5b20dd66ffa45f081f97e4a477994992 t/20-modules/Type-Tiny-Class/exporter.t SHA256 4dc217754b0dbc5c7c52a3a37c0406dbb6a3f810ff73ac791b8c173c032b1027 t/20-modules/Type-Tiny-Class/exporter_with_options.t SHA256 f6f9f0237a42c3248c70d113af635fc612a65fad31a30f4bcb9b2a4c8cd2d3fd t/20-modules/Type-Tiny-Class/plus-constructors.t SHA256 fd0ad1c8b5d2a613011d78916825385916f9dae270dc3a158ef85fc9b39fece4 t/20-modules/Type-Tiny-ConstrainedObject/basic.t SHA256 6a4db302a997c6bceebce8723f0298a3b7610a933deb702284be7c5c85dcab27 t/20-modules/Type-Tiny-Duck/basic.t SHA256 9ee7bbfef2869d5973c7d3666d0d9c7d7ff7a32eeb501b8dc658d2251fe76d70 t/20-modules/Type-Tiny-Duck/cmp.t SHA256 2d59307938cbe4134b46b40caaa3a752279c73bec6bd4f2d592fe4bcc3ac1589 t/20-modules/Type-Tiny-Duck/errors.t SHA256 c16be51576caaa20d4da95e9cf7b01e32a348d7c5497ca36f76cda44b3248dc1 t/20-modules/Type-Tiny-Duck/exporter.t SHA256 ee865ae61dfe8935d2f006a341d03c94a63c5652e546c34f576cd645cb0297d4 t/20-modules/Type-Tiny-Enum/basic.t SHA256 ef7584092a062bf7e5c4a5c7df173744b0cf43ed7c690b0b7f533660a7f7f027 t/20-modules/Type-Tiny-Enum/cmp.t SHA256 072e05d4ac7a13c197bc4939ac9bd83dcd5fc55ad12b86f66ab29efe157efe80 t/20-modules/Type-Tiny-Enum/errors.t SHA256 cb9122a874092d2b3ef2a7cbd5b48a233ead4cfdcab9a764ea1aea98ff5cb9d2 t/20-modules/Type-Tiny-Enum/exporter.t SHA256 2a35f35644d57f95172e900beed5ca3944d35fd38b4e03fbecd93e82d83ae4f5 t/20-modules/Type-Tiny-Enum/exporter_lexical.t SHA256 445ff9842244d36869bc5b3f7e42922a4484a1ca4e0fe0483289e20fa60e988f t/20-modules/Type-Tiny-Enum/sorter.t SHA256 0ebe1183916303c0a307ca5e465d7f5302cebbd65b45f0bfe09f013ef40706bd t/20-modules/Type-Tiny-Enum/union_intersection.t SHA256 5e83563c8be71313ffc19c53a5864642f890e7fcb9bfb556f0142bf24c2c6362 t/20-modules/Type-Tiny-Enum/use_eq.t SHA256 8d5dc9fe1a04fd5c3fdd7171b08732acab8815a03494c158b6aa53766450f768 t/20-modules/Type-Tiny-Intersection/basic.t SHA256 a879bc99e3a38b888992050af2b559bc84bdf2f1f5229546c69c09f35b9bcea5 t/20-modules/Type-Tiny-Intersection/cmp.t SHA256 8511faaaf9dde82f91ba35e1667483926165cd76626de1df22f9f8ff9a6a1a6a t/20-modules/Type-Tiny-Intersection/constrainedobject.t SHA256 8cf455f2b57f4a5a821c47baed3f2870cead9ef3c54302e0f9dad174d2c1777b t/20-modules/Type-Tiny-Intersection/errors.t SHA256 d1a93f1222a6d7fa99b3da70ff3eb5a7acd8164824d699973cac8ed334cce024 t/20-modules/Type-Tiny-Role/basic.t SHA256 2d88663e09529d6ab615e6840b08e59b57e0a20b8bed80236f073317a6006fed t/20-modules/Type-Tiny-Role/errors.t SHA256 d404db9a6735efa33bfee583f7b3afee15b24f699d9b0edb30985ef5021211a1 t/20-modules/Type-Tiny-Role/exporter.t SHA256 2bcbe4f2b2f688ce4e05e04597155ea2ab84c8a26ef59a23d64e3265a1938ff0 t/20-modules/Type-Tiny-Union/basic.t SHA256 022d23f48ca09b074cfe29a3677709dd9769ffe8fad208951c12b69fb5e0dc24 t/20-modules/Type-Tiny-Union/constrainedobject.t SHA256 57f0824f2fd0c57eed2f64d11e531097e150fe429e33c7ae0fe7fc82df61a0b8 t/20-modules/Type-Tiny-Union/errors.t SHA256 0124d302d8cfe7e4aee4585eec8669a3a867b2793588504a62c806df65a6f8db t/20-modules/Type-Tiny-Union/relationships.t SHA256 cdfedd7d5cfd275b592058bf707525760042bb650e7820a18ca799a57189d3a5 t/20-modules/Type-Tiny-_HalfOp/double-union.t SHA256 492baf545c9a9965be66e5c16482478ac39226051deb24733a1e9c7536aea16d t/20-modules/Type-Tiny-_HalfOp/extra-params.t SHA256 05d698f5a491b1c22b6cd0c32f16db3349a59d6bf983fab9c43cda4ff63da8ff t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t SHA256 3a933f720b695c6758aa51ba3f285e6f05bd70c90b270f55609c4101f130cdd7 t/20-modules/Type-Tiny/arithmetic.t SHA256 b9fe81b8ff41f117ac4fb7af62ce49ced5fb7f7fe79c88dc3679ff5a029002f9 t/20-modules/Type-Tiny/basic.t SHA256 dd5c122205fc534cd21891e3b6625aedaba0e7056a57d9d97770e99aede73269 t/20-modules/Type-Tiny/cmp.t SHA256 75a9bdf5451ae4d307c9f41c510d74b07ab1acc088c36e2044781a7b234891d9 t/20-modules/Type-Tiny/coercion-modifiers.t SHA256 8e02bde1431fac72bfa6f05f5872c9a18fe786c954c942ce26f076c1086b21b6 t/20-modules/Type-Tiny/constraint-strings.t SHA256 df816124a06dea7f9b85afd2cfdf3f93a134d14b88f85cf0c9568fe5faf38d7b t/20-modules/Type-Tiny/custom-exception-classes.t SHA256 11dcdfed1ca22d01ede0e1b43c499102a45fe735a1bb63049679f3d12b414e3d t/20-modules/Type-Tiny/definition-context.t SHA256 6724bd20edb03987fff4e6efd33863fbc47ba1a86369369424dcd1005e5024d1 t/20-modules/Type-Tiny/deprecation.t SHA256 cd24d3c338b4cf83e3597ece64ed26023e586b92684766a87130101052aaae41 t/20-modules/Type-Tiny/esoteric.t SHA256 dcfc1af5adb6231ecafafcf361f4c9805b5f46a4c693205df439ccfc67545bbf t/20-modules/Type-Tiny/inline-assert.t SHA256 f2757baff42130ca5b2adf7961b49181190e0233b0e903f1f0ae591b7787eb81 t/20-modules/Type-Tiny/list-methods.t SHA256 db6cd2fe2c1d1ab88cbad218d0c6f927aacb133ec82b82f1b65fa48d29436e29 t/20-modules/Type-Tiny/my-methods.t SHA256 ff14c1452f766de38d18eed71e201a9aabdf30bc8955f0f099aebddf379f6fd6 t/20-modules/Type-Tiny/parameterization.t SHA256 61a114a94c2b13b9ee5bb5d42d80253d0816a7b59b6d896b4b3159dc3f9cc283 t/20-modules/Type-Tiny/refcount.t SHA256 233640dc7f6866fe96ccef201fe673df2eb01a044c7563f0eaa65ef7651c3e87 t/20-modules/Type-Tiny/shortcuts.t SHA256 a4051869a2020bf197316bc3366e82b42c5096ee597e6824d9478ded5d771ad4 t/20-modules/Type-Tiny/smartmatch.t SHA256 41ae26fbdb5be88c1742342db44ccf0345507a8acabb0a78d0fe805936bc745c t/20-modules/Type-Tiny/strictmode-off.t SHA256 1ed0e7c742c2a7411b4e80666e5cff21cd8f56cd3293997a9c562354d97af7bb t/20-modules/Type-Tiny/strictmode-on.t SHA256 dbf7d60a58c55ab8d8aebaa89871d04b6b56cce4510707a8d88d92c933dc6bbe t/20-modules/Type-Tiny/syntax.t SHA256 63f1aa0bdcac0025c989f470839dc105379c0c20d59f5168bbbba836c348da61 t/20-modules/Type-Tiny/to-moose.t SHA256 9bbe9b97a1e8788b88807f9bdf37c8625d41bf1a0ace8cf3881fa4dd9138e9bc t/20-modules/Type-Tiny/to-mouse.t SHA256 54fc1a473318a281f5936b1e84da0acc2f6c9767589fe102b0a6868606e390f0 t/20-modules/Type-Tiny/type_default.t SHA256 b11c671bd188d8fcb76e0700352ef69e5acf56c547c622964b2e7b1e5e04b5e1 t/20-modules/Type-Utils/auto-registry.t SHA256 09afa8a1a40df064310f7a91afe65c3f2e64aeb075ff8c392280106fb230f151 t/20-modules/Type-Utils/classifier.t SHA256 100443dd8eb27c5211937e02a40cf39fa7b8e0c154c8bd5ab6c45ef1abbf356e t/20-modules/Type-Utils/dwim-both.t SHA256 868337b36f0eccf5b240b1460b69d8ade870f4bfe5bfed8d9c4f93d702deca6b t/20-modules/Type-Utils/dwim-moose.t SHA256 6c96bc1f87798594a641af97856760b12cd40006008778b7e60f6901125b90e2 t/20-modules/Type-Utils/dwim-mouse.t SHA256 41e25707e79047f5b6b4abf2e3c5dcd611c257a6571a682ea4712c84ae4eb14c t/20-modules/Type-Utils/is.t SHA256 fc632e8cd40ebbf0efbd3b82d6e03104c0534b8d1d6a53cb50679253bb9e2ed5 t/20-modules/Type-Utils/match-on-type.t SHA256 68727e106c6655fd9e7157f4833bf373bf9ae396f2eaf2f3896b7474215ffe65 t/20-modules/Type-Utils/warnings.t SHA256 caf879b6982b1ada6dcd0af693c4fa44b4f38612543ab8e72f78ae1a259e71f5 t/20-modules/Types-Common-Numeric/basic.t SHA256 f1d04b5e89c6d2bf2092fa6e2d7f175cd3c64d90eb511c65c76df10675982094 t/20-modules/Types-Common-Numeric/immutable.t SHA256 cee0a015968603cabfba3dd4db64fb4811f27a9507b19678a78152d52083afab t/20-modules/Types-Common-Numeric/ranges.t SHA256 8f748da1a8abcb6b1b97894a0b5e3c38f9f7008377f22c6c4256695e914d0162 t/20-modules/Types-Common-String/basic.t SHA256 2e7dbb31dfde3f4b8286e9e53a29e5b3ac37ece2480bf575c75362a57437f821 t/20-modules/Types-Common-String/coerce.t SHA256 99777ed4a71d3fe7a8c1e618f3f38cebb7361b21a6ddf9f2c95b1dacd7f01d16 t/20-modules/Types-Common-String/immutable.t SHA256 3c404e7293c3eefb77adeefd093db94fc8590d32503dca11421db04f5750ddd2 t/20-modules/Types-Common-String/strlength.t SHA256 3775686706e14f82f8a68f61f1c31c05e7379df9e53a20abd599df5a4af4d8fe t/20-modules/Types-Common-String/unicode.t SHA256 4e14fd6bd81e83089aab050299ad70379467cdb74f5b7ba81fe8f4310cfde0d5 t/20-modules/Types-Common/basic.t SHA256 2e3b488de41eb360719e35950d5bcc3ecb4e315e9514cbe9cf904537af440625 t/20-modules/Types-Common/immutable.t SHA256 051e52c2d2a0e7633d37d735e7c8d13c0e759ee94c831426b3b4266cb98827ea t/20-modules/Types-Standard-ArrayRef/exporter.t SHA256 536a5639c1c96b9f21a821b28c417671b6ed1b3e1f2b98e1cbd73f31cace3c53 t/20-modules/Types-Standard-CycleTuple/exporter.t SHA256 d2805f3f20e7e279d7dbfb5c38a41866636ff47759153ba1044cf3e47daa1cdc t/20-modules/Types-Standard-Dict/exporter.t SHA256 0827eec3d787012993d8a2a0957e9a4abc1d88c12149deb42dfae2e2acbfcd09 t/20-modules/Types-Standard-HashRef/exporter.t SHA256 de3b99f59f21df02e9f7bf53780cf5e338c4f6eb9763fe837d11f6383a83a82e t/20-modules/Types-Standard-Map/exporter.t SHA256 c46420d9a05c9dea99a611f5c79ed3befa846f4b9531abc292eaafb7265bc892 t/20-modules/Types-Standard-ScalarRef/exporter.t SHA256 40d31602d3ed770d1f1137c6e122afdcce6ba27e8092f2fb725fd40368cffc5b t/20-modules/Types-Standard-StrMatch/exporter.t SHA256 29ced8ae44e9c722935dc7783fc84f5e53a7742135aac3e567b6e9f5218d7577 t/20-modules/Types-Standard-Tuple/exporter.t SHA256 dd4c18edee9a4fab56b740761d5cc34584f2aa2b1e21f2871f1cd1c0ac41e142 t/20-modules/Types-Standard/arrayreflength.t SHA256 b42a9cc88f6a33879a0df9ae5b964502f1e49d2db87293ef00c87a6f264cc91d t/20-modules/Types-Standard/basic.t SHA256 90220f206a880f7ff4d3ca16b8ce8a0d9975ebd2edd77f77b76045b4eeebe9d4 t/20-modules/Types-Standard/cycletuple.t SHA256 91970babb9440993c9cb3f99daea3fa0dadaa293924524b20f061520aee4aec1 t/20-modules/Types-Standard/deep-coercions.t SHA256 2337aed7bf58c41bfcb2da161caf576d5f4816ca19f2c0dfa6fb2efab8afed05 t/20-modules/Types-Standard/filehandle.t SHA256 59bf66e1dcdf11415eb77696538ca5f51ddae94690041de579ac73cefcd3527d t/20-modules/Types-Standard/immutable.t SHA256 418ddbaaf3e16263bebf3a9d3e49d174abd3bbb3ea88cdb780cfffc9b490844c t/20-modules/Types-Standard/lockdown.t SHA256 1bf246b270dbaaafd37ddb8adb545b97ff35fde58d8bf036e6547e0034e4d1f4 t/20-modules/Types-Standard/mxtmlb-alike.t SHA256 f8426d8cf803c21330938aba108601e12ce815ddcb3562662014274c7685f2f8 t/20-modules/Types-Standard/optlist.t SHA256 2ddc600262a3c203215a6bc8292f5abbe2a4c933cc01414d1b40f6a4aa9b6ae2 t/20-modules/Types-Standard/overload.t SHA256 ae84bb027af65b1d4f2d631c881f040fc10ebc8afcff0a02e6c878eaf75a272d t/20-modules/Types-Standard/strmatch-allow-callbacks.t SHA256 c19b7fa66ad1d2b5d56d8b04f064ddb9d626990ac72601e3fdbb6317748080b8 t/20-modules/Types-Standard/strmatch-avoid-callbacks.t SHA256 4647903c5551e3fd40f2b0ebab9b4bdf9f900be362b5c28451d726b66c577143 t/20-modules/Types-Standard/strmatch.t SHA256 61b9c3aa1e2f99eb3a81227ae54ab086946abb9caf9e1890252d103039edf28a t/20-modules/Types-Standard/structured.t SHA256 a5b11dcf8a86aca69c71736e6bc2842d7456b579156446a794a4094f80377986 t/20-modules/Types-Standard/tied.t SHA256 a12b2e1972feef0eb065af3118169eb56710de011f6e894584522d780f0e2a10 t/20-modules/Types-TypeTiny/basic.t SHA256 50407a0d195f281cadb768e8a3f1dfaeca9cc5f07ccd5f0f10890bd445c323c3 t/20-modules/Types-TypeTiny/coercion.t SHA256 caa2570acf3deb89dc0e95e642421e0343a3200a5698682f34de1723a8b98ed1 t/20-modules/Types-TypeTiny/meta.t SHA256 34b5d28e8dc497f57198d5cc08af7ceadcc85b2f1c8404a5c694948ded6fc231 t/20-modules/Types-TypeTiny/moosemouse.t SHA256 f7e7e710578b4bec454233a931087bb72a730bc1769f1fd970b8dbbccfe1163c t/20-modules/Types-TypeTiny/progressiveexporter.t SHA256 758c18b015776cf169d9ccc3f9a54d7193691f8df7202a93e61b49d3c7b2fbe5 t/20-modules/Types-TypeTiny/type-puny.t SHA256 d5c4839c77e98da2a891c553903ee8f93b9df6becfc1a0422385c28fe2f27265 t/21-types/Any.t SHA256 162f45847b270699ed80cc17c7a6a80c858c72cb98265344b5ecdca3b1d53b04 t/21-types/ArrayLike.t SHA256 5c5f5b37ce57a6584712a24b717df131de66e39413701484bed057da4b633d4f t/21-types/ArrayRef.t SHA256 72e7dd3d358c15cb179e6f739d61390f2d9c086a24c68835a23b665f519a42cb t/21-types/Bool.t SHA256 e9041b9abe8e2a809f421c3b6b21d8929502681c420fe548315a58b98184001d t/21-types/BoolLike.t SHA256 f4173fc5cf939eeb4f524bc389fa50e90d2e98a7e01a41e8c0689383a15e08ad t/21-types/ClassName.t SHA256 31eb741c98ea0c77147df5a27b0809985700af384203454cee91d373b369182d t/21-types/CodeLike.t SHA256 37528b00e8321b4b5fb08613ea2ea6683a8c77da9d7b0c0656f6a2ad94cf2120 t/21-types/CodeRef.t SHA256 b2f1f0762548887320c094b318194b737a55cea6da83bfb43167b9c33e75a978 t/21-types/ConsumerOf.t SHA256 4f6a193bf28320efab7c6ecb5fa9e00165847504d9c216200d9a96daa3ffcf46 t/21-types/CycleTuple.t SHA256 25a14e561fa5ab955ff1d116dacaf27fc27c830843eb9c944b6ac492c3f97f4e t/21-types/Defined.t SHA256 bcd1df2937d24ae26bc4d66f86b35abadc4b9731926bba3ead26ef73000f2424 t/21-types/DelimitedStr.t SHA256 1e38cb6e6724903fc75fdec6fc2aeb7f560624fd29f8dbf292185b8976bba9e9 t/21-types/Dict.t SHA256 e78eed9029e46ba4bc6ce1ee6c37845e876bad0d158219bc6066cf3663d5da7e t/21-types/Enum.t SHA256 cabdf4c9c3522a6359514fa3fd1415aa3acc9aaaddc96dc712f3e29ab7b1879b t/21-types/FileHandle.t SHA256 a281d6827c07820eed24f7f590a293577406b95935c93a18b3220d9211735d4f t/21-types/GlobRef.t SHA256 aa8c04cb5d7c0d3267c698db84cc24e679a0495d5b141f928aca78b44106e03f t/21-types/HasMethods.t SHA256 6ba8da0ce85fb9e4d99a9c09491f706ac5e212bccb725b7aa0cee2590c042dcc t/21-types/HashLike.t SHA256 456a045224630de8b6c6f1791598083fc210cd3cbd5c51c6b5c9607c40843aca t/21-types/HashRef.t SHA256 8170b6a1a5784da3cb56d0c2a3bf2b682977b8e39713393d1c526b974a9e0e5e t/21-types/InstanceOf.t SHA256 c8ac4d1ad6adf6473a82d86a628383ae70ab506145982fa58a4597875046b440 t/21-types/Int.t SHA256 0733ca656356e06445f6ac893f6e1e5f350799c3c7ca1edad7444eb239b5ae91 t/21-types/IntRange.t SHA256 2b6c6e1f6f286ba7788f31ddb79d6a8c704db10dd2ba053a32324db27194ee0b t/21-types/Item.t SHA256 de912a02509dd34fe467765c1f9b9f517068518cb97c57b8723ee3d33ab4786f t/21-types/LaxNum.t SHA256 c3d1dd769294541f686481b7f5410b54a07856e65e777ce2d617089952f22715 t/21-types/LowerCaseSimpleStr.t SHA256 6617bc53f3390f5970ebacd9b19bfaa16649ff690cc324536aa364dffb941b25 t/21-types/LowerCaseStr.t SHA256 ce956135335cfe0b85bf0b783fa6de61a1f6735203d69deff8be9e9d5d930bdd t/21-types/Map.t SHA256 8387cecabe5aa0c7de8ffccc520901b9e2dae3e7e4979a6bed8a50971fa75bd4 t/21-types/Maybe.t SHA256 a00996c5456d6f4bdaf3b6d064931e1a823daaed6440289c1890ea431dc1e599 t/21-types/NegativeInt.t SHA256 afc40dc740b467d53a598e254dc89de64a2d6ed275b6639bd05975f8043ee3dd t/21-types/NegativeNum.t SHA256 92646312d765f433e29ce094c38c6569b3da87fb71e40c8e00ad07810adae681 t/21-types/NegativeOrZeroInt.t SHA256 5e99eed0777db36abc42cd342652d178bb1ce5bea458a512e6a1e6b05d1f5baf t/21-types/NegativeOrZeroNum.t SHA256 dfef68e1490974bb8db3a841d0865760b57d1fb8b42eb7d638fb31595eb18453 t/21-types/NonEmptySimpleStr.t SHA256 43e675a90e4f1f4bf1fbfe4342c84695ed1df0deb5e0f56b31ca80c016aead85 t/21-types/NonEmptyStr.t SHA256 499af5eeacc71bae53f31ff46632b7e5245d0a5e893286699803750314b954be t/21-types/Num.t SHA256 da966e30f10488c56d2c3da46900a031a508fd75b6b7a91fc9cedac0d9f3af5f t/21-types/NumRange.t SHA256 8e4f463b5267708f9b3f5d65f0654335e3f8fdde95f979b0ed8bb402577c4ecc t/21-types/NumericCode.t SHA256 03b21c83538d9f0abfb9ee58b53d6fbe5da56f57fec77932f05a8316947d2c8a t/21-types/Object.t SHA256 0d56823af82ae6108f0beb2f0d23ad0f2e1ec425fb310901e19a300d56c6afd6 t/21-types/OptList.t SHA256 56611be5a17a80f0795ac5ca19be5003c6b42b3fd935328394852959d0603d6c t/21-types/Optional.t SHA256 62e85b21c992ea08357f5160aee841eb749597e74c8077b7a8cfde2cc0112692 t/21-types/Overload.t SHA256 037db061238b0ecd71a78ed85c75e6830749a28cd3d7a432406253586dc968ce t/21-types/Password.t SHA256 6b1d2850f92e5984667709e14394fb4e0c2660a14c39cfd0418e134c1d606fcd t/21-types/PositiveInt.t SHA256 2d897d3bd84a7fa8087d23aad3fcdf3e629d1abbf83a445c5e08bc507780f076 t/21-types/PositiveNum.t SHA256 1be7d932ed9abf87092060def6558e50f02acd49a9816cec01c06b8515d5af89 t/21-types/PositiveOrZeroInt.t SHA256 9c58079f05364574acf956f7ac91a34a2d82ea02ca63ca741de65c9973cb0a3d t/21-types/PositiveOrZeroNum.t SHA256 70cc55e66826a92e02db108e897bee83ad41f825f030b803be56414e3cff9c5a t/21-types/Ref.t SHA256 ce707a81768e655c819dc5c74f4fb7dcfecebad7eb62d41b7fda707557520aee t/21-types/RegexpRef.t SHA256 65f5ab1a85ce5513b507187ea5f31d7497c62cc1d5d70641f159f36212600f12 t/21-types/RoleName.t SHA256 d58dcfab90a3239902a8291200f86e5e573cb72c06f46be5e356ce018deecbc7 t/21-types/ScalarRef.t SHA256 d3a93618198f38193f9315e337d68aabda4b329f01d535b2247b703de9a3a100 t/21-types/SimpleStr.t SHA256 b7cfe262f3d9e18e51cb3bf55948c434c5109004aba780ec83440329a335bbe7 t/21-types/SingleDigit.t SHA256 c4232b76bade194e1f051aac4a96c51eab459971aa480286c1979851a6ff7697 t/21-types/Slurpy.t SHA256 1e90fb7e930680d1cdc69626d22bbbab0f6cfdefb67162875541773741c681d0 t/21-types/Str.t SHA256 c63db7c5d179daee03c23a5531c5c49e694d846201c7213d9e21a1b1f6562953 t/21-types/StrLength.t SHA256 44324307ee5d1440e5db18c7d79494d76e350409b8dc7b98f22c9608dd64d697 t/21-types/StrMatch-more.t SHA256 14eb468a27d25d4229feae7f23eac96893128c0e5814a8496a0959a742353987 t/21-types/StrMatch.t SHA256 9bb03b2a9f949849423d002e710a5437b511456620070eb11df34f5912810241 t/21-types/StrictNum.t SHA256 392ec393a98e38a2f4bf5af9855a2282d07c15279eea9e6a7a99f72d5cd2b846 t/21-types/StringLike.t SHA256 4b7b06bee3e80526adf4602046702fd6ff61a930f205eddf95c1a56046d324da t/21-types/StrongPassword.t SHA256 7f5d5764a5ecc0fbe4940461f2ed20e0782541d7dabdb4218bf43b4db6998d51 t/21-types/Tied.t SHA256 e960f0acfbad845a6817caec24319bd12b2a323fb3815255b8d239f0e2ba836d t/21-types/Tuple.t SHA256 d06ae82aeab383a4b087bdfd9df2d4a54715ae10eb3bcf66d0ada402a1e7a0ec t/21-types/TypeTiny.t SHA256 f5834b8c97f2ff4edfb243bda33b10f68291fd1c0d79802912d339d80ea9addb t/21-types/Undef.t SHA256 8ad34b709d5d636d3aa796da67186f407242bb9267e8a8820403b76099d18298 t/21-types/UpperCaseSimpleStr.t SHA256 5bec91b904f7b97dd5109d17a75058f5205dca7a8840f20a91110a7ebccf8e47 t/21-types/UpperCaseStr.t SHA256 636de07931f2e17c79cdb3d816549d56d32d16dd173cb5cc7fa32433399a5517 t/21-types/Value.t SHA256 1ff697382bedda4657626a18c0b540b74bc7c594dd61b065f8b8b8871424e842 t/21-types/_ForeignTypeConstraint.t SHA256 549b1140f521a9b4dc9ff1cf6ba49c0199b958a6e3c2b663b88c0c7857028891 t/30-external/Class-InsideOut/basic.t SHA256 4e79f745dcb9a0f39f52d62dc0339697a3be9d7baced14a8bcba67e699ade937 t/30-external/Class-Plain/basic.t SHA256 298b8ce1d1c093203907e302f466042cef178715b87c9f320d20f5b9310e1199 t/30-external/Class-Plain/multisig.t SHA256 4af69ad9e5d93123e072aeac4c56e1dda58d85b978fd9d8a0ed19f74b0be4546 t/30-external/Data-Constraint/basic.t SHA256 23ed965d61bf5089423c4380e976336782338656800ab359103f1237066358c7 t/30-external/Exporter-Tiny/basic.t SHA256 1f1e316f0756813f0e8041317173b2399b38f6a0f80161bceff24b6e43b9112d t/30-external/Exporter-Tiny/installer.t SHA256 483fce0445b04dc512a9beb82cff3f9d26deee51b04ec2636651bf77ab47b4de t/30-external/Exporter-Tiny/role-conflict.t SHA256 c7f7396c9ce5f16b40421e191c02fc7b1445a602f2a9cb7f8545d24e93b2f4eb t/30-external/Function-Parameters/basic.t SHA256 3df760fa4004a6360b96f093dda57f75d7ca74cccb7b8f9c2aec22fad40251be t/30-external/JSON-PP/basic.t SHA256 f46318f9a845fd04a6573fd9c0d4b72d62da932b853e84718f6300f2aac6d6c0 t/30-external/Kavorka/80returntype.t SHA256 349767f134bb7b6be104ff1450d6bd484f5cf367ec184dc25f687d8011251a42 t/30-external/Kavorka/basic.t SHA256 f57d20fca05f6ab17e21d5b8fb8fe1fe6175e7e8232c538b1419ced0a77d9936 t/30-external/Moo/basic.t SHA256 704e58d379d31ea462b2966b9f4a68c981213511aa5db2d9c81522ba44d7c99f t/30-external/Moo/coercion-inlining-avoidance.t SHA256 7070e2fc5b11b238dcc8d9d1a2f412b225a344960824adb259feeacf5522dbac t/30-external/Moo/coercion.t SHA256 da082c10c3f857e257f1ca51968d433663fca33dd938e45c1348825bbab8e575 t/30-external/Moo/exceptions.t SHA256 7f80123235397a2738b39414f28d9cfa029fc64d6bda41c3ddcdc9c598540568 t/30-external/Moo/inflation.t SHA256 1b73ce18ac891cfa6d3c866e3e5a961473eb7a7e8236fea6795bfaffb4e7c699 t/30-external/Moo/inflation2.t SHA256 b7f6c67386c3b62f0878d3f2c00319e94fc3b248aa945ba73310406efeccd76a t/30-external/Moops/basic.t SHA256 f99ddc4f9d88a154d98a8c4bf3f94ff9acc1570a4d1662a98ea384b62aef975a t/30-external/Moops/library-keyword.t SHA256 182bbbf7da8963f2ef6c16a206e8dcfbff51cc0b66560a7dfc5bfc53a4de3dbe t/30-external/Moose/accept-moose-types.t SHA256 c5056acb5dd62177fbb12bb0053e1fb305efff96695aec0b4cfa66c6280858a2 t/30-external/Moose/basic.t SHA256 5e5005427ac013ac2c8e98f91f0580eb158dca02276f76f6ce48783752fd5b6a t/30-external/Moose/coercion-more.t SHA256 eb9a732c58554c93df3416aa2e8e5a7c82c02b9bf1156077659df1b315599017 t/30-external/Moose/coercion.t SHA256 9df49d6a54c49910191984eae57c790dab263e82ba2a62e89ea2b4af23d2e8f2 t/30-external/Moose/inflate-then-inline.t SHA256 1db00ac3c827c55a324795bac95e042876e3d32f3796a92a5b632c8f70fc8f95 t/30-external/Moose/native-attribute-traits.t SHA256 42653351b6b12396bb31f10d9b9e08505f9022cee8a2ddf4b0751334dd5b68c5 t/30-external/Moose/parameterized.t SHA256 9c2275e7b866c8398998482a20f0d37b73b2921fc35d92db72cff0ddbcc16b22 t/30-external/MooseX-Getopt/coercion.t SHA256 ac6229842f6b7fdff9b05001c946fdb9a28bd684364e9ec29493a39a4c47bf07 t/30-external/MooseX-Types/basic.t SHA256 133d365a410106303d55b3137db1a206c99020df75d1ba2d9b1a9a332f4bcffe t/30-external/MooseX-Types/extending.t SHA256 d2dc2dd065e1a2ff62a5d71f93c3c5863f4b18bd1b29a9ee11f1b94766acd0e8 t/30-external/MooseX-Types/more.t SHA256 587aaa643eedd8fd226167c32785f15efa5ea99889b4746f4b1a3d3e0076da04 t/30-external/Mouse/basic.t SHA256 fdea313afbb88f31a2543c6072cd3e558fa9495d8db9faf1b38f91b50771b05e t/30-external/Mouse/coercion.t SHA256 0e597ef06216e55b8987813c20d12d01c5015e71bf03277cb6c1c9a01d6f5f97 t/30-external/Mouse/parameterized.t SHA256 fdac3c684bbad068cf6616f53c1f87a8588f722c9923fe33a7e306934146dc90 t/30-external/MouseX-Types/basic.t SHA256 4452e93218131302d64098905265866ea716eef774a2b914ea5c2026eb96b9d0 t/30-external/MouseX-Types/extending.t SHA256 28f00b6ddc80f66b0192a2f0381eb6227413e0791b6b01e2ed259e17f2f528e0 t/30-external/Object-Accessor/basic.t SHA256 8900ff4a4a8e30ead532428ee16b3a596fc8a39c5f5720ad4387281cf4e8a6c5 t/30-external/Return-Type/basic.t SHA256 896744ceda504797997404bf13cf01dab77eb0a515498da1948c88c63c7ae436 t/30-external/Specio/basic.t SHA256 2047e4e5edb2179e8c7435822234370978aeabf2af059c27318450100c5b4131 t/30-external/Specio/library.t SHA256 5186091c3cabae6cb419974da5abfc615dadc2ecc77ecb4f9f303d6be1284af2 t/30-external/Sub-Quote/basic.t SHA256 3091bed10ccd964d21838dc1f912ffb75f2059026b79e1e93e994a255ebf1c83 t/30-external/Sub-Quote/delayed-quoting.t SHA256 e56a677d09bd643e96144eaa104a68944a3696fb328fe9a2e8a6f2b032336fcd t/30-external/Sub-Quote/unquote-coercions.t SHA256 767d6ff7c4c6f868d64a91ebd9065c466833c93c34ee16b036f6afc997fbea35 t/30-external/Sub-Quote/unquote-constraints.t SHA256 42768d60cd22eee35385bd8316335ee1f45fb5dea0f0539b82975b0b355e47e1 t/30-external/Switcheroo/basic.t SHA256 db920994ee3d601273c8b241323602fe6e912132004413fa3e4105e78a39f357 t/30-external/Type-Library-Compiler/basic.t SHA256 daf305483b88264062978a4483b052ca6a9c22bc82f75f1318fe3e0658d9606b t/30-external/Types-ReadOnly/basic.t SHA256 e6908b849ae3142102fd272e9677410241dfdb7e587ae8a04120cefd04f50258 t/30-external/Validation-Class-Simple/archaic.t SHA256 2391fa8e45128e6cd6a0295a39885fc69e00f4ab6d6c6c7ba609b1958922ee4e t/30-external/Validation-Class-Simple/basic.t SHA256 6d0dd0f610ac60dab0acfc4bd53e590cd93fe310cb4fcf03c9c0e4949a7e8b8c t/30-external/match-simple/basic.t SHA256 0da142b734a4828416e94606dd5a5b8b476d2ae3bcb5aede923bb8cfe1933417 t/40-bugs/73f51e2d.pl SHA256 09de832bcc8ef2d1dcb1de81085164ff02a42648be6707073ba5012e76b9b9e2 t/40-bugs/73f51e2d.t SHA256 6f719259d9407d71899871e484a0195b9bc4a87ddae2d34df3c927e7f10ce13f t/40-bugs/gh1.t SHA256 2ccae617c46957d0bb5352ea40dfb7b26c96bcd2fdf69ba69b97faea2a0fb762 t/40-bugs/gh14.t SHA256 07276da9562999a100db1d89d52269be7cfbe26eda8cd635695431b47cccf502 t/40-bugs/gh140.t SHA256 974b7483e05b848a4f57d3a8e8e8cdc9ea284655ec036767a7b302ea7074d392 t/40-bugs/gh143.t SHA256 726189f92eb36e27df4fa3ae8cc314e0c06d8a2341b8810854ce4d5fdbbca6ad t/40-bugs/gh158.t SHA256 bced65739eaf44334ae6300bf85e1894ab7a2cca0ec3fc4f6296fca4f45c4aaa t/40-bugs/gh180.t SHA256 e741d58cd271734a50cd84f2886036fc60cb2c499bf117a0d6f68d15653d0031 t/40-bugs/gh80.t SHA256 a9f83481ee387c350c386788ac849b09c08a9da9bcf243574189ab38646eae0e t/40-bugs/gh96.t SHA256 d0123e45039a007307208fc0793220e92d1fa1b31346f957f83abf41d4cd41be t/40-bugs/hg166.t SHA256 5fc75909caf44e4b8bd01cff93ed352a6b0aeb0e2f02e9487b088627f2258bdc t/40-bugs/rt102748.t SHA256 69ad6131410905b6e0a62f5702942d176a8790706adae4390fc9126320f95b2e t/40-bugs/rt104154.t SHA256 ee90b580abe044fca0d6f3277a547af13e7c9d51a9013d4b0ce83f9375287b26 t/40-bugs/rt121763.t SHA256 f926a90c22f4826de418b81cea6a37d2f3cebab0ffb9432b91545d57f589fa4d t/40-bugs/rt125132.t SHA256 57385d6a688b69e499dbc932e8cde43d043357e15aab7c512a72ccdd343177d9 t/40-bugs/rt125765.t SHA256 51383246a0d334bc3814e306e82bcd751b3f857c47ed14a83c8d63f039fdd1e5 t/40-bugs/rt129729.t SHA256 589a0e8c4ee8b54f46701a60b8dfb85bc25f5d0fcfc7646bb9ab5f9b41d1c44c t/40-bugs/rt130823.t SHA256 4b23e61e45b745df8f6b1dd3a1a2e7c563bfc899c09c079f682fed90752e433f t/40-bugs/rt131401.t SHA256 a22f6410cbaaf2f6a8ee20a019ced25c2d1dee3d76a99a9689cab74898ebe8df t/40-bugs/rt131576.t SHA256 9cee7b0f61099ee0986663e1a56337cfd2dbe9a4347c84a93f6b97ff625963c3 t/40-bugs/rt133141.t SHA256 550cd0f804d4ec3cc55418b797b1cc818897b618d5f0556e6bc401da63a04e82 t/40-bugs/rt85911.t SHA256 b109c8b97ba2bc539539f61b6d9fe5e14edace2a771460768ffc08ca6ab936bd t/40-bugs/rt86004.t SHA256 76771e2e067c7603d7d4c0361fca0203f6744b9cf4728a0384b05e29263c680b t/40-bugs/rt86233.t SHA256 9ab694024440a9071f9ed71e856dcdee9b87dfa0414dde5ba4204f0b6b99d1b1 t/40-bugs/rt86239.t SHA256 a398798d714765f4223e5c1d669b562c8f906706a65fb176390c36a5f0abdb98 t/40-bugs/rt90096-2.t SHA256 5f2ec00f961ea64300262fd40be30be898ca09c52ea312d1acccaf8895a27f08 t/40-bugs/rt90096.t SHA256 65c7030da70b6853f9cffb21f5c4030b2dd280830d270b8c62341e7272dc4bd3 t/40-bugs/rt92571-2.t SHA256 8d1265598410e35371893e32c5334367320183b1665cd98c2779ee416575fee5 t/40-bugs/rt92571.t SHA256 f7d40b802fb7ded3095564c1ffe9b5f38fa5220752525d6bfdb30bcf1d0d8098 t/40-bugs/rt92591.t SHA256 d4540120316773b27479ea63635dd94cf068a9b08821a9ce756624301c4bf1cc t/40-bugs/rt94196.t SHA256 86ad238b31a124248966364f5d81ad17478a1d5edc7d92c4c6adc0105caabf34 t/40-bugs/rt97684.t SHA256 2037be2bc1b0fdaa2b8314a4c877f58f802adc0b684507c2d435e478e9f0b818 t/40-bugs/rt98113.t SHA256 7f774117a10f4667b82ac38ef567096edc5661b27fc98e2b2de5a597d386624e t/40-bugs/ttxs-gh1.t SHA256 2c3a733f07579b90310756958d7a6c087cf6ec6146c442e6d8d58d3b9c30c6b0 t/98-param-eg-from-docs.t SHA256 e29dde3d8fba82e9abd21f40a0c8e6f154a8b49d7cb657b1445d8d6b00f024a1 t/99-moose-std-types-test.t SHA256 7f662474dac5012f3a5414d996071602da277818fdc5782fbc79bfa70e548dae t/README SHA256 3307fd8b49816324049167e0e9712dab10bd10450188d7b190d12a586df6f3af t/lib/BiggerLib.pm SHA256 f55bd05d028bb0dd2e0d45304c3f521c85d9be1e785b2c788be3d9698660f786 t/lib/CompiledLib.pm SHA256 cac541676d819f3b175018a5a598e6bc7486eb469dc74cf3adf79ffc8bdb2565 t/lib/DemoLib.pm SHA256 8a026265132a296da9a41a80ec89351c333ce68f783c7dea36705cf373406b00 t/lib/Type/Puny.pm SHA256 71046e18a4c100df05777738dbfadb138f833fb0d7be62f7694e7c4fba83978b t/mk-test-manifest.pl SHA256 db83383c188deec1e84187ef3d8aa13ad2333113d017466668a2a6c1c44d5960 t/not-covered.pl -----BEGIN PGP SIGNATURE----- iF0EAREDAB0WIQRVJKj/4+s6z4WzNujOv4Eoaip9OQUCaSdcoAAKCRDOv4Eoaip9 Obp+AJ4oH9H6DhDtg8xU3O2huGXyqiC5HwCgnUD8UdIQ+ZEdDgOIiqb153xINgo= =b7e3 -----END PGP SIGNATURE----- dist.ini000664001750001750 16215111656240 14036 0ustar00taitai000000000000Type-Tiny-2.008006;; class = 'Dist::Inkt::Profile::TOBYINK' ;; name = 'Type-Tiny' ;; source_for_readme = 'lib/Type/Tiny/Manual.pod' doap.ttl000664001750001750 137161715111656240 14163 0ustar00taitai000000000000Type-Tiny-2.008006@prefix cpan-uri: . @prefix dc: . @prefix doap: . @prefix doap-bugs: . @prefix doap-changeset: . @prefix doap-deps: . @prefix doap-tests: . @prefix foaf: . @prefix nfo: . @prefix rdfs: . @prefix xsd: . dc:title "the same terms as the perl 5 programming language system itself". a doap:Project; doap:developer ; doap:download-page ; doap:homepage ; doap:name "Acme-Types-NonStandard"; doap:programming-language "Perl". a doap:Project; doap:developer ; doap:download-page ; doap:homepage ; doap:name "List-Objects-Types"; doap:programming-language "Perl". a doap:Project; dc:contributor ; doap-bugs:issue , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap-deps:develop-recommendation [ doap-deps:on "Test::Memory::Cycle"^^doap-deps:CpanId; ]; doap-deps:develop-suggestion [ doap-deps:on "Dist::Inkt::Profile::TOBYINK"^^doap-deps:CpanId; rdfs:comment "This is used for building the release tarball."@en; ]; doap-deps:runtime-conflict [ doap-deps:on "Kavorka <= 0.013"^^doap-deps:CpanId; rdfs:comment "Theoretically broken by changes to parameterization of Dict to allow it to accept a slurpy."@en; ], [ doap-deps:on "Types::ReadOnly <= 0.001"^^doap-deps:CpanId; rdfs:comment "Theoretically broken by changes to parameterization of Dict to allow it to accept a slurpy."@en; ]; doap-deps:runtime-recommendation [ doap-deps:on "perl 5.010001"^^doap-deps:CpanId; rdfs:comment "For smartmatch operator overloading; and to avoid some pre-5.10 hacks."@en; ], [ doap-deps:on "Devel::StackTrace"^^doap-deps:CpanId; rdfs:comment "Type::Exception can use Devel::StackTrace for stack traces."@en; ], [ doap-deps:on "Devel::LexAlias 0.05"^^doap-deps:CpanId; rdfs:comment "Devel::LexAlias is useful for some Eval::TypeTiny features."@en; ], [ doap-deps:on "Type::Tiny::XS 0.025"^^doap-deps:CpanId; rdfs:comment "Makes a lot of stuff faster."@en; ], [ doap-deps:on "Ref::Util::XS 0.100"^^doap-deps:CpanId; rdfs:comment "Makes some stuff faster."@en; ], [ doap-deps:on "Regexp::Util 0.003"^^doap-deps:CpanId; rdfs:comment "Saner serialization of StrMatch type constraints."@en; ], [ doap-deps:on "Sub::Util"^^doap-deps:CpanId; rdfs:comment "This allows Type::Library to name subs nicely."@en; ], [ doap-deps:on "Class::XSAccessor 1.17"^^doap-deps:CpanId; rdfs:comment "Makes some stuff marginally faster."@en; ]; doap-deps:runtime-requirement [ doap-deps:on "perl 5.008001"^^doap-deps:CpanId ], [ doap-deps:on "Exporter::Tiny 1.006000"^^doap-deps:CpanId; rdfs:comment "This module was spun off from the Type-Tiny distribution."@en; ]; doap-deps:runtime-suggestion [ doap-deps:on "Moose 2.0000"^^doap-deps:CpanId; rdfs:comment "Type::Tiny works nicely with Moose."@en; ], [ doap-deps:on "Mouse 1.00"^^doap-deps:CpanId; rdfs:comment "Type::Tiny works nicely with Mouse."@en; ], [ doap-deps:on "Moo 1.006000"^^doap-deps:CpanId; rdfs:comment "Type::Tiny works nicely with Moo. Use Moo 1.006000 or above for best results."@en; ], [ doap-deps:on "Reply"^^doap-deps:CpanId; rdfs:comment "Type::Tiny bundles a plugin for Reply."@en; ]; doap-deps:test-recommendation [ doap-deps:on "Test::Warnings"^^doap-deps:CpanId; rdfs:comment "For testing Type::Utils."@en; ], [ doap-deps:on "Test::Deep"^^doap-deps:CpanId; rdfs:comment "For testing Type::Library."@en; ], [ doap-deps:on "Test::Tester 0.109"^^doap-deps:CpanId; rdfs:comment "For testing Test::TypeTiny."@en; ]; doap-deps:test-requirement [ doap-deps:on "Test::More 0.96"^^doap-deps:CpanId; rdfs:comment "I don't have the patience to maintain a test suite that runs on ancient versions of Test::More."@en; ]; doap-deps:test-suggestion [ doap-deps:on "Test::Memory::Cycle"^^doap-deps:CpanId; ]; doap:bug-database ; doap:category [ rdfs:label "Moo" ], [ rdfs:label "Argument Validation" ], [ rdfs:label "Argument Checking" ], [ rdfs:label "Validation" ], [ rdfs:label "Moose" ], [ rdfs:label "Mouse" ], [ rdfs:label "Type Constraint" ], [ rdfs:label "Type Coercion" ], [ rdfs:label "Type Library" ], [ rdfs:label "Schema" ], [ rdfs:label "Parameter Validation" ], [ rdfs:label "Parameter Checking" ]; doap:created "2013-03-23"^^xsd:date; doap:developer , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap:download-page ; doap:helper , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap:homepage , ; doap:license ; doap:maintainer ; doap:name "Type-Tiny"; doap:programming-language "Perl"; doap:release , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , , ; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "tiny, yet Moo(se)-compatible type constraint"; doap:tester ; foaf:page , , , , , , , , . a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Developer preview"; dc:identifier "Type-Tiny-0.000_01"^^xsd:string; dc:issued "2013-04-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_02"^^xsd:string; dc:issued "2013-04-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_03"^^xsd:string; dc:issued "2013-04-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_04"^^xsd:string; dc:issued "2013-04-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_05"^^xsd:string; dc:issued "2013-04-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_06"^^xsd:string; dc:issued "2013-04-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_07"^^xsd:string; dc:issued "2013-04-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_08"^^xsd:string; dc:issued "2013-04-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_09"^^xsd:string; dc:issued "2013-04-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_09"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_10"^^xsd:string; dc:issued "2013-04-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_10"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_11"^^xsd:string; dc:issued "2013-04-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_11"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.000_12"^^xsd:string; dc:issued "2013-04-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_12"^^xsd:string. a doap:Version; rdfs:label "First public release"; dc:identifier "Type-Tiny-0.001"^^xsd:string; dc:issued "2013-04-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.002"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_01"^^xsd:string; dc:issued "2013-04-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_02"^^xsd:string; dc:issued "2013-04-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_03"^^xsd:string; dc:issued "2013-04-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_04"^^xsd:string; dc:issued "2013-04-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_05"^^xsd:string; dc:issued "2013-04-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_06"^^xsd:string; dc:issued "2013-04-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_07"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_08"^^xsd:string; dc:issued "2013-04-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_09"^^xsd:string; dc:issued "2013-04-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_09"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_10"^^xsd:string; dc:issued "2013-04-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_10"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_11"^^xsd:string; dc:issued "2013-04-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_11"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_12"^^xsd:string; dc:issued "2013-05-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_12"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_13"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_13"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_14"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_14"^^xsd:string; rdfs:comment "No functional changes.". a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_15"^^xsd:string; dc:issued "2013-05-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_15"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.003_16"^^xsd:string; dc:issued "2013-05-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003_16"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.004"^^xsd:string; dc:issued "2013-05-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_01"^^xsd:string; dc:issued "2013-05-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_02"^^xsd:string; dc:issued "2013-05-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_03"^^xsd:string; dc:issued "2013-05-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_04"^^xsd:string; dc:issued "2013-05-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_05"^^xsd:string; dc:issued "2013-05-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_06"^^xsd:string; dc:issued "2013-05-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_07"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.005_08"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005_08"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.006"^^xsd:string; dc:issued "2013-05-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Happy birthday to me..."; dc:identifier "Type-Tiny-0.007_01"^^xsd:string; dc:issued "2013-06-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_02"^^xsd:string; dc:issued "2013-06-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_03"^^xsd:string; dc:issued "2013-06-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_04"^^xsd:string; dc:issued "2013-06-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_05"^^xsd:string; dc:issued "2013-06-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_06"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_07"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_08"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_09"^^xsd:string; dc:issued "2013-06-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_09"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.007_10"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007_10"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.008"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_01"^^xsd:string; dc:issued "2013-06-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_02"^^xsd:string; dc:issued "2013-06-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_03"^^xsd:string; dc:issued "2013-06-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_04"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_05"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_06"^^xsd:string; dc:issued "2013-06-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.009_07"^^xsd:string; dc:issued "2013-06-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.009_07"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.010"^^xsd:string; dc:issued "2013-06-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.011_01"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.011_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.011_02"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.011_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.011_03"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.011_03"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.012"^^xsd:string; dc:issued "2013-06-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.012"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.013_01"^^xsd:string; dc:issued "2013-06-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.013_01"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.014"^^xsd:string; dc:issued "2013-06-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.014"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.015_01"^^xsd:string; dc:issued "2013-07-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.015_02"^^xsd:string; dc:issued "2013-07-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.015_03"^^xsd:string; dc:issued "2013-07-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.015_04"^^xsd:string; dc:issued "2013-07-13"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.015_05"^^xsd:string; dc:issued "2013-07-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.015_05"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.016"^^xsd:string; dc:issued "2013-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.016"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.017_01"^^xsd:string; dc:issued "2013-07-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.017_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.017_02"^^xsd:string; dc:issued "2013-07-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.017_02"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.018"^^xsd:string; dc:issued "2013-07-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.018"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.019_01"^^xsd:string; dc:issued "2013-07-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.019_01"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.020"^^xsd:string; dc:issued "2013-07-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.020"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.021_01"^^xsd:string; dc:issued "2013-07-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.021_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.021_02"^^xsd:string; dc:issued "2013-07-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.021_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.021_03"^^xsd:string; dc:issued "2013-07-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.021_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.021_04"^^xsd:string; dc:issued "2013-07-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.021_04"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.022"^^xsd:string; dc:issued "2013-08-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.022"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.023_01"^^xsd:string; dc:issued "2013-08-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.023_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.023_02"^^xsd:string; dc:issued "2013-08-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.023_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.023_03"^^xsd:string; dc:issued "2013-08-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.023_03"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.024"^^xsd:string; dc:issued "2013-08-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.024"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.025_01"^^xsd:string; dc:issued "2013-09-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.025_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.025_02"^^xsd:string; dc:issued "2013-09-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.025_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.025_03"^^xsd:string; dc:issued "2013-09-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.025_03"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.026"^^xsd:string; dc:issued "2013-09-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.026"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_01"^^xsd:string; dc:issued "2013-09-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_02"^^xsd:string; dc:issued "2013-09-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_03"^^xsd:string; dc:issued "2013-09-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_04"^^xsd:string; dc:issued "2013-09-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_05"^^xsd:string; dc:issued "2013-09-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_06"^^xsd:string; dc:issued "2013-09-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_07"^^xsd:string; dc:issued "2013-09-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_08"^^xsd:string; dc:issued "2013-09-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.027_09"^^xsd:string; dc:issued "2013-09-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.027_09"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.028"^^xsd:string; dc:issued "2013-09-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.028"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.029_01"^^xsd:string; dc:issued "2013-09-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.029_02"^^xsd:string; dc:issued "2013-10-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.029_03"^^xsd:string; dc:issued "2013-10-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.029_04"^^xsd:string; dc:issued "2013-10-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.029_04"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.030"^^xsd:string; dc:issued "2013-10-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.030"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.031_01"^^xsd:string; dc:issued "2013-10-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.031_02"^^xsd:string; dc:issued "2013-11-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.031_03"^^xsd:string; dc:issued "2013-11-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.031_04"^^xsd:string; dc:issued "2013-11-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.031_05"^^xsd:string; dc:issued "2013-11-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.031_05"^^xsd:string. a doap:Version; rdfs:label "Remember, remember the fifth of November"; dc:identifier "Type-Tiny-0.032"^^xsd:string; dc:issued "2013-11-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.032"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.033_01"^^xsd:string; dc:issued "2013-11-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.033_02"^^xsd:string; dc:issued "2013-11-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.033_03"^^xsd:string; dc:issued "2013-11-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.033_04"^^xsd:string; dc:issued "2013-12-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.033_04"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.034"^^xsd:string; dc:issued "2013-12-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.034"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.035_01"^^xsd:string; dc:issued "2013-12-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.035_01"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.036"^^xsd:string; dc:issued "2013-12-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.036"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.037_01"^^xsd:string; dc:issued "2013-12-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.037_02"^^xsd:string; dc:issued "2013-12-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.037_03"^^xsd:string; dc:issued "2013-12-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.037_03"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.038"^^xsd:string; dc:issued "2014-01-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.038"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_01"^^xsd:string; dc:issued "2014-01-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_02"^^xsd:string; dc:issued "2014-01-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_03"^^xsd:string; dc:issued "2014-02-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_04"^^xsd:string; dc:issued "2014-02-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_05"^^xsd:string; dc:issued "2014-02-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_06"^^xsd:string; dc:issued "2014-02-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_07"^^xsd:string; dc:issued "2014-02-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_08"^^xsd:string; dc:issued "2014-02-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_09"^^xsd:string; dc:issued "2014-02-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_09"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_10"^^xsd:string; dc:issued "2014-03-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_10"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_11"^^xsd:string; dc:issued "2014-03-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_11"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_12"^^xsd:string; dc:issued "2014-03-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_12"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.039_13"^^xsd:string; dc:issued "2014-03-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.039_13"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.040"^^xsd:string; dc:issued "2014-03-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.040"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.041_01"^^xsd:string; dc:issued "2014-03-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.041_02"^^xsd:string; dc:issued "2014-03-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.041_03"^^xsd:string; dc:issued "2014-03-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.041_04"^^xsd:string; dc:issued "2014-03-31"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.041_04"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.042"^^xsd:string; dc:issued "2014-04-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.042"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.043_01"^^xsd:string; dc:issued "2014-04-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.043_02"^^xsd:string; dc:issued "2014-04-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.043_03"^^xsd:string; dc:issued "2014-05-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.043_04"^^xsd:string; dc:issued "2014-05-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.043_05"^^xsd:string; dc:issued "2014-05-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.043_05"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.044"^^xsd:string; dc:issued "2014-06-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.044"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.045_01"^^xsd:string; dc:issued "2014-06-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.045_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.045_02"^^xsd:string; dc:issued "2014-07-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.045_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.045_03"^^xsd:string; dc:issued "2014-07-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.045_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.045_04"^^xsd:string; dc:issued "2014-07-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.045_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.045_05"^^xsd:string; dc:issued "2014-07-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.045_05"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-0.046"^^xsd:string; dc:issued "2014-07-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.046"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "The 87% Coverage Release"; dc:identifier "Type-Tiny-0.047_01"^^xsd:string; dc:issued "2014-07-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "The 92% Coverage Release"; dc:identifier "Type-Tiny-0.047_02"^^xsd:string; dc:issued "2014-07-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_02"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "The 96% Coverage Release"; dc:identifier "Type-Tiny-0.047_03"^^xsd:string; dc:issued "2014-07-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_03"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "The 98% Coverage Release"; dc:identifier "Type-Tiny-0.047_04"^^xsd:string; dc:issued "2014-07-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_04"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Sanity++"; dc:identifier "Type-Tiny-0.047_05"^^xsd:string; dc:issued "2014-07-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_05"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "What made the Queen go all ice crazy?"; dc:identifier "Type-Tiny-0.047_06"^^xsd:string; dc:issued "2014-07-31"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_06"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.047_07"^^xsd:string; dc:issued "2014-08-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_07"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Sanity++"; dc:identifier "Type-Tiny-0.047_08"^^xsd:string; dc:issued "2014-08-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_08"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-0.047_09"^^xsd:string; dc:issued "2014-08-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.047_09"^^xsd:string. a doap:Version; rdfs:label "Happy CPAN Day!"; dc:identifier "Type-Tiny-1.000000"^^xsd:string; dc:issued "2014-08-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000001"^^xsd:string; dc:issued "2014-08-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000002"^^xsd:string; dc:issued "2014-08-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000003"^^xsd:string; dc:issued "2014-08-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000004"^^xsd:string; dc:issued "2014-09-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000005"^^xsd:string; dc:issued "2014-10-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000005"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.000006"^^xsd:string; dc:issued "2017-01-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.000006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_000"^^xsd:string; dc:issued "2014-09-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_001"^^xsd:string; dc:issued "2014-09-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_002"^^xsd:string; dc:issued "2014-10-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_003"^^xsd:string; dc:issued "2017-02-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_004"^^xsd:string; dc:issued "2017-02-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_005"^^xsd:string; dc:issued "2017-04-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_006"^^xsd:string; dc:issued "2017-04-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "May the fourth be with you"; dc:identifier "Type-Tiny-1.001_007"^^xsd:string; dc:issued "2017-05-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_008"^^xsd:string; dc:issued "2017-05-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_009"^^xsd:string; dc:issued "2017-05-13"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Puppiversary"; dc:identifier "Type-Tiny-1.001_010"^^xsd:string; dc:issued "2017-05-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_011"^^xsd:string; dc:issued "2017-05-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_011"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_012"^^xsd:string; dc:issued "2017-05-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_012"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Kittiversary"; dc:identifier "Type-Tiny-1.001_013"^^xsd:string; dc:issued "2017-05-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_013"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_014"^^xsd:string; dc:issued "2017-05-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_014"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_015"^^xsd:string; dc:issued "2017-05-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_015"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.001_016"^^xsd:string; dc:issued "2017-05-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.001_016"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.002000"^^xsd:string; dc:issued "2017-06-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.002000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.002001"^^xsd:string; dc:issued "2017-06-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.002001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_000"^^xsd:string; dc:issued "2018-05-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_001"^^xsd:string; dc:issued "2018-05-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_002"^^xsd:string; dc:issued "2018-05-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_003"^^xsd:string; dc:issued "2018-06-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_004"^^xsd:string; dc:issued "2018-06-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_005"^^xsd:string; dc:issued "2018-07-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_006"^^xsd:string; dc:issued "2018-07-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_007"^^xsd:string; dc:issued "2018-07-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_008"^^xsd:string; dc:issued "2018-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_009"^^xsd:string; dc:issued "2018-07-24"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.003_010"^^xsd:string; dc:issued "2018-07-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.003_010"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.004000"^^xsd:string; dc:issued "2018-07-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.004001"^^xsd:string; dc:issued "2018-07-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.004002"^^xsd:string; dc:issued "2018-07-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.004003"^^xsd:string; dc:issued "2019-01-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.004004"^^xsd:string; dc:issued "2019-01-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.004004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.005_000"^^xsd:string; dc:issued "2019-01-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.005_001"^^xsd:string; dc:issued "2019-01-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.005_002"^^xsd:string; dc:issued "2019-01-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.005_003"^^xsd:string; dc:issued "2019-02-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.005_004"^^xsd:string; dc:issued "2019-11-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.005_004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.006000"^^xsd:string; dc:issued "2019-11-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.006000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_000"^^xsd:string; dc:issued "2019-11-17"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_001"^^xsd:string; dc:issued "2019-11-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_002"^^xsd:string; dc:issued "2019-11-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_003"^^xsd:string; dc:issued "2019-11-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_004"^^xsd:string; dc:issued "2019-11-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_005"^^xsd:string; dc:issued "2019-12-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_006"^^xsd:string; dc:issued "2019-12-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_007"^^xsd:string; dc:issued "2019-12-03"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_008"^^xsd:string; dc:issued "2019-12-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_009"^^xsd:string; dc:issued "2019-12-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_010"^^xsd:string; dc:issued "2019-12-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_011"^^xsd:string; dc:issued "2019-12-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_011"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_012"^^xsd:string; dc:issued "2019-12-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_012"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_013"^^xsd:string; dc:issued "2019-12-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_013"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_014"^^xsd:string; dc:issued "2019-12-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_014"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.007_015"^^xsd:string; dc:issued "2019-12-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.007_015"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008000"^^xsd:string; dc:issued "2019-12-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008001"^^xsd:string; dc:issued "2019-12-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008002"^^xsd:string; dc:issued "2020-01-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008003"^^xsd:string; dc:issued "2020-01-13"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008004"^^xsd:string; dc:issued "2020-01-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.008005"^^xsd:string; dc:issued "2020-01-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.008005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.009_000"^^xsd:string; dc:issued "2020-02-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.009_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.009_001"^^xsd:string; dc:issued "2020-02-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.009_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.009_002"^^xsd:string; dc:issued "2020-02-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.009_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.009_003"^^xsd:string; dc:issued "2020-02-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.009_003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.010000"^^xsd:string; dc:issued "2020-02-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.010001"^^xsd:string; dc:issued "2020-03-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010001"^^xsd:string. a doap:Version; rdfs:label "Mayday"; dc:identifier "Type-Tiny-1.010002"^^xsd:string; dc:issued "2020-05-01"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010002"^^xsd:string. a doap:Version; rdfs:label "The Crazy 88"; dc:identifier "Type-Tiny-1.010003"^^xsd:string; dc:issued "2020-08-08"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.010004"^^xsd:string; dc:issued "2020-08-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.010005"^^xsd:string; dc:issued "2020-08-26"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010005"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.010006"^^xsd:string; dc:issued "2020-09-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.010006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_000"^^xsd:string; dc:issued "2020-09-15"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_001"^^xsd:string; dc:issued "2020-09-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_002"^^xsd:string; dc:issued "2020-09-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_003"^^xsd:string; dc:issued "2020-09-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_004"^^xsd:string; dc:issued "2020-09-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_005"^^xsd:string; dc:issued "2020-09-30"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_006"^^xsd:string; dc:issued "2020-10-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_007"^^xsd:string; dc:issued "2020-10-06"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_008"^^xsd:string; dc:issued "2020-10-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_009"^^xsd:string; dc:issued "2020-10-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_010"^^xsd:string; dc:issued "2020-10-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.011_011"^^xsd:string; dc:issued "2020-10-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.011_011"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012000"^^xsd:string; dc:issued "2020-10-28"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012001"^^xsd:string; dc:issued "2021-01-10"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012002"^^xsd:string; dc:issued "2021-05-02"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012003"^^xsd:string; dc:issued "2021-05-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012004"^^xsd:string; dc:issued "2021-07-29"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.012005"^^xsd:string; dc:issued "2022-06-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.012005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.013_000"^^xsd:string; dc:issued "2022-06-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.013_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.013_001"^^xsd:string; dc:issued "2022-06-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.013_001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.014000"^^xsd:string; dc:issued "2022-06-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.014000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.015_000"^^xsd:string; dc:issued "2022-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.015_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.015_001"^^xsd:string; dc:issued "2022-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.015_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.015_002"^^xsd:string; dc:issued "2022-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.015_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-1.015_003"^^xsd:string; dc:issued "2022-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.015_003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016000"^^xsd:string; dc:issued "2022-07-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016001"^^xsd:string; dc:issued "2022-07-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016002"^^xsd:string; dc:issued "2022-07-19"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016003"^^xsd:string; dc:issued "2022-07-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016004"^^xsd:string; dc:issued "2022-07-22"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016005"^^xsd:string; dc:issued "2022-07-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016005"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016006"^^xsd:string; dc:issued "2022-07-25"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016006"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016007"^^xsd:string; dc:issued "2022-08-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016007"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016008"^^xsd:string; dc:issued "2022-08-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016008"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016009"^^xsd:string; dc:issued "2022-08-27"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016009"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-1.016010"^^xsd:string; dc:issued "2022-08-31"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.016010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview A"; dc:identifier "Type-Tiny-1.999_000"^^xsd:string; dc:issued "2022-09-04"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview B"; dc:identifier "Type-Tiny-1.999_001"^^xsd:string; dc:issued "2022-09-05"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview C"; dc:identifier "Type-Tiny-1.999_002"^^xsd:string; dc:issued "2022-09-07"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview D"; dc:identifier "Type-Tiny-1.999_003"^^xsd:string; dc:issued "2022-09-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview E"; dc:identifier "Type-Tiny-1.999_004"^^xsd:string; dc:issued "2022-09-09"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview F"; dc:identifier "Type-Tiny-1.999_005"^^xsd:string; dc:issued "2022-09-11"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview G"; dc:identifier "Type-Tiny-1.999_006"^^xsd:string; dc:issued "2022-09-12"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview H"; dc:identifier "Type-Tiny-1.999_007"^^xsd:string; dc:issued "2022-09-13"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview I"; dc:identifier "Type-Tiny-1.999_008"^^xsd:string; dc:issued "2022-09-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview J"; dc:identifier "Type-Tiny-1.999_009"^^xsd:string; dc:issued "2022-09-16"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview K"; dc:identifier "Type-Tiny-1.999_010"^^xsd:string; dc:issued "2022-09-18"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_010"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview L"; dc:identifier "Type-Tiny-1.999_011"^^xsd:string; dc:issued "2022-09-20"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_011"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview M"; dc:identifier "Type-Tiny-1.999_012"^^xsd:string; dc:issued "2022-09-21"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_012"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Type::Tiny 2.0 Preview N"; dc:identifier "Type-Tiny-1.999_013"^^xsd:string; dc:issued "2022-09-23"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "1.999_013"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.000000"^^xsd:string; dc:issued "2022-09-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage Type-Tiny 1.999_013 as a stable release."; ], [ a doap-changeset:Tests; rdfs:label "Minor fix for Class::Plain-related tests."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.000000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.000001"^^xsd:string; dc:issued "2022-09-29"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Clearer documentation of Types::TypeTiny::to_TypeTiny."; ], [ a doap-changeset:Tests; rdfs:label "No longer report Type::Tie version at start of test suite, as Type::Tie is now bundled."; ], [ a doap-changeset:Bugfix; rdfs:label "Avoid uninitialized warnings when creating a union between an Enum type and a non-Enum type."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.000001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.001_000"^^xsd:string; dc:issued "2022-09-29"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Avoid uninitialized warnings when creating a union between an Enum type and a non-Enum type."; doap-changeset:fixes ; doap-changeset:thanks ; ], [ a doap-changeset:Addition; rdfs:label "Type::Library now has an undocumented, but tested and hopefully stable `_remove_type` method."; ], [ a doap-changeset:Change; rdfs:label "Type::Tiny will now mark particular parts of its guts as readonly. Currently this is mainly used to prevent people pushing to and popping from type constraints which overload `@{}`."; ], [ a doap-changeset:Change; rdfs:label "The list of packages Type::Tiny considers to be 'internal' has been moved from Error::TypeTiny to Type::Tiny."; ], [ a doap-changeset:Addition; rdfs:label "Type::Tiny now has a `definition_context` attribute/method indicating the file and line number where a type constraint was first defined."; ], [ a doap-changeset:Documentation; rdfs:label "Clearer documentation of Types::TypeTiny::to_TypeTiny."; ], [ a doap-changeset:Tests; rdfs:label "No longer report Type::Tie version at start of test suite, as Type::Tie is now bundled."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.001_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.001_001"^^xsd:string; dc:issued "2022-10-19"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Type::Tiny::XS will now provide XS implementations of some parameterized ArrayLike/HashLike types."; ], [ a doap-changeset:Change; rdfs:label "Type::Library will better detect if two types result in functions with the same name."; ], [ a doap-changeset:Change; rdfs:label "When importing `use Type::Library -util`, Type::Library will now pass some relevant import options to Type::Utils."; ], [ a doap-changeset:Documentation; rdfs:label "Typo fix in Type::Tiny::Manual::UsingWithMoo."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.001_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.001_002"^^xsd:string; dc:issued "2022-12-03"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Type::Params no longer attempts to figure out the maximum number of expected arguments to functions which take key-value pairs. This allows `yourfunc(y=>1,y=>2)` to behave more intuitively, with the function just seeing the second value for `y`, instead of it throwing an exception complaining about too many arguments."; ], [ a doap-changeset:Change; rdfs:label "If Type::Params signatures receive multiple unrecognized named arguments, the error message now lists them using Type::Utils::english_list() instead of just joining them with commas. This means that the error message will include 'and' before the last unrecognized named argument. If Type::Tiny::AvoidCallbacks is set to true while the signature is compiled, the old behaviour will be retained."; ], [ a doap-changeset:Tests; rdfs:label "Test `t/20-modules/Type-Tiny-Enum/exporter_lexical.t` will now run on older versions of Perl, provided Lexical::Sub is installed."; ], [ a doap-changeset:Packaging; rdfs:label "Depend on Exporter::Tiny 1.006000 which offers lexical export support for older versions of Perl, provided Lexical::Sub is installed."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.001_002"^^xsd:string. a doap:Version; rdfs:label "Happy Fibonacci Day! 1/1/23"; dc:identifier "Type-Tiny-2.002000"^^xsd:string; dc:issued "2023-01-01"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as stable."; ], [ a doap-changeset:Documentation; rdfs:label "Update NEWS."; ], [ a doap-changeset:Documentation; rdfs:label "Update copyright dates to 2023."; ], [ a doap-changeset:Bugfix; rdfs:label "When Foo is a parameterized StrMatch type, ensure is_Foo always returns a single boolean value, even in list context."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.002000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.002001"^^xsd:string; dc:issued "2023-01-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Bugfix for Type::Tie+Storable issue affecting 32-bit builds of Perl."; doap-changeset:fixes ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.002001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.003_000"^^xsd:string; dc:issued "2023-04-02"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Class."; ], [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Duck."; ], [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Enum."; ], [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Intersection."; ], [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Role."; ], [ a doap-changeset:Documentation; rdfs:label "Add SYNOPSIS for Type::Tiny::Union."; ], [ a doap-changeset:Documentation, doap-changeset:Tests; rdfs:label "Add documentation and tests for the combination of the `goto_next` and `multiple` options when used with `signature_for`."; ], [ a doap-changeset:Documentation; rdfs:label "Add example of `signature_for` applying a signature to multiple functions at once."; ], [ a doap-changeset:Documentation; rdfs:label "Document changes to `make_immutable` in Type::Library v2.x."; rdfs:seeAlso ; ], [ a doap-changeset:Addition; rdfs:label "Type::Tiny::Bitfield class."; rdfs:seeAlso ; ], [ a doap-changeset:Addition; rdfs:label "Types::TypeTiny::BoolLike type constraint."; rdfs:seeAlso ; ], [ a doap-changeset:Addition; rdfs:label "Type::Tiny now has an `exception_class` attribute, allowing a type to throw exceptions using a custom class. These classes should usually be a subclass of Error::TypeTiny::Assertion."; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.003_000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.004000"^^xsd:string; dc:issued "2023-04-05"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor pod changes to Types::Standard."; ], [ a doap-changeset:Documentation; rdfs:label "Document that the `BoolLike` type is unstable."; ], [ a doap-changeset:Packaging; rdfs:label "Summarized the change log for versions prior to Type::Tiny 2.000000. If you need more information, see the Changes file included with Type::Tiny 2.002001."; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.004000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.005_001"^^xsd:string; dc:issued "2024-09-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Improve documentation for the initialization of the `coercion` attribute for `Type::Tiny`."; doap-changeset:fixes ; doap-changeset:thanks ; ], [ a doap-changeset:Update; rdfs:label "Smartmatch discontinued beginning perl-5.41.3; Type::Tiny will no longer attempt to support smartmatch if the Perl version is too high."; doap-changeset:fixes ; doap-changeset:thanks ; rdfs:seeAlso ; ], [ a doap-changeset:Documentation; rdfs:label "Fixes for various typos."; doap-changeset:thanks ; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.005_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.005_002"^^xsd:string; dc:issued "2024-09-08"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Improved initialization of variables when they are tied to a type constraint; initialization to explicit values will work even when not tied via the `ttie` wrapper function; if no explicit values are provided, tied scalars will be initialized to the type's `type_default`. So for example, `tie( my $title, Str )` will initialize `$title` to the empty string instead of undef, and `tie( my $title, Str, 'Foo' )` will initialize the variable to 'Foo' as was already implied by documentation."; doap-changeset:fixes , ; doap-changeset:thanks , ; ], [ a doap-changeset:Change; rdfs:label "Inlining `Int` now calls the XS implementation when available. (The speed improvement is negligible, but it also may result in small memory savings.)"; doap-changeset:blame ; rdfs:seeAlso ; ], [ a doap-changeset:Documentation; rdfs:label "Fix minor typo in documentation for named parameters in `Type::Params`."; ], [ a doap-changeset:Bugfix; rdfs:label "Fix uninitialized warning messages from Error::TypeTiny when processing very shallow stack traces."; doap-changeset:fixes ; doap-changeset:thanks ; ], [ a doap-changeset:Removal; rdfs:label "Support for the ${^TYPE_PARAMS_MULTISIG} global variable has been dropped. Using this global variable was deprecated in trial version 1.999_010 and stable version 2.000000, both of which are nearly two years old. Use ${^_TYPE_PARAMS_MULTISIG} instead."; ], [ a doap-changeset:Documentation, doap-changeset:Update; rdfs:label "Update copyright notices in files to 2024."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.005_002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.006000"^^xsd:string; dc:issued "2024-09-24"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackage as stable. (See also the changelog for 2.005_001 and 2.005_002.)"; ], [ a doap-changeset:Documentation; rdfs:label "Update NEWS."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.006000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_000"^^xsd:string; dc:issued "2024-10-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "The `signature_for` function in Type::Params now returns a value, though in most contexts you'll probably want to call it in void context anyway."; ], [ a doap-changeset:Addition; rdfs:label "The `signature_for` function in Type::Params now includes most of the functionality of Return::Type (a separate CPAN distribution not bundled with Type::Tiny)."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_000"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_001"^^xsd:string; dc:issued "2024-11-24"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "If Perl has been built with -Dusequadmath then cowardly refuse to use Type::Tiny::XS's implementation of is_Int."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_001"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_002"^^xsd:string; dc:issued "2024-12-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Update most examples to use features (postfix derefs, sub signatures) from more modern versions of Perl that allow for cleaner, tidier code."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_002"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_003"^^xsd:string; dc:issued "2025-03-06"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor pod fixed and improvements."; ], [ a doap-changeset:Documentation; rdfs:label "Update copyright dates to 2025."; ], [ a doap-changeset:Addition; rdfs:label "New Type::Params feature allow_dash automatically supports `-foo` as an alias for `foo`."; ], [ a doap-changeset:Addition; rdfs:label "New Type::Params feature list_to_named automatically extracts named parameters from a list of positional arguments."; ], [ a doap-changeset:Addition; rdfs:label "Type::Params optionally exports two shortcut keywords: `signature_for_func` and `signature_for_method`. The exact behaviour of these may change in the future."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_003"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_004"^^xsd:string; dc:issued "2025-03-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Major rewrite of `Type::Params` documentation to prioritize `signature_for` and modern Perl, and some corresponding adjustments to `Type::Tiny::Manual`."; ], [ a doap-changeset:Bugfix; rdfs:label "Use `List::Util::sum` instead of `List::Util::sum0` which doesn't exist in some older versions of List::Util. Fixes bug introduced in 2.007_003."; ], [ a doap-changeset:Bugfix; rdfs:label "Avoid the `//` operator in `Type::Params::Parameter` as it isn't supported in Perl 5.8. Fixes bug introduced in 2.007_003."; ], [ a doap-changeset:Change; rdfs:label "The `goto_next` option in `Type::Params` is now just called `next`. The original name is still supported for backwards compatibility."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_004"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_005"^^xsd:string; dc:issued "2025-03-07"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Minor fixes and improvements for `Type::Params` documentation."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_005"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_006"^^xsd:string; dc:issued "2025-03-14"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Types::TypeTiny::BoolLike now accepts boolean.pm's bools."; doap-changeset:fixes ; doap-changeset:thanks ; ], [ a doap-changeset:Change; rdfs:label "Type::Params named_to_list option now accepts blessed boolean objects. Certain other options should be more permissive accepting them too."; doap-changeset:fixes ; doap-changeset:thanks ; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::Dict::combine() function."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_006"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_007"^^xsd:string; dc:issued "2025-03-18"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Localize $@ before stringifying Error::TypeTiny objects."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_007"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_008"^^xsd:string; dc:issued "2025-03-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Use Perl's new `try` feature instead of Try::Tiny in SYNOPSIS for Error::TypeTiny."; ], [ a doap-changeset:Addition; rdfs:label "Error::TypeTiny::WrongNumberOfParameters now has a `target` attribute indicating what thing you provided the wrong number of parameters for."; ], [ a doap-changeset:Change; rdfs:label "Parameterizable types defined by Types::Standard, Types::Common::String, Types::Common::Numeric, and Type::Params will throw an Error::TypeTiny::WrongNumberOfParameters exception if parameterized with the wrong number of parameters."; ], [ a doap-changeset:Addition; rdfs:label "There's now a Type::Tiny::check_parameter_count_for_parameterized_type utility function intended to be used for parameterizable types to throw an error when parameterized with the wrong number of parameters."; ], [ a doap-changeset:Tests; rdfs:label "Improved tests for the `ArgsObject` type constraint which is optionally exported by Type::Params."; ], [ a doap-changeset:Tests; rdfs:label "Improved tests for the `goto_next` feature of Type::Params."; ], [ a doap-changeset:Bugfix; rdfs:label "Expressing return types for Type::Params as strings now works as documented."; ], [ a doap-changeset:Change; rdfs:label "Passing unknown options to Type::Params functions will now result in warnings."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_008"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_009"^^xsd:string; dc:issued "2025-03-21"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Type::Params now has a per-parameter `default_on_undef` option."; ], [ a doap-changeset:Bugfix; rdfs:label "Warnings for unknown Type::Params signature options introduced in 2.007_008 broke Mite, which passes it a `mite_signature` option and checks no warnings are thrown in its test suite. That option is now silently allowed, even though Type::Params makes no use of it."; rdfs:seeAlso ; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::ArrayRef can now export shortcuts for parameterized versions of the ArrayRef type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::HashRef can now export shortcuts for parameterized versions of the HashRef type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::ScalarRef can now export shortcuts for parameterized versions of the ScalarRef type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::StrMatch can now export shortcuts for parameterized versions of the StrMatch type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::Map can now export shortcuts for parameterized versions of the Map type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::Dict can now export shortcuts for parameterized versions of the Dict type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::Tuple can now export shortcuts for parameterized versions of the Tuple type constraint."; ], [ a doap-changeset:Addition; rdfs:label "Types::Standard::CycleTuple can now export shortcuts for parameterized versions of the CycleTuple type constraint."; ], [ a doap-changeset:Documentation; rdfs:label "Fix documentation for the coercion_generator attribute of Type::Tiny."; ], [ a doap-changeset:Addition; rdfs:label "When creating 'multi' signatures with Type::Params, the different alternatives can now be given a string identifier."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_009"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "Type-Tiny-2.007_010"^^xsd:string; dc:issued "2025-03-23"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "Warnings for unknown Type::Params signature options introduced in 2.007_008 broke Mite, which passes it a `is_wrapper` option and checks no warnings are thrown in its test suite. That option is now silently allowed, even though Type::Params makes no use of it."; rdfs:seeAlso ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.007_010"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008000"^^xsd:string; dc:issued "2025-03-31"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Packaging; rdfs:label "Repackaged with a stable version number."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008000"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008001"^^xsd:string; dc:issued "2025-04-15"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "The Optional type constraint on its own, will now be treated the same as Optional[Any]. Previously when used for named parameters, it would fail to generate predicate methods."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008001"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008002"^^xsd:string; dc:issued "2025-04-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Bugfix; rdfs:label "MooseX-Types 0.51 broke Type::Tiny's ability to reliably detect if Moose types were being used. This release fixes that."; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008002"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008003"^^xsd:string; dc:issued "2025-09-02"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "When dumping structures via Data::Dumper (mostly in error messages) suppress any warnings Data::Dumper would emit."; doap-changeset:blame ; ], [ a doap-changeset:Change; rdfs:label "Slightly streamlined `Type::Tiny::can` and `Type::Tiny::AUTOLOAD`."; ], [ a doap-changeset:Bugfix; rdfs:label "Make sure methods fake-inherited from Moose (if it's loaded) are a last resort."; doap-changeset:fixes ; doap-changeset:thanks ; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008003"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008004"^^xsd:string; dc:issued "2025-10-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Type::Tiny::Duck (used by HasMethods) now includes a new_intersection constructor."; ], [ a doap-changeset:Documentation; rdfs:label "Type::Tiny pod syntax fix."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008004"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008005"^^xsd:string; dc:issued "2025-11-20"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Minor optimization for Type::Params: sometimes it would construct an arrayref of hashref from the slurpy arguments to a function and then check that they arrayref it created was an arrayref, or check the hashref it created was a hashref. Those checks seem unnecessary; if they had ever failed it would indicate something deeply wrong with Perl itself. These superfluous checks are now avoided."; ], [ a doap-changeset:Change; rdfs:label "Minor optimization for Type::Params: sometimes it would wrap a `goto` in a `do` block for no reason. That could potentially slow down the call as Perl might create a new lexical context unnecessarily. It is unlikely to make a measurable difference."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008005"^^xsd:string. a doap:Version; dc:identifier "Type-Tiny-2.008006"^^xsd:string; dc:issued "2025-11-26"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Minor optimization for non-XS type check code for Enum types: if there are only a small number of valid strings (five or under), check using `eq` and `or` operators instead of compiling a regexp to check against them all at once. This can be controlled by passing the `use_eq` attribute to the Type::Tiny::Enum constructor, but is otherwise automatic."; ]; doap-changeset:versus ; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "2.008006"^^xsd:string. a foaf:Agent; foaf:mbox_sha1sum "cbd91ef3fd54c52cae34a5aaaed67dbf2da2b222". a foaf:Agent; foaf:mbox_sha1sum "2df4a653a57f2b27e8de55ebc0376974cdd60687". a foaf:Agent; foaf:mbox_sha1sum "860965460650325643501bf4e96aae390839b15d". a foaf:Agent; foaf:mbox_sha1sum "6c23833ac4a0b3ff955b4bc44976286eb1b15406". a foaf:Agent; foaf:mbox_sha1sum "e33976c4f7181cf955bd615e23814efb48545a3b". a foaf:Agent; foaf:mbox_sha1sum "fccaf03a90fdc927c8fcb3f0f8d4f5969c827b77". a foaf:Agent; foaf:mbox_sha1sum "943afe1e2148176ac8ba1c73bf2973580ad5b430". a foaf:Agent; foaf:mbox_sha1sum "eed2e225c2bb8a6b16179ac7dda75c6c59944cb0". a foaf:Agent; foaf:mbox_sha1sum "81750d13fe3e08dcbab06cebd34a9fe4fabd946f". a foaf:Agent; foaf:mbox_sha1sum "e6fb72dd0e31375b4c8626469a9a4ae195a6969e". a foaf:Agent; foaf:mbox_sha1sum "955e33f1b3b76c38043d3cb7d726fb4a93abf72a". a foaf:Agent; foaf:mbox_sha1sum "7699492dc595c10d65b72468627cb6bd0cd6536f". a foaf:Agent; foaf:mbox_sha1sum "3f7f4bf84805bce44de4b3046c7b92968e58348a". a foaf:Agent; foaf:mbox_sha1sum "00f47fd749128f7a4b60b9a9266a3f7dfd3d5f8e". a foaf:Agent; foaf:mbox_sha1sum "726bf25858db97a4640f0eb479d341e3c13c69fe". a foaf:Agent; foaf:mbox_sha1sum "68bb6d7424e2fe1bb9612197430db87f84a8b6d7". a foaf:Agent; foaf:mbox_sha1sum "a3bb054f532b528948e94b81574f172b9eaca03c". a foaf:Agent; foaf:mbox_sha1sum "339d855871c015a11cff4d97513ab012ecccb2ea". a foaf:Agent; foaf:mbox_sha1sum "ea2515cb691aed3a376aaff9e3272a81a0f17c5f". a foaf:Agent; foaf:mbox_sha1sum "0a6ed89ab18aed06a0df071c64be174e13fde53c". a foaf:Agent; foaf:mbox_sha1sum "01353d2d1cc7cb31f847fdc07ff0dee7024b34c9". a foaf:Agent; foaf:mbox_sha1sum "838ce7bd78e69a1fac0a1e0f8f55bad9c324099a". a foaf:Agent; foaf:mbox_sha1sum "f30f17582ef9f59c6d0070b7624ea8062ef3f1ce". a foaf:Agent; foaf:mbox_sha1sum "5cfb9529eb9d18c8083a378c2697245ba8f2ee65". a foaf:Agent; foaf:mbox_sha1sum "01f1833f79d2ed448399911d7c175c2602ae168a". a foaf:Agent; foaf:mbox_sha1sum "2076415c777cb97057ba1791ca3601b678516c2d". a foaf:Agent; foaf:mbox_sha1sum "ed010f54c43079761d1e89fe3160a14f07bd5311". a foaf:Agent; foaf:mbox_sha1sum "d182f0d5e392756c7df07f84047fcc7b52b5de90". a foaf:Agent; foaf:mbox_sha1sum "8e5fc889879f63ab979882081793ca857fb8ead5". a foaf:Agent; foaf:mbox_sha1sum "5c4419a9f32d74564c6fa40f2d8b57489b8b5233". a foaf:Agent; foaf:mbox_sha1sum "f669927e9fa39d8be66e29728ec5ed3c0392499b". a foaf:Agent; foaf:mbox_sha1sum "80fbc0cb07cadccbcc37d346aab91090cffade12". a foaf:Agent; foaf:mbox_sha1sum "d9cd7d7db8c561cc55fc8194b6b6ad0a9e180def". a foaf:Person; foaf:name "Alexander Hartmaier"; foaf:nick "ABRAXXA"; foaf:page . a foaf:Person; foaf:name "Andrew Ruder"; foaf:nick "AERUDER"; foaf:page . a foaf:Person; foaf:name "Andreas J König"; foaf:nick "ANDK"; foaf:page . a foaf:Person; foaf:name "Jon Portnoy"; foaf:nick "AVENJ"; foaf:page . a foaf:Person; foaf:name "Branislav Zahradník"; foaf:nick "BARNEY"; foaf:page . a foaf:Person; foaf:name "Brendan Byrd"; foaf:nick "BBYRD"; foaf:page . a foaf:Person; foaf:name "Aran Clary Deltac"; foaf:nick "BLUEFEET"; foaf:page . a foaf:Person; foaf:name "Philippe Bruhat"; foaf:nick "BOOK"; foaf:page . a foaf:Person; foaf:name "Kevin Dawson"; foaf:nick "BOWTIE"; foaf:page . a foaf:Person; foaf:name "Chromatic"; foaf:nick "CHROMATIC"; foaf:page . a foaf:Person; foaf:name "David Golden"; foaf:nick "DAGOLDEN"; foaf:page . a foaf:Person; foaf:name "Gianni Ceccarelli"; foaf:nick "DAKKAR"; foaf:page . a foaf:Person; foaf:name "Diab Jerius"; foaf:nick "DJERIUS"; foaf:page . a foaf:Person; foaf:name "Karen Etheridge"; foaf:nick "ETHER"; foaf:page . a foaf:Person; foaf:name "Graham Knop"; foaf:nick "HAARG"; foaf:page . a foaf:Person; foaf:name "Hauke D"; foaf:nick "HAUKEX"; foaf:page , . a foaf:Person; foaf:name "Dagfinn Ilmari Mannsåker"; foaf:nick "ILMARI"; foaf:page . a foaf:Person; foaf:name "Ingy döt Net"; foaf:nick "INGY"; foaf:page . a foaf:Person; foaf:name "James E Keenan"; foaf:nick "JKEENAN"; foaf:page . a foaf:Person; foaf:name "Jonas B Nielsen"; foaf:nick "JONASBN"; foaf:page . a foaf:Person; foaf:name "Jason R Mash"; foaf:nick "JRMASH"; foaf:page . a foaf:Person; foaf:name "Peter Karman"; foaf:nick "KARMAN"; foaf:page . a foaf:Person; foaf:name "Lucas Buchala"; foaf:nick "LSBUCHALA"; foaf:page , . a foaf:Person; foaf:name "Lucas Tiago de Moraes"; foaf:nick "LUCAS"; foaf:page . a foaf:Person; foaf:name "Mark Fowler"; foaf:nick "MARKF"; foaf:page . a foaf:Person; foaf:name "Mark Stosberg"; foaf:nick "MARKSTOS"; foaf:page . a foaf:Person; foaf:name "Marcel Timmerman"; foaf:nick "MARTIMM"; foaf:page . a foaf:Person; foaf:name "Matt Phillips"; foaf:nick "MATTP"; foaf:page . a foaf:Person; foaf:name "Meredith Howard"; foaf:nick "MHOWARD"; foaf:page , . a foaf:Person; foaf:name "Vyacheslav Matyukhin"; foaf:nick "MMCLERIC"; foaf:page . a foaf:Person; foaf:name "Michael G Schwern"; foaf:nick "MSCHWERN"; foaf:page . a foaf:Person; foaf:name "Matt S Trout"; foaf:nick "MSTROUT"; foaf:page . a foaf:Person; foaf:name "Yuval Kogman"; foaf:nick "NUFFIN"; foaf:page . a foaf:Person; foaf:name "Peter Flanigan"; foaf:nick "PJFL"; foaf:page . a foaf:Person; foaf:name "Richard Clamp"; foaf:nick "RCLAMP"; foaf:page . a foaf:Person; foaf:name "Peter Rabbitson"; foaf:nick "RIBASUSHI"; foaf:page . a foaf:Person; foaf:name "Ricardo Signes"; foaf:nick "RJBS"; foaf:page . a foaf:Person; foaf:name "Robert Moore"; foaf:nick "RMOORE"; foaf:page . a foaf:Person; foaf:name "Robert Rothenberg"; foaf:nick "RRWO"; foaf:page . a foaf:Person; foaf:name "Richard Simões"; foaf:nick "RSIMOES"; foaf:page . a foaf:Person; foaf:name "Daniel Schröer"; foaf:nick "SCHROEER"; foaf:page . a foaf:Person; foaf:name "Shlomi Fish"; foaf:nick "SHLOMIF"; foaf:page . a foaf:Person; foaf:name "Samuel Kaufman"; foaf:nick "SKAUFMAN"; foaf:page . a foaf:Person; foaf:name "Szymon Nieznański"; foaf:nick "SNEZ"; foaf:page . a foaf:Person; foaf:name "Sandor Patocs"; foaf:nick "SPATOCS"; foaf:page . a foaf:Person; foaf:name "Marcel Montes"; foaf:nick "SPICEMAN"; foaf:page . a foaf:Person; foaf:name "Slaven Rezić"; foaf:nick "SREZIC"; foaf:page . a foaf:Person; foaf:name "Steven Lee"; foaf:nick "STEVENL"; foaf:page . a foaf:Person; foaf:name "Tim Bunce"; foaf:nick "TIMB"; foaf:page . a foaf:Person; foaf:mbox ; foaf:name "Toby Inkster"; foaf:nick "TOBYINK"; foaf:page . a foaf:Person; foaf:name "MATSUNO Tokuhiro"; foaf:nick "TOKUHIROM"; foaf:page . a foaf:Person; foaf:name "Thomas Sibley"; foaf:nick "TSIBLEY"; foaf:page , . a foaf:Person; foaf:name "Caleb Cushing"; foaf:nick "XENO"; foaf:page . a doap-bugs:Issue; rdfs:label "check and coerce arguments not being passed to parameterized types"; dc:created "2014-11-04T09:22:03Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "170b4944cacd3cffb9f5a27ab96a099d8650cc38"; ]; doap-bugs:id "100014"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "localize SIG DIE"; dc:created "2014-12-08T15:12:04Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "2b16b2ce13b2165be6ff6908b31276fbbe805630"; ]; doap-bugs:id "100780"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Malformed UTF-8 character warnings in Perl 5.10 with utf8 pragma on"; dc:created "2015-01-17T02:44:33Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "101582"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Test suite fails with perl 5.21.8"; dc:created "2015-01-20T22:18:42Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "101639"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Document that compile needs to be called from within the subroutine"; dc:created "2015-03-02T19:51:30Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "102457"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "\"Default\" type constraint for using with Dict and Tuple"; dc:created "2015-03-08T13:14:04Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "102638"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types serialization / deserialization"; dc:created "2015-03-08T13:15:18Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "102639"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Library can't consume MooseX::Types::DBIx::Class"; dc:created "2015-03-13T17:55:43Z"^^xsd:dateTime; dc:reporter _:B1; doap-bugs:id "102748", "102748"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Tests inheriting from a MooseX::Types library that uses MooseX::Types::Parameterizable and MooseX::Meta::TypeCoercion::Parameterizable."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt102748.t"; ]; ]. a doap-bugs:Issue; rdfs:label "\"used only once\" warnings from test suite"; dc:created "2015-03-18T13:55:53Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "fca375f12085d4a03a2606da02bd0d6b346ee4d3"; ]; doap-bugs:id "102864"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "\"deep_explanation\" never called for some types"; dc:created "2015-05-01T21:11:02+01:00"^^xsd:dateTime; dc:reporter _:B1; doap-bugs:id "104154", "104154"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Tests for deep coercion."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt104154.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Tests fail on old Perl and old Moose"; dc:created "2015-06-01T17:56:58+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "7dbda2121338302f841f71d891a5b7a20af08056"; ]; doap-bugs:id "104848"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "coercions fail to be executed on uncompiled type checks"; dc:created "2015-06-06T19:05:28+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "105022"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "documentation on coerce methods needs more details"; dc:created "2015-06-07T14:27:46+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "105034"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "[PATCH] Croak when a parameterized ArrayRef is used like a Tuple"; dc:created "2015-06-17T17:28:14+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "3c261d7474c1dbb3f73460d61d84f80fb0f4111c"; ]; doap-bugs:id "105299"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Strawberry perl x32 5.22.0 crashes"; dc:created "2015-06-26T14:37:14+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "105505"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Library messages lost when used with named parameters in Type::Params"; dc:created "2015-06-29T20:18:48+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "c9913d208967575ac8ec0e160f734609a3d240c5"; ]; doap-bugs:id "105561"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Make Type::Tiny assertions compatible with Carp::Always and/or Carp::Verbose"; dc:created "2015-11-30T02:26:19Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "109940"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Unescaped literal \"{\" characters in regular expression patterns are no longer permissible"; dc:created "2016-05-15T05:32:54+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "114386"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Mismatch in isa vs can for parameterized types"; dc:created "2016-05-31T19:50:58+01:00"^^xsd:dateTime; dc:reporter _:B2; doap-bugs:id "114915"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Bug in coercions for parameterized types"; dc:created "2016-09-14T19:47:29+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "4d06cb14e5ce9dc1558c4e9c48d7058203c1a18e"; ]; doap-bugs:id "117838"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Provide method to inline an attribute type check"; dc:created "2017-02-13T11:13:56Z"^^xsd:dateTime; dc:reporter _:B2; doap-bugs:id "120226"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "1.001_006 breaks SHLOMIF/AI-Pathfinding-OptimizeMultiple-0.0.13.tar.gz"; dc:created "2017-05-01T08:52:48+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "121478"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Comparison to Params::ValidationCompiler isn't really accurate"; dc:created "2017-05-04T18:52:41+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "121529"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "FileHandle behaviour is different between Type::Tiny and Type::Tiny::XS"; dc:created "2017-05-18T10:19:45+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "121762"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Sometimes \"explain\" is missing from Error::TypeTiny::Assertion"; dc:created "2017-05-18T10:21:25+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "121763", "121763"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test to make sure 'compile' keeps a reference to all the types that get compiled, to avoid them going away before exceptions can be thrown for them."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt121763.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Weird Perl <5.14 error with Union Types"; dc:created "2017-05-18T10:24:46+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "121764"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Document the options hash to `compile` and `compile_named` and provide some more useful options."; dc:created "2017-05-23T23:45:33+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "121840"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Support `any_of`, `all_of`, `one_of`, and `none_of` in options hash to `compile_named`"; dc:created "2017-05-24T00:05:56+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "121841"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Depends on Ref::Util::XS 0.200.0 which doesn't exist yet"; dc:created "2017-06-04T09:07:45+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "121981"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "1.002001 fails to install in docker"; dc:created "2017-06-09T01:44:32+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "56ca9233eaa3ac431a6588ed72aefec65a07316a"; ]; doap-bugs:id "122054"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Documented code using class_type with plus_coercions doesn’t work"; dc:created "2017-07-01T22:26:24+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "ba2fc0575516e4553efc73b60344d4dc30d5e758"; ]; doap-bugs:id "122305"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Circular reference on Type::Coercion"; dc:created "2017-08-31T01:40:52+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "122931"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "typo: Params::ValidateCompiler → Params::ValidationCompiler"; dc:created "2017-09-14T10:51:38+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "8fb5238859d200bb4e1de91964c58d779f04a913"; ]; doap-bugs:id "123041"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Code from Type::Utils synopsis doesn't work"; dc:created "2017-10-11T09:14:04+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "123243"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "[PATCH] Compatibility with constants and with CV-in-stash optimisation"; dc:created "2017-10-27T18:56:31+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "de3f4914b6898a5e74e0642110ee39086fe9aff2"; ]; doap-bugs:id "123408"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "00-begin.t fails with -DDEBUGGING perls"; dc:created "2018-01-13T07:33:26Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "124067"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "warning: \"Found = in conditional, should be == at temporary compiled converter from 'Dict' line 1\""; dc:created "2018-01-17T23:25:54Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "124121"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Library::_mksub generates a new sub when importing types from another library"; dc:created "2018-03-08T18:40:43Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "124728"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Nasty interaction between compile() and $1"; dc:created "2018-04-19T14:51:32+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "78e234e70caad29b81a6eb58bc71d278e10bf76e"; ]; doap-bugs:id "125132", "125132"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test inlined Int type check clobbering '$1'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt125132.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Error when generating explanation"; dc:created "2018-07-06T09:31:57+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "18d9c920110a0a23e4a3d0e284d3e9ef4731a553"; ]; doap-bugs:id "125765", "125765"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Check weird error doesn't happen with deep explain."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt125765.t"; ]; ]. a doap-bugs:Issue; rdfs:label "dev releases are not removing _ from their versions"; dc:created "2018-07-13T00:03:06+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "125839"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Error::TypeTiny not correctly reporting line number of error"; dc:created "2018-07-27T18:59:51+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "125942"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "t/30-integration/Moo/exceptions.t fails with really old Moo"; dc:created "2018-07-28T14:58:22+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "125948"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label ""; dc:created "2018-08-31T08:59:32+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "2974f68d48930089dcf73edb575a06ed34a5679b"; ]; doap-bugs:id "127005"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Bool type check fails on JSON::PP::Boolean"; dc:created "2018-09-11T08:24:49+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "127090"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Test Errors while trying to install Type-Tiny 1.004002"; dc:created "2018-10-10T09:21:55+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "b16438b6db2b156bced63c1cf47a1761d3a2df01"; ]; doap-bugs:id "127327"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Ambiguous exceptions where used with Params::ValidationCompiler"; dc:created "2018-10-28T19:39:59Z"^^xsd:dateTime; dc:reporter _:B4; doap-bugs:id "127504"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Test::TypeTiny should_pass fails but check works"; dc:created "2018-11-13T19:47:37Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "127635"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Predicate for complementary_type"; dc:created "2018-12-10T17:10:38Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "127986"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "allow IntRange and NumRange to only have upper bounds"; dc:created "2018-12-17T20:56:56Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "128039"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Bool type not properly validated via Type::Params::validate"; dc:created "2018-12-18T15:16:08Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "128046"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Support something similar to Params::ValidationCompiler#named_to_list"; dc:created "2019-01-23T19:43:53Z"^^xsd:dateTime; dc:reporter _:B5; doap-bugs:id "128337"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Char type in Types::Common::String"; dc:created "2019-02-13T04:49:05Z"^^xsd:dateTime; dc:reporter _:B5; doap-bugs:id "128493"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Add NumberLike to Types::TypeTiny"; dc:created "2019-03-17T14:57:17Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "2e7830c8d1fcbba54d43210e32819ec90fe9a45a"; ]; doap-bugs:id "128867"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Allowable value of Type::Tiny::Enum should maintain order"; dc:created "2019-05-22T11:18:33+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "129650"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Union with Enum with a value containing a '-' character fails"; dc:created "2019-06-02T02:30:22+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "129729", "129729"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test that Enum types containing hyphens work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt129729.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Consider documenting other styles of employing Type::Params"; dc:created "2019-08-21T07:14:17+01:00"^^xsd:dateTime; dc:reporter _:B4; doap-bugs:id "130353"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "is_Int sometimes gives false positives"; dc:created "2019-08-29T13:11:07+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "5ce5571608e34e0602196c86d87d1c0e7695f425"; ]; doap-bugs:id "130411"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Cycle references"; dc:created "2019-10-26T11:37:51+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "217b5f4f500428733491a7b87d5830252d372a79"; ]; doap-bugs:id "130823", "130823"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Check for memory cycles."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt130823.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Request: Types::TypeTiny::to_TypeTiny: add support for Specio::Constraint::Simple "; dc:created "2019-11-18T01:52:22Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "131011"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Why do you quote module names?"; dc:created "2019-11-19T18:48:00Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "81e3dfd9a09872c0b11985dbce425a247a702a3c"; ]; doap-bugs:id "131032"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Auto-reporting?"; dc:created "2019-12-13T08:56:30Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "131172"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "string constraint fails with (constraint|inline)_generator"; dc:created "2019-12-25T12:24:52Z"^^xsd:dateTime; dc:reporter _:B6; doap-bugs:id "131238"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Ability to use \"inlined\" only instead of \"constraint\""; dc:created "2019-12-25T14:25:30Z"^^xsd:dateTime; dc:reporter _:B6; doap-bugs:id "131243"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Bareword errors in Type::Tiny::Class"; dc:created "2020-01-09T11:33:49Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "131401", "131401"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that Type::Tiny::Class loads Type::Tiny early enough for bareword constants to be okay."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt131401.t"; ]; ]. a doap-bugs:Issue; rdfs:label "compilation error for function signatures with Moose enum TypeConstraints"; dc:created "2020-01-25T02:48:39Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "131559"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; doap-bugs:id "131576"^^xsd:string; doap-bugs:page ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test that inlined type checks don't generate issuing warning when compiled in packages that override built-ins."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt131576.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Question: recursive container types"; dc:created "2020-02-04T13:54:22Z"^^xsd:dateTime; dc:reporter _:B7; doap-bugs:id "131666"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "slurpy parameters don't work with Type::Params::compile_named"; dc:created "2020-02-09T22:22:35Z"^^xsd:dateTime; dc:reporter _:B5; doap-bugs:id "131720"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Possible bug/typo in Type::Registry"; dc:created "2020-02-11T19:44:18Z"^^xsd:dateTime; dc:reporter _:B7; doap-bugs:id "131744"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types::Common::String reporting deeper problems"; dc:created "2020-02-12T10:08:34Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "15f6c4899c89e04ddaa123236f977fed488cd65f"; ]; doap-bugs:id "131756"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Inherited coercions have too high priority"; dc:created "2020-04-21T10:33:23+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "132392"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Documentation issue and/or bug with compile_named+head+named_to_list?"; dc:created "2020-04-24T21:57:56+01:00"^^xsd:dateTime; dc:reporter _:B6; doap-bugs:id "132419"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Undeclared dependency on Scalar::Util 1.18"; dc:created "2020-04-26T16:53:10+01:00"^^xsd:dateTime; dc:reporter _:B2; doap-bugs:id "132426"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "interesting parsing differences with parameterized types on 5.10"; dc:created "2020-04-30T03:47:27+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "132455"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "StrMatch[] warns \"Use of uninitialized value $_ in pattern match (m//)\" and fails to validate properly"; dc:created "2020-05-10T14:41:56+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "f1984aa5bbf5d56cc6a413820b658db2c0698c06"; ]; doap-bugs:id "132539"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "ClassName constraint for a package with empty ISA is inconsistent with Type::Tiny"; dc:created "2020-05-14T17:03:53+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "132583"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Bool constraint permitting invalid values"; dc:created "2020-05-29T05:36:49+01:00"^^xsd:dateTime; dc:reporter _:B4; doap-bugs:id "132733"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Large integers do not pass Int"; dc:created "2020-06-01T15:52:51+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "132754"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Unable to use provided is_InstanceOf"; dc:created "2020-07-01T08:31:12+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "dd3c5714b913833a3f2caadba99f08e7885c91bb"; ]; doap-bugs:id "132918"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "allow specifing a class name for Type::Params::compile_named_oo"; dc:created "2020-07-22T15:24:26+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "133036"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; doap-bugs:id "133141"^^xsd:string; doap-bugs:page ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that Tuple[Enum[\"test string\"]] can initialize in XS"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt133141.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Confusing error message if required slurpy Dict not present in parameter list"; dc:created "2013-05-05T03:35:42+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "85054"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "exception objects"; dc:created "2013-05-09T04:52:37+01:00"^^xsd:dateTime; dc:reporter _:B8; doap-bugs:id "85149"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Library has wrong VERSION variable"; dc:created "2013-05-30T03:53:03+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "85720"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "support for optional arguments"; dc:created "2013-05-30T14:11:03+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "85732"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type comparison not working on 5.8"; dc:created "2013-06-05T18:39:56+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "a0b2c81a1ab31a33a19293431d21804ea3bd09ac"; ]; doap-bugs:id "85895"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "\"coercion cannot be inlined\" error w/ Type::Params::compile & Dict"; dc:created "2013-06-06T04:00:30+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "85911", "85911"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test Type::Params with deep Dict coercion."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt85911.t"; ]; ]. a doap-bugs:Issue; rdfs:label "type constraint fails after coercion if too many elements in Dict"; dc:created "2013-06-08T23:03:45+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86004", "86004"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test Type::Params with more complex Dict coercion."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt86004.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Missing coercion with Moose and Type::Tiny"; dc:created "2013-06-15T22:30:28+01:00"^^xsd:dateTime; dc:reporter _:B9; doap-bugs:id "86172"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "\"Cannot inline type constraint check\" erro with compile and Dict"; dc:created "2013-06-18T15:23:52+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86233", "86233"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Fix: \"Cannot inline type constraint check\" error with compile and Dict."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt86233.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Optional constraints ignored if wrapped in Dict"; dc:created "2013-06-18T16:34:37+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86239", "86239"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Fix: Optional constraints ignored if wrapped in Dict."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt86239.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Can't locate object method \"NAME\" via package \"B::SPECIAL\""; dc:created "2013-06-24T14:48:37+01:00"^^xsd:dateTime; dc:reporter _:B9; doap-bugs:id "86383"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "'extends' is not declared"; dc:created "2013-07-09T18:53:01+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "1fa560e9f30b9c4621aad0c3ffca750ba9e3abae"; ]; doap-bugs:id "86813"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Reduce boilerplate for inline_as"; dc:created "2013-07-12T14:29:19+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86891"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Reduce boilerplate for message"; dc:created "2013-07-12T14:45:49+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86892"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Clarify \"may\" in the docs in relation to using constraint => quote_sub q{...}"; dc:created "2013-07-12T15:08:16+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "86893"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "I was bitten by equals() being looser than expected (ie structural) which impacts is_subtype_of()"; dc:created "2013-07-24T18:20:27+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "87264"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "PackageName type"; dc:created "2013-07-26T23:18:08+01:00"^^xsd:dateTime; dc:reporter _:B8; doap-bugs:id "87366"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Dict type doesn't notice missing Bool elements"; dc:created "2013-07-30T15:09:13+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "87443"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "slurpy Dict[ foo => InstanceOf[\"bar\"] ] fails (due to unescaped quotes in throw?)"; dc:created "2013-08-14T11:59:43+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "87846"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Make constraint failure errors look less like data dumps"; dc:created "2013-08-21T13:22:54+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "87999"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Several subclasses of Type::Tiny don't accept a hashref to the constructor"; dc:created "2013-08-23T17:00:11+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "88064"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Tuple validation unexpectedly successful"; dc:created "2013-08-29T19:42:31+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "88277"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Grouped alternatives"; dc:created "2013-08-30T18:33:23+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "88291"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Coercion Hierarchies"; dc:created "2013-09-06T00:09:56+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "88452"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Tiny::Union could better mock Moose::Meta::TypeConstraint::Union"; dc:created "2013-09-13T09:21:08+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "88648"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Better messsages for type constraint failures"; dc:created "2013-09-13T13:52:03+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "88655"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Typo in Type::Utils documentation"; dc:created "2013-09-19T03:52:25+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "88798"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Union and Intersection should still allow constraint/inlined attributes"; dc:created "2013-09-25T01:13:06+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "88951"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Fwd: Union?"; dc:created "2013-09-30T17:42:42+01:00"^^xsd:dateTime; dc:reporter _:B8; doap-bugs:id "89073"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Moo attribute information not included in exception messages"; dc:created "2013-10-03T17:09:02+01:00"^^xsd:dateTime; dc:reporter _:B2; doap-bugs:id "89234"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Make truncation length in Type::Tiny::_dd (currently 72) configurable"; dc:created "2013-10-04T12:41:25+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "89251"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "validate_explain and Intersections"; dc:created "2013-10-06T16:21:31+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "89279"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types::Exception not being indexed properly"; dc:created "2013-10-06T16:24:38+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "89280"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Item should be a subtype of Any"; dc:created "2013-10-08T01:51:05+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "89317"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Gazetteer type constraint"; dc:created "2013-10-08T21:20:35+01:00"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "89352"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types::Standard: please add StrLen (string with length) type"; dc:created "2013-10-22T11:42:15+01:00"^^xsd:dateTime; dc:reporter _:B10; doap-bugs:id "89691"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types::Standard: is it possible to check for an empty ArrayRef/HashRef?"; dc:created "2013-10-22T13:22:36+01:00"^^xsd:dateTime; dc:reporter _:B10; doap-bugs:id "89696"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Maybe[Foo] should better emulate Foo|Undef for constraints"; dc:created "2013-11-01T00:43:36Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "89936"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Modification of a read-only value attempted at parameter validation for '__ANON__'"; dc:created "2013-11-06T15:24:29Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "90096", "90096"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Additional tests related to RT#90096. Make sure that Type::Params localizes '$_'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt90096-2.t"; ]; ], [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that Type::Params localizes '$_'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt90096.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Type::Params::multisig fails to validate when presented with a slurpy Dict"; dc:created "2013-11-28T00:53:07Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "90865"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "possible documentation error in Error::TypeTiny::Assertion"; dc:created "2013-11-28T02:25:01Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "90867"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Utils::extends does not handle named type coercions"; dc:created "2013-12-03T17:44:14Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "be10c65554cd95cd10b3305311f8cfb45bf39499"; ]; doap-bugs:id "91153"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "test failure"; dc:created "2013-12-17T12:39:50Z"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "e808ede8c60c2fe4c802fed08b9b7745f122515d"; ]; doap-bugs:id "91468"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Types::Standard: please add $class->DOES(...), $class->isa(...) and $class =~ /$valid_class_re/ constraints."; dc:created "2014-01-02T19:49:31Z"^^xsd:dateTime; dc:reporter _:B10; doap-bugs:id "91802"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "unexpected error from on-the-fly type union coercions, e.g. ( Str | Str )->coercion"; dc:created "2014-01-30T05:56:04Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "92571", "92571"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that the weakening of the reference from a Type::Coercion::Union object back to its \"owner\" type constraint does not break functionality."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt92571-2.t"; ]; ], [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that the weakening of the reference from a Type::Coercion object back to its \"owner\" type constraint does not break functionality."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt92571.t"; ]; ]. a doap-bugs:Issue; rdfs:label "anonymous coercions (via declare_coercion) ignore passed coercion maps if not in a Type::Library"; dc:created "2014-01-30T22:24:22Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "92591", "92591"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Make sure that 'declare_coercion' works outside type libraries."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt92591.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Inlining/compiling of coercions which haven't been frozen"; dc:created "2014-02-25T14:13:36Z"^^xsd:dateTime; dc:reporter _:B3; doap-bugs:id "93345"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type::Params; slurpy Dict breaks HasMethods"; dc:created "2014-03-26T04:18:03Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "94196", "94196"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Problematic inlining using '$_'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt94196.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Type::Tiny and when()"; dc:created "2014-03-28T15:35:36Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "94286"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "documentation error in Types::Standard vis-à-vis coercions"; dc:created "2014-06-11T17:20:17+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "96379"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "5.20+ fails compile( Optional ) if passing explicit undef"; dc:created "2014-06-19T04:42:06+01:00"^^xsd:dateTime; dc:reporter _:B8; doap-bugs:id "96545"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "InstanceOf[Class::Name] is not cached, makes declaring coercion inconsistent"; dc:created "2014-07-25T23:50:47+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "97516"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Strange breakage with Mouse"; dc:created "2014-08-01T22:03:06+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "97684", "97684"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "The \"too few arguments for type constraint check functions\" error."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt97684.t"; ]; ]. a doap-bugs:Issue; rdfs:label "incorrect argument fingered in validate w/ optional coerced arg and bogus extra arg"; dc:created "2014-08-07T19:25:02+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "97840"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Overload fallback gets clobbered on 5.10"; dc:created "2014-08-17T18:41:34+01:00"^^xsd:dateTime; dc:reporter _:B9; doap-bugs:id "98113", "98113"^^xsd:string; doap-bugs:page , ; doap-bugs:status ; doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test overload fallback"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/rt98113.t"; ]; ]. a doap-bugs:Issue; rdfs:label "Install failed with older Moose"; dc:created "2014-08-18T23:18:09+01:00"^^xsd:dateTime; dc:reporter _:B9; doap-bugs:id "98159"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "a Dict with optional values and custom coercions can fail to validate"; dc:created "2014-08-27T17:06:50+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "98362"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "Type constraint parsing fails when using a classname in the fun/method arguments"; dc:created "2014-08-30T03:25:27+01:00"^^xsd:dateTime; dc:reporter ; doap-bugs:id "98458"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "inline_check code generation flaw/bug"; dc:created "2014-10-05T11:05:32+01:00"^^xsd:dateTime; dc:reporter [ a foaf:Agent; foaf:mbox_sha1sum "4adbbbbb2b570e8761bc411981ae5c1daad25184"; ]; doap-bugs:id "99312"; doap-bugs:page ; doap-bugs:status . a doap-bugs:Issue; rdfs:label "In Type::Params please throw exception showing caller"; dc:created "2014-10-29T15:03:49Z"^^xsd:dateTime; dc:reporter ; doap-bugs:id "99889"; doap-bugs:page ; doap-bugs:status . doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Type::Params's 'optional' and 'slurpy' together."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh140.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test initializing tied variables."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh143.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test for non-inlined coercions in Moo. The issue that prompted this test was actually invalid, caused by a typo in the bug reporter's code. But I wrote the test case, so I might as well include it."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh14.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Ensure no warning on certain shallow stack traces."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh158.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test that subtypes of Type::Tiny::Class work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh1.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Test that stringifying Error::TypeTiny doesn't clobber $@."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh80.t"; ]; ]. doap-tests:regression_test [ a doap-tests:RegressionTest; doap-tests:purpose "Type::Tiny's 'display_name' should never wrap lines!"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/gh96.t"; ]; ]. foaf:nick "bokutin"; foaf:page . foaf:nick "sbuggles". foaf:nick "Zaki Mughal"; foaf:page . foaf:mbox ; foaf:name "David Steinbrunner". foaf:nick "Daniel Mita"; foaf:page . foaf:name "Pierre Masci"; foaf:page . foaf:name "Hugo van der Sanden"; foaf:page . foaf:name "Windymelt"; foaf:page , . foaf:mbox ; foaf:name "Benct Philip Jonsson". foaf:mbox ; foaf:name "Peter Valdemar Mørch". foaf:mbox ; foaf:name "Ivanov Anton". foaf:nick "jsf116"; foaf:page . foaf:homepage ; foaf:name "André Walker"; foaf:page . foaf:mbox ; foaf:name "Alexandr Ciornii"; foaf:page . foaf:name "Yoshikazu Sawa"; foaf:page . foaf:name "James Wright". foaf:mbox ; foaf:name "Zoffix Znet". foaf:mbox ; foaf:name "Denis Ibaev"; foaf:page . foaf:name "Florian Schlichting"; foaf:page . foaf:name "Nelo Onyiah"; foaf:page . foaf:nick "Zhtwn". foaf:nick "XSven"; foaf:page . foaf:name "KB Jørgensen". _:B1 a foaf:Agent; foaf:mbox_sha1sum "a1ea66ab424d54745bcff0459ccedc34810b6698". _:B10 a foaf:Agent; foaf:mbox_sha1sum "11285309b4bb0908c954155cfa81c1027c7a146e". _:B2 a foaf:Agent; foaf:mbox_sha1sum "b07d8ccbdad5ade6520ad7d8b42c5b0784604ff8". _:B3 a foaf:Agent; foaf:mbox_sha1sum "7ed2c97d6b43f439d14fb072af1c0ce3a2e83d9d". _:B4 a foaf:Agent; foaf:mbox_sha1sum "4489b6413868d5d58fb4c3fcbd9488bde196f7fc". _:B5 a foaf:Agent; foaf:mbox_sha1sum "73bf7b6cff88b2a42dc321f8d660290f47e5708c". _:B6 a foaf:Agent; foaf:mbox_sha1sum "150605fca571df9cd4d0d5e8e505d0b9b726bdbf". _:B7 a foaf:Agent; foaf:mbox_sha1sum "d57f722ec7bbb556e6c80158266dd5d21d6a6a13". _:B8 a foaf:Agent; foaf:mbox_sha1sum "fb673bc745f8b8bc65c33bc4700155dcba13dd5d". _:B9 a foaf:Agent; foaf:mbox_sha1sum "773c118edc593a4272b888498829f9ef4fb0a55c". _:B11 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/smartmatch.t". _:B12 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/typetiny-constructor.t". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Coercion::FromMoose"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks the types adopted from Moose still have a coercion which works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion-FromMoose/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks crazy Type::Coercion::FromMoose errors."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion-FromMoose/errors.t"; ]; ]; nfo:fileName "lib/Type/Coercion/FromMoose.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Coercion::Union"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Coercion::Union works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion-Union/basic.t"; ]; ]; nfo:fileName "lib/Type/Coercion/Union.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Library"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that the assertion functions exported by a type library work as expected."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/assert.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests that placeholder objects generated by '-declare' work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/declared-types.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Library warns about deprecated types."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/deprecation.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests errors thrown by Type::Library."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests type libraries can detect two types trying to export the same functions."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/exportables-duplicated.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests correct things are exported by type libraries."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/exportables.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks 'of' and 'where' import options works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/import-params.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that it's possible to extend existing type libraries."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/inheritance.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that the check functions exported by a type library work as expected."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/is.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks type libraries put types in their own type registries."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/own-registry.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests that types may be defined recursively."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/recursive-type-definitions.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Type::Library's hidden '_remove_type' method."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/remove-type.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that the coercion functions exported by a type library work as expected."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/to.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that the type functions exported by a type library work as expected."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Library/types.t"; ]; ]; nfo:fileName "lib/Type/Library.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Params"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Test 'compile_named' supports parameter aliases."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/alias.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check that people doing silly things with Test::Params get"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/badsigs.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params' interaction with Carp: use Type::Params compile => { confess => 1 };"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/carping.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test 'compile' and 'compile_named' support autocloned parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/clone.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage of types with coercions."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/coerce.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params' 'compile_named' function with $AvoidCallbacks true."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/compile-named-avoidcallbacks.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params' brand spanking new 'compile_named' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/compile-named-bless.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'compile_named_oo' function, with PERL_TYPE_PARAMS_XS set to \"0\"."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/compile-named-oo-pp.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'compile_named_oo' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/compile-named-oo.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params' brand spanking new 'compile_named' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/compile-named.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test 'compile' and 'compile_named' support defaults for parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/defaults.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'goto_next' option."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/goto_next.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params' brand spanking new 'compile_named' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/hashorder.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage for method calls."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/methods.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage with mix of positional and named parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/mixednamed.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Make sure that custom 'multisig()' messages work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/multisig-custom-message.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'multi' signatures work with 'goto_next'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/multisig-gotonext.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'multisig' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/multisig.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage with named parameters and 'named_to_list'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/named-to-list.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage with named parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/named.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params with type constraints that cannot be inlined."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/noninline.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params support for 'on_die'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/on-die.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage with optional parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/optional.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params positional parameters, a la the example in the documentation: sub nth_root { state $check = compile( Num, Num ); my ($x, $n) = $check->(@_); return $x ** (1 / $n); }"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/positional.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params usage with slurpy parameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/slurpy.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Params 'strictness' option."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/strictness.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test allow_dash option for Type::Params."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-allowdash.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests that Type::Params supports 'default_on_undef'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-default-on-undef.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Params v2 default coderefs get passed an invocant."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-defaults.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests that Type::Params v2 'signature_for' delays signature compilation."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-delayed-compilation.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test a few Type::Params v2 exceptions."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-exceptions.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test the 'fallback' option for modern Type::Params v2 API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-fallback.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test list_to_named option for Type::Params."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-listtonamed.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests new 'multi' option in Type::Params."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-multi.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Named parameter tests for modern Type::Params v2 API on Perl 5.8."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-named-backcompat.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Named slurpy parameter tests for modern Type::Params v2 API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-named-plus-slurpy.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Named parameter tests for modern Type::Params v2 API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-named.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Positional parameter tests for modern Type::Params v2 API on Perl 5.8."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-positional-backcompat.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Named slurpy parameter tests for modern Type::Params v2 API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-positional-plus-slurpy.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Positional parameter tests for modern Type::Params v2 API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-positional.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Params v2 supports return typrs."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-returns.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test 'signature_for_func' and 'signature_for_method' shortcuts."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-shortcuts.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests warnings from Type::Params."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-warnings.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Params v2 'signature_for' can find methods to wrap using inheritance."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/v2-wrap-inherited-method.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test 'wrap_subs' and 'wrap_methods' from Type::Params."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params/wrap.t"; ]; ]; nfo:fileName "lib/Type/Params.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Params::Signature"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Basic tests that 'Type::Params::Signature->new_from_compile' works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Params-Signature/basic.t"; ]; ]; nfo:fileName "lib/Type/Params/Signature.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Parser"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Parser works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Parser/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Parser can pick up MooseX::Types type constraints."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Parser/moosextypes.t"; ]; ]; nfo:fileName "lib/Type/Parser.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Registry"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Check the Type::Registrys can have parents."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/parent.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Registry refcount stuff."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/refcount.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Registry->for_class is automagically populated."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/automagic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Registry works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various newish Type::Registry method calls."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/methods.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Registry works with MooseX::Types."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/moosextypes.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Registry works with MouseX::Types."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Registry/mousextypes.t"; ]; ]; nfo:fileName "lib/Type/Registry.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tie"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie compiles and seems to work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/01basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie seems to work with MooseX::Types."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/02moosextypes.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that 'ttie' prototype works. Test case suggested by Graham Knop (HAARG)."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/03prototypicalweirdness.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie works with a home-made type constraint system conforming to Type::API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/04nots.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie seems to work with Type::Tiny."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/05typetiny.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie works with Clone::clone"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/06clone.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tie works with Storable::dclone"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/06storable.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that this sort of thing works: tie my $var, Int;"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Tie with a very minimal object, with only a 'check' method."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tie/very-minimal.t"; ]; ]; nfo:fileName "lib/Type/Tie.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CONTRIBUTING". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CREDITS". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "Changes". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "INSTALL". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "LICENSE". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "META.ttl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "Makefile.PL"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "NEWS". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "README". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "TODO". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "TODO.mm". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/benchmarking/benchmark-coercion.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/benchmarking/benchmark-constraints.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/benchmarking/benchmark-param-validation.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/benchmarking/benchmark-named-param-validation.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/benchmarking/versus-scalar-validation.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/nonempty.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/page-numbers.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/datetime-coercions.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/jsoncapable.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/changes.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/doap.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/makefile.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/people.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/rights.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "t/README". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/not-covered.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/mk-test-manifest.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/boolean.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/Test/Fatal.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/Test/Requires.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/Try/Tiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/archaic/Test/Builder/Module.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/archaic/Test/Builder/Tester.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "inc/archaic/Test/Builder/Tester/Color.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "MANIFEST.SKIP". _:B13 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/00-begin.t". _:B14 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/01-compile.t". _:B15 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/02-api.t". _:B16 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/03-leak.t". _:B17 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/98-param-eg-from-docs.t". _:B18 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/99-moose-std-types-test.t". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Devel::TypeTiny::Perl58Compat"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks 're::is_regexp()' works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t"; ]; ]; nfo:fileName "lib/Devel/TypeTiny/Perl58Compat.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Error::TypeTiny"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests for basic Error::TypeTiny functionality."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Error-TypeTiny/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests that Error::TypeTiny is capable of providing stack traces."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Error-TypeTiny/stacktrace.t"; ]; ]; nfo:fileName "lib/Error/TypeTiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Error::TypeTiny::Assertion"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Error::TypeTiny::Assertion."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Error-TypeTiny-Assertion/basic.t"; ]; ]; nfo:fileName "lib/Error/TypeTiny/Assertion.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Error::TypeTiny::Compilation"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests for Error::TypeTiny::Compilation, mostly by triggering compilation errors using Eval::TypeTiny."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Error-TypeTiny-Compilation/basic.t"; ]; ]; nfo:fileName "lib/Error/TypeTiny/Compilation.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Error::TypeTiny::WrongNumberOfParameters"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Error::TypeTiny::WrongNumberOfParameters."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Error-TypeTiny-WrongNumberOfParameters/basic.t"; ]; ]; nfo:fileName "lib/Error/TypeTiny/WrongNumberOfParameters.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Eval::TypeTiny"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny supports alias=>1 using Devel::LexAlias implementation."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/aliases-devel-lexalias.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny supports alias=>1 using Perl refaliasing."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/aliases-native.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny supports alias=>1 using PadWalker implementation."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/aliases-padwalker.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny supports alias=>1 using 'tie()' implementation."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/aliases-tie.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny with experimental lexical subs."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny/lexical-subs.t"; ]; ]; nfo:fileName "lib/Eval/TypeTiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Eval::TypeTiny::CodeAccumulator"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny::CodeAccumulator."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Eval::TypeTiny::CodeAccumulator using the callback returned from 'add_placeholder'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t"; ]; ]; nfo:fileName "lib/Eval/TypeTiny/CodeAccumulator.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Test::TypeTiny"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Test::TypeTiny (which is somewhat important because Test::TypeTiny is itself used for the majority of the type constraint tests). In particular, this tests that everything works when the '$EXTENDED_TESTING' environment variable is false."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Test-TypeTiny/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Test::TypeTiny works when the '$EXTENDED_TESTING' environment variable is true. Note that Test::Tester appears to have issues with subtests, so currently 'should_pass' and 'should_fail' are not tested."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Test-TypeTiny/extended.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Test::TypeTiny (which is somewhat important because Test::TypeTiny is itself used for the majority of the type constraint tests). In particular, this tests that everything works when the '$EXTENDED_TESTING' environment variable is false."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Test-TypeTiny/matchfor.t"; ]; ]; nfo:fileName "lib/Test/TypeTiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Coercion"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Coercion works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various undocumented Type::Coercion methods. The fact that these are tested here should not be construed to mean tht they are any any way a stable, supported part of the Type::Coercion API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/esoteric.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Type::Coercion objects are mutable, unlike Type::Tiny objects. However, they can be frozen, making them immutable. (And Type::Tiny will freeze them occasionally, if it feels it has to.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/frozen.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Coercion can be inlined."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/inlining.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks the 'Split' and 'Join' parameterized coercions from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/parameterized.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Coercion overload of '~~'."; doap-tests:test_script _:B11; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks proper Type::Coercion objects are automatically created by the Type::Tiny constructor."; doap-tests:test_script _:B12; ]; nfo:fileName "lib/Type/Coercion.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests overloading of bitwise operators and numeric comparison operators for Type::Tiny."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/arithmetic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test new type comparison stuff with Type::Tiny objects."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/cmp.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks 'plus_coercions', 'minus_coercions' and 'no_coercions' methods work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/coercion-modifiers.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works accepts strings of Perl code as constraints."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/constraint-strings.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Tiny's 'exception_class' attribute."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/custom-exception-classes.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks the 'definition_context' method."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/definition-context.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny's 'deprecated' attribute works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/deprecation.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various undocumented Type::Tiny methods. The fact that these are tested here should not be construed to mean tht they are any any way a stable, supported part of the Type::Tiny API."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/esoteric.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests for Type::Tiny's 'inline_assert' method."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/inline-assert.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny's list processing methods."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/list-methods.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny's 'my_methods' attribute."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/my-methods.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "There are loads of tests for parameterization in 'stdlib.t', 'stdlib-overload.t', 'stdlib-strmatch.t', 'stdlib-structures.t', 'syntax.t', 'stdlib-automatic.t', etc. This file includes a handful of other parameterization-related tests that didn't fit anywhere else."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/parameterization.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny refcount stuff."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/refcount.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test the '->of' and '->where' shortcut methods."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/shortcuts.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with the smartmatch operator."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/smartmatch.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check Type::Tiny '/' overload in lax mode."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/strictmode-off.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check Type::Tiny '/' overload in strict mode."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/strictmode-on.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that all this Type[Param] syntactic sugar works. In particular, the following three type constraints are expected to be equivalent to each other: use Types::Standard qw( ArrayRef Int Num Str ); use Type::Utils qw( union intersection ); my $type1 = ArrayRef[Int] | ArrayRef[Num & ~Int] | ArrayRef[Str & ~Num]; my $type2 = union [ ArrayRef[Int], ArrayRef[Num & ~Int], ArrayRef[Str & ~Num], ]; my $type3 = union([ ArrayRef->parameterize(Int), ArrayRef->parameterize( intersection([ Num, Int->complementary_type, ]), ), ArrayRef->parameterize( intersection([ Str, Num->complementary_type, ]), ), ]);"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/syntax.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny objects can be converted to Moose type constraint objects."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/to-moose.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny objects can be converted to Mouse type constraint objects."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/to-mouse.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny's 'type_default' attribute works."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny/type_default.t"; ]; ]; nfo:fileName "lib/Type/Tiny.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Bitfield"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "(Unknown.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Bitfield/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "(Unknown.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Bitfield/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "(Unknown.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Bitfield/import-options.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "(Unknown.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Bitfield/plus.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Bitfield.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Class"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks class type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Class/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks class type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Class/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Class can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Class/exporter.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Class can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Class/exporter_with_options.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks the 'Type::Tiny::Class''s 'plus_constructors' method."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Class/plus-constructors.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Class.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::ConstrainedObject"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Check 'stringifies_to', 'numifies_to', and 'with_attribute_values' work for Type::Tiny::Class, Type::Tiny::Role, and Type::Tiny::Duck."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-ConstrainedObject/basic.t"; ]; ]; nfo:fileName "lib/Type/Tiny/ConstrainedObject.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Duck"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks duck type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Duck/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test new type comparison stuff with Type::Tiny::Duck objects."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Duck/cmp.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks duck type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Duck/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Duck can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Duck/exporter.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Duck.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Enum"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks enum type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test new type comparison stuff with Type::Tiny::Enum."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/cmp.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks enum type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Enum can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/exporter.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Enum can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/exporter_lexical.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Enum's sorter."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/sorter.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks enums form natural unions and intersections."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Enum/union_intersection.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Enum.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Intersection"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks intersection type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Intersection/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check cmp for Type::Tiny::Intersection."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Intersection/cmp.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check 'stringifies_to', 'numifies_to', and 'with_attribute_values' work for Type::Tiny::Intersection."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Intersection/constrainedobject.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks intersection type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Intersection/errors.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Intersection.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Role"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks role type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Role/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks role type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Role/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny::Role can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Role/exporter.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Role.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::Union"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks union type constraints work."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Union/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Check 'stringifies_to', 'numifies_to', and 'with_attribute_values' work for Type::Tiny::Union."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Union/constrainedobject.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks union type constraints throw sane error messages."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Union/errors.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks union type constraint subtype/supertype relationships."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-Union/relationships.t"; ]; ]; nfo:fileName "lib/Type/Tiny/Union.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Tiny::_HalfOp"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Ensure that the following works: ArrayRef[Str] | Undef | Str"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-_HalfOp/double-union.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Ensure that the following works consistently on all supported Perls: HashRef[Int]|Undef, @extra_parameters"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-_HalfOp/extra-params.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Ensure that the following works consistently on all supported Perls: ArrayRef[Int] | HashRef[Int]"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t"; ]; ]; nfo:fileName "lib/Type/Tiny/_HalfOp.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Type::Utils"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Utils declaration functions put types in the caller type registry."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/auto-registry.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Utils 'classifier' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/classifier.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks sane behaviour of 'dwim_type' from Type::Utils when both Moose and Mouse are loaded."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/dwim-both.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Moose type constraints, and MooseX::Types type constraints are picked up by 'dwim_type' from Type::Utils."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/dwim-moose.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Mouse type constraints, and MouseX::Types type constraints are picked up by 'dwim_type' from Type::Utils."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/dwim-mouse.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Utils 'is' function."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/is.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Type::Utils 'match_on_type' and 'compile_match_on_type' functions."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/match-on-type.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests warnings raised by Type::Utils."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Utils/warnings.t"; ]; ]; nfo:fileName "lib/Type/Utils.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Common"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Types::Common."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Types::Common cannot be added to!"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common/immutable.t"; ]; ]; nfo:fileName "lib/Types/Common.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Common::Numeric"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests constraints for Types::Common::Numeric. These tests are based on tests from MooseX::Types::Common."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-Numeric/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Types::Common::Numeric cannot be added to!"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-Numeric/immutable.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests constraints for Types::Common::Numeric's 'IntRange' and 'NumRange'."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-Numeric/ranges.t"; ]; ]; nfo:fileName "lib/Types/Common/Numeric.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Common::String"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests constraints for Types::Common::String. These tests are based on tests from MooseX::Types::Common."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-String/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests coercions for Types::Common::String. These tests are based on tests from MooseX::Types::Common."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-String/coerce.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Types::Common::String cannot be added to!"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-String/immutable.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests constraints for Types::Common::String's 'StrLength'tring"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-String/strlength.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Unicode support for Types::Common::String. These tests are based on tests from MooseX::Types::Common."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Common-String/unicode.t"; ]; ]; nfo:fileName "lib/Types/Common/String.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks the new ArrayRef[$type, $min, $max] from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/arrayreflength.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against the type constraints from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'CycleTuple' from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/cycletuple.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "If a coercion exists for type 'Foo', then Type::Tiny should be able to auto-generate a coercion for type 'ArrayRef[Foo]', etc."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/deep-coercions.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'FileHandle' from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/filehandle.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Tests Types::Standard cannot be added to!"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/immutable.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "OK, we need to bite the bullet and lock down coercions on core type constraints and parameterized type constraints."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/lockdown.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test the following types from Types::Standard which were inspired by MooX::Types::MooseLike::Base. * 'InstanceOf' * 'ConsumerOf' * 'HasMethods' * 'Enum' Rather than checking they work directly, we check they are equivalent to known (and well-tested) type constraints generated using Type::Utils."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/mxtmlb-alike.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'OptList' from Types::Standard. Checks the standalone 'MkOpt' coercion."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/optlist.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'Overload' from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/overload.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'StrMatch' from Types::Standard when '$Type::Tiny::AvoidCallbacks' is false."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/strmatch-allow-callbacks.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'StrMatch' from Types::Standard when '$Type::Tiny::AvoidCallbacks' is true."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/strmatch-avoid-callbacks.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'StrMatch' from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/strmatch.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against structured types from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/structured.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks various values against 'Tied' from Types::Standard."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard/tied.t"; ]; ]; nfo:fileName "lib/Types/Standard.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::ArrayRef"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::ArrayRef can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-ArrayRef/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/ArrayRef.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::CycleTuple"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::CycleTuple can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-CycleTuple/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/CycleTuple.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::Dict"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::Dict can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-Dict/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/Dict.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::HashRef"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::HashRef can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-HashRef/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/HashRef.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::Map"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::Map can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-Map/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/Map.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::ScalarRef"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::ScalarRef can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-ScalarRef/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/ScalarRef.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::StrMatch"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::StrMatch can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-StrMatch/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/StrMatch.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::Standard::Tuple"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks Types::Standard::Tuple can export."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-Standard-Tuple/exporter.t"; ]; ]; nfo:fileName "lib/Types/Standard/Tuple.pm"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:SourceCode; rdfs:label "Types::TypeTiny"; doap-tests:test [ a doap-tests:AutomatedTest; doap-tests:purpose "Test the Types::TypeTiny bootstrap library. (That is, type constraints used by Type::Tiny internally.)"; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/basic.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test Types::TypeTiny::to_TypeTiny pseudo-coercion and the Types::TypeTiny::_ForeignTypeConstraint type."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/coercion.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test the Types::TypeTiny introspection methods. Types::TypeTiny doesn't inherit from Type::Library (because bootstrapping), so provides independent re-implementations of the most important introspection stuff."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/meta.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Stuff that was originally in basic.t but was split out to avoid basic.t requiring Moose and Mouse."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/moosemouse.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks that Types::TypeTiny avoids loading Exporter::Tiny."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/progressiveexporter.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Test that Type::Tiny works okay with Type::Puny, a clone of Type::Nano."; doap-tests:test_script [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Types-TypeTiny/type-puny.t"; ]; ]; nfo:fileName "lib/Types/TypeTiny.pm"; nfo:programmingLanguage "Perl". _:B19 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Class-InsideOut/basic.t". _:B20 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Class-Plain/basic.t". _:B21 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Class-Plain/multisig.t". _:B22 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Data-Constraint/basic.t". _:B23 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/basic.t". _:B24 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/installer.t". _:B25 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/role-conflict.t". _:B26 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Function-Parameters/basic.t". _:B27 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/JSON-PP/basic.t". _:B28 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Kavorka/80returntype.t". _:B29 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Kavorka/basic.t". _:B30 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/basic.t". _:B31 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/coercion-inlining-avoidance.t". _:B32 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/coercion.t". _:B33 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/exceptions.t". _:B34 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/inflation.t". _:B35 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/inflation2.t". _:B36 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moops/basic.t". _:B37 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moops/library-keyword.t". _:B38 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/accept-moose-types.t". _:B39 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/basic.t". _:B40 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/coercion-more.t". _:B41 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/coercion.t". _:B42 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/inflate-then-inline.t". _:B43 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/native-attribute-traits.t". _:B44 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/parameterized.t". _:B45 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Getopt/coercion.t". _:B46 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/basic.t". _:B47 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/extending.t". _:B48 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/more.t". _:B49 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/basic.t". _:B50 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/coercion.t". _:B51 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/parameterized.t". _:B52 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MouseX-Types/basic.t". _:B53 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MouseX-Types/extending.t". _:B54 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Object-Accessor/basic.t". _:B55 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Return-Type/basic.t". _:B56 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Specio/basic.t". _:B57 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Specio/library.t". _:B58 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/basic.t". _:B59 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/delayed-quoting.t". _:B60 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/unquote-coercions.t". _:B61 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/unquote-constraints.t". _:B62 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Switcheroo/basic.t". _:B63 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Type-Library-Compiler/basic.t". _:B64 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Types-ReadOnly/basic.t". _:B65 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Validation-Class-Simple/archaic.t". _:B66 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Validation-Class-Simple/basic.t". _:B67 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/match-simple/basic.t". _:B68 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/73f51e2d.t". _:B69 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/hg166.t". _:B70 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/ttxs-gh1.t". [] a doap-tests:Test; doap-tests:purpose "Print some standard diagnostics before beginning testing."; doap-tests:test_script _:B13. [] a doap-tests:Test; doap-tests:purpose "Test that Type::Tiny, Type::Library, etc compile."; doap-tests:test_script _:B14. [] a doap-tests:Test; doap-tests:purpose "Test that Type::Tiny and Type::Coercion provide a Moose/Mouse-compatible API."; doap-tests:test_script _:B15. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Class::InsideOut."; doap-tests:test_script _:B19. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Class::Plain."; doap-tests:test_script _:B20. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Class::Plain."; doap-tests:test_script _:B21. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests integration with Data::Constraint."; doap-tests:test_script _:B22. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Exporter::Tiny has the features Type::Tiny needs."; doap-tests:test_script _:B23. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Type::Library libraries work with Sub::Exporter plugins."; doap-tests:test_script _:B24. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests exporting to two roles; tries to avoid reporting conflicts."; doap-tests:test_script _:B25. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Function::Parameters."; doap-tests:test_script _:B26. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check *Bool* and *BoolLike* type constraints against JSON::PP's bools."; doap-tests:test_script _:B27. [] a doap-tests:AutomatedTest; doap-tests:purpose "Adopted test from Kavorka test suite."; doap-tests:test_script _:B28. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with Kavorka."; doap-tests:test_script _:B29. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Moo. Checks values that should pass and should fail; checks error messages."; doap-tests:test_script _:B30. [] a doap-tests:AutomatedTest; doap-tests:purpose "A rather complex case of defining an attribute with a type coercion in Moo; and only then adding coercion definitions to it. Does Moo pick up on the changes? It should."; doap-tests:test_script _:B31. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Moo."; doap-tests:test_script _:B32. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Error::TypeTiny interaction with Moo."; doap-tests:test_script _:B33. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks that type constraints continue to work when a Moo class is inflated to a Moose class. Checks that Moo::HandleMoose correctly calls back to Type::Tiny to build Moose type constraints."; doap-tests:test_script _:B34. [] a doap-tests:AutomatedTest; doap-tests:purpose "A test for type constraint inflation from Moo to Moose."; doap-tests:test_script _:B35. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that type constraints work in Moops. This file is borrowed from the Moops test suite, where it is called '31types.t'."; doap-tests:test_script _:B36. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that type libraries can be declared with Moops. This file is borrowed from the Moops test suite, where it is called '71library.t'."; doap-tests:test_script _:B37. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Moose type constraints can be passed into the Type::Tiny API where a Type::Tiny constraint might usually be expected."; doap-tests:test_script _:B38. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Moose. Checks values that should pass and should fail; checks error messages."; doap-tests:test_script _:B39. [] a doap-tests:AutomatedTest; doap-tests:purpose "Test for the good old \"You cannot coerce an attribute unless its type has a coercion\" error."; doap-tests:test_script _:B40. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Moose; both mutable and immutable classes."; doap-tests:test_script _:B41. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraint inlining works with Moose in strange edge cases where we need to inflate Type::Tiny constraints into full Moose::Meta::TypeConstraint objects."; doap-tests:test_script _:B42. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints and coercions work with Moose native attribute traits."; doap-tests:test_script _:B43. [] a doap-tests:AutomatedTest; doap-tests:purpose "Test that parameterizable Moose types are still parameterizable when they are converted to Type::Tiny."; doap-tests:test_script _:B44. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with MooseX::Getopt; both mutable and immutable classes."; doap-tests:test_script _:B45. [] a doap-tests:AutomatedTest; doap-tests:purpose "Complex checks between Type::Tiny and MooseX::Types."; doap-tests:test_script _:B46. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Library can extend an existing MooseX::Types type constraint library."; doap-tests:test_script _:B47. [] a doap-tests:AutomatedTest; doap-tests:purpose "More checks between Type::Tiny and MooseX::Types. This started out as an example of making a parameterized 'Not[]' type constraint, but worked out as a nice test case."; doap-tests:test_script _:B48. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Mouse. Checks values that should pass and should fail; checks error messages."; doap-tests:test_script _:B49. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Mouse; both mutable and immutable classes."; doap-tests:test_script _:B50. [] a doap-tests:AutomatedTest; doap-tests:purpose "Test that parameterizable Mouse types are still parameterizable when they are converted to Type::Tiny."; doap-tests:test_script _:B51. [] a doap-tests:AutomatedTest; doap-tests:purpose "Complex checks between Type::Tiny and MouseX::Types."; doap-tests:test_script _:B52. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Library can extend an existing MooseX::Types type constraint library."; doap-tests:test_script _:B53. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Object::Accessor."; doap-tests:test_script _:B54. [] a doap-tests:AutomatedTest; doap-tests:purpose "Test that this sort of thing works: sub foo :ReturnType(Int) { ...; }"; doap-tests:test_script _:B55. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Specio type constraints can be converted to Type::Tiny with inlining support."; doap-tests:test_script _:B56. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Specio type libraries can be extended by Type::Library."; doap-tests:test_script _:B57. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints can be made inlinable using Sub::Quote."; doap-tests:test_script _:B58. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints can be made inlinable using Sub::Quote even if Sub::Quote is loaded late."; doap-tests:test_script _:B59. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type coercions can be unquoted Sub::Quote."; doap-tests:test_script _:B60. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints can be unquoted Sub::Quote."; doap-tests:test_script _:B61. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with Switcheroo."; doap-tests:test_script _:B62. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny interacts nicely with Type::Library::Compiled-generated libraries."; doap-tests:test_script _:B63. [] a doap-tests:AutomatedTest; doap-tests:purpose "Types::ReadOnly does some frickin weird stuff with parameterization. Check it all works!"; doap-tests:test_script _:B64. [] a doap-tests:AutomatedTest; doap-tests:purpose "Fake Validation::Class::Simple 7.900017 by overriding '$VERSION' variable. (There is a reason for this... 'Types::TypeTiny::to_TypeTiny' follows two different code paths depending on the version of the Validation::Class::Simple object passed to it.)"; doap-tests:test_script _:B65. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints Validation::Class::Simple objects can be used as type constraints."; doap-tests:test_script _:B66. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with match::simple."; doap-tests:test_script _:B67. [] a doap-tests:RegressionTest; doap-tests:purpose "Possible issue causing segfaults on threaded Perl 5.18.x."; doap-tests:test_script _:B68. [] a doap-tests:RegressionTest; doap-tests:purpose "Ensure that stringifying Error::TypeTiny doesn't clobber '$@'."; doap-tests:test_script _:B69. [] a doap-tests:RegressionTest; doap-tests:purpose "Test that was failing with Type::Tiny::XS prior to 0.009."; doap-tests:test_script _:B70. [] a doap-tests:Test; doap-tests:purpose "Check for memory leaks. These tests are not comprehensive; chances are that there are still memory leaks lurking somewhere in Type::Tiny. If you have any concrete suggestions for things to test, or fixes for identified memory leaks, please file a bug report. https://rt.cpan.org/Ticket/Create.html?Queue=Type-Tiny."; doap-tests:test_script _:B16. [] a doap-tests:Test; doap-tests:purpose "An example of parameterized types from Type::Tiny::Manual::Libraries. The example uses Type::Tiny, Type::Library, and Type::Coercion, and makes use of inlining and parameterization, so is a good canary to check everything is working."; doap-tests:test_script _:B17. [] a doap-tests:Test; doap-tests:purpose "Type constraint tests pilfered from the Moose test suite."; doap-tests:test_script _:B18. datetime-coercions.pl000664001750001750 525615111656240 20354 0ustar00taitai000000000000Type-Tiny-2.008006/examples=pod =encoding utf-8 =head1 PURPOSE This example expands upon the Example::Types library defined in L. It defines class types for L and L and some structured types for hashes that can be used to instantiate DateTime objects. It defines some coercions for the C class type. A simple L class is provided using some of these types and coercions. The class also defines a couple of extra coercions inline. See the source code of this file for the actual example code. =head1 DEPENDENCIES L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2024 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib "lib", "../lib"; BEGIN { package Example::Types; use Type::Library -base, -declare => qw( Datetime DatetimeHash Duration EpochHash ); use Type::Utils; use Types::Standard -types; require DateTime; require DateTime::Duration; class_type Datetime, { class => "DateTime" }; class_type Duration, { class => "DateTime::Duration" }; declare DatetimeHash, as Dict[ year => Int, month => Optional[ Int ], day => Optional[ Int ], hour => Optional[ Int ], minute => Optional[ Int ], second => Optional[ Int ], nanosecond => Optional[ Int ], time_zone => Optional[ Str ], ]; declare EpochHash, as Dict[ epoch => Int, time_zone => Optional[ Str ], ]; coerce Datetime, from Int, via { "DateTime"->from_epoch(epoch => $_) }, from Undef, via { "DateTime"->now }, from DatetimeHash, via { "DateTime"->new(%$_) }, from EpochHash, via { "DateTime"->from_epoch(%$_) }; $INC{"Example/Types.pm"} = __FILE__; }; BEGIN { package Person; use Moose; use Types::Standard qw( Str Int Num ); use Example::Types qw( Datetime Duration ); has name => ( is => "ro", isa => Str, required => 1, ); has age => ( is => "ro", isa => Int->plus_coercions(Num, 'int($_)', Duration, '$_->years'), coerce => 1, init_arg => undef, lazy => 1, builder => "_build_age", ); has date_of_birth => ( is => "ro", isa => Datetime, coerce => 1, required => 1, ); sub _build_age { my $self = shift; return Datetime->class->now - $self->date_of_birth; } }; my $me = Person->new( name => "Toby Inkster", date_of_birth => { epoch => 328646500, time_zone => "Asia/Tokyo" }, ); printf("%s is %d years old.\n", $me->name, $me->age); jsoncapable.pl000664001750001750 66315111656240 17034 0ustar00taitai000000000000Type-Tiny-2.008006/examplesuse strict; use warnings; use feature 'say'; BEGIN { package My::Types; use Type::Library 1.012 -utils, -extends => [ 'Types::Standard' ], -declare => 'JSONCapable'; declare JSONCapable, as Undef | ScalarRef[ Enum[ 0..1 ] ] | Num | Str | ArrayRef[ JSONCapable ] | HashRef[ JSONCapable ] ; } use My::Types 'is_JSONCapable'; my $var = { foo => 1, bar => [ \0, "baz", [] ], }; say is_JSONCapable $var; nonempty.pl000664001750001750 205015111656240 16434 0ustar00taitai000000000000Type-Tiny-2.008006/examplesuse v5.14; use strict; use warnings; package Example1 { use Moo; use Sub::Quote 'quote_sub'; use Types::Standard -types; has my_string => ( is => 'ro', isa => Str->where( 'length($_) > 0' ), ); has my_array => ( is => 'ro', isa => ArrayRef->where( '@$_ > 0' ), ); has my_hash => ( is => 'ro', isa => HashRef->where( 'keys(%$_) > 0' ), ); } use Test::More; use Test::Fatal; is( exception { Example1::->new( my_string => 'u' ) }, undef, 'non-empty string, okay', ); isa_ok( exception { Example1::->new( my_string => '' ) }, 'Error::TypeTiny', 'result of empty string', ); is( exception { Example1::->new( my_array => [undef] ) }, undef, 'non-empty arrayref, okay', ); isa_ok( exception { Example1::->new( my_array => [] ) }, 'Error::TypeTiny', 'result of empty arrayref', ); is( exception { Example1::->new( my_hash => { '' => undef } ) }, undef, 'non-empty hashref, okay', ); isa_ok( exception { Example1::->new( my_hash => +{} ) }, 'Error::TypeTiny', 'result of empty hashref', ); done_testing; page-numbers.pl000664001750001750 342315111656240 17155 0ustar00taitai000000000000Type-Tiny-2.008006/examplesuse strict; use warnings; # Type constraint library… BEGIN { package Types::Bookish; $INC{'Types/Bookish.pm'} = __FILE__; use Type::Library -base, -declare => qw( PageNumber PageRangeArray PageRange PageSeriesArray PageSeries ); use Types::Standard qw( Str StrMatch Tuple ArrayRef ); use Types::Common::Numeric qw( PositiveInt ); use Type::Utils -all; declare PageNumber, as PositiveInt, ; declare PageRangeArray, as Tuple[ PageNumber, PageNumber ], constraint => '$_->[0] < $_->[1]', ; declare PageRange, as StrMatch[ qr/\A([0-9]+)-([0-9]+)\z/, PageRangeArray ], ; coerce PageRangeArray from PageRange, q{ [ split /-/, $_ ] }, ; coerce PageRange from PageRangeArray, q{ join q/-/, @$_ }, ; declare PageSeriesArray, as ArrayRef[ PageNumber | PageRange ], constraint => ( # This constraint prevents page series arrays from being in # the wrong order, like [ 20, '4-16', 12 ]. 'my $J = join q/-/, @$_; '. 'my $S = join q/-/, sort { $a <=> $b } split /-/, $J; '. '$S eq $J' ), ; declare PageSeries, as Str, constraint => ( 'my $tmp = [split /\s*,\s*/]; '. PageSeriesArray->inline_check('$tmp') ), ; coerce PageSeriesArray from PageSeries, q{ [ split /\s*,\s*/, $_ ] }, from PageRange, q{ [ $_ ] }, from PageNumber, q{ [ $_ ] }, ; coerce PageSeries from PageSeriesArray, q{ join q[,], @$_ }, ; __PACKAGE__->meta->make_immutable; } use Types::Bookish -types; use Perl::Tidy; PageNumber->assert_valid('4'); PageRangeArray->assert_valid([4, 16]); PageRange->assert_valid('4-16'); PageSeriesArray->assert_valid([ '4-16', 18, 20 ]); PageSeries->assert_valid('4-16, 18, 20'); Perl::Tidy::perltidy( source => \( PageSeries->inline_check('$DATA') ), destination => \( my $tidied ), ); print $tidied; boolean.pm000664001750001750 421115111656240 15137 0ustar00taitai000000000000Type-Tiny-2.008006/incuse strict; use warnings; package boolean; our $VERSION = '0.46'; my ($true, $false); use overload '""' => sub { ${$_[0]} }, '!' => sub { ${$_[0]} ? $false : $true }, fallback => 1; use base 'Exporter'; @boolean::EXPORT = qw(true false boolean); @boolean::EXPORT_OK = qw(isTrue isFalse isBoolean); %boolean::EXPORT_TAGS = ( all => [@boolean::EXPORT, @boolean::EXPORT_OK], test => [qw(isTrue isFalse isBoolean)], ); sub import { my @options = grep $_ ne '-truth', @_; $_[0]->truth if @options != @_; @_ = @options; goto &Exporter::import; } my ($true_val, $false_val, $bool_vals); BEGIN { my $t = 1; my $f = 0; $true = do {bless \$t, 'boolean'}; $false = do {bless \$f, 'boolean'}; $true_val = overload::StrVal($true); $false_val = overload::StrVal($false); $bool_vals = {$true_val => 1, $false_val => 1}; } # refaddrs change on thread spawn, so CLONE fixes them up sub CLONE { $true_val = overload::StrVal($true); $false_val = overload::StrVal($false); $bool_vals = {$true_val => 1, $false_val => 1}; } sub true() { $true } sub false() { $false } sub boolean($) { die "Not enough arguments for boolean::boolean" if scalar(@_) == 0; die "Too many arguments for boolean::boolean" if scalar(@_) > 1; return not(defined $_[0]) ? false : "$_[0]" ? $true : $false; } sub isTrue($) { not(defined $_[0]) ? false : (overload::StrVal($_[0]) eq $true_val) ? true : false; } sub isFalse($) { not(defined $_[0]) ? false : (overload::StrVal($_[0]) eq $false_val) ? true : false; } sub isBoolean($) { not(defined $_[0]) ? false : (exists $bool_vals->{overload::StrVal($_[0])}) ? true : false; } sub truth { die "-truth not supported on Perl 5.22 or later" if $] >= 5.021005; # enable modifying true and false &Internals::SvREADONLY( \ !!0, 0); &Internals::SvREADONLY( \ !!1, 0); # turn perl internal booleans into blessed booleans: ${ \ !!0 } = $false; ${ \ !!1 } = $true; # make true and false read-only again &Internals::SvREADONLY( \ !!0, 1); &Internals::SvREADONLY( \ !!1, 1); } sub TO_JSON { ${$_[0]} ? \1 : \0 } 1; 00-begin.t000664001750001750 523615111656240 14352 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE Print some standard diagnostics before beginning testing. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; sub diag_version { my ($module, $version, $return) = @_; if ($module =~ /\//) { my @modules = split /\s*\/\s*/, $module; my @versions = map diag_version($_, undef, 1), @modules; return @versions if $return; return diag sprintf(' %-43s %s', join("/", @modules), join("/", @versions)); } unless (defined $version) { eval "use $module ()"; $version = $module->VERSION; } if (!defined $version) { return 'undef' if $return; return diag sprintf(' %-40s undef', $module); } my ($major, $rest) = split /\./, $version; $major =~ s/^v//; return "$major\.$rest" if $return; return diag sprintf(' %-40s % 4d.%s', $module, $major, $rest); } sub diag_env { require B; my $var = shift; return diag sprintf(' $%-40s %s', $var, exists $ENV{$var} ? B::perlstring($ENV{$var}) : "undef"); } sub banner { diag( ' ' ); diag( '# ' x 36 ); diag( ' ' ); diag( " PERL: $]" ); diag( " XS: " . ( exists($ENV{PERL_TYPE_TINY_XS}) && !$ENV{PERL_TYPE_TINY_XS} ? 'PP' : 'maybe XS' ) ); diag( " NUMBERS: " . ( $ENV{PERL_TYPES_STANDARD_STRICTNUM} ? 'strict' : 'loose' ) ); diag( " TESTING: " . ( $ENV{EXTENDED_TESTING} ? 'extended' : 'normal' ) ); diag( " COVERAGE: " . ( $ENV{COVERAGE} ? 'coverage report' : 'not checking coverage' ) ) if $ENV{TRAVIS}; diag( ' ' ); diag( '# ' x 36 ); } banner(); while () { chomp; if (/^#\s*(.*)$/ or /^$/) { diag($1 || ""); next; } if (/^\$(.+)$/) { diag_env($1); next; } if (/^perl$/) { diag_version("Perl", $]); next; } diag_version($_) if /\S/; } require Types::Standard; diag( ' ' ); diag( !Types::Standard::Str()->_has_xsub ? ">>>> Type::Tiny is not using XS" : $INC{'Type/Tiny/XS.pm'} ? ">>>> Type::Tiny is using Type::Tiny::XS" : ">>>> Type::Tiny is using Mouse::XS" ); diag( ' ' ); diag( '# ' x 36 ); diag( ' ' ); ok 1; done_testing; __END__ Exporter::Tiny Return::Type Type::Tiny::XS Scalar::Util/Sub::Util Ref::Util/Ref::Util::XS Regexp::Util Class::XSAccessor Devel::LexAlias/PadWalker Devel::StackTrace Class::Tiny Moo/MooX::TypeTiny Moose/MooseX::Types Mouse/MouseX::Types $AUTOMATED_TESTING $NONINTERACTIVE_TESTING $EXTENDED_TESTING $AUTHOR_TESTING $RELEASE_TESTING $PERL_TYPE_TINY_XS $PERL_TYPES_STANDARD_STRICTNUM $PERL_ONLY 01-compile.t000664001750001750 216615111656240 14716 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tiny, Type::Library, etc compile. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use_ok("Eval::TypeTiny"); use_ok("Test::TypeTiny"); use_ok("Type::Coercion"); use_ok("Type::Coercion::Union"); use_ok("Error::TypeTiny"); use_ok("Error::TypeTiny::Assertion"); use_ok("Error::TypeTiny::Compilation"); use_ok("Error::TypeTiny::WrongNumberOfParameters"); use_ok("Type::Library"); use_ok("Types::Standard"); use_ok("Types::TypeTiny"); use_ok("Type::Tiny"); use_ok("Type::Tiny::Class"); use_ok("Type::Tiny::Duck"); use_ok("Type::Tiny::Enum"); use_ok("Type::Tiny::Intersection"); use_ok("Type::Tiny::Role"); use_ok("Type::Tiny::Union"); use_ok("Type::Utils"); use_ok("Type::Params"); BAIL_OUT("Further tests rely on all modules compiling.") unless "Test::Builder"->new->is_passing; done_testing; 02-api.t000664001750001750 540315111656240 14035 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tiny and Type::Coercion provide a Moose/Mouse-compatible API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; my $HAVE_MOOSE = eval { require Moose; Moose->VERSION('2.000'); 1; # return true }; my @MOOSE_WANTS = qw( _actually_compile_type_constraint _collect_all_parents _compile_subtype _compile_type _compiled_type_constraint _default_message _has_compiled_type_constraint _inline_check _new _package_defined_in _set_constraint assert_coerce assert_valid can_be_inlined check coerce coercion compile_type_constraint constraint create_child_type equals get_message has_coercion has_message has_parent inline_environment inlined is_a_type_of is_subtype_of message meta name new parent parents validate ); my $HAVE_MOUSE = eval { require Mouse }; my @MOUSE_WANTS = qw( __is_parameterized _add_type_coercions _as_string _compiled_type_coercion _compiled_type_constraint _identity _unite assert_valid check coerce compile_type_constraint create_child_type get_message has_coercion is_a_type_of message name new parameterize parent type_parameter ); require Type::Tiny; my $type = "Type::Tiny"->new(name => "TestType"); if ( $HAVE_MOOSE ) { no warnings 'once'; *Moose::Meta::TypeConstraint::bleh_this_does_not_exist = sub { 42 }; push @MOOSE_WANTS, 'bleh_this_does_not_exist'; } for (@MOOSE_WANTS) { SKIP: { skip "Moose::Meta::TypeConstraint PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOOSE; ok($type->can($_), "Moose::Meta::TypeConstraint API: $type->can('$_')"); } } if ( $HAVE_MOOSE ) { is( $type->can('bleh_this_does_not_exist')->( $type ), 42 ); is( $type->bleh_this_does_not_exist(), 42 ); } for (@MOUSE_WANTS) { SKIP: { skip "Mouse::Meta::TypeConstraint PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOUSE; ok($type->can($_), "Mouse::Meta::TypeConstraint API: $type->can('$_')"); } } my @MOOSE_WANTS_COERCE = qw( _compiled_type_coercion _new add_type_coercions coerce compile_type_coercion has_coercion_for_type meta new type_coercion_map type_constraint ); require Type::Coercion; my $coerce = "Type::Coercion"->new(name => "TestCoercion"); for (@MOOSE_WANTS_COERCE) { SKIP: { skip "Moose::Meta::TypeCoercion PRIVATE API: '$_'", 1 if /^_/ && !$HAVE_MOOSE; ok($coerce->can($_), "Moose::Meta::TypeCoercion API: $coerce->can('$_')"); } } BAIL_OUT("Further tests rely on the Type::Tiny and Type::Coercion APIs.") unless "Test::Builder"->new->is_passing; done_testing; 03-leak.t000664001750001750 417515111656240 14206 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE Check for memory leaks. These tests are not comprehensive; chances are that there are still memory leaks lurking somewhere in Type::Tiny. If you have any concrete suggestions for things to test, or fixes for identified memory leaks, please file a bug report. L. =head1 DEPENDENCIES L. This test is skipped on Perl < 5.10.1 because I'm not interested in jumping through hoops for ancient versions of Perl. =head1 MISC ATTRIBUTE DECORATION If Perl has been compiled with Misc Attribute Decoration (MAD) enabled, then this test may fail. If you don't know what MAD is, then don't worry: you probably don't have it enabled. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Config; BEGIN { plan skip_all => 'Devel::Cover' if $INC{'Devel/Cover.pm'} }; BEGIN { plan skip_all => 'Perl < 5.10.1' if $] < 5.010001 }; BEGIN { plan skip_all => 'useithreads' if $Config{'useithreads'} }; use Test::Requires 'Test::LeakTrace'; use Test::LeakTrace; use Types::Standard qw( ArrayRef HashRef ); eval { require Moo }; no_leaks_ok { my $x = Type::Tiny->new; undef($x); } 'Type::Tiny->new'; no_leaks_ok { my $x = Type::Tiny->new->coercibles; undef($x); } 'Type::Tiny->new->coercible'; no_leaks_ok { my $x = ArrayRef | HashRef; my $y = HashRef | ArrayRef; undef($_) for $x, $y; } 'ArrayRef | HashRef'; no_leaks_ok { my $x = ArrayRef[HashRef]; my $y = HashRef[ArrayRef]; undef($_) for $x, $y; } 'ArrayRef[HashRef]'; no_leaks_ok { my $x = Type::Tiny->new; $x->check(1); undef($x); } 'Type::Tiny->new->check'; no_leaks_ok { my $x = ArrayRef->plus_coercions(HashRef, sub { [sort keys %$_] }); my $a = $x->coerce({bar => 1, baz => 2}); undef($_) for $x, $a; } 'ArrayRef->plus_coercions->coerce'; done_testing; 98-param-eg-from-docs.t000664001750001750 442515111656240 16666 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE An example of parameterized types from L. The example uses L, L, and L, and makes use of inlining and parameterization, so is a good canary to check everything is working. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::TypeTiny; use Test::More; BEGIN { package My::Types; use Type::Library -base; use Type::Utils 'extends'; BEGIN { extends 'Types::Standard' }; __PACKAGE__->add_type( name => 'MultipleOf', parent => Int, constraint_generator => sub { my $i = assert_Int(shift); return sub { $_ % $i == 0 }; }, inline_generator => sub { my $i = shift; return sub { my $varname = pop; return (undef, "($varname % $i == 0)"); }; }, coercion_generator => sub { my $i = $_[2]; require Type::Coercion; return Type::Coercion->new( type_coercion_map => [ Num, qq{ int($i * int(\$_/$i)) } ], ); }, ); __PACKAGE__->make_immutable; $INC{'My/Types.pm'} = __FILE__; }; use My::Types 'MultipleOf'; my $MultipleOfThree = MultipleOf->of(3); should_pass(0, $MultipleOfThree); should_fail(1, $MultipleOfThree); should_fail(2, $MultipleOfThree); should_pass(3, $MultipleOfThree); should_fail(4, $MultipleOfThree); should_fail(5, $MultipleOfThree); should_pass(6, $MultipleOfThree); should_fail(7, $MultipleOfThree); should_fail(-1, $MultipleOfThree); should_pass(-3, $MultipleOfThree); should_fail(0.1, $MultipleOfThree); should_fail([], $MultipleOfThree); should_fail(undef, $MultipleOfThree); subtest 'coercion' => sub { is($MultipleOfThree->coerce(0), 0); is($MultipleOfThree->coerce(1), 0); is($MultipleOfThree->coerce(2), 0); is($MultipleOfThree->coerce(3), 3); is($MultipleOfThree->coerce(4), 3); is($MultipleOfThree->coerce(5), 3); is($MultipleOfThree->coerce(6), 6); is($MultipleOfThree->coerce(7), 6); is($MultipleOfThree->coerce(8), 6); is($MultipleOfThree->coerce(8.9), 6); }; #diag( $MultipleOfThree->inline_check('$VALUE') ); done_testing; 99-moose-std-types-test.t000664001750001750 4662515111656240 17370 0ustar00taitai000000000000Type-Tiny-2.008006/t=pod =encoding utf-8 =head1 PURPOSE Type constraint tests pilfered from the L test suite. =head1 DEPENDENCIES Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE, but largely derived from the Moose test suite. Moose is maintained by the Moose Cabal, along with the help of many contributors. See "CABAL" in Moose and "CONTRIBUTORS" in Moose for details. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Infinity Interactive, Inc.. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut #!/usr/bin/perl use Test::More; BEGIN { $ENV{PERL_TYPES_STANDARD_STRICTNUM} = 1; }; BEGIN { $ENV{AUTOMATED_TESTING} or $ENV{EXTENDED_TESTING} or $ENV{AUTHOR_TESTING} or $ENV{RELEASE_TESTING} or plan skip_all => 'EXTENDED_TESTING' }; use strict; use warnings; use Test::Fatal; use Test::Requires { 'Moose' => '2.0000' }; use Eval::TypeTiny; use IO::File; use Scalar::Util qw( blessed openhandle ); use Type::Utils { replace => 1 }, -all; use Types::Standard; my $ZERO = 0; my $ONE = 1; my $INT = 100; my $NEG_INT = -100; my $NUM = 42.42; my $NEG_NUM = -42.42; my $EMPTY_STRING = q{}; my $STRING = 'foo'; my $NUM_IN_STRING = 'has 42 in it'; my $INT_WITH_NL1 = "1\n"; my $INT_WITH_NL2 = "\n1"; my $SCALAR_REF = \( my $var ); my $SCALAR_REF_REF = \$SCALAR_REF; my $ARRAY_REF = []; my $HASH_REF = {}; my $CODE_REF = sub { }; my $GLOB = do { no warnings 'once'; *GLOB_REF }; my $GLOB_REF = \$GLOB; open my $FH, '<', $0 or die "Could not open $0 for the test"; my $FH_OBJECT = IO::File->new( $0, 'r' ) or die "Could not open $0 for the test"; my $REGEX = qr/../; my $REGEX_OBJ = bless qr/../, 'BlessedQR'; my $FAKE_REGEX = bless {}, 'Regexp'; my $OBJECT = bless {}, 'Foo'; my $UNDEF = undef; { package Thing; sub new { } sub foo { } } my $CLASS_NAME = 'Thing'; { package Role; use Moose::Role; sub foo { } } my $ROLE_NAME = 'Role'; my %tests = ( Any => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Item => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Defined => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $UNDEF, ], }, Undef => { accept => [ $UNDEF, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], }, Bool => { accept => [ $ZERO, $ONE, $EMPTY_STRING, $UNDEF, ], reject => [ $INT, $NEG_INT, $NUM, $NEG_NUM, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], }, Maybe => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Value => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ], reject => [ $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Ref => { accept => [ $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, $UNDEF, ], }, Num => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, ], reject => [ $EMPTY_STRING, $STRING, $NUM_IN_STRING, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, $INT_WITH_NL1, $INT_WITH_NL2, ], }, Int => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, ], reject => [ $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Str => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, ], reject => [ $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ScalarRef => { accept => [ $SCALAR_REF, $SCALAR_REF_REF, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ArrayRef => { accept => [ $ARRAY_REF, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, HashRef => { accept => [ $HASH_REF, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, CodeRef => { accept => [ $CODE_REF, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, RegexpRef => { accept => [ $REGEX, $REGEX_OBJ, $FAKE_REGEX, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $OBJECT, $UNDEF, ], }, GlobRef => { accept => [ $GLOB_REF, $FH, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $FH_OBJECT, $OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $UNDEF, ], }, FileHandle => { accept => [ $FH, $FH_OBJECT, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $UNDEF, ], }, Object => { accept => [ $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], }, ClassName => { accept => [ $CLASS_NAME, $ROLE_NAME, ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, RoleName => { accept => [ $ROLE_NAME, ], reject => [ $CLASS_NAME, $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); for my $name ( sort keys %tests ) { test_constraint( 'Types::Standard'->get_type($name), $tests{$name} ); test_constraint( dwim_type("$name|$name"), $tests{$name} ); } my %substr_test_str = ( ClassName => 'x' . $CLASS_NAME, RoleName => 'x' . $ROLE_NAME, ); # We need to test that the Str constraint (and types that derive from it) # accept the return val of substr() - which means passing that return val # directly to the checking code foreach my $type_name (qw(Str Num Int ClassName RoleName)) { my $str = $substr_test_str{$type_name} || '123456789'; my $type = 'Types::Standard'->get_type($type_name); my $unoptimized = $type->parent->create_child_type(constraint => $type->constraint)->compiled_check; my $inlined; { $inlined = eval_closure( source => 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }', ); } ok( $type->check( substr( $str, 1, 5 ) ), $type_name . ' accepts return val from substr using ->check' ); ok( $unoptimized->( substr( $str, 1, 5 ) ), $type_name . ' accepts return val from substr using unoptimized constraint' ); ok( $inlined->( substr( $str, 1, 5 ) ), $type_name . ' accepts return val from substr using inlined constraint' ); # only Str accepts empty strings. next unless $type_name eq 'Str'; ok( $type->check( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using ->check' ); ok( $unoptimized->( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using unoptimized constraint' ); ok( $inlined->( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using inlined constraint' ); } { my $class_tc = class_type {class => 'Thing'}; test_constraint( $class_tc, { accept => [ ( bless {}, 'Thing' ), ], reject => [ 'Thing', $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], } ); } { package Duck; sub new { } sub quack { } sub flap { } } { package DuckLike; sub new { } sub quack { } sub flap { } } { package Bird; sub new { } sub flap { } } { my @methods = qw( quack flap ); my $duck = duck_type 'Duck' => [@methods]; test_constraint( $duck, { accept => [ ( bless {}, 'Duck' ), ( bless {}, 'DuckLike' ), ], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ( bless {}, 'Bird' ), $UNDEF, ], } ); } { my @allowed = qw( bar baz quux ); my $enum = enum 'Enumerated' => [@allowed]; test_constraint( $enum, { accept => \@allowed, reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], } ); } { require Type::Tiny::Union; my $union = 'Type::Tiny::Union'->new( type_constraints => [ Types::Standard::Int, Types::Standard::Object, ], ); test_constraint( $union, { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], } ); } { note 'Anonymous Union Test'; my $union = union[ Types::Standard::Int, Types::Standard::Object ]; test_constraint( $union, { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], } ); } { note 'Named Union Test'; my $union = union 'NamedUnion' => [ Types::Standard::Int, Types::Standard::Object ]; test_constraint( $union, { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, ], reject => [ $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], } ); } { note 'Combined Union Test'; my $union = union( [ Types::Standard::Int, enum [qw[ red green blue ]] ] ); test_constraint( $union, { accept => [ $ZERO, $ONE, $INT, $NEG_INT, 'red', 'green', 'blue', ], reject => [ 'yellow', 'pink', $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $UNDEF, ], } ); } { my $enum1 = enum 'Enum1' => ['a', 'b']; my $enum2 = enum 'Enum2' => ['x', 'y']; my $union = subtype 'EnumUnion', as ($enum1|$enum2); test_constraint( $union, { accept => [qw( a b x y )], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $ARRAY_REF, $HASH_REF, $CODE_REF, $GLOB, $GLOB_REF, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $FAKE_REGEX, $OBJECT, $UNDEF, ], } ); } { package DoesRole; use Moose; with 'Role'; } close $FH or warn "Could not close the filehandle $0 for test"; $FH_OBJECT->close or warn "Could not close the filehandle $0 for test"; done_testing; sub test_constraint { my $type = shift; my $tests = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; unless ( blessed $type ) { BAIL_OUT("TYPE STRING!!! $type!"); } my $name = $type->name; note "TYPE: $name"; my $unoptimized = $type->has_parent ? $type->parent->create_child_type(constraint => $type->constraint)->compiled_check : 'Type::Tiny'->new( constraint => $type->constraint )->compiled_check; my $inlined; if ( $type->can_be_inlined ) { $inlined = eval_closure( source => 'sub { ( ' . $type->_inline_check('$_[0]') . ' ) }', environment => $type->inline_environment, ); } require Moose; my $class = Moose::Meta::Class->create_anon( superclasses => ['Moose::Object'], ); $class->add_attribute( simple => ( is => 'ro', isa => $type, ) ); $class->add_attribute( collection => ( traits => ['Array'], isa => Types::Standard::ArrayRef()->parameterize($type), default => sub { [] }, handles => { add_to_collection => 'push' }, ) ); my $anon_class = $class->name; for my $accept ( @{ $tests->{accept} || [] } ) { my $described = describe($accept); ok( $type->check($accept), "$name accepts $described using ->check" ); ok( $unoptimized->($accept), "$name accepts $described using unoptimized constraint" ); if ($inlined) { ok( $inlined->($accept), "$name accepts $described using inlined constraint" ); } is( exception { $anon_class->new( simple => $accept ); }, undef, "no exception passing $described to constructor with $name" ); is( exception { $anon_class->new()->add_to_collection($accept); }, undef, "no exception passing $described to native trait push method with $name" ); } for my $reject ( @{ $tests->{reject} || [] } ) { my $described = describe($reject); ok( !$type->check($reject), "$name rejects $described using ->check" ); ok( !$unoptimized->($reject), "$name rejects $described using unoptimized constraint" ); if ($inlined) { ok( !$inlined->($reject), "$name rejects $described using inlined constraint" ); } ok( exception { $anon_class->new( simple => $reject ); }, "got exception passing $described to constructor with $name" ); ok( exception { $anon_class->new()->add_to_collection($reject); }, "got exception passing $described to native trait push method with $name" ); } } sub describe { my $val = shift; return 'undef' unless defined $val; if ( !ref $val ) { return q{''} if $val eq q{}; $val =~ s/\n/\\n/g; return $val; } return 'open filehandle' if openhandle $val && !blessed $val; return blessed $val ? ( ref $val ) . ' object' : ( ref $val ) . ' reference'; } README000664001750001750 132515111656240 13537 0ustar00taitai000000000000Type-Tiny-2.008006/tRunning the test suite ====================== In the main directory for the distribution (i.e. the directory containing dist.ini), run the following command: prove -lr -Iinc "t" Test suite structure ==================== Each test should contain its own documentation in pod format. t/20-modules/ - tests for each module in the distribution t/21-types/ - tests for each type in every bundled type library t/30-external/ - tests for using Type-Tiny with other software - these should be skipped if the other software is not available t/40-bugs/ - tests related to specific bug reports t/lib/ - support files for test cases. t/*.t - miscellaneous other tests t/*.pl - support files for managing test cases mk-test-manifest.pl000664001750001750 603415111656240 16406 0ustar00taitai000000000000Type-Tiny-2.008006/t#!/usr/bin/env perl use v5.014; use Path::Tiny; use Path::Iterator::Rule; use Pod::POM; use constant PROJ_NAME => 'Type-Tiny'; use constant PROJ_DIR => path(path(__FILE__)->absolute->dirname)->parent; use constant LIB_DIR => PROJ_DIR->child('lib'); use constant TEST_DIR => PROJ_DIR->child('t'); my $rule = Path::Iterator::Rule->new->file->name('*.t'); package Local::View { use parent 'Pod::POM::View::Text'; sub view_seq_link { my ($self, $link) = @_; $link =~ s/^.*?\|//; return $link; } } sub podpurpose { my $pod = Pod::POM->new->parse_file($_[0]->openr_raw); my ($purpose) = grep $_->title eq 'PURPOSE', $pod->head1; my $content = eval { $purpose->content->present('Local::View') } || "(Unknown.)"; my $trimmed = ($content =~ s/(\A\s+)|(\s+\z)//rms); $trimmed =~ s/\s+/ /g; $trimmed =~ s/"/\\"/g if $_[1]; return $trimmed; } say '@prefix : .'; MISC_TESTS: { my $iter = $rule->clone->max_depth(1)->iter( TEST_DIR ); while (my $file = $iter->()) { my $test = path($file); say "[] a :Test; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\"."; } } UNIT_TESTS: { my $iter = $rule->iter( TEST_DIR->child('20-modules') ); my %mods; while (my $file = $iter->()) { my $test = path($file); my ($module) = ($test =~ m(t/20-modules/([^/]+)/)); $module =~ s{-}{::}g; push @{ $mods{$module} ||= [] }, $test; } for my $mod (sort keys %mods) { say "m`$mod ${\ PROJ_NAME }`"; for my $test (sort @{ $mods{$mod} }) { say "\t:test [ a :AutomatedTest; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\" ];"; } say "\t."; } } INTEGRATION_TESTS: { my $iter = $rule->iter( TEST_DIR->child('30-external') ); while (my $file = $iter->()) { my $test = path($file); say "[] a :AutomatedTest; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\"."; } } REGRESSION_TESTS: { my $iter = $rule->iter( TEST_DIR->child('40-bugs') ); my %bugs; my %ghbugs; while (my $file = $iter->()) { my $test = path($file); if ($test =~ m/\/rt([0-9]+)/) { push @{ $bugs{$1} ||= [] }, $test; next; } elsif ($test =~ m/\/gh([0-9]+)/) { push @{ $ghbugs{$1} ||= [] }, $test; next; } say "[] a :RegressionTest; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\"."; } for my $rt (sort { $a <=> $b } keys %bugs) { say "RT#$rt"; for my $test (@{$bugs{$rt}}) { say "\t:regression_test [ a :RegressionTest; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\"];"; } say "\t."; } for my $gh (sort { $a <=> $b } keys %ghbugs) { say ""; for my $test (@{$ghbugs{$gh}}) { say "\t:regression_test [ a :RegressionTest; :test_script f`${\ $test->relative(PROJ_DIR) } ${\ PROJ_NAME }`; :purpose \"${\ podpurpose($test,1) }\"];"; } say "\t."; } } not-covered.pl000664001750001750 113315111656240 15436 0ustar00taitai000000000000Type-Tiny-2.008006/t#!/usr/bin/env perl use v5.014; use Path::Tiny; use Path::Iterator::Rule; use constant LIB_DIR => path(path(__FILE__)->absolute->dirname)->parent->child('lib'); use constant TEST_DIR => path(path(__FILE__)->absolute->dirname)->parent->child('t/20-modules'); my $rule = Path::Iterator::Rule->new->file->perl_module; my $iter = $rule->iter( LIB_DIR ); while (my $file = $iter->()) { my $module = path($file)->relative(LIB_DIR); $module =~ s{.pm$}{}; $module =~ s{/}{::}g; TEST_DIR->child($module =~ s/::/-/gr)->exists or ($module =~ /^Types::Standard::/) # helper module or say $module; } benchmark-coercions.pl000664001750001750 674515111656240 23146 0ustar00taitai000000000000Type-Tiny-2.008006/examples/benchmarking=pod =encoding utf-8 =head1 PURPOSE Compares the speed of the constructor in four equivalent classes built using different tools: =over =item B L with L types and non-L coderef coercions. =item B L with L types and coercions. =item B L with L type constraints and coderef coercions. Class is made immutable. =item B L with L type constraints and coercions. Class is made immutable. =back =head1 RESULTS For both Moose and Moo, L type constraints are clearly faster than the conventional approach. B<< With Type::Tiny::XS: >> Rate Moo_MXTML Moose Moo_TT Moose_TT Moo_MXTML 3040/s -- -44% -64% -83% Moose 5463/s 80% -- -35% -69% Moo_TT 8373/s 175% 53% -- -52% Moose_TT 17612/s 479% 222% 110% -- B<< Without Type::Tiny::XS: >> Rate Moo_MXTML Moo_TT Moose Moose_TT Moo_MXTML 3140/s -- -41% -50% -63% Moo_TT 5288/s 68% -- -16% -38% Moose 6305/s 101% 19% -- -26% Moose_TT 8574/s 173% 62% 36% -- (Tested versions: Type::Tiny 0.045_03, Type::Tiny::XS 0.004, Moose 2.1207, Moo 1.005000, and MooX::Types::MooseLike 0.25.) =head1 DEPENDENCIES To run this script, you will need: L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2024 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Benchmark ':all'; { package Local::Moo_MXTML; use Moo; use MooX::Types::MooseLike::Base qw(HashRef ArrayRef Int is_Int); has attr1 => ( is => "ro", isa => ArrayRef[Int], coerce => sub { is_Int($_[0]) ? [ $_[0] ] : $_[0] }, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); } { package Local::Moo_TT; use Moo; use Types::Standard qw(HashRef ArrayRef Int); my $AofI = (ArrayRef[Int])->plus_coercions(Int, '[$_]'); has attr1 => ( is => "ro", isa => $AofI, coerce => $AofI->coercion, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); } { package Local::Moose; use Moose; use Moose::Util::TypeConstraints qw(subtype as coerce from via); subtype "AofI", as "ArrayRef[Int]"; coerce "AofI", from "Int", via { [$_] }; has attr1 => ( is => "ro", isa => "AofI", coerce => 1, ); has attr2 => ( is => "ro", isa => "HashRef[ArrayRef[Int]]", ); __PACKAGE__->meta->make_immutable; } { package Local::Moose_TT; use Moose; use Types::Standard qw(HashRef ArrayRef Int); use Sub::Quote; my $AofI = (ArrayRef[Int])->plus_coercions(Int, '[$_]'); has attr1 => ( is => "ro", isa => $AofI, coerce => 1, ); has attr2 => ( is => "ro", isa => HashRef[ArrayRef[Int]], ); __PACKAGE__->meta->make_immutable; } our %data = ( attr1 => 4, attr2 => { one => [0 .. 1], two => [0 .. 2], three => [0 .. 3], }, ); cmpthese(-1, { Moo_MXTML => q{ Local::Moo_MXTML->new(%::data) }, Moo_TT => q{ Local::Moo_TT->new(%::data) }, Moose_TT => q{ Local::Moose_TT->new(%::data) }, Moose => q{ Local::Moose->new(%::data) }, }); benchmark-constraints.pl000664001750001750 1145315111656240 23541 0ustar00taitai000000000000Type-Tiny-2.008006/examples/benchmarking=pod =encoding utf-8 =head1 PURPOSE Compares the speed of the constructor in six equivalent classes built using different tools: =over =item B L with L types. =item B L with L types. =item B L with L type constraints. Class is made immutable. =item B L with L type constraints. Class is made immutable. =item B L with L type constraints. Class is made immutable. B<< XS is switched off using C environment variable. >> =item B L with L type constraints. Class is made immutable. B<< XS is switched off using C environment variable. >> =back Each tool is used to define a class like the following: { package Local::Class; use Whatever::Tool; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); } Then we benchmark the following object instantiation: Local::Class->new( attr1 => [1..10], attr2 => { one => [0 .. 1], two => [0 .. 2], three => [0 .. 3], }, ); =head1 RESULTS In all cases, L type constraints are clearly faster than the conventional approach. B<< With Type::Tiny::XS: >> Rate Moo_MXTML Mouse Moose Moo_TT Moose_TT Mouse_TT Moo_MXTML 2428/s -- -35% -57% -82% -90% -91% Mouse 3759/s 55% -- -33% -72% -85% -86% Moose 5607/s 131% 49% -- -58% -78% -79% Moo_TT 13274/s 447% 253% 137% -- -48% -51% Moose_TT 25358/s 945% 575% 352% 91% -- -7% Mouse_TT 27306/s 1025% 626% 387% 106% 8% -- B<< Without Type::Tiny::XS: >> Rate Moo_MXTML Mouse Moo_TT Moose Moose_TT Mouse_TT Moo_MXTML 2610/s -- -31% -56% -56% -67% -67% Mouse 3759/s 44% -- -36% -37% -52% -52% Moo_TT 5894/s 126% 57% -- -1% -24% -25% Moose 5925/s 127% 58% 1% -- -24% -25% Moose_TT 7802/s 199% 108% 32% 32% -- -1% Mouse_TT 7876/s 202% 110% 34% 33% 1% -- (Tested versions: Type::Tiny 0.045_03, Type::Tiny::XS 0.004, Moose 2.1207, Moo 1.005000, MooX::Types::MooseLike 0.25, and Mouse 2.3.0) =head1 DEPENDENCIES To run this script, you will need: L, L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2024 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Benchmark ':all'; BEGIN { $ENV{MOUSE_PUREPERL} = 1 }; { package Local::Moo_MXTML; use Moo; use MooX::Types::MooseLike::Base qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); } { package Local::Moo_TT; use Moo; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); } { package Local::Moose; use Moose; has attr1 => (is => "ro", isa => "ArrayRef[Int]"); has attr2 => (is => "ro", isa => "HashRef[ArrayRef[Int]]"); __PACKAGE__->meta->make_immutable; } { package Local::Moose_TT; use Moose; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); __PACKAGE__->meta->make_immutable; } { package Local::Mouse; use Mouse; has attr1 => (is => "ro", isa => "ArrayRef[Int]"); has attr2 => (is => "ro", isa => "HashRef[ArrayRef[Int]]"); __PACKAGE__->meta->make_immutable; } { package Local::Mouse_TT; use Mouse; use Types::Standard qw(HashRef ArrayRef Int); has attr1 => (is => "ro", isa => ArrayRef[Int]); has attr2 => (is => "ro", isa => HashRef[ArrayRef[Int]]); __PACKAGE__->meta->make_immutable; } our %data = ( attr1 => [1..10], attr2 => { one => [0 .. 1], two => [0 .. 2], three => [0 .. 3], }, ); cmpthese(-1, { Moo_MXTML => q{ Local::Moo_MXTML->new(%::data) }, Moose => q{ Local::Moose->new(%::data) }, Mouse => q{ Local::Mouse->new(%::data) }, Moo_TT => q{ Local::Moo_TT->new(%::data) }, Moose_TT => q{ Local::Moose_TT->new(%::data) }, Mouse_TT => q{ Local::Mouse_TT->new(%::data) }, }); benchmark-named-param-validation.pl000664001750001750 1162715111656240 25507 0ustar00taitai000000000000Type-Tiny-2.008006/examples/benchmarking=pod =encoding utf-8 =head1 DESCRIPTION Let's use L to see how fast L is compared with other modules for validating named parameters. (Hint: very fast.) =head1 RESULTS The results of running the script on a fairly low-powered laptop. Each parameter checking implementation is called 250,000 times. The table below displays the average time taken for each call in nanoseconds. =head2 With Type::Tiny::XS Type::Params with Type::Tiny .................... 1560 ns (641025/s) Params::ValidationCompiler with Type::Tiny ...... 1679 ns (595238/s) Type::Params with Moose ......................... 1719 ns (581395/s) Pure Perl Implementation with Ref::Util::XS ..... 1840 ns (543478/s) Naive Pure Perl Implementation .................. 2039 ns (490196/s) Type::Params with Specio ........................ 2439 ns (409836/s) Params::ValidationCompiler with Specio .......... 2480 ns (403225/s) Type::Params with Mouse ......................... 2519 ns (396825/s) Params::ValidationCompiler with Moose ........... 2560 ns (390624/s) Data::Validator with Mouse ...................... 2599 ns (384615/s) Params::Validate with Type::Tiny ................ 2800 ns (357142/s) Data::Validator with Type::Tiny ................. 2920 ns (342465/s) Params::Validate ................................ 3399 ns (294117/s) Data::Validator with Moose ...................... 4920 ns (203252/s) Params::Check with Type::Tiny ................... 5279 ns (189393/s) Params::Check with coderefs ..................... 6359 ns (157232/s) MooseX::Params::Validate with Moose ............. 10520 ns (95057/s) MooseX::Params::Validate with Type::Tiny ........ 10520 ns (95057/s) Type::Params with Type::Nano .................... 10679 ns (93632/s) =head2 Without Type::Tiny::XS Pure Perl Implementation with Ref::Util::XS ..... 1839 ns (543478/s) Type::Params with Type::Tiny .................... 1959 ns (510204/s) Naive Pure Perl Implementation .................. 2039 ns (490196/s) Type::Params with Moose ......................... 2079 ns (480769/s) Params::ValidationCompiler with Type::Tiny ...... 2119 ns (471698/s) Type::Params with Specio ........................ 2439 ns (409836/s) Params::ValidationCompiler with Specio .......... 2520 ns (396825/s) Params::ValidationCompiler with Moose ........... 2599 ns (384615/s) Params::Validate ................................ 3359 ns (297619/s) Type::Params with Mouse ......................... 3760 ns (265957/s) Params::Validate with Type::Tiny ................ 3920 ns (255102/s) Data::Validator with Type::Tiny ................. 4359 ns (229357/s) Data::Validator with Mouse ...................... 4640 ns (215517/s) Data::Validator with Moose ...................... 5399 ns (185185/s) Params::Check with coderefs ..................... 6359 ns (157232/s) Params::Check with Type::Tiny ................... 6359 ns (157232/s) MooseX::Params::Validate with Moose ............. 10440 ns (95785/s) MooseX::Params::Validate with Type::Tiny ........ 10440 ns (95785/s) Type::Params with Type::Nano .................... 10520 ns (95057/s) =head1 ANALYSIS Type::Params (using Type::Tiny type constraints) is the fastest framework for checking named parameters for a function, whether or not Type::Tiny::XS is available. Params::ValidationCompiler (also using Type::Tiny type constraints) is very nearly as fast. Params::ValidationCompiler using other type constraints is also quite fast, and when Type::Tiny::XS is not available, Moose and Specio constraints run almost as fast as Type::Tiny constraints. Data::Validator is acceptably fast. Params::Check is fairly slow, and MooseX::Params::Validate very slow. Type::Tiny::XS seems to slow down MooseX::Params::Validate for some strange reason. Type::Nano is slow. (But it's not written for speed!) =head1 DEPENDENCIES To run this script, you will need: L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2017-2024 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use v5.12; use strict; use warnings; use Benchmark qw(:hireswallclock timeit); use Benchmark::Featureset::ParamCheck 0.006; use Module::Runtime qw(use_module); my $data = 'Benchmark::Featureset::ParamCheck'->trivial_named_data; my @impl = 'Benchmark::Featureset::ParamCheck'->implementations; my $iter = 250_000; say for map { sprintf( '%s %s %6d ns (%d/s)', $_->[0]->long_name, '.' x (48 - length($_->[0]->long_name)), 1_000_000_000 * $_->[1]->cpu_a / $iter, $iter / $_->[1]->cpu_a, ); } sort { $a->[1]->cpu_a <=> $b->[1]->cpu_a; } map { my $pkg = use_module($_); [ $pkg, timeit 1, sub { $pkg->run_named_check($iter, $data) } ]; } @impl; benchmark-param-validation.pl000664001750001750 1132615111656240 24421 0ustar00taitai000000000000Type-Tiny-2.008006/examples/benchmarking=pod =encoding utf-8 =head1 DESCRIPTION Let's use L to see how fast L is compared with other modules for validating positional parameters. (Hint: very fast.) =head1 RESULTS The results of running the script on a fairly low-powered laptop. Each parameter checking implementation is called 250,000 times. The table below displays the average time taken for each call in nanoseconds. =head2 With Type::Tiny::XS Pure Perl Implementation with Ref::Util::XS ..... 479 ns (2083333/s) Type::Params with Type::Tiny .................... 519 ns (1923076/s) Params::ValidationCompiler with Type::Tiny ...... 560 ns (1785714/s) Naive Pure Perl Implementation .................. 640 ns (1562499/s) Type::Params with Moose ......................... 799 ns (1250000/s) Params::ValidationCompiler with Specio .......... 1399 ns (714285/s) Params::ValidationCompiler with Moose ........... 1479 ns (675675/s) Type::Params with Mouse ......................... 1520 ns (657894/s) Type::Params with Specio ........................ 1560 ns (641025/s) Params::Validate with Type::Tiny ................ 2199 ns (454545/s) Params::Validate ................................ 2760 ns (362318/s) Data::Validator with Mouse ...................... 5560 ns (179856/s) Data::Validator with Type::Tiny ................. 5600 ns (178571/s) Data::Validator with Moose ...................... 5680 ns (176056/s) MooseX::Params::Validate with Moose ............. 8079 ns (123762/s) MooseX::Params::Validate with Type::Tiny ........ 8120 ns (123152/s) Type::Params with Type::Nano .................... 9160 ns (109170/s) =head2 Without Type::Tiny::XS Pure Perl Implementation with Ref::Util::XS ..... 479 ns (2083333/s) Naive Pure Perl Implementation .................. 599 ns (1666666/s) Type::Params with Type::Tiny .................... 1079 ns (925925/s) Params::ValidationCompiler with Type::Tiny ...... 1120 ns (892857/s) Type::Params with Moose ......................... 1240 ns (806451/s) Type::Params with Specio ........................ 1520 ns (657894/s) Params::ValidationCompiler with Specio .......... 1560 ns (641025/s) Params::ValidationCompiler with Moose ........... 1599 ns (625000/s) Params::Validate ................................ 2640 ns (378787/s) Type::Params with Mouse ......................... 2760 ns (362318/s) Params::Validate with Type::Tiny ................ 3279 ns (304878/s) Data::Validator with Moose ...................... 5760 ns (173611/s) Data::Validator with Type::Tiny ................. 5799 ns (172413/s) Data::Validator with Mouse ...................... 5800 ns (172413/s) MooseX::Params::Validate with Type::Tiny ........ 8079 ns (123762/s) MooseX::Params::Validate with Moose ............. 8120 ns (123152/s) Type::Params with Type::Nano .................... 9119 ns (109649/s) =head1 ANALYSIS Type::Params (using Type::Tiny type constraints) is the fastest framework for checking positional parameters for a function, whether or not Type::Tiny::XS is available. The only way to beat it is to write your own type checking in longhand, but if Type::Tiny::XS is installed, hand-rolled code might still be slower. Params::ValidationCompiler (also using Type::Tiny type constraints) is very nearly as fast. Params::ValidationCompiler using other type constraints is also quite fast, and when Type::Tiny::XS is not available, Moose and Specio constraints run almost as fast as Type::Tiny constraints. Data::Validator and MooseX::Params::Validate are far slower. Type::Nano is slow. (But it's not written for speed!) =head1 DEPENDENCIES To run this script, you will need: L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2024 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use v5.12; use strict; use warnings; use Benchmark qw(:hireswallclock timeit); use Benchmark::Featureset::ParamCheck 0.006; use Module::Runtime qw(use_module); my $data = 'Benchmark::Featureset::ParamCheck'->trivial_positional_data; my @impl = 'Benchmark::Featureset::ParamCheck'->implementations; my $iter = 250_000; say for map { sprintf( '%s %s %6d ns (%d/s)', $_->[0]->long_name, '.' x (48 - length($_->[0]->long_name)), 1_000_000_000 * $_->[1]->cpu_a / $iter, $iter / $_->[1]->cpu_a, ); } sort { $a->[1]->cpu_a <=> $b->[1]->cpu_a; } map { my $pkg = use_module($_); $pkg->accept_array ? [ $pkg, timeit 1, sub { $pkg->run_positional_check($iter, @$data) } ] : () } @impl; versus-scalar-validation.pl000664001750001750 400315111656240 24135 0ustar00taitai000000000000Type-Tiny-2.008006/examples/benchmarkinguse strict; use warnings; use Test::More; use Test::Fatal; use Test::Benchmark; use Benchmark qw(timethis); $Test::Benchmark::VERBOSE = 1; { package UseSV; use Scalar::Validation qw(:all); sub test { my $p_bool = par p_bool => -Enum => [0 => '1'] => shift; my $p_123 = par p_123 => -Enum => {1 => 1, 2 => 1, 3 => 1} => shift; my $p_free = par p_free => sub { $_ > 5 } => shift, sub { "$_ is not larger than 5" }; p_end \@_; return $p_bool + $p_123 + $p_free; } } { package UseTP; use Type::Params qw(compile); use Types::Standard qw(Enum); use Types::XSD::Lite qw(Integer); my $_check = compile Enum[0,1], Enum[1..3], Integer[minExclusive => 5]; sub test { my ($p_bool, $p_123, $p_free) = $_check->(@_); return $p_bool + $p_123 + $p_free; } } subtest "Scalar::Validation works ok" => sub { is( UseSV::test(1,2,7), 10 ); like( exception { UseSV::test(2,2,2) }, qr/^Error/, ); }; subtest "Type::Params works ok" => sub { is( UseTP::test(1,2,7), 10 ); like( exception { UseTP::test(2,2,2) }, qr/did not pass type constraint/, ); }; is_fastest('TP', -1, { SV => q[ UseSV::test(1,2,7) ], TP => q[ UseTP::test(1,2,7) ], }, 'Type::Params is fastest at passing validations'); is_fastest('TP', -1, { SV => q[ eval { UseSV::test(1,2,3) } ], TP => q[ eval { UseTP::test(1,2,3) } ], }, 'Type::Params is fastest at failing validations'); done_testing; __END__ # Subtest: Scalar::Validation works ok ok 1 ok 2 1..2 ok 1 - Scalar::Validation works ok # Subtest: Type::Params works ok ok 1 ok 2 1..2 ok 2 - Type::Params works ok ok 3 - Type::Params is fastest at passing validations # TP - 2 wallclock secs ( 1.17 usr + 0.00 sys = 1.17 CPU) @ 6564.10/s (n=7680) # SV - 1 wallclock secs ( 1.03 usr + 0.00 sys = 1.03 CPU) @ 4744.66/s (n=4887) ok 4 - Type::Params is fastest at failing validations # TP - 1 wallclock secs ( 1.05 usr + 0.00 sys = 1.05 CPU) @ 3412.38/s (n=3583) # SV - 1 wallclock secs ( 1.07 usr + 0.03 sys = 1.10 CPU) @ 1285.45/s (n=1414) 1..4 Fatal.pm000664001750001750 245515111656240 15476 0ustar00taitai000000000000Type-Tiny-2.008006/inc/Test#line 1 use strict; use warnings; package Test::Fatal; { $Test::Fatal::VERSION = '0.010'; } # ABSTRACT: incredibly simple helpers for testing code with exceptions use Carp (); use Try::Tiny 0.07; use base 'Exporter'; our @EXPORT = qw(exception); our @EXPORT_OK = qw(exception success dies_ok lives_ok); sub exception (&) { my $code = shift; return try { $code->(); return undef; } catch { return $_ if $_; my $problem = defined $_ ? 'false' : 'undef'; Carp::confess("$problem exception caught by Test::Fatal::exception"); }; } sub success (&;@) { my $code = shift; return finally( sub { return if @_; # <-- only run on success $code->(); }, @_ ); } my $Tester; # Signature should match that of Test::Exception sub dies_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( exception( \&$code ), $name ); $ok or $Tester->diag( "expected an exception but none was raised" ); return $ok; } sub lives_ok (&;$) { my $code = shift; my $name = shift; require Test::Builder; $Tester ||= Test::Builder->new; my $ok = $Tester->ok( !exception( \&$code ), $name ); $ok or $Tester->diag( "expected return but an exception was raised" ); return $ok; } 1; __END__ #line 212 Requires.pm000664001750001750 374315111656240 16247 0ustar00taitai000000000000Type-Tiny-2.008006/inc/Test#line 1 package Test::Requires; use strict; use warnings; our $VERSION = '0.06'; use base 'Test::Builder::Module'; use 5.006000; sub import { my $class = shift; my $caller = caller(0); # export methods { no strict 'refs'; *{"$caller\::test_requires"} = \&test_requires; } # test arguments if (@_ == 1 && ref $_[0] && ref $_[0] eq 'HASH') { while (my ($mod, $ver) = each %{$_[0]}) { test_requires($mod, $ver, $caller); } } else { for my $mod (@_) { test_requires($mod, undef, $caller); } } } sub test_requires { my ( $mod, $ver, $caller ) = @_; return if $mod eq __PACKAGE__; if (@_ != 3) { $caller = caller(0); } $ver ||= ''; eval qq{package $caller; no warnings; use $mod $ver}; ## no critic. if (my $e = $@) { my $skip_all = sub { my $builder = __PACKAGE__->builder; if (not defined $builder->has_plan) { $builder->skip_all(@_); } elsif ($builder->has_plan eq 'no_plan') { $builder->skip(@_); if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } else { for (1..$builder->has_plan) { $builder->skip(@_); } if ( $builder->can('parent') && $builder->parent ) { die bless {} => 'Test::Builder::Exception'; } exit 0; } }; if ( $e =~ /^Can't locate/ ) { $skip_all->("requires $mod"); } elsif ( $e =~ /^Perl (\S+) required/ ) { $skip_all->("requires Perl $1"); } elsif ( $e =~ /^\Q$mod\E version (\S+) required/ ) { $skip_all->("requires $mod $1"); } else { $skip_all->("$e"); } } } 1; __END__ #line 128 Tiny.pm000664001750001750 4332515111656240 15252 0ustar00taitai000000000000Type-Tiny-2.008006/inc/Trypackage Try::Tiny; BEGIN { $Try::Tiny::AUTHORITY = 'cpan:NUFFIN'; } $Try::Tiny::VERSION = '0.21'; use 5.006; # ABSTRACT: minimal try/catch with proper preservation of $@ use strict; use warnings; use Exporter (); our @ISA = qw( Exporter ); our @EXPORT = our @EXPORT_OK = qw(try catch finally); use Carp; $Carp::Internal{+__PACKAGE__}++; BEGIN { eval "use Sub::Name; 1" or *{subname} = sub {1} } # Need to prototype as @ not $$ because of the way Perl evaluates the prototype. # Keeping it at $$ means you only ever get 1 sub because we need to eval in a list # context & not a scalar one sub try (&;@) { my ( $try, @code_refs ) = @_; # we need to save this here, the eval block will be in scalar context due # to $failed my $wantarray = wantarray; # work around perl bug by explicitly initializing these, due to the likelyhood # this will be used in global destruction (perl rt#119311) my ( $catch, @finally ) = (); # find labeled blocks in the argument list. # catch and finally tag the blocks by blessing a scalar reference to them. foreach my $code_ref (@code_refs) { if ( ref($code_ref) eq 'Try::Tiny::Catch' ) { croak 'A try() may not be followed by multiple catch() blocks' if $catch; $catch = ${$code_ref}; } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) { push @finally, ${$code_ref}; } else { croak( 'try() encountered an unexpected argument (' . ( defined $code_ref ? $code_ref : 'undef' ) . ') - perhaps a missing semi-colon before or' ); } } # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's # not perfect, but we could provide a list of additional errors for # $catch->(); # name the blocks if we have Sub::Name installed my $caller = caller; subname("${caller}::try {...} " => $try); subname("${caller}::catch {...} " => $catch) if $catch; subname("${caller}::finally {...} " => $_) foreach @finally; # save the value of $@ so we can set $@ back to it in the beginning of the eval # and restore $@ after the eval finishes my $prev_error = $@; my ( @ret, $error ); # failed will be true if the eval dies, because 1 will not be returned # from the eval body my $failed = not eval { $@ = $prev_error; # evaluate the try block in the correct context if ( $wantarray ) { @ret = $try->(); } elsif ( defined $wantarray ) { $ret[0] = $try->(); } else { $try->(); }; return 1; # properly set $fail to false }; # preserve the current error and reset the original value of $@ $error = $@; $@ = $prev_error; # set up a scope guard to invoke the finally block at the end my @guards = map { Try::Tiny::ScopeGuard->_new($_, $failed ? $error : ()) } @finally; # at this point $failed contains a true value if the eval died, even if some # destructor overwrote $@ as the eval was unwinding. if ( $failed ) { # if we got an error, invoke the catch block. if ( $catch ) { # This works like given($error), but is backwards compatible and # sets $_ in the dynamic scope for the body of C<$catch> for ($error) { return $catch->($error); } # in case when() was used without an explicit return, the C # loop will be aborted and there's no useful return value } return; } else { # no failure, $@ is back to what it was, everything is fine return $wantarray ? @ret : $ret[0]; } } sub catch (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare catch()' unless wantarray; return ( bless(\$block, 'Try::Tiny::Catch'), @rest, ); } sub finally (&;@) { my ( $block, @rest ) = @_; croak 'Useless bare finally()' unless wantarray; return ( bless(\$block, 'Try::Tiny::Finally'), @rest, ); } { package # hide from PAUSE Try::Tiny::ScopeGuard; use constant UNSTABLE_DOLLARAT => ($] < '5.013002') ? 1 : 0; sub _new { shift; bless [ @_ ]; } sub DESTROY { my ($code, @args) = @{ $_[0] }; local $@ if UNSTABLE_DOLLARAT; eval { $code->(@args); 1; } or do { warn "Execution of finally() block $code resulted in an exception, which " . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. ' . 'Your program will continue as if this event never took place. ' . "Original exception text follows:\n\n" . (defined $@ ? $@ : '$@ left undefined...') . "\n" ; } } } __PACKAGE__ __END__ =pod =encoding UTF-8 =head1 NAME Try::Tiny - minimal try/catch with proper preservation of $@ =head1 VERSION version 0.21 =head1 SYNOPSIS You can use Try::Tiny's C and C to expect and handle exceptional conditions, avoiding quirks in Perl and common mistakes: # handle errors with a catch handler try { die "foo"; } catch { warn "caught error: $_"; # not $@ }; You can also use it like a standalone C to catch and ignore any error conditions. Obviously, this is an extreme measure not to be undertaken lightly: # just silence errors try { die "foo"; }; =head1 DESCRIPTION This module provides bare bones C/C/C statements that are designed to minimize common mistakes with eval blocks, and NOTHING else. This is unlike L which provides a nice syntax and avoids adding another call stack layer, and supports calling C from the C block to return from the parent subroutine. These extra features come at a cost of a few dependencies, namely L and L which are occasionally problematic, and the additional catch filtering uses L type constraints which may not be desirable either. The main focus of this module is to provide simple and reliable error handling for those having a hard time installing L, but who still want to write correct C blocks without 5 lines of boilerplate each time. It's designed to work as correctly as possible in light of the various pathological edge cases (see L) and to be compatible with any style of error values (simple strings, references, objects, overloaded objects, etc). If the C block dies, it returns the value of the last statement executed in the C block, if there is one. Otherwise, it returns C in scalar context or the empty list in list context. The following examples all assign C<"bar"> to C<$x>: my $x = try { die "foo" } catch { "bar" }; my $x = try { die "foo" } || { "bar" }; my $x = (try { die "foo" }) // { "bar" }; my $x = eval { die "foo" } || "bar"; You can add C blocks, yielding the following: my $x; try { die 'foo' } finally { $x = 'bar' }; try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' }; C blocks are always executed making them suitable for cleanup code which cannot be handled using local. You can add as many C blocks to a given C block as you like. Note that adding a C block without a preceding C block suppresses any errors. This behaviour is consistent with using a standalone C, but it is not consistent with C/C patterns found in other programming languages, such as Java, Python, Javascript or C#. If you learnt the C/C pattern from one of these languages, watch out for this. =head1 EXPORTS All functions are exported by default using L. If you need to rename the C, C or C keyword consider using L to get L's flexibility. =over 4 =item try (&;@) Takes one mandatory C subroutine, an optional C subroutine and C subroutine. The mandatory subroutine is evaluated in the context of an C block. If no error occurred the value from the first block is returned, preserving list/scalar context. If there was an error and the second subroutine was given it will be invoked with the error in C<$_> (localized) and as that block's first and only argument. C<$@> does B contain the error. Inside the C block it has the same value it had before the C block was executed. Note that the error may be false, but if that happens the C block will still be invoked. Once all execution is finished then the C block, if given, will execute. =item catch (&;@) Intended to be used in the second argument position of C. Returns a reference to the subroutine it was given but blessed as C which allows try to decode correctly what to do with this code reference. catch { ... } Inside the C block the caught error is stored in C<$_>, while previous value of C<$@> is still available for use. This value may or may not be meaningful depending on what happened before the C, but it might be a good idea to preserve it in an error stack. For code that captures C<$@> when throwing new errors (i.e. L), you'll need to do: local $@ = $_; =item finally (&;@) try { ... } catch { ... } finally { ... }; Or try { ... } finally { ... }; Or even try { ... } finally { ... } catch { ... }; Intended to be the second or third element of C. C blocks are always executed in the event of a successful C or if C is run. This allows you to locate cleanup code which cannot be done via C e.g. closing a file handle. When invoked, the C block is passed the error that was caught. If no error was caught, it is passed nothing. (Note that the C block does not localize C<$_> with the error, since unlike in a C block, there is no way to know if C<$_ == undef> implies that there were no errors.) In other words, the following code does just what you would expect: try { die_sometimes(); } catch { # ...code run in case of error } finally { if (@_) { print "The try block died with: @_\n"; } else { print "The try block ran without error.\n"; } }; B block>. C will not do anything about handling possible errors coming from code located in these blocks. Furthermore B blocks are not trappable and are unable to influence the execution of your program>. This is due to limitation of C-based scope guards, which C is implemented on top of. This may change in a future version of Try::Tiny. In the same way C blesses the code reference this subroutine does the same except it bless them as C. =back =head1 BACKGROUND There are a number of issues with C. =head2 Clobbering $@ When you run an C block and it succeeds, C<$@> will be cleared, potentially clobbering an error that is currently being caught. This causes action at a distance, clearing previous errors your caller may have not yet handled. C<$@> must be properly localized before invoking C in order to avoid this issue. More specifically, C<$@> is clobbered at the beginning of the C, which also makes it impossible to capture the previous error before you die (for instance when making exception objects with error stacks). For this reason C will actually set C<$@> to its previous value (the one available before entering the C block) in the beginning of the C block. =head2 Localizing $@ silently masks errors Inside an C block, C behaves sort of like: sub die { $@ = $_[0]; return_undef_from_eval(); } This means that if you were polite and localized C<$@> you can't die in that scope, or your error will be discarded (printing "Something's wrong" instead). The workaround is very ugly: my $error = do { local $@; eval { ... }; $@; }; ... die $error; =head2 $@ might not be a true value This code is wrong: if ( $@ ) { ... } because due to the previous caveats it may have been unset. C<$@> could also be an overloaded error object that evaluates to false, but that's asking for trouble anyway. The classic failure mode is: sub Object::DESTROY { eval { ... } } eval { my $obj = Object->new; die "foo"; }; if ( $@ ) { } In this case since C is not localizing C<$@> but still uses C, it will set C<$@> to C<"">. The destructor is called when the stack is unwound, after C sets C<$@> to C<"foo at Foo.pm line 42\n">, so by the time C is evaluated it has been cleared by C in the destructor. The workaround for this is even uglier than the previous ones. Even though we can't save the value of C<$@> from code that doesn't localize, we can at least be sure the C was aborted due to an error: my $failed = not eval { ... return 1; }; This is because an C that caught a C will always return a false value. =head1 SHINY SYNTAX Using Perl 5.10 you can use L. The C block is invoked in a topicalizer context (like a C block), but note that you can't return a useful value from C using the C blocks without an explicit C. This is somewhat similar to Perl 6's C blocks. You can use it to concisely match errors: try { require Foo; } catch { when (/^Can't locate .*?\.pm in \@INC/) { } # ignore default { die $_ } }; =head1 CAVEATS =over 4 =item * C<@_> is not available within the C block, so you need to copy your arglist. In case you want to work with argument values directly via C<@_> aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference: sub foo { my ( $self, @args ) = @_; try { $self->bar(@args) } } or sub bar_in_place { my $self = shift; my $args = \@_; try { $_ = $self->bar($_) for @$args } } =item * C returns from the C block, not from the parent sub (note that this is also how C works, but not how L works): sub parent_sub { try { die; } catch { return; }; say "this text WILL be displayed, even though an exception is thrown"; } Instead, you should capture the return value: sub parent_sub { my $success = try { die; 1; }; return unless $success; say "This text WILL NEVER appear!"; } # OR sub parent_sub_with_catch { my $success = try { die; 1; } catch { # do something with $_ return undef; #see note }; return unless $success; say "This text WILL NEVER appear!"; } Note that if you have a C block, it must return C for this to work, since if a C block exists, its return value is returned in place of C when an exception is thrown. =item * C introduces another caller stack frame. L is not used. L will not report this when using full stack traces, though, because C<%Carp::Internal> is used. This lack of magic is considered a feature. =item * The value of C<$_> in the C block is not guaranteed to be the value of the exception thrown (C<$@>) in the C block. There is no safe way to ensure this, since C may be used unhygenically in destructors. The only guarantee is that the C will be called if an exception is thrown. =item * The return value of the C block is not ignored, so if testing the result of the expression for truth on success, be sure to return a false value from the C block: my $obj = try { MightFail->new; } catch { ... return; # avoid returning a true value; }; return unless $obj; =item * C<$SIG{__DIE__}> is still in effect. Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of C blocks, since it isn't people have grown to rely on it. Therefore in the interests of compatibility, C does not disable C<$SIG{__DIE__}> for the scope of the error throwing code. =item * Lexical C<$_> may override the one set by C. For example Perl 5.10's C form uses a lexical C<$_>, creating some confusing behavior: given ($foo) { when (...) { try { ... } catch { warn $_; # will print $foo, not the error warn $_[0]; # instead, get the error like this } } } Note that this behavior was changed once again in L. However, since the entirety of lexical C<$_> is now L, it is unclear whether the new version 18 behavior is final. =back =head1 SEE ALSO =over 4 =item L Much more feature complete, more convenient semantics, but at the cost of implementation complexity. =item L Automatic error throwing for builtin functions and more. Also designed to work well with C/C. =item L A lightweight role for rolling your own exception classes. =item L Exception object implementation with a C statement. Does not localize C<$@>. =item L Provides a C statement, but properly calling C is your responsibility. The C keyword pushes C<$@> onto an error stack, avoiding some of the issues with C<$@>, but you still need to localize to prevent clobbering. =back =head1 LIGHTNING TALK I gave a lightning talk about this module, you can see the slides (Firefox only): L Or read the source: L =head1 VERSION CONTROL L =head1 AUTHORS =over 4 =item * Yuval Kogman =item * Jesse Luehrs =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Yuval Kogman. This is free software, licensed under: The MIT (X11) License =cut TypeTiny.pm000664001750001750 1354015111656240 16420 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Errorpackage Error::TypeTiny; use 5.008001; use strict; use warnings; BEGIN { $Error::TypeTiny::AUTHORITY = 'cpan:TOBYINK'; $Error::TypeTiny::VERSION = '2.008006'; } $Error::TypeTiny::VERSION =~ tr/_//d; require Type::Tiny; __PACKAGE__->Type::Tiny::_install_overloads( q[""] => sub { local $@; $_[0]->to_string }, q[bool] => sub { 1 }, ); require Carp; *CarpInternal = \%Carp::CarpInternal; our %CarpInternal; $CarpInternal{$_}++ for @Type::Tiny::InternalPackages; sub new { my $class = shift; my %params = ( @_ == 1 ) ? %{ $_[0] } : @_; return bless \%params, $class; } sub throw { my $next = $_[0]->can( 'throw_cb' ); splice( @_, 1, 0, undef ); goto $next; } sub throw_cb { my $class = shift; my $callback = shift; my ( $level, @caller, %ctxt ) = 0; while ( do { my $caller = caller $level; defined $caller and $CarpInternal{$caller}; } ) { $level++; } if ( ( ( caller( $level - 1 ) )[1] || "" ) =~ /^(?:parameter validation for|exportable function) '(.+?)'$/ ) { my ( $pkg, $func ) = ( $1 =~ m{^(.+)::(\w+)$} ); $level++ if caller( $level ) eq ( $pkg || "" ); } { no warnings 'uninitialized'; # Moo's Method::Generate::Constructor puts an eval in the stack trace, # that is useless for debugging, so show the stack frame one above. $level++ if ( ( caller( $level ) )[1] =~ /^\(eval \d+\)$/ and ( caller( $level ) )[3] eq '(eval)' # (caller())[3] is $subroutine ); @ctxt{qw/ package file line /} = caller( $level ); } my $stack = undef; if ( our $StackTrace ) { require Devel::StackTrace; $stack = "Devel::StackTrace"->new( ignore_package => [ keys %CarpInternal ], ); } our $LastError = $class->new( context => \%ctxt, stack_trace => $stack, @_, ); $callback ? $callback->( $LastError ) : die( $LastError ); } #/ sub throw sub message { $_[0]{message} ||= $_[0]->_build_message } sub context { $_[0]{context} } sub stack_trace { $_[0]{stack_trace} } sub to_string { my $e = shift; my $c = $e->context; my $m = $e->message; $m =~ /\n\z/s ? $m : $c ? sprintf( "%s at %s line %s.\n", $m, $c->{file} || 'file?', $c->{line} || 'NaN' ) : sprintf( "%s\n", $m ); } #/ sub to_string sub _build_message { return 'An exception has occurred'; } sub croak { my ( $fmt, @args ) = @_; @_ = ( __PACKAGE__, message => sprintf( $fmt, @args ), ); goto \&throw; } 1; __END__ =pod =encoding utf-8 =head1 NAME Error::TypeTiny - exceptions for Type::Tiny and friends =head1 SYNOPSIS use feature 'try'; use Data::Dumper; use Types::Standard qw( Str ); try { Str->assert_valid( undef ); } catch ( $exception ) { warn "Encountered Error: $exception"; warn Dumper( $exception->explain ) if $exception->isa( "Error::TypeTiny::Assertion" ); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION When Type::Tiny and its related modules encounter an error, they throw an exception object. These exception objects inherit from Error::TypeTiny. =head2 Constructors =over =item C<< new(%attributes) >> Moose-style constructor function. =item C<< throw(%attributes) >> Constructs an exception and passes it to C. Automatically populates C and C if appropriate. =item C<< throw_cb($callback, %attributes) >> Constructs an exception and passes it to C<< $callback >> which should be a coderef; if undef, uses C. Automatically populates C and C if appropriate. =back =head2 Attributes =over =item C The error message. =item C Hashref containing the package, file and line that generated the error. =item C A more complete stack trace. This feature requires L; use the C<< $StackTrace >> package variable to switch it on. =back =head2 Methods =over =item C Returns the message, followed by the context if it is set. =back =head2 Functions =over =item C<< Error::TypeTiny::croak($format, @args) >> Functional-style shortcut to C method. Takes an C-style format string and optional arguments to construct the C. =back =head2 Overloading =over =item * Stringification is overloaded to call C. =back =head2 Package Variables =over =item C<< %Carp::CarpInternal >> Error::TypeTiny honours this package variable from L. (C< %Error::TypeTiny::CarpInternal> is an alias for it.) =item C<< $Error::TypeTiny::StackTrace >> Boolean to toggle stack trace generation. =item C<< $Error::TypeTiny::LastError >> A reference to the last exception object thrown. =back =head1 CAVEATS Although Error::TypeTiny objects are thrown for errors produced by Type::Tiny, that doesn't mean every time you use Type::Tiny you'll get Error::TypeTinys whenever you want. For example, if you use a Type::Tiny type constraint in a Moose attribute, Moose will not call the constraint's C method (which throws an exception). Instead it will call C and C (which do not), and will C an error message of its own. (The C<< $LastError >> package variable may save your bacon.) =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. TypeTiny.pm000664001750001750 3711315111656240 16220 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Evalpackage Eval::TypeTiny; use strict; sub _clean_eval { local $@; local $SIG{__DIE__}; my $r = eval $_[0]; my $e = $@; return ( $r, $e ); } use warnings; BEGIN { *HAS_LEXICAL_SUBS = ( $] >= 5.018 ) ? sub () { !!1 } : sub () { !!0 }; *NICE_PROTOTYPES = ( $] >= 5.014 ) ? sub () { !!1 } : sub () { !!0 }; } sub _pick_alternative { my $ok = 0; while ( @_ ) { my ( $type, $condition, $result ) = splice @_, 0, 3; if ( $type eq 'needs' ) { ++$ok if eval "require $condition; 1"; } elsif ( $type eq 'if' ) { ++$ok if $condition; } next unless $ok; return ref( $result ) eq 'CODE' ? $result->() : ref( $result ) eq 'SCALAR' ? eval( $$result ) : $result; } return; } { sub IMPLEMENTATION_DEVEL_LEXALIAS () { 'Devel::LexAlias' } sub IMPLEMENTATION_PADWALKER () { 'PadWalker' } sub IMPLEMENTATION_TIE () { 'tie' } sub IMPLEMENTATION_NATIVE () { 'perl' } my $implementation; #<<< # uncoverable subroutine sub ALIAS_IMPLEMENTATION () { $implementation ||= _pick_alternative( if => ( $] ge '5.022' ) => IMPLEMENTATION_NATIVE, needs => 'Devel::LexAlias' => IMPLEMENTATION_DEVEL_LEXALIAS, needs => 'PadWalker' => IMPLEMENTATION_PADWALKER, if => !!1 => IMPLEMENTATION_TIE, ); } #>>> sub _force_implementation { $implementation = shift; } } BEGIN { *_EXTENDED_TESTING = $ENV{EXTENDED_TESTING} ? sub() { !!1 } : sub() { !!0 }; } our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @EXPORT = qw( eval_closure ); our @EXPORT_OK = qw( HAS_LEXICAL_SUBS HAS_LEXICAL_VARS ALIAS_IMPLEMENTATION IMPLEMENTATION_DEVEL_LEXALIAS IMPLEMENTATION_PADWALKER IMPLEMENTATION_NATIVE IMPLEMENTATION_TIE set_subname type_to_coderef NICE_PROTOTYPES ); $VERSION =~ tr/_//d; # See Types::TypeTiny for an explanation of this import method. # # uncoverable subroutine sub import { no warnings "redefine"; our @ISA = qw( Exporter::Tiny ); require Exporter::Tiny; my $next = \&Exporter::Tiny::import; *import = $next; my $class = shift; my $opts = { ref( $_[0] ) ? %{ +shift } : () }; $opts->{into} ||= scalar( caller ); return $class->$next( $opts, @_ ); } #/ sub import { my $subname; my %already; # prevent renaming established functions sub set_subname ($$) { $subname = _pick_alternative( needs => 'Sub::Util' => \ q{ \&Sub::Util::set_subname }, needs => 'Sub::Name' => \ q{ \&Sub::Name::subname }, if => !!1 => 0, ) unless defined $subname; $subname and !$already{$_[1]}++ and return &$subname; $_[1]; } #/ sub set_subname ($$) } sub type_to_coderef { my ( $type, %args ) = @_; my $post_method = $args{post_method} || q(); my ( $coderef, $qualified_name ); if ( ! defined $type ) { my $library = $args{type_library}; my $name = $args{type_name}; $qualified_name = "$library\::$name"; $coderef = sub (;@) { my $params; $params = shift if ref( $_[0] ) eq "ARRAY"; $type ||= do { $library->can( 'get_type' ) or require Error::TypeTiny && Error::TypeTiny::croak( "Expected $library to be a type library, but it doesn't seem to be" ); $library->get_type( $name ); }; my $t; if ( $type ) { $t = $params ? $type->parameterize( @$params ) : $type; $t = $t->$post_method if $post_method; } else { require Error::TypeTiny && Error::TypeTiny::croak( "Cannot parameterize a non-existant type" ) if $params; require Type::Tiny::_DeclaredType; $t = Type::Tiny::_DeclaredType->new( library => $library, name => $name ); } @_ && wantarray ? return ( $t, @_ ) : return $t; }; require Scalar::Util && &Scalar::Util::set_prototype( $coderef, ';$' ) if Eval::TypeTiny::NICE_PROTOTYPES; } else { #<<< my $source = $type->is_parameterizable ? sprintf( q{ sub (%s) { if (ref($_[0]) eq 'Type::Tiny::_HalfOp') { my $complete_type = shift->complete($type); @_ && wantarray ? return($complete_type, @_) : return $complete_type; } my $params; $params = shift if ref($_[0]) eq q(ARRAY); my $t = $params ? $type->parameterize(@$params) : $type; @_ && wantarray ? return($t%s, @_) : return $t%s; } }, NICE_PROTOTYPES ? q(;$) : q(;@), $post_method, $post_method, ) : sprintf( q{ sub () { $type%s if $] } }, $post_method ); #>>> $qualified_name = $type->qualified_name; $coderef = eval_closure( source => $source, description => $args{description} || sprintf( "exportable function '%s'", $qualified_name ), environment => { '$type' => \$type }, ); } $args{anonymous} ? $coderef : set_subname( $qualified_name, $coderef ); } sub eval_closure { my ( %args ) = @_; my $src = ref $args{source} eq "ARRAY" ? join( "\n", @{ $args{source} } ) : $args{source}; $args{alias} = 0 unless defined $args{alias}; $args{line} = 1 unless defined $args{line}; $args{description} =~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined $args{description}; $src = qq{#line $args{line} "$args{description}"\n$src} if defined $args{description} && !( $^P & 0x10 ); $args{environment} ||= {}; if ( _EXTENDED_TESTING ) { require Scalar::Util; for my $k ( sort keys %{ $args{environment} } ) { next if $k =~ /^\$/ && Scalar::Util::reftype( $args{environment}{$k} ) =~ /^(SCALAR|REF)$/; next if $k =~ /^\@/ && Scalar::Util::reftype( $args{environment}{$k} ) eq q(ARRAY); next if $k =~ /^\%/ && Scalar::Util::reftype( $args{environment}{$k} ) eq q(HASH); next if $k =~ /^\&/ && Scalar::Util::reftype( $args{environment}{$k} ) eq q(CODE); require Error::TypeTiny; Error::TypeTiny::croak( "Expected a variable name and ref; got %s => %s", $k, $args{environment}{$k} ); } #/ for my $k ( sort keys %...) } #/ if ( _EXTENDED_TESTING) my $sandpkg = 'Eval::TypeTiny::Sandbox'; my $alias = exists( $args{alias} ) ? $args{alias} : 0; my @keys = sort keys %{ $args{environment} }; my $i = 0; my $source = join "\n" => ( "package $sandpkg;", "sub {", map( _make_lexical_assignment( $_, $i++, $alias ), @keys ), $src, "}", ); if ( $alias and ALIAS_IMPLEMENTATION eq IMPLEMENTATION_TIE ) { _manufacture_ties(); } my ( $compiler, $e ) = _clean_eval( $source ); if ( $e ) { chomp $e; require Error::TypeTiny::Compilation; "Error::TypeTiny::Compilation"->throw( code => ( ref $args{source} eq "ARRAY" ? join( "\n", @{ $args{source} } ) : $args{source} ), errstr => $e, environment => $args{environment}, ); } #/ if ( $e ) my $code = $compiler->( @{ $args{environment} }{@keys} ); undef( $compiler ); if ( $alias and ALIAS_IMPLEMENTATION eq IMPLEMENTATION_DEVEL_LEXALIAS ) { require Devel::LexAlias; Devel::LexAlias::lexalias( $code, $_ => $args{environment}{$_} ) for grep !/^\&/, @keys; } if ( $alias and ALIAS_IMPLEMENTATION eq IMPLEMENTATION_PADWALKER ) { require PadWalker; my %env = map +( $_ => $args{environment}{$_} ), grep !/^\&/, @keys; PadWalker::set_closed_over( $code, \%env ); } return $code; } #/ sub eval_closure my $tmp; sub _make_lexical_assignment { my ( $key, $index, $alias ) = @_; my $name = substr( $key, 1 ); if ( HAS_LEXICAL_SUBS and $key =~ /^\&/ ) { $tmp++; my $tmpname = '$__LEXICAL_SUB__' . $tmp; return "no warnings 'experimental::lexical_subs';" . "use feature 'lexical_subs';" . "my $tmpname = \$_[$index];" . "my sub $name { goto $tmpname };"; } if ( !$alias ) { my $sigil = substr( $key, 0, 1 ); return "my $key = $sigil\{ \$_[$index] };"; } elsif ( ALIAS_IMPLEMENTATION eq IMPLEMENTATION_NATIVE ) { return "no warnings 'experimental::refaliasing';" . "use feature 'refaliasing';" . "my $key; \\$key = \$_[$index];"; } elsif ( ALIAS_IMPLEMENTATION eq IMPLEMENTATION_DEVEL_LEXALIAS ) { return "my $key;"; } elsif ( ALIAS_IMPLEMENTATION eq IMPLEMENTATION_PADWALKER ) { return "my $key;"; } else { my $tieclass = { '@' => 'Eval::TypeTiny::_TieArray', '%' => 'Eval::TypeTiny::_TieHash', '$' => 'Eval::TypeTiny::_TieScalar', }->{ substr( $key, 0, 1 ) }; return sprintf( 'tie(my(%s), "%s", $_[%d]);', $key, $tieclass, $index, ); } #/ else [ if ( !$alias ) ] } #/ sub _make_lexical_assignment { my $tie; sub _manufacture_ties { $tie ||= eval <<'FALLBACK'; } } no warnings qw(void once uninitialized numeric); use Type::Tiny (); { package # Eval::TypeTiny::_TieArray; require Tie::Array; our @ISA = qw( Tie::StdArray ); sub TIEARRAY { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied(@$self) and return tied(@$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]) unless $method eq 'DESTROY'; } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied(@$self) and tied(@$self)->can(@_)); return $code; } __PACKAGE__->Type::Tiny::_install_overloads( q[bool] => sub { !! tied @{$_[0]} }, q[""] => sub { '' . tied @{$_[0]} }, q[0+] => sub { 0 + tied @{$_[0]} }, ); } { package # Eval::TypeTiny::_TieHash; require Tie::Hash; our @ISA = qw( Tie::StdHash ); sub TIEHASH { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied(%$self) and return tied(%$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]) unless $method eq 'DESTROY'; } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied(%$self) and tied(%$self)->can(@_)); return $code; } __PACKAGE__->Type::Tiny::_install_overloads( q[bool] => sub { !! tied %{$_[0]} }, q[""] => sub { '' . tied %{$_[0]} }, q[0+] => sub { 0 + tied %{$_[0]} }, ); } { package # Eval::TypeTiny::_TieScalar; require Tie::Scalar; our @ISA = qw( Tie::StdScalar ); sub TIESCALAR { my $class = shift; bless $_[0] => $class; } sub AUTOLOAD { my $self = shift; my ($method) = (our $AUTOLOAD =~ /(\w+)$/); defined tied($$self) and return tied($$self)->$method(@_); require Carp; Carp::croak(qq[Can't call method "$method" on an undefined value]) unless $method eq 'DESTROY'; } sub can { my $self = shift; my $code = $self->SUPER::can(@_) || (defined tied($$self) and tied($$self)->can(@_)); return $code; } __PACKAGE__->Type::Tiny::_install_overloads( q[bool] => sub { !! tied ${$_[0]} }, q[""] => sub { '' . tied ${$_[0]} }, q[0+] => sub { 0 + tied ${$_[0]} }, ); } 1; FALLBACK 1; __END__ =pod =encoding utf-8 =for stopwords pragmas coderefs =head1 NAME Eval::TypeTiny - utility to evaluate a string of Perl code in a clean environment =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This module is used by Type::Tiny to compile coderefs from strings of Perl code, and hashrefs of variables to close over. =head2 Functions By default this module exports one function, which works much like the similarly named function from L: =over =item C<< eval_closure(source => $source, environment => \%env, %opt) >> =back Other functions can be imported on request: =over =item C<< set_subname( $fully_qualified_name, $coderef ) >> Works like the similarly named function from L, but will fallback to doing nothing if neither L nor L are available. Also will cowardly refuse the set the name of a coderef a second time if it's already named it. =item C<< type_to_coderef( $type, %options ) >> Turns a L object into a coderef, suitable for installing into a symbol table to create a function like C or C. (Actually should work for any object which provides C, C, and C methods, such as L.) C<< $options{post_method} >> can be a string of Perl indicating a method to call on the type constraint before returning it. For example C<< '->moose_type' >>. C<< $options{description} >> can be a description of the coderef which may be shown in stack traces, etc. The coderef will be named using C unless C<< $options{anonymous} >> is true. If C<< $type >> is undef, then it is assumed that the type constraint hasn't been defined yet but will later, yet you still want a function now. C<< $options{type_library} >> and C<< $options{type_name} >> will be used to find the type constraint when the function gets called. =back =head2 Constants The following constants may be exported, but are not by default. =over =item C<< HAS_LEXICAL_SUBS >> Boolean indicating whether Eval::TypeTiny has support for lexical subs. (This feature requires Perl 5.18.) =item C<< ALIAS_IMPLEMENTATION >> Returns a string indicating what implementation of C<< alias => 1 >> is being used. Eval::TypeTiny will automatically choose the best implementation. This constant can be matched against the C<< IMPLEMENTATION_* >> constants. =item C<< IMPLEMENTATION_NATIVE >> If C<< ALIAS_IMPLEMENTATION eq IMPLEMENTATION_NATIVE >> then Eval::TypeTiny is currently using Perl 5.22's native alias feature. This requires Perl 5.22. =item C<< IMPLEMENTATION_DEVEL_LEXALIAS >> If C<< ALIAS_IMPLEMENTATION eq IMPLEMENTATION_DEVEL_LEXALIAS >> then Eval::TypeTiny is currently using L to provide aliases. =item C<< IMPLEMENTATION_PADWALKER >> If C<< ALIAS_IMPLEMENTATION eq IMPLEMENTATION_PADWALKER >> then Eval::TypeTiny is currently using L to provide aliases. =item C<< IMPLEMENTATION_TIE >> If C<< ALIAS_IMPLEMENTATION eq IMPLEMENTATION_TIE >> then Eval::TypeTiny is using the fallback implementation of aliases using C. This is the slowest implementation, and may cause problems in certain edge cases, like trying to alias already-tied variables, but it's the only way to implement C<< alias => 1 >> without a recent version of Perl or one of the two optional modules mentioned above. =item C<< NICE_PROTOTYPES >> If this is true, then type_to_coderef will give parameterizable type constraints the slightly nicer prototype of C<< (;$) >> instead of the default C<< (;@) >>. This allows constructs like: ArrayRef[Int] | HashRef[Int] ... to "just work". =back =head1 EVALUATION ENVIRONMENT The evaluation is performed in the presence of L, but the absence of L. (This is different to L which enables warnings for compiled closures.) The L pragma is not active in the evaluation environment, so the following will not work: use feature qw(say); use Eval::TypeTiny qw(eval_closure); my $say_all = eval_closure( source => 'sub { say for @_ }', ); $say_all->("Hello", "World"); The L pragma does not "carry over" into the stringy eval. It is of course possible to import pragmas into the evaluated string as part of the string itself: use Eval::TypeTiny qw(eval_closure); my $say_all = eval_closure( source => 'sub { use feature qw(say); say for @_ }', ); $say_all->("Hello", "World"); =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. TypeTiny.pm000664001750001750 1614115111656240 16246 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Testpackage Test::TypeTiny; use strict; use warnings; use Test::More qw(); use Scalar::Util qw(blessed); use Types::TypeTiny (); use Type::Tiny (); require Exporter::Tiny; our @ISA = 'Exporter::Tiny'; BEGIN { *EXTENDED_TESTING = $ENV{EXTENDED_TESTING} ? sub() { !!1 } : sub() { !!0 }; } our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @EXPORT = qw( should_pass should_fail ok_subtype ); our @EXPORT_OK = qw( EXTENDED_TESTING matchfor ); $VERSION =~ tr/_//d; my $overloads_installed = 0; sub matchfor { my @matchers = @_; bless \@matchers, do { package # Test::TypeTiny::Internal::MATCHFOR; Test::TypeTiny::Internal::MATCHFOR->Type::Tiny::_install_overloads( q[==] => 'match', q[eq] => 'match', q[""] => 'to_string', ) unless $overloads_installed++; sub to_string { $_[0][0]; } sub match { my ( $self, $e ) = @_; my $does = Scalar::Util::blessed( $e ) ? ( $e->can( 'DOES' ) || $e->can( 'isa' ) ) : undef; for my $s ( @$self ) { return 1 if ref( $s ) && $e =~ $s; return 1 if !ref( $s ) && $does && $e->$does( $s ); } return; } #/ sub match __PACKAGE__; }; } #/ sub matchfor sub _mk_message { require Type::Tiny; my ( $template, $value ) = @_; sprintf( $template, Type::Tiny::_dd( $value ) ); } sub ok_subtype { my ( $type, @s ) = @_; @_ = ( not( scalar grep !$_->is_subtype_of( $type ), @s ), sprintf( "%s subtype: %s", $type, join q[, ], @s ), ); goto \&Test::More::ok; } eval( EXTENDED_TESTING ? <<'SLOW' : <<'FAST'); sub should_pass { my ($value, $type, $message) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; $type = Types::TypeTiny::to_TypeTiny($type) unless blessed($type) && $type->can("check"); my $strictures = $type->can("_strict_check"); my $compiled = $type->can("compiled_check"); my $can_inline = $type->can("can_be_inlined") && $type->can_be_inlined && $type->can("inline_check"); my $count = 1; $count +=1 if $strictures; $count +=1 if $compiled; $count +=2 if $can_inline; my @codes; if ( $can_inline ) { push @codes, eval sprintf('no warnings; [ q(inlined), sub { my $VAR = shift; %s } ]', $type->inline_check('$VAR')); local $Type::Tiny::AvoidCallbacks = 1; push @codes, eval sprintf('no warnings; [ q(inlined avoiding callbacks), sub { my $VAR = shift; %s } ]', $type->inline_check('$VAR')); } my $test = "Test::Builder"->new->child( $message || _mk_message("%s passes type constraint $type", $value), ); $test->plan(tests => $count); $test->ok(!!$type->check($value), '->check'); $test->ok(!!$type->_strict_check($value), '->_strict_check') if $strictures; $test->ok(!!$type->compiled_check->($value), '->compiled_check') if $compiled; for my $code ( @codes ) { $test->ok(!!$code->[1]->($value), $code->[0]); } $test->finalize; return $test->is_passing; } sub should_fail { my ($value, $type, $message) = @_; $type = Types::TypeTiny::to_TypeTiny($type) unless blessed($type) && $type->can("check"); local $Test::Builder::Level = $Test::Builder::Level + 1; my $strictures = $type->can("_strict_check"); my $compiled = $type->can("compiled_check"); my $can_inline = $type->can("can_be_inlined") && $type->can_be_inlined && $type->can("inline_check"); my $count = 1; $count +=1 if $strictures; $count +=1 if $compiled; $count +=2 if $can_inline; my @codes; if ( $can_inline ) { push @codes, eval sprintf('no warnings; [ q(inlined), sub { my $VAR = shift; %s } ]', $type->inline_check('$VAR')); local $Type::Tiny::AvoidCallbacks = 1; push @codes, eval sprintf('no warnings; [ q(inlined avoiding callbacks), sub { my $VAR = shift; %s } ]', $type->inline_check('$VAR')); } my $test = "Test::Builder"->new->child( $message || _mk_message("%s fails type constraint $type", $value), ); $test->plan(tests => $count); $test->ok(!$type->check($value), '->check'); $test->ok(!$type->_strict_check($value), '->_strict_check') if $strictures; $test->ok(!$type->compiled_check->($value), '->compiled_check') if $compiled; for my $code ( @codes ) { $test->ok(!$code->[1]->($value), $code->[0]); } $test->finalize; return $test->is_passing; } SLOW sub should_pass { my ($value, $type, $message) = @_; $type = Types::TypeTiny::to_TypeTiny($type) unless blessed($type) && $type->can("check"); @_ = ( !!$type->check($value), $message || _mk_message("%s passes type constraint $type", $value), ); goto \&Test::More::ok; } sub should_fail { my ($value, $type, $message) = @_; $type = Types::TypeTiny::to_TypeTiny($type) unless blessed($type) && $type->can("check"); @_ = ( !$type->check($value), $message || _mk_message("%s fails type constraint $type", $value), ); goto \&Test::More::ok; } FAST 1; __END__ =pod =encoding utf-8 =head1 NAME Test::TypeTiny - useful functions for testing the efficacy of type constraints =head1 SYNOPSIS =for test_synopsis BEGIN { die "SKIP: uses a module that doesn't exist as an example" }; use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Mine qw(Integer Number); should_pass(1, Integer); should_pass(-1, Integer); should_pass(0, Integer); should_fail(2.5, Integer); ok_subtype(Number, Integer); done_testing; =head1 STATUS This module is covered by the L. =head1 DESCRIPTION L provides a few handy functions for testing type constraints. =head2 Functions =over =item C<< should_pass($value, $type, $test_name) >> =item C<< should_pass($value, $type) >> Test that passes iff C<< $value >> passes C<< $type->check >>. =item C<< should_fail($value, $type, $test_name) >> =item C<< should_fail($value, $type) >> Test that passes iff C<< $value >> fails C<< $type->check >>. =item C<< ok_subtype($type, @subtypes) >> Test that passes iff all C<< @subtypes >> are subtypes of C<< $type >>. =item C<< EXTENDED_TESTING >> Exportable boolean constant. =item C<< matchfor(@things) >> Assistant for matching exceptions. Not exported by default. See also L. =back =head1 ENVIRONMENT If the C environment variable is set to true, this module will promote each C or C test into a subtest block and test the type constraint in both an inlined and non-inlined manner. This variable must be set at compile time (i.e. before this module is loaded). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. For an alternative to C, see L which will happily accept a Type::Tiny type constraint instead of a MooseX::Types one. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Coercion.pm000664001750001750 5560315111656240 16232 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Coercion; use 5.008001; use strict; use warnings; BEGIN { $Type::Coercion::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::VERSION = '2.008006'; } $Type::Coercion::VERSION =~ tr/_//d; use Eval::TypeTiny qw<>; use Scalar::Util qw< blessed >; use Types::TypeTiny qw<>; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } require Type::Tiny; __PACKAGE__->Type::Tiny::_install_overloads( q("") => sub { caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? $_[0]->_stringify_no_magic : $_[0]->display_name; }, q(bool) => sub { 1 }, q(&{}) => "_overload_coderef", ); __PACKAGE__->Type::Tiny::_install_overloads( q(~~) => sub { $_[0]->has_coercion_for_value( $_[1] ) }, ) if Type::Tiny::SUPPORT_SMARTMATCH(); sub _overload_coderef { my $self = shift; if ( "Sub::Quote"->can( "quote_sub" ) && $self->can_be_inlined ) { $self->{_overload_coderef} = Sub::Quote::quote_sub( $self->inline_coercion( '$_[0]' ) ) if !$self->{_overload_coderef} || !$self->{_sub_quoted}++; } else { Scalar::Util::weaken( my $weak = $self ); $self->{_overload_coderef} ||= sub { $weak->coerce( @_ ) }; } $self->{_overload_coderef}; } #/ sub _overload_coderef sub new { my $class = shift; my %params = ( @_ == 1 ) ? %{ $_[0] } : @_; $params{name} = '__ANON__' unless exists( $params{name} ); my $C = delete( $params{type_coercion_map} ) || []; my $F = delete( $params{frozen} ); my $self = bless \%params, $class; $self->add_type_coercions( @$C ) if @$C; $self->_preserve_type_constraint; Scalar::Util::weaken( $self->{type_constraint} ); # break ref cycle $self->{frozen} = $F if $F; unless ( $self->is_anon ) { # First try a fast ASCII-only expression, but fall back to Unicode $self->name =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $self->name =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid coercion name', $self->name; } return $self; } #/ sub new sub _stringify_no_magic { sprintf( '%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ), Scalar::Util::refaddr( $_[0] ) ); } sub name { $_[0]{name} } sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } sub library { $_[0]{library} } sub type_constraint { $_[0]{type_constraint} ||= $_[0]->_maybe_restore_type_constraint; } sub type_coercion_map { $_[0]{type_coercion_map} ||= [] } sub moose_coercion { $_[0]{moose_coercion} ||= $_[0]->_build_moose_coercion } sub compiled_coercion { $_[0]{compiled_coercion} ||= $_[0]->_build_compiled_coercion; } sub frozen { $_[0]{frozen} ||= 0 } sub coercion_generator { $_[0]{coercion_generator} } sub parameters { $_[0]{parameters} } sub parameterized_from { $_[0]{parameterized_from} } sub has_library { exists $_[0]{library} } sub has_type_constraint { defined $_[0]->type_constraint } # sic sub has_coercion_generator { exists $_[0]{coercion_generator} } sub has_parameters { exists $_[0]{parameters} } sub _preserve_type_constraint { my $self = shift; $self->{_compiled_type_constraint_check} = $self->{type_constraint}->compiled_check if $self->{type_constraint}; } sub _maybe_restore_type_constraint { my $self = shift; if ( my $check = $self->{_compiled_type_constraint_check} ) { return Type::Tiny->new( constraint => $check ); } return; # uncoverable statement } sub add { my $class = shift; my ( $x, $y, $swap ) = @_; Types::TypeTiny::is_TypeTiny( $x ) and return $x->plus_fallback_coercions( $y ); Types::TypeTiny::is_TypeTiny( $y ) and return $y->plus_coercions( $x ); _croak "Attempt to add $class to something that is not a $class" unless blessed( $x ) && blessed( $y ) && $x->isa( $class ) && $y->isa( $class ); ( $y, $x ) = ( $x, $y ) if $swap; my %opts; if ( $x->has_type_constraint and $y->has_type_constraint and $x->type_constraint == $y->type_constraint ) { $opts{type_constraint} = $x->type_constraint; } elsif ( $x->has_type_constraint and $y->has_type_constraint ) { # require Type::Tiny::Union; # $opts{type_constraint} = "Type::Tiny::Union"->new( # type_constraints => [ $x->type_constraint, $y->type_constraint ], # ); } $opts{display_name} ||= "$x+$y"; delete $opts{display_name} if $opts{display_name} eq '__ANON__+__ANON__'; my $new = $class->new( %opts ); $new->add_type_coercions( @{ $x->type_coercion_map } ); $new->add_type_coercions( @{ $y->type_coercion_map } ); return $new; } #/ sub add sub _build_display_name { shift->name; } sub qualified_name { my $self = shift; if ( $self->has_library and not $self->is_anon ) { return sprintf( "%s::%s", $self->library, $self->name ); } return $self->name; } sub is_anon { my $self = shift; $self->name eq "__ANON__"; } sub _clear_compiled_coercion { delete $_[0]{_overload_coderef}; delete $_[0]{compiled_coercion}; } sub freeze { $_[0]{frozen} = 1; $_[0] } sub i_really_want_to_unfreeze { $_[0]{frozen} = 0; $_[0] } sub coerce { my $self = shift; return $self->compiled_coercion->( @_ ); } sub assert_coerce { my $self = shift; my $r = $self->coerce( @_ ); $self->type_constraint->assert_valid( $r ) if $self->has_type_constraint; return $r; } sub has_coercion_for_type { my $self = shift; my $type = Types::TypeTiny::to_TypeTiny( $_[0] ); return "0 but true" if $self->has_type_constraint && $type->is_a_type_of( $self->type_constraint ); my $c = $self->type_coercion_map; for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) { return !!1 if $type->is_a_type_of( $c->[$i] ); } return; } #/ sub has_coercion_for_type sub has_coercion_for_value { my $self = shift; local $_ = $_[0]; return "0 but true" if $self->has_type_constraint && $self->type_constraint->check( @_ ); my $c = $self->type_coercion_map; for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) { return !!1 if $c->[$i]->check( @_ ); } return; } #/ sub has_coercion_for_value sub add_type_coercions { my $self = shift; my @args = @_; _croak "Attempt to add coercion code to a Type::Coercion which has been frozen" if $self->frozen; while ( @args ) { my $type = Types::TypeTiny::to_TypeTiny( shift @args ); if ( blessed $type and my $method = $type->can( 'type_coercion_map' ) ) { push @{ $self->type_coercion_map }, @{ $method->( $type ) }; } else { my $coercion = shift @args; _croak "Types must be blessed Type::Tiny objects" unless Types::TypeTiny::is_TypeTiny( $type ); _croak "Coercions must be code references or strings" unless Types::TypeTiny::is_StringLike( $coercion ) || Types::TypeTiny::is_CodeLike( $coercion ); push @{ $self->type_coercion_map }, $type, $coercion; } } #/ while ( @args ) $self->_clear_compiled_coercion; return $self; } #/ sub add_type_coercions sub _build_compiled_coercion { my $self = shift; my @mishmash = @{ $self->type_coercion_map }; return sub { $_[0] } unless @mishmash; if ( $self->can_be_inlined ) { return Eval::TypeTiny::eval_closure( source => sprintf( 'sub ($) { %s }', $self->inline_coercion( '$_[0]' ) ), description => sprintf( "compiled coercion '%s'", $self ), ); } # These arrays will be closed over. my ( @types, @codes ); while ( @mishmash ) { push @types, shift @mishmash; push @codes, shift @mishmash; } if ( $self->has_type_constraint ) { unshift @types, $self->type_constraint; unshift @codes, undef; } my @sub; for my $i ( 0 .. $#types ) { push @sub, $types[$i]->can_be_inlined ? sprintf( 'if (%s)', $types[$i]->inline_check( '$_[0]' ) ) : sprintf( 'if ($checks[%d]->(@_))', $i ); push @sub, !defined( $codes[$i] ) ? sprintf( ' { return $_[0] }' ) : Types::TypeTiny::is_StringLike( $codes[$i] ) ? sprintf( ' { local $_ = $_[0]; return scalar(%s); }', $codes[$i] ) : sprintf( ' { local $_ = $_[0]; return scalar($codes[%d]->(@_)) }', $i ); } #/ for my $i ( 0 .. $#types) push @sub, 'return $_[0];'; return Eval::TypeTiny::eval_closure( source => sprintf( 'sub ($) { %s }', join qq[\n], @sub ), description => sprintf( "compiled coercion '%s'", $self ), environment => { '@checks' => [ map $_->compiled_check, @types ], '@codes' => \@codes, }, ); } #/ sub _build_compiled_coercion sub can_be_inlined { my $self = shift; return unless $self->frozen; return if $self->has_type_constraint && !$self->type_constraint->can_be_inlined; my @mishmash = @{ $self->type_coercion_map }; while ( @mishmash ) { my ( $type, $converter ) = splice( @mishmash, 0, 2 ); return unless $type->can_be_inlined; return unless Types::TypeTiny::is_StringLike( $converter ); } return !!1; } #/ sub can_be_inlined sub _source_type_union { my $self = shift; my @r; push @r, $self->type_constraint if $self->has_type_constraint; my @mishmash = @{ $self->type_coercion_map }; while ( @mishmash ) { my ( $type ) = splice( @mishmash, 0, 2 ); push @r, $type; } require Type::Tiny::Union; return "Type::Tiny::Union"->new( type_constraints => \@r, tmp => 1 ); } #/ sub _source_type_union sub inline_coercion { my $self = shift; my $varname = $_[0]; _croak "This coercion cannot be inlined" unless $self->can_be_inlined; my @mishmash = @{ $self->type_coercion_map }; return "($varname)" unless @mishmash; my ( @types, @codes ); while ( @mishmash ) { push @types, shift @mishmash; push @codes, shift @mishmash; } if ( $self->has_type_constraint ) { unshift @types, $self->type_constraint; unshift @codes, undef; } my @sub; for my $i ( 0 .. $#types ) { push @sub, sprintf( '(%s) ?', $types[$i]->inline_check( $varname ) ); push @sub, ( defined( $codes[$i] ) && ( $varname eq '$_' ) ) ? sprintf( 'scalar(do { %s }) :', $codes[$i] ) : defined( $codes[$i] ) ? sprintf( 'scalar(do { local $_ = %s; %s }) :', $varname, $codes[$i] ) : sprintf( '%s :', $varname ); } #/ for my $i ( 0 .. $#types) push @sub, "$varname"; "@sub"; } #/ sub inline_coercion sub _build_moose_coercion { my $self = shift; my %options = (); $options{type_coercion_map} = [ $self->freeze->_codelike_type_coercion_map( 'moose_type' ) ]; $options{type_constraint} = $self->type_constraint if $self->has_type_constraint; require Moose::Meta::TypeCoercion; my $r = "Moose::Meta::TypeCoercion"->new( %options ); return $r; } #/ sub _build_moose_coercion sub _codelike_type_coercion_map { my $self = shift; my $modifier = $_[0]; my @orig = @{ $self->type_coercion_map }; my @new; while ( @orig ) { my ( $type, $converter ) = splice( @orig, 0, 2 ); push @new, $modifier ? $type->$modifier : $type; if ( Types::TypeTiny::is_CodeLike( $converter ) ) { push @new, $converter; } else { push @new, Eval::TypeTiny::eval_closure( source => sprintf( 'sub { local $_ = $_[0]; %s }', $converter ), description => sprintf( "temporary compiled converter from '%s'", $type ), ); } } #/ while ( @orig ) return @new; } #/ sub _codelike_type_coercion_map sub is_parameterizable { shift->has_coercion_generator; } sub is_parameterized { shift->has_parameters; } sub parameterize { my $self = shift; return $self unless @_; $self->is_parameterizable or _croak "Constraint '%s' does not accept parameters", "$self"; @_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_; return ref( $self )->new( type_constraint => $self->type_constraint, type_coercion_map => [ $self->coercion_generator->( $self, $self->type_constraint, @_ ) ], parameters => \@_, frozen => 1, parameterized_from => $self, ); } #/ sub parameterize sub _reparameterize { my $self = shift; my ( $target_type ) = @_; $self->is_parameterized or return $self; my $parent = $self->parameterized_from; return ref( $self )->new( type_constraint => $target_type, type_coercion_map => [ $parent->coercion_generator->( $parent, $target_type, @{ $self->parameters } ) ], parameters => \@_, frozen => 1, parameterized_from => $parent, ); } #/ sub _reparameterize sub isa { my $self = shift; if ( $INC{"Moose/Meta/TypeCoercion.pm"} and blessed( $self ) and $_[0] eq 'Moose::Meta::TypeCoercion' ) { return !!1; } if ( $INC{"Moose/Meta/TypeCoercion.pm"} and blessed( $self ) and $_[0] =~ /^(Class::MOP|MooseX?)::/ ) { my $r = $self->moose_coercion->isa( @_ ); return $r if $r; } $self->SUPER::isa( @_ ); } #/ sub isa sub can { my $self = shift; my $can = $self->SUPER::can( @_ ); return $can if $can; if ( $INC{"Moose/Meta/TypeCoercion.pm"} and blessed( $self ) and my $method = $self->moose_coercion->can( @_ ) ) { return sub { $method->( shift->moose_coercion, @_ ) }; } return; } #/ sub can sub AUTOLOAD { my $self = shift; my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ ); return if $m eq 'DESTROY'; if ( $INC{"Moose/Meta/TypeCoercion.pm"} and blessed( $self ) and my $method = $self->moose_coercion->can( $m ) ) { return $method->( $self->moose_coercion, @_ ); } _croak q[Can't locate object method "%s" via package "%s"], $m, ref( $self ) || $self; } #/ sub AUTOLOAD # Private Moose method, but Moo uses this... sub _compiled_type_coercion { my $self = shift; if ( @_ ) { my $thing = $_[0]; if ( blessed( $thing ) and $thing->isa( "Type::Coercion" ) ) { $self->add_type_coercions( @{ $thing->type_coercion_map } ); } elsif ( Types::TypeTiny::is_CodeLike( $thing ) ) { require Types::Standard; $self->add_type_coercions( Types::Standard::Any(), $thing ); } } #/ if ( @_ ) $self->compiled_coercion; } #/ sub _compiled_type_coercion *compile_type_coercion = \&compiled_coercion; sub meta { _croak( "Not really a Moose::Meta::TypeCoercion. Sorry!" ) } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Coercion - a set of coercions to a particular target type constraint =head1 STATUS This module is covered by the L. =head1 DESCRIPTION =head2 Constructors =over =item C<< new(%attributes) >> Moose-style constructor function. =item C<< add($c1, $c2) >> Create a Type::Coercion from two existing Type::Coercion objects. =back =head2 Attributes Attributes are named values that may be passed to the constructor. For each attribute, there is a corresponding reader method. For example: my $c = Type::Coercion->new( type_constraint => Int ); my $t = $c->type_constraint; # Int =head3 Important attributes These are the attributes you are likely to be most interested in providing when creating your own type coercions, and most interested in reading when dealing with coercion objects. =over =item C Weak reference to the target type constraint (i.e. the type constraint which the output of coercion coderefs is expected to conform to). =item C Arrayref of source-type/code pairs. =item C Boolean; default false. A frozen coercion cannot have C called upon it. =item C A name for the coercion. These need to conform to certain naming rules (they must begin with an uppercase letter and continue using only letters, digits 0-9 and underscores). Optional; if not supplied will be an anonymous coercion. =item C A name to display for the coercion when stringified. These don't have to conform to any naming rules. Optional; a default name will be calculated from the C. =item C The package name of the type library this coercion is associated with. Optional. Informational only: setting this attribute does not install the coercion into the package. =back =head3 Attributes related to parameterizable and parameterized coercions The following attributes are used for parameterized coercions, but are not fully documented because they may change in the near future: =over =item C<< coercion_generator >> =item C<< parameters >> =item C<< parameterized_from >> =back =head3 Lazy generated attributes The following attributes should not be usually passed to the constructor; unless you're doing something especially unusual, you should rely on the default lazily-built return values. =over =item C<< compiled_coercion >> Coderef to coerce a value (C<< $_[0] >>). The general point of this attribute is that you should not set it, but rely on the lazily-built default. Type::Coerce will usually generate a pretty fast coderef, inlining all type constraint checks, etc. =item C A L object equivalent to this one. Don't set this manually; rely on the default built one. =back =head2 Methods =head3 Predicate methods These methods return booleans indicating information about the coercion. They are each tightly associated with a particular attribute. (See L.) =over =item C, C Simple Moose-style predicate methods indicating the presence or absence of an attribute. =item C Returns true iff the coercion does not have a C. =back The following predicates are used for parameterized coercions, but are not fully documented because they may change in the near future: =over =item C<< has_coercion_generator >> =item C<< has_parameters >> =item C<< is_parameterizable >> =item C<< is_parameterized >> =back =head3 Coercion The following methods are used for coercing values to a type constraint: =over =item C<< coerce($value) >> Coerce the value to the target type. Returns the coerced value, or the original value if no coercion was possible. =item C<< assert_coerce($value) >> Coerce the value to the target type, and throw an exception if the result does not validate against the target type constraint. Returns the coerced value. =back =head3 Coercion code definition methods These methods all return C<< $self >> so are suitable for chaining. =over =item C<< add_type_coercions($type1, $code1, ...) >> Takes one or more pairs of L constraints and coercion code, creating an ordered list of source types and coercion codes. Coercion codes can be expressed as either a string of Perl code (this includes objects which overload stringification), or a coderef (or object that overloads coderefification). In either case, the value to be coerced is C<< $_ >>. C<< add_type_coercions($coercion_object) >> also works, and can be used to copy coercions from another type constraint: $type->coercion->add_type_coercions($othertype->coercion)->freeze; =item C<< freeze >> Sets the C attribute to true. Called automatically by L sometimes. =item C<< i_really_want_to_unfreeze >> If you really want to unfreeze a coercion, call this method. Don't call this method. It will potentially lead to subtle bugs. This method is considered unstable; future versions of Type::Tiny may alter its behaviour (e.g. to throw an exception if it has been detected that unfreezing this particular coercion will cause bugs). =back =head3 Parameterization The following method is used for parameterized coercions, but is not fully documented because it may change in the near future: =over =item C<< parameterize(@params) >> =back =head3 Type coercion introspection methods These methods allow you to determine a coercion's relationship to type constraints: =over =item C<< has_coercion_for_type($source_type) >> Returns true iff this coercion has a coercion from the source type. Returns the special string C<< "0 but true" >> if no coercion should actually be necessary for this type. (For example, if a coercion coerces to a theoretical "Number" type, there is probably no coercion necessary for values that already conform to the "Integer" type.) =item C<< has_coercion_for_value($value) >> Returns true iff the value could be coerced by this coercion. Returns the special string C<< "0 but true" >> if no coercion would be actually be necessary for this value (due to it already meeting the target type constraint). =back The C attribute provides a type constraint object for the target type constraint of the coercion. See L. =head3 Inlining methods =for stopwords uated The following methods are used to generate strings of Perl code which may be pasted into stringy Cuated subs to perform type coercions: =over =item C<< can_be_inlined >> Returns true iff the coercion can be inlined. =item C<< inline_coercion($varname) >> Much like C from L. =back =head3 Other methods =over =item C<< qualified_name >> For non-anonymous coercions that have a library, returns a qualified C<< "MyLib::MyCoercion" >> sort of name. Otherwise, returns the same as C. =item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >> If Moose is loaded, then the combination of these methods is used to mock a Moose::Meta::TypeCoercion. =back The following methods exist for Moose/Mouse compatibility, but do not do anything useful. =over =item C<< compile_type_coercion >> =item C<< meta >> =back =head2 Overloading =over =item * Boolification is overloaded to always return true. =item * Coderefification is overloaded to call C. =item * On Perl 5.10.1 and above, smart match is overloaded to call C. =back Previous versions of Type::Coercion would overload the C<< + >> operator to call C. Support for this was dropped after 0.040. =head1 DIAGNOSTICS =over =item I<< Attempt to add coercion code to a Type::Coercion which has been frozen >> Type::Tiny type constraints are designed as immutable objects. Once you've created a constraint, rather than modifying it you generally create child constraints to do what you need. Type::Coercion objects, on the other hand, are mutable. Coercion routines can be added at any time during the object's lifetime. Sometimes Type::Tiny needs to freeze a Type::Coercion object to prevent this. In L and L code this is likely to happen as soon as you use a type constraint in an attribute. Workarounds: =over =item * Define as many of your coercions as possible within type libraries, not within the code that uses the type libraries. The type library will be evaluated relatively early, likely before there is any reason to freeze a coercion. =item * If you do need to add coercions to a type within application code outside the type library, instead create a subtype and add coercions to that. The C method provided by L should make this simple. =back =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Library.pm000664001750001750 4211215111656240 16064 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Library; use 5.008001; use strict; use warnings; BEGIN { $Type::Library::AUTHORITY = 'cpan:TOBYINK'; $Type::Library::VERSION = '2.008006'; } $Type::Library::VERSION =~ tr/_//d; use Eval::TypeTiny qw< eval_closure set_subname type_to_coderef NICE_PROTOTYPES >; use Scalar::Util qw< blessed refaddr >; use Type::Tiny (); use Types::TypeTiny (); require Exporter::Tiny; our @ISA = 'Exporter::Tiny'; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } #### #### Hooks for Exporter::Tiny #### # Handling for -base, -extends, and -utils tags. # sub _exporter_validate_opts { my ( $class, $opts ) = ( shift, @_ ); $class->setup_type_library( @{$opts}{qw/ into utils extends /}, $opts ) if $_[0]{base} || $_[0]{extends}; return $class->SUPER::_exporter_validate_opts( @_ ); } # In Exporter::Tiny, this method takes a sub name, a 'value' (i.e. # potentially an options hashref for the export), and some global # options, and returns a list of name+coderef pairs to actually # export. We override it to provide some useful features. # sub _exporter_expand_sub { my ( $class, $name, $value, $globals ) = ( shift, @_ ); # Handle exporting '+Type'. # # Note that this recurses, so if used in conjunction with the other # special cases handled by this method, will still work. # if ( $name =~ /^\+(.+)/ and $class->has_type( "$1" ) ) { my $type = $class->get_type( "$1" ); my $exported = $type->exportables; return map $class->_exporter_expand_sub( $_->{name}, +{ %{ $value || {} } }, $globals, ), @$exported; } # Is the function being exported one which is associated with a # type constraint? If so, which one. If not, then forget the rest # and just use the superclass method. # if ( my $f = $class->meta->{'functions'}{$name} and defined $class->meta->{'functions'}{$name}{'type'} ) { my $type = $f->{type}; my $tag = $f->{tags}[0]; my $typename = $type->name; # If $value has `of` or `where` options, then this is a # custom type. # my $custom_type = 0; for my $param ( qw/ of where / ) { exists $value->{$param} or next; defined $value->{-as} or _croak( "Parameter '-as' not supplied" ); $type = $type->$param( $value->{$param} ); $name = $value->{-as}; ++$custom_type; } # If we're exporting a type itself, then export a custom # function if they customized the type or want a Moose/Mouse # type constraint. # if ( $tag eq 'types' ) { my $post_method = q(); $post_method = '->mouse_type' if $globals->{mouse}; $post_method = '->moose_type' if $globals->{moose}; return ( $name => type_to_coderef( $type, post_method => $post_method ) ) if $post_method || $custom_type; } # If they're exporting some other type of function, like # 'to', 'is', or 'assert', then find the correct exportable # by tag name, and return that. # # XXX: this will fail for tags like 'constants' where there # will be multiple exportables which match! # if ( $custom_type and $tag ne 'types' ) { my $exportable = $type->exportables_by_tag( $tag, $typename ); return ( $value->{-as} || $exportable->{name}, $exportable->{code} ); } } # In all other cases, the superclass method will work. # return $class->SUPER::_exporter_expand_sub( @_ ); } # Mostly just rely on superclass to do the actual export, but add # a couple of useful behaviours. # sub _exporter_install_sub { my ( $class, $name, $value, $globals, $sym ) = ( shift, @_ ); my $into = $globals->{into}; my $type = $class->meta->{'functions'}{$name}{'type'}; my $tags = $class->meta->{'functions'}{$name}{'tags'}; # Issue a warning if exporting a deprecated type constraint. # Exporter::Tiny::_carp( "Exporting deprecated type %s to %s", $type->qualified_name, ref( $into ) ? "reference" : "package $into", ) if ( defined $type and $type->deprecated and not $globals->{allow_deprecated} ); # If exporting a type constraint into a real package, then # add it to the package's type registry. # if ( !ref $into and $into ne '-lexical' and defined $type and grep $_ eq 'types', @$tags ) { # If they're renaming it, figure out what name, and use that. # XXX: `-as` can be a coderef, and can be in $globals in that case. my ( $prefix ) = grep defined, $value->{-prefix}, $globals->{prefix}, q(); my ( $suffix ) = grep defined, $value->{-suffix}, $globals->{suffix}, q(); my $as = $prefix . ( $value->{-as} || $name ) . $suffix; $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $into )->add_type( $type, $as ) : ( $Type::Registry::DELAYED{$into}{$as} = $type ); } $class->SUPER::_exporter_install_sub( @_ ); } #/ sub _exporter_install_sub sub _exporter_fail { my ( $class, $name, $value, $globals ) = ( shift, @_ ); # Passing the `-declare` flag means that if a type isn't found, then # we export a placeholder function instead of failing. if ( $globals->{declare} ) { return ( $name, type_to_coderef( undef, type_name => $name, type_library => $globals->{into} || _croak( "Parameter 'into' not supplied" ), ), ); } #/ if ( $globals->{declare...}) return $class->SUPER::_exporter_fail( @_ ); } #/ sub _exporter_fail #### #### Type library functionality #### sub setup_type_library { my ( $class, $type_library, $install_utils, $extends, $opts ) = ( shift, @_ ); my @extends = ref( $extends ) ? @$extends : $extends ? $extends : (); unshift @extends, $class if $class ne __PACKAGE__; if ( not ref $type_library ) { no strict "refs"; push @{"$type_library\::ISA"}, $class; ( my $file = $type_library ) =~ s{::}{/}g; $INC{"$file.pm"} ||= __FILE__; } if ( $install_utils ) { require Type::Utils; 'Type::Utils'->import( { %$opts, into => $type_library }, '-default', ); } if ( @extends and not ref $type_library ) { require Type::Utils; my $wrapper = eval "sub { package $type_library; &Type::Utils::extends; }"; $wrapper->( @extends ); } } sub meta { no strict "refs"; no warnings "once"; return $_[0] if blessed $_[0]; ${"$_[0]\::META"} ||= bless {}, $_[0]; } sub add_type { my $meta = shift->meta; my $class = blessed( $meta ) ; _croak( 'Type library is immutable' ) if $meta->{immutable}; my $type = ref( $_[0] ) =~ /^Type::Tiny\b/ ? $_[0] : blessed( $_[0] ) ? Types::TypeTiny::to_TypeTiny( $_[0] ) : ref( $_[0] ) eq q(HASH) ? 'Type::Tiny'->new( library => $class, %{ $_[0] } ) : "Type::Tiny"->new( library => $class, @_ ); my $name = $type->{name}; if ( $meta->has_type( $name ) ) { my $existing = $meta->get_type( $name ); return if $type->{uniq} == $existing->{uniq}; _croak( 'Type %s already exists in this library', $name ); } _croak( 'Type %s conflicts with coercion of same name', $name ) if $meta->has_coercion( $name ); _croak( 'Cannot add anonymous type to a library' ) if $type->is_anon; $meta->{types} ||= {}; $meta->{types}{$name} = $type; no strict "refs"; no warnings "redefine", "prototype"; for my $exportable ( @{ $type->exportables } ) { my $name = $exportable->{name}; my $code = $exportable->{code}; my $tags = $exportable->{tags}; _croak( 'Function %s is provided by types %s and %s', $name, $meta->{'functions'}{$name}{'type'}->name, $type->name ) if $meta->{'functions'}{$name}; *{"$class\::$name"} = set_subname( "$class\::$name", $code ); push @{"$class\::EXPORT_OK"}, $name; push @{ ${"$class\::EXPORT_TAGS"}{$_} ||= [] }, $name for @$tags; $meta->{'functions'}{$name} = { type => $type, tags => $tags }; } $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $class )->add_type( $type, $name ) : ( $Type::Registry::DELAYED{$class}{$name} = $type ); return $type; } #/ sub add_type # For Type::TinyX::Facets # Only use this if you know what you're doing! sub _remove_type { my $meta = shift->meta; my $type = $meta->get_type( $_[0] ); my $class = ref $meta; _croak( 'Type library is immutable' ) if $meta->{immutable}; delete $meta->{types}{$type->name}; no strict "refs"; no warnings "redefine", "prototype"; my @clean; my $_scrub = sub { my ( $arr, $name ) = @_; @$arr = grep $_ ne $name, @$arr; }; for my $exportable ( @{ $type->exportables } ) { my $name = $exportable->{name}; push @clean, $name; &$_scrub( \@{"$class\::EXPORT_OK"}, $name ); for my $t ( @{ $exportable->{tags} } ) { &$_scrub( ${"$class\::EXPORT_TAGS"}{$t} ||= [], $name ); } delete $meta->{'functions'}{$name}; } eval { require namespace::clean; 'namespace::clean'->clean_subroutines( $class, @clean ); }; delete 'Type::Registry'->for_class( $class )->{$type->name} if $INC{'Type/Registry.pm'}; delete $Type::Registry::DELAYED{$class}{$type->name}; return $type; } #/ sub _remove_type sub get_type { my $meta = shift->meta; $meta->{types}{ $_[0] }; } sub has_type { my $meta = shift->meta; exists $meta->{types}{ $_[0] }; } sub type_names { my $meta = shift->meta; keys %{ $meta->{types} }; } sub add_coercion { my $meta = shift->meta; my $class = blessed( $meta ); _croak( 'Type library is immutable' ) if $meta->{immutable}; require Type::Coercion; my $c = blessed( $_[0] ) ? $_[0] : "Type::Coercion"->new( @_ ); my $name = $c->name; _croak( 'Coercion %s already exists in this library', $name ) if $meta->has_coercion( $name ); _croak( 'Coercion %s conflicts with type of same name', $name ) if $meta->has_type( $name ); _croak( 'Cannot add anonymous type to a library' ) if $c->is_anon; $meta->{coercions} ||= {}; $meta->{coercions}{$name} = $c; no strict "refs"; no warnings "redefine", "prototype"; *{"$class\::$name"} = type_to_coderef( $c ); push @{"$class\::EXPORT_OK"}, $name; push @{ ${"$class\::EXPORT_TAGS"}{'coercions'} ||= [] }, $name; $meta->{'functions'}{$name} = { coercion => $c, tags => [ 'coercions' ] }; return $c; } #/ sub add_coercion sub get_coercion { my $meta = shift->meta; $meta->{coercions}{ $_[0] }; } sub has_coercion { my $meta = shift->meta; exists $meta->{coercions}{ $_[0] }; } sub coercion_names { my $meta = shift->meta; keys %{ $meta->{coercions} }; } sub make_immutable { my $meta = shift->meta; my $class = ref( $meta ); no strict "refs"; no warnings "redefine", "prototype"; for my $type ( values %{ $meta->{types} } ) { $type->coercion->freeze; next unless $type->has_coercion && $type->coercion->frozen; for my $e ( $type->exportables_by_tag( 'to' ) ) { my $qualified_name = $class . '::' . $e->{name}; *$qualified_name = set_subname( $qualified_name, $e->{code} ); } } $meta->{immutable} = 1; } 1; __END__ =pod =encoding utf-8 =for stopwords Moo(se)-compatible MooseX::Types-like =head1 NAME Type::Library - tiny, yet Moo(se)-compatible type libraries =head1 SYNOPSIS =for test_synopsis BEGIN { die "SKIP: crams multiple modules into single example" }; package Types::Mine { use Scalar::Util qw(looks_like_number); use Type::Library -base; use Type::Tiny; my $NUM = "Type::Tiny"->new( name => "Number", constraint => sub { looks_like_number($_) }, message => sub { "$_ ain't a number" }, ); __PACKAGE__->meta->add_type($NUM); __PACKAGE__->meta->make_immutable; } package Ermintrude { use Moo; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } package Bullwinkle { use Moose; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } package Maisy { use Mouse; use Types::Mine qw(Number); has favourite_number => (is => "ro", isa => Number); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION L is a tiny class for creating MooseX::Types-like type libraries which are compatible with Moo, Moose and Mouse. If you're reading this because you want to create a type library, then you're probably better off reading L. =head2 Type library methods A type library is a singleton class. Use the C method to get a blessed object which other methods can get called on. For example: Types::Mine->meta->add_type($foo); =over =item C<< add_type($type) >> or C<< add_type(%opts) >> Add a type to the library. If C<< %opts >> is given, then this method calls C<< Type::Tiny->new(%opts) >> first, and adds the resultant type. Adding a type named "Foo" to the library will automatically define four functions in the library's namespace: =over =item C<< Foo >> Returns the Type::Tiny object. =item C<< is_Foo($value) >> Returns true iff $value passes the type constraint. =item C<< assert_Foo($value) >> Returns $value iff $value passes the type constraint. Dies otherwise. =item C<< to_Foo($value) >> Coerces the value to the type. =back =item C<< get_type($name) >> Gets the C object corresponding to the name. =item C<< has_type($name) >> Boolean; returns true if the type exists in the library. =item C<< type_names >> List all types defined by the library. =item C<< add_coercion($c) >> or C<< add_coercion(%opts) >> Add a standalone coercion to the library. If C<< %opts >> is given, then this method calls C<< Type::Coercion->new(%opts) >> first, and adds the resultant coercion. Adding a coercion named "FooFromBar" to the library will automatically define a function in the library's namespace: =over =item C<< FooFromBar >> Returns the Type::Coercion object. =back =item C<< get_coercion($name) >> Gets the C object corresponding to the name. =item C<< has_coercion($name) >> Boolean; returns true if the coercion exists in the library. =item C<< coercion_names >> List all standalone coercions defined by the library. =item C<< import(@args) >> Type::Library-based libraries are exporters. =item C<< make_immutable >> Prevents new type constraints and coercions from being added to the library, and also calls C<< $type->coercion->freeze >> on every type constraint in the library. (Prior to Type::Library v2, C would call C<< $type->coercion->freeze >> on every constraint in the library, but not prevent new type constraints and coercions from being added to the library.) =back =head2 Type library exported functions Type libraries are exporters. For the purposes of the following examples, assume that the C library defines types C and C. # Exports nothing. # use Types::Mine; # Exports a function "String" which is a constant returning # the String type constraint. # use Types::Mine qw( String ); # Exports both String and Number as above. # use Types::Mine qw( String Number ); # Same. # use Types::Mine qw( :types ); # Exports "coerce_String" and "coerce_Number", as well as any other # coercions # use Types::Mine qw( :coercions ); # Exports a sub "is_String" so that "is_String($foo)" is equivalent # to "String->check($foo)". # use Types::Mine qw( is_String ); # Exports "is_String" and "is_Number". # use Types::Mine qw( :is ); # Exports a sub "assert_String" so that "assert_String($foo)" is # equivalent to "String->assert_return($foo)". # use Types::Mine qw( assert_String ); # Exports "assert_String" and "assert_Number". # use Types::Mine qw( :assert ); # Exports a sub "to_String" so that "to_String($foo)" is equivalent # to "String->coerce($foo)". # use Types::Mine qw( to_String ); # Exports "to_String" and "to_Number". # use Types::Mine qw( :to ); # Exports "String", "is_String", "assert_String" and "coerce_String". # use Types::Mine qw( +String ); # Exports everything. # use Types::Mine qw( :all ); Type libraries automatically inherit from L; see the documentation of that module for tips and tricks importing from libraries. =head2 Type::Library's methods The above sections describe the characteristics of libraries built with Type::Library. The following methods are available on Type::Library itself. =over =item C<< setup_type_library( $package, $utils, \@extends ) >> Sets up a package to be a type library. C<< $utils >> is a boolean indicating whether to import L into the package. C<< @extends >> is a list of existing type libraries the package should extend. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =begin trustme =item meta =end trustme Params.pm000664001750001750 15246015111656240 15733 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Params; use 5.008001; use strict; use warnings; BEGIN { $Type::Params::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::VERSION = '2.008006'; } $Type::Params::VERSION =~ tr/_//d; use B qw(); use Eval::TypeTiny qw( eval_closure set_subname ); use Scalar::Util qw( refaddr ); use Error::TypeTiny; use Error::TypeTiny::Assertion; use Error::TypeTiny::WrongNumberOfParameters; use Types::Standard (); use Types::TypeTiny (); require Exporter::Tiny; our @ISA = 'Exporter::Tiny'; our @EXPORT = qw( compile compile_named ); our @EXPORT_OK = qw( compile_named_oo validate validate_named multisig Invocant ArgsObject wrap_subs wrap_methods signature signature_for signature_for_func signature_for_method ); our %EXPORT_TAGS = ( compile => [ qw( compile compile_named compile_named_oo ) ], wrap => [ qw( wrap_subs wrap_methods ) ], sigs => [ qw( signature signature_for ) ], validate => [ qw( validate validate_named ) ], sigplus => [ qw( signature signature_for signature_for_func signature_for_method ) ], v1 => [ qw( compile compile_named ) ], # Old default v2 => [ qw( signature signature_for ) ], # New recommendation ); { my $Invocant; sub Invocant () { $Invocant ||= do { require Type::Tiny::Union; 'Type::Tiny::Union'->new( name => 'Invocant', type_constraints => [ Types::Standard::Object(), Types::Standard::ClassName(), ], ); }; } #/ sub Invocant my $ArgsObject; sub ArgsObject (;@) { $ArgsObject ||= do { 'Type::Tiny'->new( name => 'ArgsObject', parent => Types::Standard::Object(), constraint => q{ ref($_) =~ qr/^Type::Params::OO::/ }, constraint_generator => sub { Type::Tiny::check_parameter_count_for_parameterized_type( 'Type::Params', 'ArgsObject', \@_, 1, 1 ); my $param = Types::Standard::assert_Str( shift ); sub { defined( $_->{'~~caller'} ) and $_->{'~~caller'} eq $param }; }, inline_generator => sub { my $param = shift; my $quoted = B::perlstring( $param ); sub { my $var = pop; return ( Types::Standard::Object()->inline_check( $var ), sprintf( q{ ref(%s) =~ qr/^Type::Params::OO::/ }, $var ), sprintf( q{ do { use Scalar::Util (); Scalar::Util::reftype(%s) eq 'HASH' } }, $var ), sprintf( q{ defined((%s)->{'~~caller'}) && ((%s)->{'~~caller'} eq %s) }, $var, $var, $quoted ), ); }; }, ); }; @_ ? $ArgsObject->parameterize( @{ $_[0] } ) : $ArgsObject; } #/ sub ArgsObject (;@) &Scalar::Util::set_prototype( \&ArgsObject, ';$' ) if Eval::TypeTiny::NICE_PROTOTYPES; } sub signature { if ( @_ % 2 ) { require Error::TypeTiny; Error::TypeTiny::croak( "Expected even-sized list of arguments" ); } my ( %opts ) = @_; $opts{next} ||= delete $opts{goto_next} if exists $opts{goto_next}; my $for = [ caller( 1 + ( $opts{caller_level} || 0 ) ) ]->[3] || ( ( $opts{package} || '__ANON__' ) . '::__ANON__' ); my ( $pkg, $sub ) = ( $for =~ /^(.+)::(\w+)$/ ); $opts{package} ||= $pkg; $opts{subname} ||= $sub; require Type::Params::Signature; 'Type::Params::Signature'->new_from_v2api( \%opts )->return_wanted; } sub signature_for { if ( not @_ % 2 ) { require Error::TypeTiny; Error::TypeTiny::croak( "Expected odd-sized list of arguments; did you forget the function name?" ); } my ( $function, %opts ) = @_; my $package = $opts{package} || caller( $opts{caller_level} || 0 ); $opts{next} ||= delete $opts{goto_next} if exists $opts{goto_next}; if ( ref($function) eq 'ARRAY' ) { $opts{package} = $package; return map { signature_for( $_, %opts ) } @$function; } $opts{_is_signature_for} = 1; my $fullname = ( $function =~ /::/ ) ? $function : "$package\::$function"; $opts{package} ||= $package; $opts{subname} ||= ( $function =~ /::(\w+)$/ ) ? $1 : $function; $opts{next} ||= do { no strict 'refs'; exists(&$fullname) ? \&$fullname : undef; }; if ( $opts{method} ) { $opts{next} ||= eval { $package->can( $opts{subname} ) }; } if ( $opts{fallback} and not $opts{next} ) { $opts{next} = ref( $opts{fallback} ) ? $opts{fallback} : sub {}; } if ( not $opts{next} ) { require Error::TypeTiny; return Error::TypeTiny::croak( "Function '$function' not found to wrap!" ); } require Type::Params::Signature; my $sig = 'Type::Params::Signature'->new_from_v2api( \%opts ); # Delay compilation my $compiled; my $coderef = sub { $compiled ||= $sig->coderef->compile; no strict 'refs'; no warnings 'redefine'; *$fullname = set_subname( $fullname, $compiled ); goto( $compiled ); }; no strict 'refs'; no warnings 'redefine'; *$fullname = set_subname( $fullname, $coderef ); return $sig; } sub signature_for_func { if ( not @_ % 2 ) { require Error::TypeTiny; Error::TypeTiny::croak( "Expected odd-sized list of arguments; did you forget the function name?" ); } my ( $function, %opts ) = @_; my $N = !!$opts{named}; @_ = ( $function, method => 0, allow_dash => $N, list_to_named => $N, %opts ); goto \&signature_for; } sub signature_for_method { if ( not @_ % 2 ) { require Error::TypeTiny; Error::TypeTiny::croak( "Expected odd-sized list of arguments; did you forget the function name?" ); } my ( $function, %opts ) = @_; my $N = !!$opts{named}; @_ = ( $function, method => 1, allow_dash => $N, list_to_named => $N, %opts ); goto \&signature_for; } sub compile { my @args = @_; @_ = ( positional => \@args ); goto \&signature; } sub compile_named { my @args = @_; @_ = ( bless => 0, named => \@args ); goto \&signature; } sub compile_named_oo { my @args = @_; @_ = ( bless => 1, named => \@args ); goto \&signature; } # Would be faster to inline this into validate and validate_named, but # that would complicate them. :/ sub _mk_key { local $_; join ':', map { Types::Standard::is_HashRef( $_ ) ? do { my %h = %$_; sprintf( '{%s}', _mk_key( map { ; $_ => $h{$_} } sort keys %h ) ); } : Types::TypeTiny::is_TypeTiny( $_ ) ? sprintf( 'TYPE=%s', $_->{uniq} ) : Types::Standard::is_Ref( $_ ) ? sprintf( 'REF=%s', refaddr( $_ ) ) : Types::Standard::is_Undef( $_ ) ? sprintf( 'UNDEF' ) : B::perlstring( $_ ) } @_; } #/ sub _mk_key { my %compiled; sub validate { my $arg = shift; my $sub = ( $compiled{ _mk_key( @_ ) } ||= signature( caller_level => 1, %{ ref( $_[0] ) eq 'HASH' ? shift( @_ ) : +{} }, positional => [ @_ ], ) ); @_ = @$arg; goto $sub; } #/ sub validate } { my %compiled; sub validate_named { my $arg = shift; my $sub = ( $compiled{ _mk_key( @_ ) } ||= signature( caller_level => 1, bless => 0, %{ ref( $_[0] ) eq 'HASH' ? shift( @_ ) : +{} }, named => [ @_ ], ) ); @_ = @$arg; goto $sub; } #/ sub validate_named } sub multisig { my %options = ( ref( $_[0] ) eq "HASH" ) ? %{ +shift } : (); signature( %options, multi => \@_, ); } #/ sub multisig sub wrap_methods { my $opts = ref( $_[0] ) eq 'HASH' ? shift : {}; $opts->{caller} ||= caller; $opts->{skip_invocant} = 1; $opts->{use_can} = 1; unshift @_, $opts; goto \&_wrap_subs; } sub wrap_subs { my $opts = ref( $_[0] ) eq 'HASH' ? shift : {}; $opts->{caller} ||= caller; $opts->{skip_invocant} = 0; $opts->{use_can} = 0; unshift @_, $opts; goto \&_wrap_subs; } sub _wrap_subs { my $opts = shift; while ( @_ ) { my ( $name, $proto ) = splice @_, 0, 2; my $fullname = ( $name =~ /::/ ) ? $name : sprintf( '%s::%s', $opts->{caller}, $name ); my $orig = do { no strict 'refs'; exists &$fullname ? \&$fullname : $opts->{use_can} ? ( $opts->{caller}->can( $name ) || sub { } ) : sub { } }; my $new; if ( ref $proto eq 'CODE' ) { $new = $opts->{skip_invocant} ? sub { my $s = shift; @_ = ( $s, &$proto ); goto $orig; } : sub { @_ = &$proto; goto $orig; }; } else { $new = compile( { 'package' => $opts->{caller}, 'subname' => $name, 'next' => $orig, 'head' => $opts->{skip_invocant} ? 1 : 0, }, @$proto, ); } no strict 'refs'; no warnings 'redefine'; *$fullname = set_subname( $fullname, $new ); } #/ while ( @_ ) 1; } #/ sub _wrap_subs 1; __END__ =pod =encoding utf-8 =for stopwords evals invocant =head1 NAME Type::Params - sub signature validation using Type::Tiny type constraints and coercions =head1 SYNOPSIS use v5.36; use builtin qw( true false ); package Horse { use Moo; use Types::Standard qw( Object ); use Type::Params -sigs; use namespace::autoclean; ...; # define attributes, etc signature_for add_child => ( method => true, positional => [ Object ], ); sub add_child ( $self, $child ) { push $self->children->@*, $child; return $self; } } package main; my $boldruler = Horse->new; $boldruler->add_child( Horse->new ); $boldruler->add_child( 123 ); # dies (123 is not an Object!) =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This documents the details of the L package. L is a better starting place if you're new. Type::Params uses L constraints to validate the parameters to a sub. It takes the slightly unorthodox approach of separating validation into two stages: =over =item 1. Compiling the parameter specification into a coderef; then =item 2. Using the coderef to validate parameters. =back The first stage is slow (it might take a couple of milliseconds), but only needs to be done the first time the sub is called. The second stage is fast; according to my benchmarks faster even than the XS version of L. With the modern API, you rarely need to worry about the two stages being internally separate. Note that most of the examples in this documentation use modern Perl features such as subroutine signatures, postfix dereferencing, and the C and C keywords from L. On Perl version 5.36+, you can enable all of these features using: use v5.36; use experimental 'builtin'; use builtin 'true', 'false'; Type::Params does support older versions of Perl (as old as 5.8), but you may need to adjust the syntax for some examples. =head1 MODERN API The modern API can be exported using: use Type::Params -sigs; Or: use Type::Params -v2; Or by requesting functions by name: use Type::Params qw( signature signature_for ); Two optional shortcuts can be exported: use Type::Params qw( signature_for_func signature_for_method ); Or: use Type::Params -sigplus; =head2 C<< signature_for $function_name => ( %spec ) >> Wraps an existing function in additional code that implements all aspects of the subroutine's signature, including unpacking arguments from C<< @_ >>, applying default values, coercing, and validating values. C<< signature_for( \@functions, %opts ) >> is a useful shortcut if you have multiple functions with the same signature. signature_for [ 'add_nums', 'subtract_nums' ] => ( positional => [ Num, Num ], ); Although normally used in void context, C does return a value. my $meta = signature_for add_nums => ( positional => [ Num, Num ], ); sub add_nums ( $x, $y ) { return $x + $y; } Or when used with multiple functions: my @metas = signature_for [ 'add_nums', 'subtract_nums' ] => (...); This is a blessed L object which provides some introspection possibilities. Inspecting C<< $meta->coderef->code >> can be useful to see what the signature is doing internally. =head3 Signature Specification Options The signature specification is a hash which must contain either a C, C, or C key indicating whether your function takes positional parameters, named parameters, or supports multiple calling conventions, but may also include other options. =head4 C<< positional >> B This is conceptually a list of type constraints, one for each positional parameter. For example, a signature for a function which accepts two integers: signature_for myfunc => ( positional => [ Int, Int ] ); However, each type constraint is optionally followed by a hashref of options which affect that parameter. For example: signature_for myfunc => ( positional => [ Int, { default => 40 }, Int, { default => 2 }, ] ); Type constraints can instead be given as strings, which will be looked up using C from L. signature_for myfunc => ( positional => [ 'Int', { default => 40 }, 'Int', { default => 2 }, ] ); See the section below for more information on parameter options. Optional parameters must follow required parameters, and can be specified using either the B parameterizable type constraint, the C parameter option, or by providing a default. # All three parameters are effectively optional. signature_for myfunc => ( positional => [ Optional[Int], Int, { optional => true }, Int, { default => 42 }, ] ); A single slurpy parameter may be provided at the end, using the B parameterizable type constraint, or the C parameter option: signature_for myfunc => ( positional => [ Int, Slurpy[ ArrayRef[Int] ], ] ); signature_for myfunc => ( positional => [ Int, ArrayRef[Int], { slurpy => true }, ] ); The C option can also be abbreviated to C. So C<< signature_for myfunc => ( pos => [...] ) >> can be used instead of the longer C<< signature_for myfunc => ( positional => [...] ) >>. signature_for add_numbers => ( pos => [ Num, Num ] ); sub add_numbers ( $num1, $num2 ) { return $num1 + $num2; } say add_numbers( 2, 3 ); # says 5 =head4 C<< named >> B This is conceptually a list of pairs of names and type constraints, one name+type pair for each named parameter. For example, a signature for a function which accepts two integers: signature_for myfunc => ( named => [ foo => Int, bar => Int ] ) However, each type constraint is optionally followed by a hashref of options which affect that parameter. For example: signature_for myfunc => ( named => [ foo => Int, { default => 40 }, bar => Int, { default => 2 }, ] ); Type constraints can instead be given as strings, which will be looked up using C from L. signature_for myfunc => ( named => [ foo => 'Int', { default => 40 }, bar => 'Int', { default => 2 }, ] ); Optional and slurpy parameters are allowed, but unlike positional parameters, they do not need to be at the end. See the section below for more information on parameter options. If a signature uses named parameters, the values are supplied to the function as a single parameter object: signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ] ); sub add_numbers ( $arg ) { return $arg->num1 + $arg->num2; } say add_numbers( num1 => 2, num2 => 3 ); # says 5 say add_numbers( { num1 => 2, num2 => 3 } ); # also says 5 =head4 C<< named_to_list >> B<< ArrayRef|Bool >> The C option is ignored for signatures using positional parameters, but for signatures using named parameters, allows them to be supplied to the function as a list of values instead of as a single object: signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], named_to_list => true, ); sub add_numbers ( $num1, $num2 ) { return $num1 + $num2; } say add_numbers( num1 => 2, num2 => 3 ); # says 5 say add_numbers( { num1 => 2, num2 => 3 } ); # also says 5 You can think of C above as a function which takes named parameters from the outside, but receives positional parameters on the inside. You can use an arrayref to control the order in which the parameters will be supplied. (By default they are returned in the order in which they were defined.) signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], named_to_list => [ qw( num2 num1 ) ], ); sub add_numbers ( $num2, $num1 ) { return $num1 + $num2; } say add_numbers( num1 => 2, num2 => 3 ); # says 5 say add_numbers( { num1 => 2, num2 => 3 } ); # also says 5 =head4 C<< list_to_named >> B<< Bool >> For a function that accepts named parameters, allows them to alternatively be supplied as a list in a hopefully do-what-you-mean manner. signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], list_to_named => true, ); sub add_numbers ( $arg ) { return $arg->num1 + $arg->num2; } say add_numbers( num1 => 5, num2 => 10 ); # says 15 say add_numbers( { num1 => 5, num2 => 10 } ); # also says 15 say add_numbers( 5, num2 => 10 ); # says 15 yet again say add_numbers( 5, { num2 => 10 } ); # guess what? says 15 say add_numbers( 10, num1 => 5 ); # 14. just kidding! 15 say add_numbers( 10, { num1 => 5 } ); # another 15 say add_numbers( 5, 10 ); # surprise, it says 15 # BAD: list_to_named argument cannot be at the end. say add_numbers( { num1 => 5 }, 10 ); # BAD: list_to_named argument duplicated. say add_numbers( 5, 10, { num1 => 5 } ); Where a hash or hashref of named parameters are expected, any parameter which doesn't look like it fits that pattern will be treated as a "sneaky" positional parameter, and will be tried the first time a named parameter seems to be missing. This feature is normally only applied to required parameters. It can be manually controlled on a per-parameter basis using the C option. Type::Params attempts to be intelligent at figuring out what order the sneaky positional parameters were given in. signature_for add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], list_to_named => true, ); sub add_to_ref ( $arg ) { $arg->ref->$* += $arg->num; } my $sum = 0; add_to_ref( ref => \$sum, add => 1 ); add_to_ref( \$sum, add => 2 ); add_to_ref( \$sum, 3 ); add_to_ref( 4, \$sum ); add_to_ref( 5, sum => \$sum ); add_to_ref( add => 5, sum => \$sum ); say $sum; # 21 This approach is somewhat slower, but has the potential for very do-what-I-mean functions. Note that C and C can both be used in the same signature as their meanings are not contradictory. signature_for add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], list_to_named => true, named_to_list => true, ); sub add_to_ref ( $ref, $num ) { $ref->$* += $num; } =head4 C<< head >> B<< Int|ArrayRef >> C provides an additional list of non-optional, positional parameters at the start of C<< @_ >>. This is often used for method calls. For example, if you wish to define a signature for: $object->my_method( foo => 123, bar => 456 ); You could write it as this: signature_for my_method => ( head => [ Object ], named => [ foo => Optional[Int], bar => Optional[Int] ], ); sub my_method ( $self, $arg ) { ...; } If C is set as a number instead of an arrayref, it is the number of additional arguments at the start: signature_for stash_foobar = ( head => 2, named => [ foo => Optional[Int], bar => Optional[Int] ], ); sub stash_foobar ( $self, $ctx, $arg ) { $ctx->stash->{foo} = $arg->foo if $arg->has_foo; $ctx->stash->{bar} = $arg->bar if $arg->has_bar; return $self; } ...; $app->stash_foobar( $context, foo => 123 ); In this case, no type checking is performed on those additional arguments; it is just checked that they exist. =head4 C<< tail >> B<< Int|ArrayRef >> A C is like a C except that it is for arguments at the I of C<< @_ >>. signature_for my_method => ( head => [ Object ], named => [ foo => Optional[Int], bar => Optional[Int] ], tail => [ CodeRef ], ); sub my_method ( $self, $arg, $callback ) { ...; } $object->my_method( foo => 123, bar => 456, sub { ... } ); =head4 C<< method >> B<< Bool|TypeTiny >> While C can be used for method signatures, a more declarative way is to set C<< method => true >>. If you wish to be specific that this is an object method, intended to be called on blessed objects only, then you may use C<< method => Object >>, using the B type from L. If you wish to specify that it's a class method, then use C<< method => Str >>, using the B type from L. (C<< method => ClassName >> is perhaps clearer, but it's a slower check.) signature_for my_method => ( method => true, named => [ foo => Optional[Int], bar => Optional[Int] ], ); sub my_method ( $self, $arg ) { ...; } The C option has some other subtle differences from C. Any parameter defaults which are coderefs will be called as methods on the invocant instead of being called with no arguments. The C option will be interpreted slightly differently. It is possible to use both C and C in the same signature. The invocant is interpreted as being I the C. A shortcut is provided for C<< method => true >>, though it also enables a couple of other options. use Type::Params qw( signature_for_method ); signature_for_method my_method => ( named => [ foo => Optional[Int], bar => Optional[Int] ], ); sub my_method ( $self, $arg ) { ...; } =head4 C<< description >> B This is the description of the coderef that will show up in stack traces. It defaults to "parameter validation for X" where X is the sub name. Usually the default will be fine. =head4 C<< package >> B This allows you to add signatures to functions in other packages: signature_for foo => ( package "Some::Package", ... ); If C is true and Some::Package doesn't contain a sub called "foo", then Type::Params will traverse the inheritance heirarchy, looking for "foo". If any type constraints are specified as strings, Type::Params will look for types imported by this package. # Expects the MyInt type to be known by Some::Package. signature_for foo => ( package "Some::Package", pos => [ 'MyInt' ] ); This is also supported: signature_for "Some::Package::foo" => ( ... ); =head4 C<< fallback >> B If the sub being wrapped cannot be found, then C will usually throw an error. If you want it to "still work" in this situation, use the C option. C<< fallback => \&alternative_coderef_to_wrap >> will instead wrap a different coderef if the original cannot be found. C<< fallback => true >> is a shortcut for C<< fallback => sub {} >>. An example where this might be useful is if you're adding signatures to methods which are inherited from a parent class, but you are not 100% confident will exist (perhaps dependent on the version of the parent class). signature_for add_nums => ( positional => [ Num, Num ], fallback => sub { $_[0] + $_[1] }, ); =head4 C<< on_die >> B<< Maybe[CodeRef] >> Usually when the signature check hits an error, it will throw an exception, which is a blessed L object. If you provide an C coderef, then instead the L object will be passed to it. signature_for add_numbers => ( positional => [ Num, Num ], on_die => sub { my $error = shift; print "Existential crisis: $error\n"; exit( 1 ); }, ); sub add_numbers ( $num1, $num2 ) { return $num1 + $num2; } say add_numbers(); # has an existential crisis If your C coderef doesn't exit or throw an exception, it can instead return a list which will be used as parameters for your function. signature_for add_numbers => ( positional => [ Num, Num ], on_die => sub { return ( 40, 2 ) }, ); sub add_numbers ( $num1, $num2 ) { return $num1 + $num2; } say add_numbers(); # 42 This is probably not very useful. =head4 C<< strictness >> B<< Bool|Str >> If you set C to false, then certain signature checks will simply never be done. The initial check that there's the correct number of parameters, plus type checks on parameters which don't coerce can be skipped. If you set it to true or do not set it at all, then these checks will always be done. Alternatively, it may be set to the quoted fully-qualified name of a Perl global variable or a constant, and that will be compiled into the coderef as a condition to enable strict checks. signature_for my_func => ( strictness => '$::CHECK_TYPES', positional => [ Int, ArrayRef ], ); sub my_func ( $int, $aref ) { ...; } # Type checks are skipped { local $::CHECK_TYPES = false; my ( $number, $list ) = my_func( {}, {} ); } # Type checks are performed { local $::CHECK_TYPES = true; my ( $number, $list ) = my_func( {}, {} ); } A recommended use of C is with L. use Devel::StrictMode qw( STRICT ); state $signature = signature( strictness => STRICT, positional => [ Int, ArrayRef ], ); =head4 C<< multiple >> B<< ArrayRef|HashRef >> This option allows your signature to support multiple calling conventions. Each entry in the array is an alternative signature, as a hashref: signature_for my_func => ( multiple => [ { positional => [ ArrayRef, Int ], }, { named => [ array => ArrayRef, index => Int ], named_to_list => true, }, ], ); sub my_func ( $aref, $int ) { ...; } That signature will allow your function to be called as: your_function( $arr, $ix ); your_function( array => $arr, index => $ix ); your_function( { array => $arr, index => $ix } ); Sometimes the alternatives will return the parameters in different orders: signature_for my_func => ( multiple => [ { positional => [ ArrayRef, Int ] }, { positional => [ Int, ArrayRef ] }, ], ); So how does your sub know how it's been called? One option is to use the C<< ${^_TYPE_PARAMS_MULTISIG} >> global variable which will be set to the index of the signature which was used: sub my_func { my ( $arr, $ix ) = ${^_TYPE_PARAMS_MULTISIG} == 1 ? reverse( @_ ) : @_; ...; } If you'd prefer to use identifying names instead of a numeric index, you can specify these using C: signature_for my_func => ( multiple => [ { ID => 'one', positional => [ ArrayRef, Int ] }, { ID => 'two', positional => [ Int, ArrayRef ] }, ], ); Or by using a hashref: signature_for my_func => ( multiple => { one => { positional => [ ArrayRef, Int ] }, two => { positional => [ Int, ArrayRef ] }, }, ); A neater solution is to use a C coderef to re-order alternative signature results into your preferred order: signature_for my_func => ( multiple => [ { positional => [ ArrayRef, Int ] }, { positional => [ Int, ArrayRef ], next => sub { reverse @_ } }, ], ); sub my_func ( $arr, $ix ) { ...; } While conceptally C is an arrayref of hashrefs, it is also possible to use arrayrefs in the arrayref. multiple => [ [ ArrayRef, Int ], [ Int, ArrayRef ], ] When an arrayref is used like that, it is a shortcut for a positional signature. Coderefs may additionally be used: signature_for my_func => ( multiple => [ [ ArrayRef, Int ], { positional => [ Int, ArrayRef ], next => sub { reverse @_ } }, sub { ... }, sub { ... }, ], ); The coderefs should be subs which return a list of parameters if they succeed and throw an exception if they fail. The following signatures are equivalent: signature_for my_func => ( multiple => [ { method => true, positional => [ ArrayRef, Int ] }, { method => true, positional => [ Int, ArrayRef ] }, ], ); signature_for my_func => ( method => true, multiple => [ { positional => [ ArrayRef, Int ] }, { positional => [ Int, ArrayRef ] }, ], ); The C option can also be abbreviated to C. So C<< signature( multi => [...] ) >> can be used instead of the longer C<< signature( multiple => [...] ) >>. Three whole keystrokes saved! (B in older releases of Type::Params, C<< ${^_TYPE_PARAMS_MULTISIG} >> was called C<< ${^TYPE_PARAMS_MULTISIG} >>. The latter name is no longer supported.) =head4 C<< message >> B Only used by C signatures. The error message to throw when no signatures match. =head4 C<< bless >> B, C<< class >> B<< ClassName|ArrayRef >>, and C<< constructor >> B Named parameters are usually returned as a blessed object: signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ] ); sub add_numbers ( $arg ) { return $arg->num1 + $arg->num2; } The class they are blessed into is one built on-the-fly by Type::Params. However, these three signature options allow you more control over that process. Firstly, if you set C<< bless => false >> and do not set C or C, then C<< $arg >> will just be an unblessed hashref. signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], bless => false, ); sub add_numbers ( $arg ) { return $arg->{num1} + $arg->{num2}; } This is a good speed boost, but having proper methods for each named parameter is a helpful way to catch misspelled names. If you wish to manually create a class instead of relying on Type::Params generating one on-the-fly, you can do this: package Params::For::AddNumbers { sub num1 ( $self ) { return $self->{num1}; } sub num2 ( $self ) { return $self->{num2}; } sub sum ( $self ) { return $self->num1 + $self->num2; } } signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], bless => 'Params::For::AddNumbers', ); sub add_numbers ( $arg ) { return $arg->sum; } Note that C here doesn't include a C method because Type::Params will directly do C<< bless( $arg, $opts{bless} ) >>. If you want Type::Params to use a proper constructor, you should use the C option instead: package Params::For::AddNumbers { use Moo; has [ 'num1', 'num2' ] => ( is => 'ro' ); sub sum { my $self = shift; return $self->num1 + $self->num2; } } signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], class => 'Params::For::AddNumbers', ); sub add_numbers ( $arg ) { return $arg->sum; } If you wish to use a constructor named something other than C, then use: signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], class => 'Params::For::AddNumbers', constructor => 'new_from_hashref', ); Or as a shortcut: signature_for add_numbers => ( named => [ num1 => Num, num2 => Num ], class => [ 'Params::For::AddNumbers' => 'new_from_hashref' ], ); It is doubtful you want to use any of these options, except C<< bless => false >>. =head4 C<< returns >> B, C<< returns_scalar >> B, and C<< returns_list >> B These can be used to specify the type returned by your function. signature_for round_number => ( pos => [ Num ], returns => Int, ); sub round_number ( $num ) { return int( $num ); } If your function returns different types in scalar and list context, you can use C and C to indicate separate return types in different contexts. signature_for my_func => ( pos => [ Int, Int ], returns_scalar => Int, returns_list => Tuple[ Int, Int, Int ], ); The C constraint is defined using an B-like or B-like type constraint even though it's returning a list, not a single reference. If your function is called in void context, then its return value is unimportant and should not be type checked. =head4 C<< allow_dash >> B For any "word-like" named parameters or aliases, automatically creates an alias with a leading hyphen. signature_for withdraw_funds => ( named => [ amount => Num, account => Str ], allow_dash => true, ); sub withdraw_funds ( $arg ) { ...; } withdraw_funds( amount => 11.99, account => 'ABC123' ); withdraw_funds( -amount => 11.99, account => 'ABC123' ); withdraw_funds( amount => 11.99, -account => 'ABC123' ); withdraw_funds( -amount => 11.99, -account => 'ABC123' ); Has no effect on names that are not word-like. Word-like names are those matching C<< /\A[^\W0-9]\w*\z/ >>; essentially anything Perl allows as a normal unqualified variable name. =head3 Parameter Options In the parameter lists for the C and C signature options, each parameter may be followed by a hashref of options specific to that parameter: signature_for my_func => ( positional => [ Int, \%options_for_first_parameter, Int, \%options_for_other_parameter, ], %more_options_for_signature, ); signature_for my_func => ( named => [ foo => Int, \%options_for_foo, bar => Int, \%options_for_bar, ], %more_options_for_signature, ); The following options are supported for parameters. =head4 C<< optional >> B An option I optional! This makes a parameter optional: signature_for add_nums => ( positional => [ Int, Int, Bool, { optional => true }, ], ); sub add_nums ( $num1, $num2, $debug ) { my $sum = $num1 + $num2; warn "$sum = $num1 + $num2" if $debug; return $sum; } add_nums( 2, 3, 1 ); # prints warning add_nums( 2, 3, 0 ); # no warning add_nums( 2, 3 ); # no warning L also provides a B parameterizable type which may be a neater way to do this: signature_for add_nums => ( pos => [ Int, Int, Optional[Bool] ] ); In signatures with positional parameters, any optional parameters must be defined I non-optional parameters. The C option provides a workaround for required parameters at the end of C<< @_ >>. In signatures with named parameters, the order of optional and non-optional parameters is unimportant. =head4 C<< slurpy >> B A signature may contain a single slurpy parameter, which mops up any other arguments the caller provides your function. In signatures with positional parameters, slurpy params must always have some kind of B or B type constraint, must always appear at the I of the list of positional parameters, and they work like this: signature_for add_nums => ( positional => [ Num, ArrayRef[Num], { slurpy => true }, ], ); sub add_nums ( $first_num, $other_nums ) { my $sum = $first_num; for my $other ( $other_nums->@* ) { $sum += $other; } return $sum; } say add_nums( 1 ); # says 1 say add_nums( 1, 2 ); # says 3 say add_nums( 1, 2, 3 ); # says 6 say add_nums( 1, 2, 3, 4 ); # says 10 In signatures with named parameters, slurpy params must always have some kind of B type constraint, and they work like this: use builtin qw( true false ); signature_for process_data => ( method => true, named => [ input => FileHandle, output => FileHandle, flags => HashRef[Bool], { slurpy => true }, ], ); sub process_data ( $self, $arg ) { warn "Beginning data processing" if $arg->flags->{debug}; ...; } $widget->process_data( input => \*STDIN, output => \*STDOUT, debug => true, ); The B type constraint from L may be used as a shortcut to specify slurpy parameters: signature_for add_nums => ( positional => [ Num, Slurpy[ ArrayRef[Num] ] ], ) The type B<< Slurpy[Any] >> is handled specially and treated as a slurpy B in signatures with positional parameters, and a slurpy B in signatures with named parameters, but has some additional optimizations for speed. =head4 C<< default >> B<< CodeRef|ScalarRef|Ref|Str|Undef >> A default may be provided for a parameter. signature_for my_func => ( positional => [ Int, Int, { default => "666" }, Int, { default => "999" }, ], ); Supported defaults are any strings (including numerical ones), C, and empty hashrefs and arrayrefs. Non-empty hashrefs and arrayrefs are I<< not allowed as defaults >>. Alternatively, you may provide a coderef to generate a default value: signature_for my_func => ( positional => [ Int, Int, { default => sub { 6 * 111 } }, Int, { default => sub { 9 * 111 } }, ] ); That coderef may generate any value, including non-empty arrayrefs and non-empty hashrefs. For undef, simple strings, numbers, and empty structures, avoiding using a coderef will make your parameter processing faster. Instead of a coderef, you can use a reference to a string of Perl source code: signature_for my_func => ( positional => [ Int, Int, { default => \ '6 * 111' }, Int, { default => \ '9 * 111' }, ], ); Defaults I be validated against the type constraint, and potentially coerced. Any parameter with a default will automatically be optional, as it makes no sense to provide a default for required paramaters. Note that having I defaults in a signature (even if they never end up getting used) can slow it down, as Type::Params will need to build a new array instead of just returning C<< @_ >>. =head4 C<< default_on_undef >> B Normally defaults are only applied when a parameter is I (think C for hashes or the array being too short). Setting C to true will also trigger the default if a parameter is provided but undefined. If the caller might legitimately want to supply undef as a value, it is not recommended you uswe this. =head4 C<< coerce >> B Speaking of coercion, the C option allows you to indicate that a value should be coerced into the correct type: signature_for my_func => ( positional => [ Int, Int, Bool, { coerce => true }, ], ); Setting C to false will disable coercion. If C is not specified, so is neither true nor false, then coercion will be enabled if the type constraint has a coercion, and disabled otherwise. Note that having I coercions in a signature (even if they never end up getting used) can slow it down, as Type::Params will need to build a new array instead of just returning C<< @_ >>. =head4 C<< clone >> B If this is set to true, it will deep clone incoming values via C from L (a core module since Perl 5.7.3). In the below example, C<< $arr >> is a reference to a I C<< @numbers >>, so pushing additional numbers to it leaves C<< @numbers >> unaffected. signature_for foo => ( positional => [ ArrayRef, { clone => true } ], ); sub foo ( $arr ) { push @$arr, 4, 5, 6; } my @numbers = ( 1, 2, 3 ); foo( \@numbers ); print "@numbers\n"; ## 1 2 3 Note that cloning will significantly slow down your signature. =head4 C<< name >> B This overrides the name of a named parameter. I don't know why you would want to do that. The following signature has two parameters: C and C. The name C is completely ignored. signature_for my_func => ( named => [ fool => Int, { name => 'foo' }, bar => Int, ], ); You can, however, also name positional parameters, which don't usually have names. signature_for my_func => ( positional => [ Int, { name => 'foo' }, Int, { name => 'bar' }, ], ); The names of positional parameters are not really I for anything at the moment, but may be incorporated into error messages or similar in the future. =head4 C<< getter >> B For signatures with named parameters, specifies the method name used to retrieve this parameter's value from the C<< $arg >> object. signature_for process_data => ( method => true, named => [ input => FileHandle, { getter => 'in' }, output => FileHandle, { getter => 'out' }, flags => HashRef[Bool], { slurpy => true }, ], ); sub process_data ( $self, $arg ) { warn "Beginning data processing" if $arg->flags->{debug}; my ( $in, $out ) = ( $arg->in, $arg->out ); ...; } $widget->process_data( input => \*STDIN, output => \*STDOUT, debug => true, ); Ignored by signatures with positional parameters. =head4 C<< predicate >> B The C<< $arg >> object provided by signatures with named parameters will also include "has" methods for any optional arguments. For example: signature_for process_data => ( method => true, named => [ input => Optional[ FileHandle ], output => Optional[ FileHandle ], flags => Slurpy[ HashRef[Bool] ], ], ); sub process_data ( $self, $arg ) { if ( $self->has_input and $self->has_output ) { ...; } ...; } Setting a C option allows you to choose a different name for this method instead of "has_*". It is also possible to set a C for non-optional parameters, which don't normally get a "has" method. Ignored by signatures with positional parameters. =head4 C<< alias >> B<< Str|ArrayRef[Str] >> A list of alternative names for the parameter, or a single alternative name. signature_for add_numbers => ( named => [ first_number => Int, { alias => [ 'x' ] }, second_number => Int, { alias => 'y' }, ], ); sub add_numbers ( $arg ) { return $arg->first_number + $arg->second_number; } say add_numbers( first_number => 40, second_number => 2 ); # 42 say add_numbers( x => 40, y => 2 ); # 42 say add_numbers( first_number => 40, y => 2 ); # 42 say add_numbers( first_number => 40, x => 1, y => 2 ); # dies! Ignored by signatures with positional parameters. =head4 C<< in_list >> B In conjunction with C, determines if this parameter can be provided as part of the list of "sneaky" positional parameters. If C isn't being used, C is ignored. Defaults to false if the parameter is optional or has a default. Defaults to true if the parameter is required. =head4 C<< strictness >> B Overrides the signature option C on a per-parameter basis. =head2 C<< signature_for_func $function_name => ( %spec ) >> Like C and defaults to C<< method => false >>. If the signature has named parameters, it will additionally default C and C to true. signature_for_func add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], named_to_list => true, ); sub add_to_ref ( $ref, $add ) { $ref->$* += $add; } my $sum = 0; add_to_ref( ref => \$sum, add => 1 ); add_to_ref( \$sum, 2 ); add_to_ref( 3, \$sum ); add_to_ref( 4, { -ref => \$sum } ); say $sum; # 10 The exact behaviour of C is unstable and may change in future versions of Type::Params. =head2 C<< signature_for_method $function_name => ( %spec ) >> Like C but will default C<< method => true >>. If the signature has named parameters, it will additionally default C and C to true. package Calculator { use Types::Standard qw( Num ScalarRef ); use Type::Params qw( signature_for_method ); ...; signature_for_method add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], named_to_list => true, ); sub add_to_ref ( $self, $ref, $add ) { $ref->$* += $add; } } my $calc = Calculator->new; my $sum = 0; $calc->add_to_ref( ref => \$sum, add => 1 ); $calc->add_to_ref( \$sum, 2 ); $calc->add_to_ref( 3, \$sum ); $calc->add_to_ref( 4, { -ref => \$sum } ); say $sum; # 10 The exact behaviour of C is unstable and may change in future versions of Type::Params. =head2 C<< signature( %spec ) >> The C function allows more fine-grained control over signatures. Instead of automatically wrapping your function, it returns a coderef that you can pass C<< @_ >> to. The following are roughly equivalent: signature_for add_nums => ( pos => [ Num, Num ] ); sub add_nums ( $x, $y ) { return $x + $y; } And: sub add_nums { state $signature = signature( pos => [ Num, Num ] ); my ( $x, $y ) = $signature->( @_ ); return $x + $y; } Perl allows a slightly archaic way of calling coderefs without using parentheses, which may be slightly faster at the cost of being more obscure: sub add_nums { state $signature = signature( pos => [ Num, Num ] ); my ( $x, $y ) = &$signature; # important: no parentheses! return $x + $y; } If you need to support Perl 5.8, which didn't have the C keyword: my $__add_nums_sig; sub add_nums { $__add_nums_sig ||= signature( pos => [ Num, Num ] ); my ( $x, $y ) = &$__add_nums_sig; ...; } This gives you more control over how and when the signature is built and used, and what is done with the values it unpacks. In particular, note that if your function is never called, the signature never even gets built, meaning that for functions you rarely use, there's less cost to having the signature. As of 2025, you probably want to be using C instead of C in most cases. =head3 Additional Signature Specification Options There are certain options which make no sense for C, and are only useful for C. Others may behave slightly differently. These are noted here. =head4 C<< returns >> B, C<< returns_scalar >> B, and C<< returns_list >> B Because C isn't capable of fully wrapping your function, the C, C, and C options cannot do anything. You should consider them to be documentation only. =head4 C<< subname >> B The name of the sub whose parameters we're supposed to be checking. This is useful in stack traces, etc. Defaults to the caller. =head4 C<< package >> B Works the same as in C, but it's worth mentioning it again as it ties in closely with C. =head4 C<< caller_level >> B If you're wrapping C so that you can check signatures on behalf of another package, then setting C to 1 (or more, depending on the level of wrapping!) may be an alternative to manually setting the C and C. =head4 C<< next >> B<< Bool|CodeLike >> This can be used for chaining coderefs. If you understand C, this acts like an "on_live". sub add_numbers { state $sig = signature( positional => [ Num, Num ], next => sub { my ( $num1, $num2 ) = @_; return $num1 + $num2; }, ); my $sum = $sig->( @_ ); return $sum; } say add_numbers( 2, 3 ); # says 5 If set to true instead of a coderef, has a slightly different behaviour: sub add_numbers { state $sig = signature( positional => [ Num, Num ], next => true, ); my $sum = $sig->( sub { return $_[0] + $_[1] }, @_, ); return $sum; } say add_numbers( 2, 3 ); # says 5 This looks strange. Why would this be useful? Well, it works nicely with Moose's C keyword. sub add_numbers { return $_[1] + $_[2]; } around add_numbers => signature( method => true, positional => [ Num, Num ], next => true, package => __PACKAGE__, subname => 'add_numbers', ); say __PACKAGE__->add_numbers( 2, 3 ); # says 5 Note the way C works in Moose is that it expects a wrapper coderef as its final argument. That wrapper coderef then expects to be given a reference to the original function as its first parameter. This can allow, for example, a role to provide a signature wrapping a method defined in a class. This is kind of complex, and you're unlikely to use it, but it's been proven useful for tools that integrate Type::Params with Moose-like method modifiers. Note that C is the mechanism that C internally uses to connect the signature with the wrapped sub, so using C with C is a good recipe for headaches. If using C signatures, C is useful for each "inner" signature to massage parameters into the correct order. This use of C I supported for C. The option C is supported as a historical alias for C. =head4 C<< want_source >> B Instead of returning a coderef, return Perl source code string. Handy for debugging. =head4 C<< want_details >> B Instead of returning a coderef, return a hashref of stuff including the coderef. This is mostly for people extending Type::Params and I won't go into too many details about what else this hashref contains. =head4 C<< want_object >> B Instead of returning a coderef, return a Type::Params::Signature object. This is the more modern version of C. =head1 LEGACY API The following functions were the API prior to Type::Params v2. They are still supported, but their use is now discouraged. If you don't provide an import list at all, you will import C and C: use Type::Params; This does the same: use Type::Params -v1; The following exports C, C, and C: use Type::Params -compile; The following exports C and C: use Type::Params -wrap; =head2 C<< compile( @pos_params ) >> Equivalent to C<< signature( positional => \@pos_params ) >>. C<< compile( \%spec, @pos_params ) >> is equivalent to C<< signature( %spec, positional => \@pos_params ) >>. =head2 C<< compile_named( @named_params ) >> Equivalent to C<< signature( bless => 0, named => \@named_params ) >>. C<< compile_named( \%spec, @named_params ) >> is equivalent to C<< signature( bless => false, %spec, named => \@named_params ) >>. =head2 C<< compile_named_oo( @named_params ) >> Equivalent to C<< signature( bless => true, named => \@named_params ) >>. C<< compile_named_oo( \%spec, @named_params ) >> is equivalent to C<< signature( bless => true, %spec, named => \@named_params ) >>. =head2 C<< validate( \@args, @pos_params ) >> Equivalent to C<< signature( positional => \@pos_params )->( @args ) >>. The C function has I been recommended, and is not exported unless requested by name. =head2 C<< validate_named( \@args, @named_params ) >> Equivalent to C<< signature( bless => false, named => \@named_params )->( @args ) >>. The C function has I been recommended, and is not exported unless requested by name. =head2 C<< wrap_subs( func1 => \@params1, func2 => \@params2, ... ) >> Equivalent to: signature_for func1 => ( positional => \@params1 ); signature_for func2 => ( positional => \@params2 ); One slight difference is that instead of arrayrefs, you can provide the output of one of the C functions: wrap_subs( func1 => compile_named( @params1 ) ); C is not exported unless requested by name. =head2 C<< wrap_methods( func1 => \@params1, func2 => \@params2, ... ) >> Equivalent to: signature_for func1 => ( method => 1, positional => \@params1 ); signature_for func2 => ( method => 1, positional => \@params2 ); One slight difference is that instead of arrayrefs, you can provide the output of one of the C functions: wrap_methods( func1 => compile_named( @params1 ) ); C is not exported unless requested by name. =head2 C<< multisig( @alternatives ) >> Equivalent to: signature( multiple => \@alternatives ) C<< multisig( \%spec, @alternatives ) >> is equivalent to C<< signature( %spec, multiple => \@alternatives ) >>. =head1 TYPE CONSTRAINTS Although Type::Params is not a real type library, it exports two type constraints. Their use is no longer recommended. =head2 B Type::Params exports a type B on request. This gives you a type constraint which accepts classnames I blessed objects. use Type::Params qw( compile Invocant ); signature_for my_method => ( method => Invocant, positional => [ ArrayRef, Int ], ); sub my_method ($self_or_class, $arr, $ix) { return $arr->[ $ix ]; } C is not exported unless requested by name. Recommendation: use B from L instead. =head2 B Type::Params exports a parameterizable type constraint B. It accepts the kinds of objects returned by signature checks for named parameters. use v5.36; package Foo { use Moo; use Type::Params 'ArgsObject'; has args => ( is => 'ro', isa => ArgsObject['Bar::bar'], ); } package Bar { use Types::Standard -types; use Type::Params 'signature_for'; signature_for bar => ( named => [ xxx => Int, yyy => ArrayRef ] ); sub bar ( $got ) { return 'Foo'->new( args => $got ); } } Bar::bar( xxx => 42, yyy => [] ); The parameter "Bar::bar" refers to the caller when the check is compiled, rather than when the parameters are checked. C is not exported unless requested by name. Recommendation: use B from L instead. =head1 ENVIRONMENT =over =item C Affects the building of accessors for C<< $arg >> objects. If set to true, will use L. If set to false, will use pure Perl. If this environment variable does not exist, will use Class::XSAccessor. If Class::XSAccessor is not installed or is too old, pure Perl will always be used as a fallback. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Parser.pm000664001750001750 3620015111656240 15715 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Parser; use 5.008001; use strict; use warnings; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; # Token types # sub TYPE () { "TYPE" } sub QUOTELIKE () { "QUOTELIKE" } sub STRING () { "STRING" } sub HEXNUM () { "HEXNUM" } sub CLASS () { "CLASS" } sub L_BRACKET () { "L_BRACKET" } sub R_BRACKET () { "R_BRACKET" } sub COMMA () { "COMMA" } sub SLURPY () { "SLURPY" } sub UNION () { "UNION" } sub INTERSECT () { "INTERSECT" } sub SLASH () { "SLASH" } sub NOT () { "NOT" } sub L_PAREN () { "L_PAREN" } sub R_PAREN () { "R_PAREN" } sub MYSTERY () { "MYSTERY" } our @EXPORT_OK = qw( eval_type _std_eval parse extract_type ); require Exporter::Tiny; our @ISA = 'Exporter::Tiny'; Evaluate: { sub parse { my $str = $_[0]; my $parser = "Type::Parser::AstBuilder"->new( input => $str ); $parser->build; wantarray ? ( $parser->ast, $parser->remainder ) : $parser->ast; } sub extract_type { my ( $str, $reg ) = @_; my ( $parsed, $tail ) = parse( $str ); wantarray ? ( _eval_type( $parsed, $reg ), $tail ) : _eval_type( $parsed, $reg ); } sub eval_type { my ( $str, $reg ) = @_; my ( $parsed, $tail ) = parse( $str ); _croak( "Unexpected tail on type expression: $tail" ) if $tail =~ /\S/sm; return _eval_type( $parsed, $reg ); } my $std; sub _std_eval { require Type::Registry; unless ( $std ) { $std = "Type::Registry"->new; $std->add_types( -Standard ); } eval_type( $_[0], $std ); } sub _eval_type { my ( $node, $reg ) = @_; $node = _simplify_expression( $node ); if ( $node->{type} eq "list" ) { return map _eval_type( $_, $reg ), @{ $node->{list} }; } if ( $node->{type} eq "union" ) { return $reg->_make_union_by_overload( map _eval_type( $_, $reg ), @{ $node->{union} } ); } if ( $node->{type} eq "intersect" ) { return $reg->_make_intersection_by_overload( map _eval_type( $_, $reg ), @{ $node->{intersect} } ); } if ( $node->{type} eq "slash" ) { my @types = map _eval_type( $_, $reg ), @{ $node->{slash} }; _croak( "Expected exactly two types joined with slash operator" ) unless @types == 2; return $types[0] / $types[1]; } if ( $node->{type} eq "slurpy" ) { require Types::Standard; return Types::Standard::Slurpy()->of( _eval_type( $node->{of}, $reg ) ); } if ( $node->{type} eq "complement" ) { return _eval_type( $node->{of}, $reg )->complementary_type; } if ( $node->{type} eq "parameterized" ) { my $base = _eval_type( $node->{base}, $reg ); return $base unless $base->is_parameterizable || $node->{params}; return $base->parameterize( $node->{params} ? _eval_type( $node->{params}, $reg ) : () ); } if ( $node->{type} eq "primary" and $node->{token}->type eq CLASS ) { my $class = substr( $node->{token}->spelling, 0, length( $node->{token}->spelling ) - 2 ); return $reg->make_class_type( $class ); } if ( $node->{type} eq "primary" and $node->{token}->type eq QUOTELIKE ) { return eval( $node->{token}->spelling ); #ARGH } if ( $node->{type} eq "primary" and $node->{token}->type eq STRING ) { return $node->{token}->spelling; } if ( $node->{type} eq "primary" and $node->{token}->type eq HEXNUM ) { my $sign = '+'; my $spelling = $node->{token}->spelling; if ( $spelling =~ /^[+-]/ ) { $sign = substr( $spelling, 0, 1); $spelling = substr( $spelling, 1 ); } return ( ( $sign eq '-' ) ? ( 0 - hex($spelling) ) : hex($spelling) ); } if ( $node->{type} eq "primary" and $node->{token}->type eq TYPE ) { my $t = $node->{token}->spelling; my $r = ( $t =~ /^(.+)::(\w+)$/ ) ? $reg->foreign_lookup( $t, 1 ) : $reg->simple_lookup( $t, 1 ); $r or _croak( "%s is not a known type constraint", $node->{token}->spelling ); return $r; } } #/ sub _eval_type sub _simplify_expression { my $expr = shift; if ( $expr->{type} eq "expression" and $expr->{op}[0] eq COMMA ) { return _simplify( "list", COMMA, $expr ); } if ( $expr->{type} eq "expression" and $expr->{op}[0] eq UNION ) { return _simplify( "union", UNION, $expr ); } if ( $expr->{type} eq "expression" and $expr->{op}[0] eq INTERSECT ) { return _simplify( "intersect", INTERSECT, $expr ); } if ( $expr->{type} eq "expression" and $expr->{op}[0] eq SLASH ) { return _simplify( "slash", SLASH, $expr ); } return $expr; } #/ sub _simplify_expression sub _simplify { no warnings 'recursion'; my $type = shift; my $op = shift; my @list; for my $expr ( $_[0]{lhs}, $_[0]{rhs} ) { if ( $expr->{type} eq "expression" and $expr->{op}[0] eq $op ) { my $simple = _simplify( $type, $op, $expr ); push @list, @{ $simple->{$type} }; } else { push @list, $expr; } } return { type => $type, $type => \@list }; } #/ sub _simplify } #/ Evaluate: { package Type::Parser::AstBuilder; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; sub new { my $class = shift; bless {@_}, $class; } our %precedence = ( # Type::Parser::COMMA() , 1 , Type::Parser::SLASH(), 1, Type::Parser::UNION(), 2, Type::Parser::INTERSECT(), 3, Type::Parser::NOT(), 4, ); sub _parse_primary { my $self = shift; my $tokens = $self->{tokens}; $tokens->assert_not_empty; if ( $tokens->peek( 0 )->type eq Type::Parser::NOT ) { $tokens->eat( Type::Parser::NOT ); $tokens->assert_not_empty; return { type => "complement", of => $self->_parse_primary, }; } if ( $tokens->peek( 0 )->type eq Type::Parser::SLURPY ) { $tokens->eat( Type::Parser::SLURPY ); $tokens->assert_not_empty; return { type => "slurpy", of => $self->_parse_primary, }; } if ( $tokens->peek( 0 )->type eq Type::Parser::L_PAREN ) { $tokens->eat( Type::Parser::L_PAREN ); my $r = $self->_parse_expression; $tokens->eat( Type::Parser::R_PAREN ); return $r; } if ( $tokens->peek( 1 ) and $tokens->peek( 0 )->type eq Type::Parser::TYPE and $tokens->peek( 1 )->type eq Type::Parser::L_BRACKET ) { my $base = { type => "primary", token => $tokens->eat( Type::Parser::TYPE ) }; $tokens->eat( Type::Parser::L_BRACKET ); $tokens->assert_not_empty; local $precedence{ Type::Parser::COMMA() } = 1; my $params = undef; if ( $tokens->peek( 0 )->type eq Type::Parser::R_BRACKET ) { $tokens->eat( Type::Parser::R_BRACKET ); } else { $params = $self->_parse_expression; $params = { type => "list", list => [$params] } unless $params->{type} eq "list"; $tokens->eat( Type::Parser::R_BRACKET ); } return { type => "parameterized", base => $base, params => $params, }; } #/ if ( $tokens->peek( 1 ...)) my $type = $tokens->peek( 0 )->type; if ( $type eq Type::Parser::TYPE or $type eq Type::Parser::QUOTELIKE or $type eq Type::Parser::STRING or $type eq Type::Parser::HEXNUM or $type eq Type::Parser::CLASS ) { return { type => "primary", token => $tokens->eat }; } Type::Parser::_croak( "Unexpected token in primary type expression; got '%s'", $tokens->peek( 0 )->spelling ); } #/ sub _parse_primary sub _parse_expression_1 { my $self = shift; my $tokens = $self->{tokens}; my ( $lhs, $min_p ) = @_; while ( !$tokens->empty and defined( $precedence{ $tokens->peek( 0 )->type } ) and $precedence{ $tokens->peek( 0 )->type } >= $min_p ) { my $op = $tokens->eat; my $rhs = $self->_parse_primary; while ( !$tokens->empty and defined( $precedence{ $tokens->peek( 0 )->type } ) and $precedence{ $tokens->peek( 0 )->type } > $precedence{ $op->type } ) { my $lookahead = $tokens->peek( 0 ); $rhs = $self->_parse_expression_1( $rhs, $precedence{ $lookahead->type } ); } $lhs = { type => "expression", op => $op, lhs => $lhs, rhs => $rhs, }; } #/ while ( !$tokens->empty and...) return $lhs; } #/ sub _parse_expression_1 sub _parse_expression { my $self = shift; my $tokens = $self->{tokens}; return $self->_parse_expression_1( $self->_parse_primary, 0 ); } sub build { my $self = shift; $self->{tokens} = "Type::Parser::TokenStream"->new( remaining => $self->{input} ); $self->{ast} = $self->_parse_expression; } sub ast { $_[0]{ast}; } sub remainder { $_[0]{tokens}->remainder; } } { package Type::Parser::Token; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; sub type { $_[0][0] } sub spelling { $_[0][1] } } { package Type::Parser::TokenStream; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; use Scalar::Util qw(looks_like_number); sub new { my $class = shift; bless { stack => [], done => [], @_ }, $class; } sub peek { my $self = shift; my $ahead = $_[0]; while ( $self->_stack_size <= $ahead and length $self->{remaining} ) { $self->_stack_extend; } my @tokens = grep ref, @{ $self->{stack} }; return $tokens[$ahead]; } #/ sub peek sub empty { my $self = shift; not $self->peek( 0 ); } sub eat { my $self = shift; $self->_stack_extend unless $self->_stack_size; my $r; while ( defined( my $item = shift @{ $self->{stack} } ) ) { push @{ $self->{done} }, $item; if ( ref $item ) { $r = $item; last; } } if ( @_ and $_[0] ne $r->type ) { unshift @{ $self->{stack} }, pop @{ $self->{done} }; # uncoverable statement Type::Parser::_croak( "Expected $_[0]; got " . $r->type ); # uncoverable statement } return $r; } #/ sub eat sub assert_not_empty { my $self = shift; Type::Parser::_croak( "Expected token; got empty string" ) if $self->empty; } sub _stack_size { my $self = shift; scalar grep ref, @{ $self->{stack} }; } sub _stack_extend { my $self = shift; push @{ $self->{stack} }, $self->_read_token; my ( $space ) = ( $self->{remaining} =~ m/^([\s\n\r]*)/sm ); return unless length $space; push @{ $self->{stack} }, $space; substr( $self->{remaining}, 0, length $space ) = ""; } sub remainder { my $self = shift; return join "", map { ref( $_ ) ? $_->spelling : $_ } ( @{ $self->{stack} }, $self->{remaining} ); } my %punctuation = ( '[' => bless( [ Type::Parser::L_BRACKET, "[" ], "Type::Parser::Token" ), ']' => bless( [ Type::Parser::R_BRACKET, "]" ], "Type::Parser::Token" ), '(' => bless( [ Type::Parser::L_PAREN, "[" ], "Type::Parser::Token" ), ')' => bless( [ Type::Parser::R_PAREN, "]" ], "Type::Parser::Token" ), ',' => bless( [ Type::Parser::COMMA, "," ], "Type::Parser::Token" ), '=>' => bless( [ Type::Parser::COMMA, "=>" ], "Type::Parser::Token" ), 'slurpy' => bless( [ Type::Parser::SLURPY, "slurpy" ], "Type::Parser::Token" ), '|' => bless( [ Type::Parser::UNION, "|" ], "Type::Parser::Token" ), '&' => bless( [ Type::Parser::INTERSECT, "&" ], "Type::Parser::Token" ), '/' => bless( [ Type::Parser::SLASH, "/" ], "Type::Parser::Token" ), '~' => bless( [ Type::Parser::NOT, "~" ], "Type::Parser::Token" ), ); sub _read_token { my $self = shift; return if $self->{remaining} eq ""; # Punctuation # if ( $self->{remaining} =~ /^( => | [()\]\[|&~,\/] )/xsm ) { my $spelling = $1; substr( $self->{remaining}, 0, length $spelling ) = ""; return $punctuation{$spelling}; } if ( $self->{remaining} =~ /\A\s*[q'"]/sm ) { require Text::Balanced; if ( my $quotelike = Text::Balanced::extract_quotelike( $self->{remaining} ) ) { return bless( [ Type::Parser::QUOTELIKE, $quotelike ], "Type::Parser::Token" ); } } if ( $self->{remaining} =~ /^([+-]?[\w:.+]+)/sm ) { my $spelling = $1; substr( $self->{remaining}, 0, length $spelling ) = ""; if ( $spelling =~ /::$/sm ) { return bless( [ Type::Parser::CLASS, $spelling ], "Type::Parser::Token" ); } elsif ( $spelling =~ /^[+-]?0x[0-9A-Fa-f]+$/sm ) { return bless( [ Type::Parser::HEXNUM, $spelling ], "Type::Parser::Token" ); } elsif ( looks_like_number( $spelling ) ) { return bless( [ Type::Parser::STRING, $spelling ], "Type::Parser::Token" ); } elsif ( $self->{remaining} =~ /^\s*=>/sm ) # peek ahead { return bless( [ Type::Parser::STRING, $spelling ], "Type::Parser::Token" ); } elsif ( $spelling eq "slurpy" ) { return $punctuation{$spelling}; } return bless( [ Type::Parser::TYPE, $spelling ], "Type::Parser::Token" ); } #/ if ( $self->{remaining...}) my $rest = $self->{remaining}; $self->{remaining} = ""; return bless( [ Type::Parser::MYSTERY, $rest ], "Type::Parser::Token" ); } #/ sub _read_token } 1; __END__ =pod =encoding utf-8 =for stopwords non-whitespace =head1 NAME Type::Parser - parse type constraint strings =head1 SYNOPSIS use v5.10; use strict; use warnings; use Type::Parser qw( eval_type ); use Type::Registry; my $reg = Type::Registry->for_me; $reg->add_types("Types::Standard"); my $type = eval_type("Int | ArrayRef[Int]", $reg); $type->check(10); # true $type->check([1..4]); # true $type->check({foo=>1}); # false =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Generally speaking, you probably don't want to be using this module directly. Instead use the C<< lookup >> method from L which wraps it. =head2 Functions =over =item C<< parse($string) >> Parse the type constraint string into something like an AST. If called in list context, also returns any "tail" found on the original string. =item C<< extract_type($string, $registry) >> Compile a type constraint string into a L object. If called in list context, also returns any "tail" found on the original string. =item C<< eval_type($string, $registry) >> Compile a type constraint string into a L object. Throws an error if the "tail" contains any non-whitespace character. =back =head2 Constants The following constants correspond to values returned by C<< $token->type >>. =over =item C<< TYPE >> =item C<< QUOTELIKE >> =item C<< STRING >> =item C<< HEXNUM >> =item C<< CLASS >> =item C<< L_BRACKET >> =item C<< R_BRACKET >> =item C<< COMMA >> =item C<< SLURPY >> =item C<< UNION >> =item C<< INTERSECT >> =item C<< SLASH >> =item C<< NOT >> =item C<< L_PAREN >> =item C<< R_PAREN >> =item C<< MYSTERY >> =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Registry.pm000664001750001750 3121515111656240 16272 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Registry; use 5.008001; use strict; use warnings; BEGIN { $Type::Registry::AUTHORITY = 'cpan:TOBYINK'; $Type::Registry::VERSION = '2.008006'; } $Type::Registry::VERSION =~ tr/_//d; use Exporter::Tiny qw( mkopt ); use Scalar::Util qw( refaddr ); use Type::Parser qw( eval_type ); use Types::TypeTiny (); our @ISA = 'Exporter::Tiny'; our @EXPORT_OK = qw(t); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } sub _generate_t { my $class = shift; my ( $name, $value, $globals ) = @_; my $caller = $globals->{into}; my $reg = $class->for_class( ref( $caller ) ? sprintf( 'HASH(0x%08X)', refaddr( $caller ) ) : $caller ); sub (;$) { @_ ? $reg->lookup( @_ ) : $reg }; } #/ sub _generate_t sub new { my $class = shift; ref( $class ) and _croak( "Not an object method" ); bless {}, $class; } { my %registries; sub for_class { my $class = shift; my ( $for ) = @_; $registries{$for} ||= $class->new; } sub for_me { my $class = shift; my $for = caller; $registries{$for} ||= $class->new; } } sub add_types { my $self = shift; my $opts = mkopt( \@_ ); for my $opt ( @$opts ) { my ( $library, $types ) = @$opt; $library =~ s/^-/Types::/; { local $SIG{__DIE__} = sub { }; eval "require $library"; }; my %hash; if ( $library->isa( "Type::Library" ) or $library eq 'Types::TypeTiny' ) { $types ||= [qw/-types/]; Types::TypeTiny::is_ArrayLike( $types ) or _croak( "Expected arrayref following '%s'; got %s", $library, $types ); $library->import( { into => \%hash }, @$types ); $hash{$_} = &{ $hash{$_} }() for keys %hash; } #/ if ( $library->isa( "Type::Library"...)) elsif ( $library->isa( "Exporter" ) and my $type_tag = do { no strict 'refs'; ${"$library\::EXPORT_TAGS"}{'types'} } ) { $types ||= $type_tag; $hash{$_} = $library->$_ for @$types; } elsif ( $library->isa( "MooseX::Types::Base" ) ) { $types ||= []; Types::TypeTiny::is_ArrayLike( $types ) && ( @$types == 0 ) or _croak( "Library '%s' is a MooseX::Types type constraint library. No import options currently supported", $library ); require Moose::Util::TypeConstraints; my $moosextypes = $library->type_storage; for my $name ( sort keys %$moosextypes ) { my $tt = Types::TypeTiny::to_TypeTiny( Moose::Util::TypeConstraints::find_type_constraint( $moosextypes->{$name} ) ); $hash{$name} = $tt; } } #/ elsif ( $library->isa( "MooseX::Types::Base"...)) elsif ( $library->isa( "MouseX::Types::Base" ) ) { $types ||= []; Types::TypeTiny::is_ArrayLike( $types ) && ( @$types == 0 ) or _croak( "Library '%s' is a MouseX::Types type constraint library. No import options currently supported", $library ); require Mouse::Util::TypeConstraints; my $moosextypes = $library->type_storage; for my $name ( sort keys %$moosextypes ) { my $tt = Types::TypeTiny::to_TypeTiny( Mouse::Util::TypeConstraints::find_type_constraint( $moosextypes->{$name} ) ); $hash{$name} = $tt; } } #/ elsif ( $library->isa( "MouseX::Types::Base"...)) else { _croak( "%s is not a type library", $library ); } for my $key ( sort keys %hash ) { exists( $self->{$key} ) and $self->{$key}{uniq} != $hash{$key}{uniq} and _croak( "Duplicate type name: %s", $key ); $self->{$key} = $hash{$key}; } } #/ for my $opt ( @$opts ) $self; } #/ sub add_types sub add_type { my $self = shift; my ( $type, $name ) = @_; $type = Types::TypeTiny::to_TypeTiny( $type ); $name ||= do { $type->is_anon and _croak( "Expected named type constraint; got anonymous type constraint" ); $type->name; }; exists( $self->{$name} ) and $self->{$name}{uniq} != $type->{uniq} and _croak( "Duplicate type name: %s", $name ); $self->{$name} = $type; $self; } #/ sub add_type sub alias_type { my $self = shift; my ( $old, @new ) = @_; my $lookup = eval { $self->lookup( $old ) } or _croak( "Expected existing type constraint name; got '$old'" ); $self->{$_} = $lookup for @new; $self; } sub simple_lookup { my $self = shift; my ( $tc ) = @_; $tc =~ s/(^\s+|\s+$)//g; if ( exists $self->{$tc} ) { return $self->{$tc}; } elsif ( $self->has_parent ) { return $self->get_parent->simple_lookup( @_ ); } return; } #/ sub simple_lookup sub set_parent { my $self = shift; $self->{'~~parent'} = ref( $_[0] ) ? $_[0] : ( ref( $self ) || $self )->for_class( $_[0] ); $self; } sub clear_parent { my $self = shift; delete $self->{'~~parent'}; $self; } sub has_parent { !!ref( shift->{'~~parent'} ); } sub get_parent { shift->{'~~parent'}; } sub foreign_lookup { my $self = shift; return $_[1] ? () : $self->simple_lookup( $_[0], 1 ) unless $_[0] =~ /^(.+)::(\w+)$/; my $library = $1; my $typename = $2; { local $SIG{__DIE__} = sub { }; eval "require $library;"; }; if ( $library->isa( 'MooseX::Types::Base' ) ) { require Moose::Util::TypeConstraints; my $type = Moose::Util::TypeConstraints::find_type_constraint( $library->get_type( $typename ) ) or return; return Types::TypeTiny::to_TypeTiny( $type ); } if ( $library->isa( 'MouseX::Types::Base' ) ) { require Mouse::Util::TypeConstraints; my $sub = $library->can( $typename ) or return; my $type = Mouse::Util::TypeConstraints::find_type_constraint( $sub->() ) or return; return Types::TypeTiny::to_TypeTiny( $type ); } if ( $library->can( "get_type" ) ) { my $type = $library->get_type( $typename ); return Types::TypeTiny::to_TypeTiny( $type ); } return; } #/ sub foreign_lookup sub lookup { my $self = shift; $self->simple_lookup( @_ ) or eval_type( $_[0], $self ); } sub make_union { my $self = shift; my ( @types ) = @_; require Type::Tiny::Union; return "Type::Tiny::Union"->new( type_constraints => \@types ); } sub _make_union_by_overload { my $self = shift; my ( @types ) = @_; require Type::Tiny::Union; return "Type::Tiny::Union"->new_by_overload( type_constraints => \@types ); } sub make_intersection { my $self = shift; my ( @types ) = @_; require Type::Tiny::Intersection; return "Type::Tiny::Intersection"->new( type_constraints => \@types ); } sub _make_intersection_by_overload { my $self = shift; my ( @types ) = @_; require Type::Tiny::Intersection; return "Type::Tiny::Intersection"->new_by_overload( type_constraints => \@types ); } sub make_class_type { my $self = shift; my ( $class ) = @_; require Types::Standard; return Types::Standard::InstanceOf()->of( $class ); } sub make_role_type { my $self = shift; my ( $role ) = @_; require Types::Standard; return Types::Standard::ConsumerOf()->of( $role ); } sub AUTOLOAD { my $self = shift; my ( $method ) = ( our $AUTOLOAD =~ /(\w+)$/ ); my $type = $self->simple_lookup( $method ); return $type if $type; _croak( q[Can't locate object method "%s" via package "%s"], $method, ref( $self ) ); } #/ sub AUTOLOAD # Prevent AUTOLOAD being called for DESTROY! sub DESTROY { return; # uncoverable statement } DELAYED: { our %DELAYED; for my $package ( sort keys %DELAYED ) { my $reg = __PACKAGE__->for_class( $package ); my $types = $DELAYED{$package}; for my $name ( sort keys %$types ) { $reg->add_type( $types->{$name}, $name ); } } } #/ DELAYED: 1; __END__ =pod =encoding utf-8 =for stopwords optlist =head1 NAME Type::Registry - a glorified hashref for looking up type constraints =head1 SYNOPSIS =for test_synopsis no warnings qw(misc); package Foo::Bar; use Type::Registry; my $reg = "Type::Registry"->for_me; # a registry for Foo::Bar # Register all types from Types::Standard $reg->add_types(-Standard); # Register just one type from Types::XSD $reg->add_types(-XSD => ["NonNegativeInteger"]); # Register all types from MyApp::Types $reg->add_types("MyApp::Types"); # Create a type alias $reg->alias_type("NonNegativeInteger" => "Count"); # Look up a type constraint my $type = $reg->lookup("ArrayRef[Count]"); $type->check([1, 2, 3.14159]); # croaks Alternatively: package Foo::Bar; use Type::Registry qw( t ); # Register all types from Types::Standard t->add_types(-Standard); # Register just one type from Types::XSD t->add_types(-XSD => ["NonNegativeInteger"]); # Register all types from MyApp::Types t->add_types("MyApp::Types"); # Create a type alias t->alias_type("NonNegativeInteger" => "Count"); # Look up a type constraint my $type = t("ArrayRef[Count]"); $type->check([1, 2, 3.14159]); # croaks =head1 STATUS This module is covered by the L. =head1 DESCRIPTION A type registry is basically just a hashref mapping type names to type constraint objects. =head2 Constructors =over =item C<< new >> Create a new glorified hashref. =item C<< for_class($class) >> Create or return the existing glorified hashref associated with the given class. Note that any type constraint you have imported from Type::Library-based type libraries will be automatically available in your class' registry. =item C<< for_me >> Create or return the existing glorified hashref associated with the caller. =back =head2 Methods =over =item C<< add_types(@libraries) >> The libraries list is treated as an "optlist" (a la L). Strings are the names of type libraries; if the first character is a hyphen, it is expanded to the "Types::" prefix. If followed by an arrayref, this is the list of types to import from that library. Otherwise, imports all types from the library. use Type::Registry qw(t); t->add_types(-Standard); # OR: t->add_types("Types::Standard"); t->add_types( -TypeTiny => ['HashLike'], -Standard => ['HashRef' => { -as => 'RealHash' }], ); L (and experimentally, L) libraries can also be added this way, but I<< cannot be followed by an arrayref of types to import >>. =item C<< add_type($type, $name) >> The long-awaited singular form of C. Given a type constraint object, adds it to the registry with a given name. The name may be omitted, in which case C<< $type->name >> is called, and Type::Registry will throw an error if C<< $type >> is anonymous. If a name is explicitly given, Type::Registry cares not one wit whether the type constraint is anonymous. This method can even add L and L type constraints; indeed anything that can be handled by L's C function. (Bear in mind that to_TypeTiny I results in an anonymous type constraint, so C<< $name >> will be required.) =item C<< alias_type($oldname, $newname) >> Create an alias for an existing type. =item C<< simple_lookup($name) >> Look up a type in the registry by name. Returns undef if not found. =item C<< foreign_lookup($name) >> Like C, but if the type name contains "::", will attempt to load it from a type library. (And will attempt to load that module.) =item C<< lookup($name) >> Look up by name, with a DSL. t->lookup("Int|ArrayRef[Int]") The DSL can be summed up as: X type from this registry My::Lib::X type from a type library ~X complementary type X | Y union X & Y intersection X[...] parameterized type slurpy X slurpy type Foo::Bar:: class type Croaks if not found. =item C<< make_union(@constraints) >>, C<< make_intersection(@constraints) >>, C<< make_class_type($class) >>, C<< make_role_type($role) >> Convenience methods for creating certain common type constraints. =item C<< AUTOLOAD >> Overloaded to call C. $registry->Str; # like $registry->lookup("Str") =item C, C<< set_parent($reg) >>, C<< clear_parent >>, C<< has_parent >> Advanced stuff. Allows a registry to have a "parent" registry which it inherits type constraints from. =back =head2 Functions =over =item C<< t >> This class can export a function C<< t >> which acts like C<< "Type::Registry"->for_class($importing_class) >>. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Tie.pm000664001750001750 2444615111656240 15213 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typeuse 5.008001; use strict; use warnings; use Carp (); use Exporter::Tiny (); use Scalar::Util (); ++$Carp::CarpInternal{"Type::Tie::$_"} for qw( BASE SCALAR ARRAY HASH ); { package Type::Tie; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @ISA = qw( Exporter::Tiny ); our @EXPORT = qw( ttie ); $VERSION =~ tr/_//d; sub ttie (\[$@%]@)#>&%*/&<%\$[]^!@;@) { my ( $ref, $type, @vals ) = @_; if ( 'HASH' eq ref $ref ) { tie %$ref, "Type::Tie::HASH", $type, @vals; } elsif ( 'ARRAY' eq ref $ref ) { tie @$ref, "Type::Tie::ARRAY", $type, @vals; } else { tie $$ref, "Type::Tie::SCALAR", $type, @vals; } return $ref; } }; { package Type::Tie::BASE; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; # Type::Tie::BASE is an array-based object. If you need to subclass it # and store more attributes, use $yourclass->SUPER::_NEXT_SLOT to find # the next available slot, then override _NEXT_SLOT so that other people # can subclass your class too. # sub _REF { $_[0][0] } # ro sub _TYPE { ( @_ == 2 ) ? ( $_[0][1] = $_[1] ) : $_[0][1] } # rw sub _CHECK { ( @_ == 2 ) ? ( $_[0][2] = $_[1] ) : $_[0][2] } # rw sub _COERCE { ( @_ == 2 ) ? ( $_[0][3] = $_[1] ) : $_[0][3] } # rw sub _NEXT_SLOT { 4 } sub type { shift->_TYPE } sub _INIT_REF { $_[0][0] ||= $_[0]->_DEFAULT } { my $try_xs = exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS} : exists( $ENV{PERL_ONLY} ) ? !$ENV{PERL_ONLY} : !!1; eval { require Class::XSAccessor::Array; 'Class::XSAccessor::Array'->import( replace => !!1, getters => { _REF => 0, type => 1 }, accessors => { _TYPE => 1, _CHECK => 2, _COERCE => 3 }, ); } if $try_xs; } sub _set_type { my $self = shift; my $type = $_[0]; $self->_TYPE( $type ); if ( Scalar::Util::blessed( $type ) and $type->isa( 'Type::Tiny' ) ) { $self->_CHECK( $type->compiled_check ); $self->_COERCE( $type->has_coercion ? $type->coercion->compiled_coercion : undef ); } else { $self->_CHECK( $type->can( 'compiled_check' ) ? $type->compiled_check : sub { $type->check( $_[0] ) } ); $self->_COERCE( $type->can( 'has_coercion' ) && $type->can( 'coerce' ) && $type->has_coercion ? sub { $type->coerce( $_[0] ) } : undef ); } } # Only used if the type has no get_message method sub _dd { require Type::Tiny; goto \&Type::Tiny::_dd; } sub coerce_and_check_value { my $self = shift; my $check = $self->_CHECK; my $coerce = $self->_COERCE; my @vals = map { my $val = $coerce ? $coerce->( $_ ) : $_; if ( not $check->( $val ) ) { my $type = $self->_TYPE; Carp::croak( $type && $type->can( 'get_message' ) ? $type->get_message( $val ) : sprintf( '%s does not meet type constraint %s', _dd($_), $type || 'Unknown' ) ); } $val; } ( my @cp = @_ ); # need to copy @_ for Perl < 5.14 wantarray ? @vals : $vals[0]; } # store the $type for the exiting instances so the type can be set # (uncloned) in the clone too. A clone process could be cloning several # instances of this class, so use a hash to hold the types during # cloning. These types are reference counted, so the last reference to # a particular type deletes its key. my %tmp_clone_types; sub STORABLE_freeze { my ( $o, $cloning ) = @_; Carp::croak( "Storable::freeze only supported for dclone-ing" ) unless $cloning; my $type = $o->_TYPE; my $refaddr = Scalar::Util::refaddr( $type ); $tmp_clone_types{$refaddr} ||= [ $type, 0 ]; ++$tmp_clone_types{$refaddr}[1]; return ( $refaddr, $o->_REF ); } sub STORABLE_thaw { my ( $o, $cloning, $refaddr, $o2 ) = @_; Carp::croak( "Storable::thaw only supported for dclone-ing" ) unless $cloning; $o->_THAW( $o2 ); # implement in child classes my $type = $tmp_clone_types{$refaddr}[0]; --$tmp_clone_types{$refaddr}[1] or delete $tmp_clone_types{$refaddr}; $o->_set_type($type); } }; { package Type::Tie::ARRAY; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIEARRAY { my $class = shift; my $type = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type( $type ); if ( @_ ) { my $R = $self->_REF; @$R = map { $self->coerce_and_check_value( $_ ) } @_; } $self; } sub _DEFAULT { [] } sub FETCHSIZE { scalar @{ $_[0]->_REF } } sub STORESIZE { $#{ $_[0]->_REF } = $_[1] } sub STORE { $_[0]->_REF->[ $_[1] ] = $_[0]->coerce_and_check_value( $_[2] ) } sub FETCH { $_[0]->_REF->[ $_[1] ] } sub CLEAR { @{ $_[0]->_REF } = () } sub POP { pop @{ $_[0]->_REF } } sub PUSH { my $s = shift; push @{$s->_REF}, $s->coerce_and_check_value( @_ ) } sub SHIFT { shift @{ $_[0]->_REF } } sub UNSHIFT { my $s = shift; unshift @{$s->_REF}, $s->coerce_and_check_value( @_ ) } sub EXISTS { exists $_[0]->_REF->[ $_[1] ] } sub DELETE { delete $_[0]->_REF->[ $_[1] ] } sub EXTEND {} sub SPLICE { my $o = shift; my $sz = scalar @{$o->_REF}; my $off = @_ ? shift : 0; $off += $sz if $off < 0; my $len = @_ ? shift : $sz-$off; splice @{$o->_REF}, $off, $len, $o->coerce_and_check_value( @_ ); } sub _THAW { @{ $_[0]->_INIT_REF } = @{ $_[1] } } }; { package Type::Tie::HASH; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIEHASH { my $class = shift; my $type = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type( $type ); if ( @_ ) { my $R = $self->_REF; my %H = @_; %$R = (); while ( my ( $K, $V ) = each %H ) { $R->{$K} = $self->coerce_and_check_value( $V ); } } $self; } sub _DEFAULT { +{} } sub STORE { $_[0]->_REF->{ $_[1] } = $_[0]->coerce_and_check_value( $_[2] ) } sub FETCH { $_[0]->_REF->{ $_[1] } } sub FIRSTKEY { my $a = scalar keys %{ $_[0]->_REF }; each %{ $_[0]->_REF } } sub NEXTKEY { each %{ $_[0]->_REF } } sub EXISTS { exists $_[0]->_REF->{ $_[1] } } sub DELETE { delete $_[0]->_REF->{ $_[1] } } sub CLEAR { %{ $_[0]->_REF } = () } sub SCALAR { scalar %{ $_[0]->_REF } } sub _THAW { %{ $_[0]->_INIT_REF } = %{ $_[1] } } }; { package Type::Tie::SCALAR; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIESCALAR { my $class = shift; my $type = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type($type); if ( @_ ) { Carp::croak( 'Too many initial values provided for SCALAR' ) if @_ > 1; ${ $self->_REF } = $self->coerce_and_check_value( $_[0] ); } elsif ( $type->can('type_default') and my $d = $type->type_default ) { ${ $self->_REF } = $d->(); } $self; } sub _DEFAULT { my $x; \$x } sub STORE { ${ $_[0]->_REF } = $_[0]->coerce_and_check_value( $_[1] ) } sub FETCH { ${ $_[0]->_REF } } sub _THAW { ${ $_[0]->_INIT_REF } = ${ $_[1] } } }; 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tie - tie a variable to a type constraint =head1 SYNOPSIS Type::Tie is a response to this sort of problem... use strict; use warnings; { package Local::Testing; use Moose; has numbers => ( is => "ro", isa => "ArrayRef[Num]" ); } # Nice list of numbers. my @N = ( 1, 2, 3, 3.14159 ); # Create an object with a reference to that list. my $object = Local::Testing->new(numbers => \@N); # Everything OK so far... # Now watch this! push @N, "Monkey!"; print $object->dump; # Houston, we have a problem! Just declare C<< @N >> like this: use Type::Tie; use Types::Standard qw( Num ); ttie my @N, Num, ( 1, 2, 3, 3.14159 ); Now any attempt to add a non-numeric value to C<< @N >> will die. =head1 DESCRIPTION This module exports a single function: C. C ties a variable to a type constraint, ensuring that whatever values stored in the variable will conform to the type constraint. If the type constraint has coercions, these will be used if necessary to ensure values assigned to the variable conform. use Type::Tie; use Types::Standard qw( Int Num ); ttie my $count, Int->plus_coercions(Num, 'int $_'), 0; print tied($count)->type, "\n"; # 'Int' $count++; # ok $count = 2; # ok $count = 3.14159; # ok, coerced to 3 $count = "Monkey!"; # dies While the examples in documentation (and the test suite) show type constraints from L, any type constraint objects supporting the L interfaces should work. This includes: =over =item * L / L =item * L / L =item * L =item * L =back However, with Type::Tiny, you don't even need to C<< use Type::Tie >>. use Types::Standard qw( Int Num ); tie my $count, Int->plus_coercions(Num, 'int $_'), 0; print tied($count)->type, "\n"; # 'Int' $count++; # ok $count = 2; # ok $count = 3.14159; # ok, coerced to 3 $count = "Monkey!"; # dies =head2 Cloning tied variables If you clone tied variables with C from L, the clone will also be tied. The L module is also able to successfully clone tied variables. With other cloning techniques, your level of success may vary. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =begin trustme =item ttie =end trustme Tiny.pm000664001750001750 23504115111656240 15430 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Tiny; use 5.008001; use strict; use warnings; BEGIN { if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Type::Tiny::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::VERSION = '2.008006'; $Type::Tiny::XS_VERSION = '0.016'; } $Type::Tiny::VERSION =~ tr/_//d; $Type::Tiny::XS_VERSION =~ tr/_//d; our @InternalPackages = qw( Devel::TypeTiny::Perl56Compat Devel::TypeTiny::Perl58Compat Error::TypeTiny Error::TypeTiny::Assertion Error::TypeTiny::Compilation Error::TypeTiny::WrongNumberOfParameters Eval::TypeTiny Eval::TypeTiny::CodeAccumulator Eval::TypeTiny::Sandbox Exporter::Tiny Reply::Plugin::TypeTiny Test::TypeTiny Type::Coercion Type::Coercion::FromMoose Type::Coercion::Union Type::Library Type::Params Type::Params::Alternatives Type::Params::Parameter Type::Params::Signature Type::Parser Type::Parser::AstBuilder Type::Parser::Token Type::Parser::TokenStream Type::Registry Types::Common Types::Common::Numeric Types::Common::String Types::Standard Types::Standard::_Stringable Types::Standard::ArrayRef Types::Standard::CycleTuple Types::Standard::Dict Types::Standard::HashRef Types::Standard::Map Types::Standard::ScalarRef Types::Standard::StrMatch Types::Standard::Tied Types::Standard::Tuple Types::TypeTiny Type::Tie Type::Tie::ARRAY Type::Tie::BASE Type::Tie::HASH Type::Tie::SCALAR Type::Tiny Type::Tiny::_DeclaredType Type::Tiny::_HalfOp Type::Tiny::Bitfield Type::Tiny::Class Type::Tiny::ConstrainedObject Type::Tiny::Duck Type::Tiny::Enum Type::Tiny::Intersection Type::Tiny::Role Type::Tiny::Union Type::Utils ); use Scalar::Util qw( blessed ); use Types::TypeTiny (); our $SafePackage = sprintf 'package %s;', __PACKAGE__; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } sub _swap { $_[2] ? @_[ 1, 0 ] : @_[ 0, 1 ] } BEGIN { my $support_smartmatch = 0+ !!( $] >= 5.010001 && $] <= 5.041002 ); eval qq{ sub SUPPORT_SMARTMATCH () { !! $support_smartmatch } }; my $fixed_precedence = 0+ !!( $] >= 5.014 ); eval qq{ sub _FIXED_PRECEDENCE () { !! $fixed_precedence } }; my $try_xs = exists( $ENV{PERL_TYPE_TINY_XS} ) ? !!$ENV{PERL_TYPE_TINY_XS} : exists( $ENV{PERL_ONLY} ) ? !$ENV{PERL_ONLY} : 1; my $use_xs = 0; $try_xs and eval { require Type::Tiny::XS; 'Type::Tiny::XS'->VERSION( $Type::Tiny::XS_VERSION ); $use_xs++; }; *_USE_XS = $use_xs ? sub () { !!1 } : sub () { !!0 }; *_USE_MOUSE = $try_xs ? sub () { $INC{'Mouse/Util.pm'} and Mouse::Util::MOUSE_XS() } : sub () { !!0 }; my $strict_mode = 0; $ENV{$_} && ++$strict_mode for qw( EXTENDED_TESTING AUTHOR_TESTING RELEASE_TESTING PERL_STRICT ); *_STRICT_MODE = $strict_mode ? sub () { !!1 } : sub () { !!0 }; } #/ BEGIN { sub _install_overloads { no strict 'refs'; no warnings 'redefine', 'once'; # Coverage is checked on Perl 5.26 if ( $] < 5.010 ) { # uncoverable statement require overload; # uncoverable statement push @_, fallback => 1; # uncoverable statement goto \&overload::OVERLOAD; # uncoverable statement } my $class = shift; *{ $class . '::((' } = sub { }; *{ $class . '::()' } = sub { }; *{ $class . '::()' } = do { my $x = 1; \$x }; while ( @_ ) { my $f = shift; *{ $class . '::(' . $f } = ref $_[0] ? shift : do { my $m = shift; sub { shift->$m( @_ ) } }; } } #/ sub _install_overloads } __PACKAGE__->_install_overloads( q("") => sub { caller =~ m{^(Moo::HandleMoose|Sub::Quote)} ? $_[0]->_stringify_no_magic : $_[0]->display_name; }, q(bool) => sub { 1 }, q(&{}) => "_overload_coderef", q(|) => sub { my @tc = _swap @_; if ( !_FIXED_PRECEDENCE && $_[2] ) { if ( blessed $tc[0] ) { if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { my $type = $tc[0]->{type}; my $param = $tc[0]->{param}; my $op = $tc[0]->{op}; require Type::Tiny::Union; return "Type::Tiny::_HalfOp"->new( $op, $param, "Type::Tiny::Union"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), ); } #/ if ( blessed $tc[0] eq...) } #/ if ( blessed $tc[0] ) elsif ( ref $tc[0] eq 'ARRAY' ) { require Type::Tiny::_HalfOp; return "Type::Tiny::_HalfOp"->new( '|', @tc ); } } #/ if ( !_FIXED_PRECEDENCE...) require Type::Tiny::Union; return "Type::Tiny::Union"->new_by_overload( type_constraints => \@tc ); }, q(&) => sub { my @tc = _swap @_; if ( !_FIXED_PRECEDENCE && $_[2] ) { if ( blessed $tc[0] ) { if ( blessed $tc[0] eq "Type::Tiny::_HalfOp" ) { my $type = $tc[0]->{type}; my $param = $tc[0]->{param}; my $op = $tc[0]->{op}; require Type::Tiny::Intersection; return "Type::Tiny::_HalfOp"->new( $op, $param, "Type::Tiny::Intersection"->new_by_overload( type_constraints => [ $type, $tc[1] ] ), ); } #/ if ( blessed $tc[0] eq...) } #/ if ( blessed $tc[0] ) elsif ( ref $tc[0] eq 'ARRAY' ) { require Type::Tiny::_HalfOp; return "Type::Tiny::_HalfOp"->new( '&', @tc ); } } #/ if ( !_FIXED_PRECEDENCE...) require Type::Tiny::Intersection; "Type::Tiny::Intersection"->new_by_overload( type_constraints => \@tc ); }, q(~) => sub { shift->complementary_type }, q(==) => sub { $_[0]->equals( $_[1] ) }, q(!=) => sub { not $_[0]->equals( $_[1] ) }, q(<) => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( _swap @_ ) }, q(>) => sub { my $m = $_[0]->can( 'is_subtype_of' ); $m->( reverse _swap @_ ); }, q(<=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( _swap @_ ) }, q(>=) => sub { my $m = $_[0]->can( 'is_a_type_of' ); $m->( reverse _swap @_ ); }, q(eq) => sub { "$_[0]" eq "$_[1]" }, q(cmp) => sub { $_[2] ? ( "$_[1]" cmp "$_[0]" ) : ( "$_[0]" cmp "$_[1]" ) }, q(0+) => sub { $_[0]{uniq} }, q(/) => sub { ( _STRICT_MODE xor $_[2] ) ? $_[0] : $_[1] }, ); __PACKAGE__->_install_overloads( q(~~) => sub { $_[0]->check( $_[1] ) }, ) if Type::Tiny::SUPPORT_SMARTMATCH; # Would be easy to just return sub { $self->assert_return(@_) } # but try to build a more efficient coderef whenever possible. # sub _overload_coderef { my $self = shift; # Bypass generating a coderef if we've already got the best possible one. # return $self->{_overload_coderef} if $self->{_overload_coderef_no_rebuild}; # Subclasses of Type::Tiny might override assert_return to do some kind # of interesting thing. In that case, we can't rely on it having identical # behaviour to Type::Tiny::inline_assert. # $self->{_overrides_assert_return} = ( $self->can( 'assert_return' ) != \&assert_return ) unless exists $self->{_overrides_assert_return}; if ( $self->{_overrides_assert_return} ) { $self->{_overload_coderef} ||= do { Scalar::Util::weaken( my $weak = $self ); sub { $weak->assert_return( @_ ) }; }; ++$self->{_overload_coderef_no_rebuild}; } elsif ( exists( &Sub::Quote::quote_sub ) ) { # Use `=` instead of `||=` because we want to overwrite non-Sub::Quote # coderef if possible. $self->{_overload_coderef} = $self->can_be_inlined ? Sub::Quote::quote_sub( $self->inline_assert( '$_[0]' ), ) : Sub::Quote::quote_sub( $self->inline_assert( '$_[0]', '$type' ), { '$type' => \$self }, ); ++$self->{_overload_coderef_no_rebuild}; } #/ elsif ( exists( &Sub::Quote::quote_sub...)) else { require Eval::TypeTiny; $self->{_overload_coderef} ||= $self->can_be_inlined ? Eval::TypeTiny::eval_closure( source => sprintf( 'sub { %s }', $self->inline_assert( '$_[0]', undef, no_wrapper => 1 ) ), description => sprintf( "compiled assertion 'assert_%s'", $self ), ) : Eval::TypeTiny::eval_closure( source => sprintf( 'sub { %s }', $self->inline_assert( '$_[0]', '$type', no_wrapper => 1 ) ), description => sprintf( "compiled assertion 'assert_%s'", $self ), environment => { '$type' => \$self }, ); } #/ else [ if ( $self->{_overrides_assert_return...})] $self->{_overload_coderef}; } #/ sub _overload_coderef our %ALL_TYPES; my $QFS; my $uniq = 1; sub new { my $class = shift; my %params = ( @_ == 1 ) ? %{ $_[0] } : @_; for ( qw/ name display_name library / ) { $params{$_} = $params{$_} . '' if defined $params{$_}; } my $level = 0; while ( not exists $params{definition_context} and $level < 20 ) { our $_TT_GUTS ||= do { my $g = join '|', map quotemeta, grep !m{^Types::}, @InternalPackages; qr/\A(?:$g)\z/o }; my $package = caller $level; if ( $package !~ $_TT_GUTS ) { @{ $params{definition_context} = {} }{ qw/ package file line / } = caller $level; } ++$level; } if ( exists $params{parent} ) { $params{parent} = ref( $params{parent} ) =~ /^Type::Tiny\b/ ? $params{parent} : Types::TypeTiny::to_TypeTiny( $params{parent} ); _croak "Parent must be an instance of %s", __PACKAGE__ unless blessed( $params{parent} ) && $params{parent}->isa( __PACKAGE__ ); if ( $params{parent}->deprecated and not exists $params{deprecated} ) { $params{deprecated} = 1; } } #/ if ( exists $params{parent...}) if ( exists $params{constraint} and defined $params{constraint} and not ref $params{constraint} ) { require Eval::TypeTiny; my $code = $params{constraint}; $params{constraint} = Eval::TypeTiny::eval_closure( source => sprintf( 'sub ($) { %s }', $code ), description => "anonymous check", ); $params{inlined} ||= sub { my ( $type ) = @_; my $inlined = $_ eq '$_' ? "do { $code }" : "do { local \$_ = $_; $code }"; $type->has_parent ? ( undef, $inlined ) : $inlined; } if ( !exists $params{parent} or $params{parent}->can_be_inlined ); } #/ if ( exists $params{constraint...}) # canonicalize to a boolean $params{deprecated} = !!$params{deprecated}; $params{name} = "__ANON__" unless exists $params{name}; $params{uniq} = $uniq++; if ( $params{name} ne "__ANON__" ) { # First try a fast ASCII-only expression, but fall back to Unicode $params{name} =~ /^_{0,2}[A-Z][A-Za-z0-9_]+$/sm or eval q( use 5.008; $params{name} =~ /^_{0,2}\p{Lu}[\p{L}0-9_]+$/sm ) or _croak '"%s" is not a valid type name', $params{name}; } if ( exists $params{coercion} and !ref $params{coercion} and $params{coercion} ) { $params{parent}->has_coercion or _croak "coercion => 1 requires type to have a direct parent with a coercion"; $params{coercion} = $params{parent}->coercion->type_coercion_map; } if ( !exists $params{inlined} and exists $params{constraint} and ( !exists $params{parent} or $params{parent}->can_be_inlined ) and $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) ) { my ( undef, $perlstring, $captures ) = @{ $QFS->( $params{constraint} ) || [] }; $params{inlined} = sub { my ( $self, $var ) = @_; my $code = Sub::Quote::inlinify( $perlstring, $var, $var eq q($_) ? '' : "local \$_ = $var;", 1, ); $code = sprintf( '%s and %s', $self->parent->inline_check( $var ), $code ) if $self->has_parent; return $code; } if $perlstring && !$captures; } #/ if ( !exists $params{inlined...}) my $self = bless \%params, $class; unless ( $params{tmp} ) { my $uniq = $self->{uniq}; $ALL_TYPES{$uniq} = $self; Scalar::Util::weaken( $ALL_TYPES{$uniq} ); my $tmp = $self; Scalar::Util::weaken( $tmp ); $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } = sub { $tmp }; } #/ unless ( $params{tmp} ) if ( ref( $params{coercion} ) eq q(CODE) ) { require Types::Standard; my $code = delete( $params{coercion} ); $self->{coercion} = $self->_build_coercion; $self->coercion->add_type_coercions( Types::Standard::Any(), $code ); } elsif ( ref( $params{coercion} ) eq q(ARRAY) ) { my $arr = delete( $params{coercion} ); $self->{coercion} = $self->_build_coercion; $self->coercion->add_type_coercions( @$arr ); } # Documenting this here because it's too weird to be in the pod. # There's a secret attribute called "_build_coercion" which takes a # coderef. If present, then when $type->coercion is lazy built, # the blank Type::Coercion object gets passed to the coderef, # allowing the coderef to manipulate it a little. This is used by # Types::TypeTiny to allow it to build a coercion for the TypeTiny # type constraint without needing to load Type::Coercion yet. if ( $params{my_methods} ) { require Eval::TypeTiny; Scalar::Util::reftype( $params{my_methods}{$_} ) eq 'CODE' and /\A[^0-9\W]\w+\z/ and Eval::TypeTiny::set_subname( sprintf( "%s::my_%s", $self->qualified_name, $_ ), $params{my_methods}{$_}, ) for keys %{ $params{my_methods} }; } #/ if ( $params{my_methods...}) # In general, mutating a type constraint after it's been created # is a bad idea and will probably not work. However some places are # especially harmful and can lead to confusing errors, so allow # subclasses to lock down particular keys. # $self->_lockdown( sub { &Internals::SvREADONLY( $_, !!1 ) for @_; } ); return $self; } #/ sub new sub _lockdown {} sub DESTROY { my $self = shift; delete( $ALL_TYPES{ $self->{uniq} } ); delete( $Moo::HandleMoose::TYPE_MAP{ $self->_stringify_no_magic } ); return; } sub _clone { my $self = shift; my %opts; $opts{$_} = $self->{$_} for qw< name display_name message >; $self->create_child_type( %opts ); } sub _stringify_no_magic { sprintf( '%s=%s(0x%08x)', blessed( $_[0] ), Scalar::Util::reftype( $_[0] ), Scalar::Util::refaddr( $_[0] ) ); } our $DD; sub _dd { @_ = $_ unless @_; my ( $value ) = @_; goto $DD if ref( $DD ) eq q(CODE); require B; !defined $value ? 'Undef' : !ref $value ? sprintf( 'Value %s', B::perlstring( $value ) ) : do { my $N = 0+ ( defined( $DD ) ? $DD : 72 ); require Data::Dumper; local $Data::Dumper::Indent = 0; local $Data::Dumper::Useqq = 1; local $Data::Dumper::Terse = 1; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Maxdepth = 2; my $str; eval { local $SIG{__WARN__} = sub {}; $str = Data::Dumper::Dumper( $value ); $str = substr( $str, 0, $N - 12 ) . '...' . substr( $str, -1, 1 ) if length( $str ) >= $N; 1; } or do { $str = 'which cannot be dumped' }; "Reference $str"; } #/ do } #/ sub _dd sub _loose_to_TypeTiny { my $caller = caller( 1 ); # assumption map +( ref( $_ ) ? Types::TypeTiny::to_TypeTiny( $_ ) : do { require Type::Utils; Type::Utils::dwim_type( $_, for => $caller ) } ), @_; } sub name { $_[0]{name} } sub display_name { $_[0]{display_name} ||= $_[0]->_build_display_name } sub parent { $_[0]{parent} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub compiled_check { $_[0]{compiled_type_constraint} ||= $_[0]->_build_compiled_check; } sub coercion { $_[0]{coercion} ||= $_[0]->_build_coercion } sub message { $_[0]{message} } sub library { $_[0]{library} } sub inlined { $_[0]{inlined} } sub deprecated { $_[0]{deprecated} } sub constraint_generator { $_[0]{constraint_generator} } sub inline_generator { $_[0]{inline_generator} } sub name_generator { $_[0]{name_generator} ||= $_[0]->_build_name_generator } sub coercion_generator { $_[0]{coercion_generator} } sub parameters { $_[0]{parameters} } sub moose_type { $_[0]{moose_type} ||= $_[0]->_build_moose_type } sub mouse_type { $_[0]{mouse_type} ||= $_[0]->_build_mouse_type } sub deep_explanation { $_[0]{deep_explanation} } sub my_methods { $_[0]{my_methods} ||= $_[0]->_build_my_methods } sub sorter { $_[0]{sorter} } sub exception_class { $_[0]{exception_class} ||= $_[0]->_build_exception_class } sub has_parent { exists $_[0]{parent} } sub has_library { exists $_[0]{library} } sub has_inlined { exists $_[0]{inlined} } sub has_constraint_generator { exists $_[0]{constraint_generator} } sub has_inline_generator { exists $_[0]{inline_generator} } sub has_coercion_generator { exists $_[0]{coercion_generator} } sub has_parameters { exists $_[0]{parameters} } sub has_message { defined $_[0]{message} } sub has_deep_explanation { exists $_[0]{deep_explanation} } sub has_sorter { exists $_[0]{sorter} } sub _default_message { $_[0]{_default_message} ||= $_[0]->_build_default_message; } sub has_coercion { $_[0]->coercion if $_[0]{_build_coercion}; # trigger auto build thing $_[0]{coercion} and !!@{ $_[0]{coercion}->type_coercion_map }; } sub _assert_coercion { my $self = shift; return $self->coercion if $self->{_build_coercion}; # trigger auto build thing _croak "No coercion for this type constraint" unless $self->has_coercion && @{ $self->coercion->type_coercion_map }; $self->coercion; } my $null_constraint = sub { !!1 }; sub _build_display_name { shift->name; } sub _build_constraint { return $null_constraint; } sub _is_null_constraint { shift->constraint == $null_constraint; } sub _build_coercion { require Type::Coercion; my $self = shift; my %opts = ( type_constraint => $self ); $opts{display_name} = "to_$self" unless $self->is_anon; my $coercion = "Type::Coercion"->new( %opts ); $self->{_build_coercion}->( $coercion ) if ref $self->{_build_coercion}; $coercion; } sub _build_default_message { my $self = shift; $self->{is_using_default_message} = 1; return sub { sprintf '%s did not pass type constraint', _dd( $_[0] ) } if "$self" eq "__ANON__"; my $name = "$self"; return sub { sprintf '%s did not pass type constraint "%s"', _dd( $_[0] ), $name; }; } #/ sub _build_default_message sub _build_name_generator { my $self = shift; return sub { defined && s/[\x00-\x1F]//smg for ( my ( $s, @a ) = @_ ); sprintf( '%s[%s]', $s, join q[,], map !defined() ? 'undef' : !ref() && /\W/ ? B::perlstring($_) : $_, @a ); }; } sub _build_compiled_check { my $self = shift; local our $AvoidCallbacks = 0; if ( $self->_is_null_constraint and $self->has_parent ) { return $self->parent->compiled_check; } require Eval::TypeTiny; return Eval::TypeTiny::eval_closure( source => sprintf( 'sub ($) { %s }', $self->inline_check( '$_[0]' ) ), description => sprintf( "compiled check '%s'", $self ), ) if $self->can_be_inlined; my @constraints; push @constraints, $self->parent->compiled_check if $self->has_parent; push @constraints, $self->constraint if !$self->_is_null_constraint; return $null_constraint unless @constraints; return sub ($) { local $_ = $_[0]; for my $c ( @constraints ) { return unless $c->( @_ ); } return !!1; }; } #/ sub _build_compiled_check sub _build_exception_class { my $self = shift; return $self->parent->exception_class if $self->has_parent; require Error::TypeTiny::Assertion; return 'Error::TypeTiny::Assertion'; } sub definition_context { my $self = shift; my $found = $self->find_parent(sub { ref $_->{definition_context} and exists $_->{definition_context}{file}; }); $found ? $found->{definition_context} : {}; } sub find_constraining_type { my $self = shift; if ( $self->_is_null_constraint and $self->has_parent ) { return $self->parent->find_constraining_type; } $self; } sub type_default { my ( $self, @args ) = @_; if ( exists $self->{type_default} ) { if ( @args ) { my $td = $self->{type_default}; return sub { local $_ = \@args; &$td; }; } return $self->{type_default}; } if ( my $parent = $self->parent ) { return $parent->type_default( @args ) if $self->_is_null_constraint; } return undef; } our @CMP; sub CMP_SUPERTYPE () { -1 } sub CMP_EQUAL () { 0 } sub CMP_EQUIVALENT () { '0E0' } sub CMP_SUBTYPE () { 1 } sub CMP_UNKNOWN () { ''; } # avoid getting mixed up with cmp operator at compile time *cmp = sub { my ( $A, $B ) = _loose_to_TypeTiny( $_[0], $_[1] ); return unless blessed( $A ) && $A->isa( "Type::Tiny" ); return unless blessed( $B ) && $B->isa( "Type::Tiny" ); for my $comparator ( @CMP ) { my $result = $comparator->( $A, $B ); next if $result eq CMP_UNKNOWN; if ( $result eq CMP_EQUIVALENT ) { my $prefer = @_ == 3 ? $_[2] : CMP_EQUAL; return $prefer; } return $result; } return CMP_UNKNOWN; }; push @CMP, sub { my ( $A, $B ) = @_; return CMP_EQUAL if Scalar::Util::refaddr( $A ) == Scalar::Util::refaddr( $B ); return CMP_EQUIVALENT if Scalar::Util::refaddr( $A->compiled_check ) == Scalar::Util::refaddr( $B->compiled_check ); my $A_stem = $A->find_constraining_type; my $B_stem = $B->find_constraining_type; return CMP_EQUIVALENT if Scalar::Util::refaddr( $A_stem ) == Scalar::Util::refaddr( $B_stem ); return CMP_EQUIVALENT if Scalar::Util::refaddr( $A_stem->compiled_check ) == Scalar::Util::refaddr( $B_stem->compiled_check ); if ( $A_stem->can_be_inlined and $B_stem->can_be_inlined ) { return CMP_EQUIVALENT if $A_stem->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); } A_IS_SUBTYPE: { my $A_prime = $A_stem; while ( $A_prime->has_parent ) { $A_prime = $A_prime->parent; return CMP_SUBTYPE if Scalar::Util::refaddr( $A_prime ) == Scalar::Util::refaddr( $B_stem ); return CMP_SUBTYPE if Scalar::Util::refaddr( $A_prime->compiled_check ) == Scalar::Util::refaddr( $B_stem->compiled_check ); if ( $A_prime->can_be_inlined and $B_stem->can_be_inlined ) { return CMP_SUBTYPE if $A_prime->inline_check( '$WOLFIE' ) eq $B_stem->inline_check( '$WOLFIE' ); } } #/ while ( $A_prime->has_parent) } #/ A_IS_SUBTYPE: B_IS_SUBTYPE: { my $B_prime = $B_stem; while ( $B_prime->has_parent ) { $B_prime = $B_prime->parent; return CMP_SUPERTYPE if Scalar::Util::refaddr( $B_prime ) == Scalar::Util::refaddr( $A_stem ); return CMP_SUPERTYPE if Scalar::Util::refaddr( $B_prime->compiled_check ) == Scalar::Util::refaddr( $A_stem->compiled_check ); if ( $A_stem->can_be_inlined and $B_prime->can_be_inlined ) { return CMP_SUPERTYPE if $B_prime->inline_check( '$WOLFIE' ) eq $A_stem->inline_check( '$WOLFIE' ); } } #/ while ( $B_prime->has_parent) } #/ B_IS_SUBTYPE: return CMP_UNKNOWN; }; sub equals { my $result = Type::Tiny::cmp( $_[0], $_[1] ); return unless defined $result; $result eq CMP_EQUAL; } sub is_subtype_of { my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); return unless defined $result; $result eq CMP_SUBTYPE; } sub is_supertype_of { my $result = Type::Tiny::cmp( $_[0], $_[1], CMP_SUBTYPE ); return unless defined $result; $result eq CMP_SUPERTYPE; } sub is_a_type_of { my $result = Type::Tiny::cmp( $_[0], $_[1] ); return unless defined $result; $result eq CMP_SUBTYPE or $result eq CMP_EQUAL or $result eq CMP_EQUIVALENT; } sub strictly_equals { my ( $self, $other ) = _loose_to_TypeTiny( @_ ); return unless blessed( $self ) && $self->isa( "Type::Tiny" ); return unless blessed( $other ) && $other->isa( "Type::Tiny" ); $self->{uniq} == $other->{uniq}; } sub is_strictly_subtype_of { my ( $self, $other ) = _loose_to_TypeTiny( @_ ); return unless blessed( $self ) && $self->isa( "Type::Tiny" ); return unless blessed( $other ) && $other->isa( "Type::Tiny" ); return unless $self->has_parent; $self->parent->strictly_equals( $other ) or $self->parent->is_strictly_subtype_of( $other ); } sub is_strictly_supertype_of { my ( $self, $other ) = _loose_to_TypeTiny( @_ ); return unless blessed( $self ) && $self->isa( "Type::Tiny" ); return unless blessed( $other ) && $other->isa( "Type::Tiny" ); $other->is_strictly_subtype_of( $self ); } sub is_strictly_a_type_of { my ( $self, $other ) = _loose_to_TypeTiny( @_ ); return unless blessed( $self ) && $self->isa( "Type::Tiny" ); return unless blessed( $other ) && $other->isa( "Type::Tiny" ); $self->strictly_equals( $other ) or $self->is_strictly_subtype_of( $other ); } sub qualified_name { my $self = shift; ( exists $self->{library} and $self->name ne "__ANON__" ) ? "$self->{library}::$self->{name}" : $self->{name}; } sub is_anon { my $self = shift; $self->name eq "__ANON__"; } sub parents { my $self = shift; return unless $self->has_parent; return ( $self->parent, $self->parent->parents ); } sub find_parent { my $self = shift; my ( $test ) = @_; local ( $_, $. ); my $type = $self; my $count = 0; while ( $type ) { if ( $test->( $_ = $type, $. = $count ) ) { return wantarray ? ( $type, $count ) : $type; } else { $type = $type->parent; $count++; } } return; } #/ sub find_parent sub check { my $self = shift; ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check )->( @_ ); } sub _strict_check { my $self = shift; local $_ = $_[0]; my @constraints = reverse map { $_->constraint } grep { not $_->_is_null_constraint } ( $self, $self->parents ); for my $c ( @constraints ) { return unless $c->( @_ ); } return !!1; } #/ sub _strict_check sub get_message { my $self = shift; local $_ = $_[0]; $self->has_message ? $self->message->( @_ ) : $self->_default_message->( @_ ); } sub validate { my $self = shift; return undef if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) ->( @_ ); local $_ = $_[0]; return $self->get_message( @_ ); } #/ sub validate sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); if ( $self->has_parent ) { my $parent = $self->parent->validate_explain( $value, $varname ); return [ sprintf( '"%s" is a subtype of "%s"', $self, $self->parent ), @$parent ] if $parent; } my $message = sprintf( '%s%s', $self->get_message( $value ), $varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ), ); if ( $self->is_parameterized and $self->parent->has_deep_explanation ) { my $deep = $self->parent->deep_explanation->( $self, $value, $varname ); return [ $message, @$deep ] if $deep; } local $SIG{__WARN__} = sub {}; return [ $message, sprintf( '"%s" is defined as: %s', $self, $self->_perlcode ) ]; } #/ sub validate_explain my $b; sub _perlcode { my $self = shift; local our $AvoidCallbacks = 1; return $self->inline_check( '$_' ) if $self->can_be_inlined; $b ||= do { local $@; require B::Deparse; my $tmp = "B::Deparse"->new; $tmp->ambient_pragmas( strict => "all", warnings => "all" ) if $tmp->can( 'ambient_pragmas' ); $tmp; }; my $code = $b->coderef2text( $self->constraint ); $code =~ s/\s+/ /g; return "sub $code"; } #/ sub _perlcode sub assert_valid { my $self = shift; return !!1 if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) ->( @_ ); local $_ = $_[0]; $self->_failed_check( "$self", $_ ); } #/ sub assert_valid sub assert_return { my $self = shift; return $_[0] if ( $self->{compiled_type_constraint} ||= $self->_build_compiled_check ) ->( @_ ); local $_ = $_[0]; $self->_failed_check( "$self", $_ ); } #/ sub assert_return sub can_be_inlined { my $self = shift; return $self->parent->can_be_inlined if $self->has_parent && $self->_is_null_constraint; return !!1 if !$self->has_parent && $self->_is_null_constraint; return $self->has_inlined; } sub inline_check { my $self = shift; _croak 'Cannot inline type constraint check for "%s"', $self unless $self->can_be_inlined; return $self->parent->inline_check( @_ ) if $self->has_parent && $self->_is_null_constraint; return '(!!1)' if !$self->has_parent && $self->_is_null_constraint; local $_ = $_[0]; my @r = $self->inlined->( $self, @_ ); if ( @r and not defined $r[0] ) { _croak 'Inlining type constraint check for "%s" returned undef!', $self unless $self->has_parent; $r[0] = $self->parent->inline_check( @_ ); } my $r = join " && " => map { /[;{}]/ && !/\Ado \{.+\}\z/ ? "do { $SafePackage $_ }" : "($_)" } @r; return @r == 1 ? $r : "($r)"; } #/ sub inline_check sub inline_assert { require B; my $self = shift; my ( $varname, $typevarname, %extras ) = @_; $extras{exception_class} ||= $self->exception_class; my $inline_check; if ( $self->can_be_inlined ) { $inline_check = sprintf( '(%s)', $self->inline_check( $varname ) ); } elsif ( $typevarname ) { $inline_check = sprintf( '%s->check(%s)', $typevarname, $varname ); } else { _croak 'Cannot inline type constraint check for "%s"', $self; } my $do_wrapper = !delete $extras{no_wrapper}; my $inline_throw; if ( $typevarname ) { $inline_throw = sprintf( 'Type::Tiny::_failed_check(%s, %s, %s, %s)', $typevarname, B::perlstring( "$self" ), $varname, join( ',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), sort keys %extras ), ); } #/ if ( $typevarname ) else { $inline_throw = sprintf( 'Type::Tiny::_failed_check(%s, %s, %s, %s)', $self->{uniq}, B::perlstring( "$self" ), $varname, join( ',', map +( B::perlstring( $_ ) => B::perlstring( $extras{$_} ) ), sort keys %extras ), ); } #/ else [ if ( $typevarname ) ] $do_wrapper ? qq[do { no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname };] : qq[ no warnings "void"; $SafePackage $inline_check or $inline_throw; $varname ]; } #/ sub inline_assert sub _failed_check { my ( $self, $name, $value, %attrs ) = @_; $self = $ALL_TYPES{$self} if defined $self && !ref $self; my $exception_class = delete( $attrs{exception_class} ) || ( ref $self ? $self->exception_class : 'Error::TypeTiny::Assertion' ); my $callback = delete( $attrs{on_die} ); if ( $self ) { return $exception_class->throw_cb( $callback, message => $self->get_message( $value ), type => $self, value => $value, %attrs, ); } else { return $exception_class->throw_cb( $callback, message => sprintf( '%s did not pass type constraint "%s"', _dd( $value ), $name ), value => $value, %attrs, ); } } #/ sub _failed_check sub coerce { my $self = shift; $self->_assert_coercion->coerce( @_ ); } sub assert_coerce { my $self = shift; $self->_assert_coercion->assert_coerce( @_ ); } sub is_parameterizable { shift->has_constraint_generator; } sub is_parameterized { shift->has_parameters; } { my %seen; sub ____make_key { #<<< join ',', map { Types::TypeTiny::is_TypeTiny( $_ ) ? sprintf( '$Type::Tiny::ALL_TYPES{%s}', defined( $_->{uniq} ) ? $_->{uniq} : '____CANNOT_KEY____' ) : ref() eq 'ARRAY' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '[%s]', ____make_key( @$_ ) ) } : ref() eq 'HASH' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '{%s}', ____make_key( do { my %h = %$_; map +( $_, $h{$_} ), sort keys %h; } ) ) } : ref() eq 'SCALAR' || ref() eq 'REF' ? do { $seen{$_}++ ? '____CANNOT_KEY____' : sprintf( '\\(%s)', ____make_key( $$_ ) ) } : !defined() ? 'undef' : !ref() ? do { require B; B::perlstring( $_ ) } : '____CANNOT_KEY____'; } @_; #>>> } #/ sub ____make_key my %param_cache; sub parameterize { my $self = shift; $self->is_parameterizable or @_ ? _croak( "Type '%s' does not accept parameters", "$self" ) : return ( $self ); @_ = map Types::TypeTiny::to_TypeTiny( $_ ), @_; # Generate a key for caching parameterized type constraints, # but only if all the parameters are strings or type constraints. %seen = (); my $key = $self->____make_key( @_ ); undef( $key ) if $key =~ /____CANNOT_KEY____/; return $param_cache{$key} if defined $key && defined $param_cache{$key}; local $Type::Tiny::parameterize_type = $self; local $_ = $_[0]; my $P; my ( $constraint, $compiled ) = $self->constraint_generator->( @_ ); if ( Types::TypeTiny::is_TypeTiny( $constraint ) ) { $P = $constraint; } else { my %options = ( constraint => $constraint, display_name => $self->name_generator->( $self, @_ ), parameters => [@_], ); $options{compiled_type_constraint} = $compiled if $compiled; $options{inlined} = $self->inline_generator->( @_ ) if $self->has_inline_generator; $options{type_default} = $self->{type_default_generator}->( @_ ) if exists $self->{type_default_generator}; # undocumented exists $options{$_} && !defined $options{$_} && delete $options{$_} for keys %options; $P = $self->create_child_type( %options ); if ( $self->has_coercion_generator ) { my @args = @_; $P->{_build_coercion} = sub { my $coercion = shift; my $built = $self->coercion_generator->( $self, $P, @args ); $coercion->add_type_coercions( @{ $built->type_coercion_map } ) if $built; $coercion->freeze; }; } } #/ else [ if ( Types::TypeTiny::is_TypeTiny...)] if ( defined $key ) { $param_cache{$key} = $P; Scalar::Util::weaken( $param_cache{$key} ); } $P->coercion->freeze unless $self->has_coercion_generator; return $P; } #/ sub parameterize } sub check_parameter_count_for_parameterized_type { my ( $library, $type_name, $args, $max_args, $min_args ) = @_; $args = @$args if ref $args; if ( ( defined $max_args and $args > $max_args ) or ( defined $min_args and $args < $min_args ) ) { require Error::TypeTiny::WrongNumberOfParameters; Error::TypeTiny::WrongNumberOfParameters->throw( target => "$library\::$type_name\[]", ( defined $min_args ) ? ( minimum => $min_args ) : (), ( defined $max_args ) ? ( maximum => $max_args ) : (), got => $args, ); } return; } sub child_type_class { __PACKAGE__; } sub create_child_type { my $self = shift; my %moreopts; $moreopts{is_object} = 1 if $self->{is_object}; return $self->child_type_class->new( parent => $self, %moreopts, @_ ); } sub complementary_type { my $self = shift; my $r = ( $self->{complementary_type} ||= $self->_build_complementary_type ); Scalar::Util::weaken( $self->{complementary_type} ) unless Scalar::Util::isweak( $self->{complementary_type} ); return $r; } sub _build_complementary_type { my $self = shift; my %opts = ( constraint => sub { not $self->check( $_ ) }, display_name => sprintf( "~%s", $self ), ); $opts{display_name} =~ s/^\~{2}//; $opts{inlined} = sub { shift; "not(" . $self->inline_check( @_ ) . ")" } if $self->can_be_inlined; $opts{display_name} = $opts{name} = $self->{complement_name} if $self->{complement_name}; return "Type::Tiny"->new( %opts ); } #/ sub _build_complementary_type sub _instantiate_moose_type { my $self = shift; my %opts = @_; require Moose::Meta::TypeConstraint; return "Moose::Meta::TypeConstraint"->new( %opts ); } sub _build_moose_type { my $self = shift; my $r; if ( $self->{_is_core} ) { require Moose::Util::TypeConstraints; $r = Moose::Util::TypeConstraints::find_type_constraint( $self->name ); $r->{"Types::TypeTiny::to_TypeTiny"} = $self; Scalar::Util::weaken( $r->{"Types::TypeTiny::to_TypeTiny"} ); } else { # Type::Tiny is more flexible than Moose, allowing # inlined to return a list. So we need to wrap the # inlined coderef to make sure Moose gets a single # string. # my $wrapped_inlined = sub { shift; $self->inline_check( @_ ); }; my %opts; $opts{name} = $self->qualified_name if $self->has_library && !$self->is_anon; $opts{parent} = $self->parent->moose_type if $self->has_parent; $opts{constraint} = $self->constraint unless $self->_is_null_constraint; $opts{message} = $self->message if $self->has_message; $opts{inlined} = $wrapped_inlined if $self->has_inlined; $r = $self->_instantiate_moose_type( %opts ); $r->{"Types::TypeTiny::to_TypeTiny"} = $self; $self->{moose_type} = $r; # prevent recursion $r->coercion( $self->coercion->moose_coercion ) if $self->has_coercion; } #/ else [ if ( $self->{_is_core})] return $r; } #/ sub _build_moose_type sub _build_mouse_type { my $self = shift; my %options; $options{name} = $self->qualified_name if $self->has_library && !$self->is_anon; $options{parent} = $self->parent->mouse_type if $self->has_parent; $options{constraint} = $self->constraint unless $self->_is_null_constraint; $options{message} = $self->message if $self->has_message; require Mouse::Meta::TypeConstraint; my $r = "Mouse::Meta::TypeConstraint"->new( %options ); $self->{mouse_type} = $r; # prevent recursion $r->_add_type_coercions( $self->coercion->freeze->_codelike_type_coercion_map( 'mouse_type' ) ) if $self->has_coercion; return $r; } #/ sub _build_mouse_type sub exportables { my ( $self, $base_name, $tag ) = ( shift, @_ ); # $tag is undocumented if ( not $self->is_anon ) { $base_name ||= $self->name; } $tag ||= 0; my @exportables; return \@exportables if ! $base_name; require Eval::TypeTiny; push @exportables, { name => $base_name, code => Eval::TypeTiny::type_to_coderef( $self ), tags => [ 'types' ], } if $tag eq 'types' || !$tag; push @exportables, { name => sprintf( 'is_%s', $base_name ), code => $self->compiled_check, tags => [ 'is' ], } if $tag eq 'is' || !$tag; push @exportables, { name => sprintf( 'assert_%s', $base_name ), code => $self->_overload_coderef, tags => [ 'assert' ], } if $tag eq 'assert' || !$tag; push @exportables, { name => sprintf( 'to_%s', $base_name ), code => $self->has_coercion && $self->coercion->frozen ? $self->coercion->compiled_coercion : sub ($) { $self->coerce( $_[0] ) }, tags => [ 'to' ], } if $tag eq 'to' || !$tag; return \@exportables; } sub exportables_by_tag { my ( $self, $tag, $base_name ) = ( shift, @_ ); my @matched = grep { my $e = $_; grep $_ eq $tag, @{ $e->{tags} || [] }; } @{ $self->exportables( $base_name, $tag ) }; return @matched if wantarray; _croak( 'Expected to find one exportable tagged "%s", found %d', $tag, scalar @matched ) unless @matched == 1; return $matched[0]; } sub _process_coercion_list { my $self = shift; my @pairs; while ( @_ ) { my $next = shift; if ( blessed( $next ) and $next->isa( 'Type::Coercion' ) and $next->is_parameterized ) { push @pairs => ( @{ $next->_reparameterize( $self )->type_coercion_map } ); } elsif ( blessed( $next ) and $next->can( 'type_coercion_map' ) ) { push @pairs => ( @{ $next->type_coercion_map }, ); } elsif ( ref( $next ) eq q(ARRAY) ) { unshift @_, @$next; } else { push @pairs => ( Types::TypeTiny::to_TypeTiny( $next ), shift, ); } } #/ while ( @_ ) return @pairs; } #/ sub _process_coercion_list sub plus_coercions { my $self = shift; my $new = $self->_clone; $new->coercion->add_type_coercions( $self->_process_coercion_list( @_ ), @{ $self->coercion->type_coercion_map }, ); $new->coercion->freeze; return $new; } #/ sub plus_coercions sub plus_fallback_coercions { my $self = shift; my $new = $self->_clone; $new->coercion->add_type_coercions( @{ $self->coercion->type_coercion_map }, $self->_process_coercion_list( @_ ), ); $new->coercion->freeze; return $new; } #/ sub plus_fallback_coercions sub minus_coercions { my $self = shift; my $new = $self->_clone; my @not = grep Types::TypeTiny::is_TypeTiny( $_ ), $self->_process_coercion_list( $new, @_ ); my @keep; my $c = $self->coercion->type_coercion_map; for ( my $i = 0 ; $i <= $#$c ; $i += 2 ) { my $keep_this = 1; NOT: for my $n ( @not ) { if ( $c->[$i] == $n ) { $keep_this = 0; last NOT; } } push @keep, $c->[$i], $c->[ $i + 1 ] if $keep_this; } #/ for ( my $i = 0 ; $i <=...) $new->coercion->add_type_coercions( @keep ); $new->coercion->freeze; return $new; } #/ sub minus_coercions sub no_coercions { my $new = shift->_clone; $new->coercion->freeze; $new; } sub coercibles { my $self = shift; $self->has_coercion ? $self->coercion->_source_type_union : $self; } sub isa { my $self = shift; if ( $INC{"Moose/Meta/TypeConstraint.pm"} and ref( $self ) and $_[0] =~ /^(?:Class::MOP|MooseX?::Meta)::(.+)$/ ) { my $meta = $1; return !!1 if $meta eq 'TypeConstraint'; return $self->is_parameterized if $meta eq 'TypeConstraint::Parameterized'; return $self->is_parameterizable if $meta eq 'TypeConstraint::Parameterizable'; return $self->isa( 'Type::Tiny::Union' ) if $meta eq 'TypeConstraint::Union'; my $inflate = $self->moose_type; return $inflate->isa( @_ ); } #/ if ( $INC{"Moose/Meta/TypeConstraint.pm"} ...) if ( $INC{"Mouse.pm"} and ref( $self ) and $_[0] eq 'Mouse::Meta::TypeConstraint' ) { return !!1; } $self->SUPER::isa( @_ ); } #/ sub isa sub _build_my_methods { return {}; } sub _lookup_my_method { my $self = shift; my ( $name ) = @_; if ( $self->my_methods->{$name} ) { return $self->my_methods->{$name}; } if ( $self->has_parent ) { return $self->parent->_lookup_my_method( @_ ); } return; } #/ sub _lookup_my_method my %object_methods = ( with_attribute_values => 1, stringifies_to => 1, numifies_to => 1 ); my $re_list_methods = qr/\A(?:(?:a(?:ll|ny|ssert_a(?:ll|ny))|first|grep|map|rsort|sort))\z/; sub can { my $self = shift; return !!0 if $_[0] eq 'type_parameter' && blessed( $_[0] ) && $_[0]->has_parameters; my $can = $self->SUPER::can( @_ ); return $can if $can; if ( ref( $self ) ) { if ( $_[0] =~ /\Amy_(.+)\z/ ) { my $method = $self->_lookup_my_method( $1 ); return $method if $method; } if ( $self->{is_object} && $object_methods{ $_[0] } ) { require Type::Tiny::ConstrainedObject; return Type::Tiny::ConstrainedObject->can( $_[0] ); } if ( $_[0] =~ $re_list_methods ) { my $util = $_[0]; $self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) }; return unless $self->{'_util'}{$util}; return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) }; } if ( $INC{"Moose/Meta/TypeConstraint.pm"} ) { my $method = $self->moose_type->can( @_ ); return sub { shift->moose_type->$method( @_ ) } if $method; } } #/ if ( ref( $self ) ) return; } #/ sub can sub AUTOLOAD { my $self = shift; my ( $m ) = ( our $AUTOLOAD =~ /::(\w+)$/ ); return if $m eq 'DESTROY'; if ( ref( $self ) ) { if ( $m =~ /\Amy_(.+)\z/ ) { my $method = $self->_lookup_my_method( $1 ); return &$method( $self, @_ ) if $method; } if ( $self->{is_object} && $object_methods{$m} ) { require Type::Tiny::ConstrainedObject; unshift @_, $self; no strict 'refs'; goto \&{"Type::Tiny::ConstrainedObject::$m"}; } if ( $m =~ $re_list_methods ) { return ( $self->{'_util'}{$m} ||= $self->_build_util( $m ) )->( @_ ); } if ( $INC{"Moose/Meta/TypeConstraint.pm"} ) { my $method = $self->moose_type->can( $m ); return $self->moose_type->$method( @_ ) if $method; } } #/ if ( ref( $self ) ) _croak q[Can't locate object method "%s" via package "%s"], $m, ref( $self ) || $self; } #/ sub AUTOLOAD sub DOES { my $self = shift; return !!1 if ref( $self ) && $_[0] =~ m{^ Type::API::Constraint (?: ::Coercible | ::Inlinable )? $}x; return !!1 if !ref( $self ) && $_[0] eq 'Type::API::Constraint::Constructor'; "UNIVERSAL"->can( "DOES" ) ? $self->SUPER::DOES( @_ ) : $self->isa( @_ ); } #/ sub DOES sub _has_xsub { require B; !!B::svref_2object( shift->compiled_check )->XSUB; } sub _build_util { my ( $self, $func ) = @_; Scalar::Util::weaken( my $type = $self ); if ( $func eq 'grep' || $func eq 'first' || $func eq 'any' || $func eq 'all' || $func eq 'assert_any' || $func eq 'assert_all' ) { my ( $inline, $compiled ); if ( $self->can_be_inlined ) { $inline = $self->inline_check( '$_' ); } else { $compiled = $self->compiled_check; $inline = '$compiled->($_)'; } if ( $func eq 'grep' ) { return eval "sub { grep { $inline } \@_ }"; } elsif ( $func eq 'first' ) { return eval "sub { for (\@_) { return \$_ if ($inline) }; undef; }"; } elsif ( $func eq 'any' ) { return eval "sub { for (\@_) { return !!1 if ($inline) }; !!0; }"; } elsif ( $func eq 'assert_any' ) { my $qname = B::perlstring( $self->name ); return eval "sub { for (\@_) { return \@_ if ($inline) }; Type::Tiny::_failed_check(\$type, $qname, \@_ ? \$_[-1] : undef); }"; } elsif ( $func eq 'all' ) { return eval "sub { for (\@_) { return !!0 unless ($inline) }; !!1; }"; } elsif ( $func eq 'assert_all' ) { my $qname = B::perlstring( $self->name ); return eval "sub { my \$idx = 0; for (\@_) { Type::Tiny::_failed_check(\$type, $qname, \$_, varname => sprintf('\$_[%d]', \$idx)) unless ($inline); ++\$idx }; \@_; }"; } } #/ if ( $func eq 'grep' ||...) if ( $func eq 'map' ) { my ( $inline, $compiled ); my $c = $self->_assert_coercion; if ( $c->can_be_inlined ) { $inline = $c->inline_coercion( '$_' ); } else { $compiled = $c->compiled_coercion; $inline = '$compiled->($_)'; } return eval "sub { map { $inline } \@_ }"; } #/ if ( $func eq 'map' ) if ( $func eq 'sort' || $func eq 'rsort' ) { my ( $inline, $compiled ); my $ptype = $self->find_parent( sub { $_->has_sorter } ); _croak "No sorter for this type constraint" unless $ptype; my $sorter = $ptype->sorter; # Schwarzian transformation if ( ref( $sorter ) eq 'ARRAY' ) { my $sort_key; ( $sorter, $sort_key ) = @$sorter; if ( $func eq 'sort' ) { return eval "our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$a->[1],\$b->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; } elsif ( $func eq 'rsort' ) { return eval "our (\$a, \$b); sub { map \$_->[0], sort { \$sorter->(\$b->[1],\$a->[1]) } map [\$_,\$sort_key->(\$_)], \@_ }"; } } #/ if ( ref( $sorter ) eq...) # Simple sort else { if ( $func eq 'sort' ) { return eval "our (\$a, \$b); sub { sort { \$sorter->(\$a,\$b) } \@_ }"; } elsif ( $func eq 'rsort' ) { return eval "our (\$a, \$b); sub { sort { \$sorter->(\$b,\$a) } \@_ }"; } } } #/ if ( $func eq 'sort' ||...) die "Unknown function: $func"; } #/ sub _build_util sub of { shift->parameterize( @_ ) } sub where { shift->create_child_type( constraint => @_ ) } # fill out Moose-compatible API sub inline_environment { +{} } sub _inline_check { shift->inline_check( @_ ) } sub _compiled_type_constraint { shift->compiled_check( @_ ) } sub meta { _croak( "Not really a Moose::Meta::TypeConstraint. Sorry!" ) } sub compile_type_constraint { shift->compiled_check } sub _actually_compile_type_constraint { shift->_build_compiled_check } sub hand_optimized_type_constraint { shift->{hand_optimized_type_constraint} } sub has_hand_optimized_type_constraint { exists( shift->{hand_optimized_type_constraint} ); } sub type_parameter { ( shift->parameters || [] )->[0] } sub parameterized_from { $_[0]->is_parameterized ? shift->parent : _croak( "Not a parameterized type" ); } sub has_parameterized_from { $_[0]->is_parameterized } # some stuff for Mouse-compatible API sub __is_parameterized { shift->is_parameterized( @_ ) } sub _add_type_coercions { shift->coercion->add_type_coercions( @_ ) } sub _as_string { shift->qualified_name( @_ ) } sub _compiled_type_coercion { shift->coercion->compiled_coercion( @_ ) } sub _identity { Scalar::Util::refaddr( shift ) } sub _unite { require Type::Tiny::Union; "Type::Tiny::Union"->new( type_constraints => \@_ ); } # Hooks for Type::Tie sub TIESCALAR { require Type::Tie; unshift @_, 'Type::Tie::SCALAR'; goto \&Type::Tie::SCALAR::TIESCALAR; } sub TIEARRAY { require Type::Tie; unshift @_, 'Type::Tie::ARRAY'; goto \&Type::Tie::ARRAY::TIEARRAY; } sub TIEHASH { require Type::Tie; unshift @_, 'Type::Tie::HASH'; goto \&Type::Tie::HASH::TIEHASH; } 1; __END__ =pod =encoding utf-8 =for stopwords Moo(se)-compatible MooseX MouseX MooX Moose-compat invocant =head1 NAME Type::Tiny - tiny, yet Moo(se)-compatible type constraint =head1 SYNOPSIS use v5.36; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef Object ); use Type::Params qw( signature_for ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, required => 1, ); has gender => ( is => 'ro', isa => Enum[qw( f m )], ); has age => ( is => 'rw', isa => Int->where( '$_ >= 0' ), ); has children => ( is => 'ro', isa => ArrayRef[Object], default => sub { return [] }, ); # method signature signature_for add_child => ( method => Object, positional => [ Object ], ); sub add_child ( $self, $child ) { push $self->children->@*, $child; return $self; } } package main; my $boldruler = Horse->new( name => "Bold Ruler", gender => 'm', age => 16, ); my $secretariat = Horse->new( name => "Secretariat", gender => 'm', age => 0, ); $boldruler->add_child( $secretariat ); =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This documents the internals of the L class. L is a better starting place if you're new. L is a small class for creating Moose-like type constraint objects which are compatible with Moo, Moose and Mouse. use Scalar::Util qw(looks_like_number); use Type::Tiny; my $NUM = "Type::Tiny"->new( name => "Number", constraint => sub { looks_like_number($_) }, message => sub { "$_ ain't a number" }, ); package Ermintrude { use Moo; has favourite_number => (is => "ro", isa => $NUM); } package Bullwinkle { use Moose; has favourite_number => (is => "ro", isa => $NUM); } package Maisy { use Mouse; has favourite_number => (is => "ro", isa => $NUM); } Type::Tiny conforms to L, L, L, and L. Maybe now we won't need to have separate MooseX, MouseX and MooX versions of everything? We can but hope... =head2 Constructor =over =item C<< new(%attributes) >> Moose-style constructor function. =back =head2 Attributes Attributes are named values that may be passed to the constructor. For each attribute, there is a corresponding reader method. For example: my $type = Type::Tiny->new( name => "Foo" ); print $type->name, "\n"; # says "Foo" =head3 Important attributes These are the attributes you are likely to be most interested in providing when creating your own type constraints, and most interested in reading when dealing with type constraint objects. =over =item C<< constraint >> Coderef to validate a value (C<< $_ >>) against the type constraint. The coderef will not be called unless the value is known to pass any parent type constraint (see C below). Alternatively, a string of Perl code checking C<< $_ >> can be passed as a parameter to the constructor, and will be converted to a coderef. Defaults to C<< sub { 1 } >> - i.e. a coderef that passes all values. =item C<< parent >> Optional attribute; parent type constraint. For example, an "Integer" type constraint might have a parent "Number". If provided, must be a Type::Tiny object. =item C<< inlined >> A coderef which returns a string of Perl code suitable for inlining this type. Optional. (The coderef will be called in list context and can actually return a list of strings which will be joined with C<< && >>. If the first item on the list is undef, it will be substituted with the type's parent's inline check.) If C (above) is a coderef generated via L, then Type::Tiny I be able to automatically generate C for you. If C (above) is a string, it will be able to. =item C<< name >> The name of the type constraint. These need to conform to certain naming rules (they must begin with an uppercase letter and continue using only letters, digits 0-9 and underscores). Optional; if not supplied will be an anonymous type constraint. =item C<< display_name >> A name to display for the type constraint when stringified. These don't have to conform to any naming rules. Optional; a default name will be calculated from the C. =item C<< library >> The package name of the type library this type is associated with. Optional. Informational only: setting this attribute does not install the type into the package. =item C<< deprecated >> Optional boolean indicating whether a type constraint is deprecated. L will issue a warning if you attempt to import a deprecated type constraint, but otherwise the type will continue to function as normal. There will not be deprecation warnings every time you validate a value, for instance. If omitted, defaults to the parent's deprecation status (or false if there's no parent). =item C<< message >> Coderef that returns an error message when C<< $_ >> does not validate against the type constraint. Optional (there's a vaguely sensible default.) =item C<< coercion >> A L object associated with this type. Generally speaking this attribute should not be passed to the constructor; you should rely on the default lazily-built coercion object. You may pass C<< coercion => 1 >> to the constructor to inherit coercions from the constraint's parent. (This requires the parent constraint to have a coercion.) If an arrayref is passed to the constructor (C<< coercion => [ ... ] >>), then the coercion object will be lazily built and this array will be fed to its C method. If a coderef is passed to the constructor (C<< coercion => sub { ... } >>), then the coercion object will be lazily built and this code will be used as a coercion from B. =item C<< sorter >> A coderef which can be passed two values conforming to this type constraint and returns -1, 0, or 1 to put them in order. Alternatively an arrayref containing a pair of coderefs — a sorter and a pre-processor for the Schwarzian transform. Optional. The idea is to allow for: @sorted = Int->sort( 2, 1, 11 ); # => 1, 2, 11 @sorted = Str->sort( 2, 1, 11 ); # => 1, 11, 2 =item C<< type_default >> A coderef which returns a sensible default value for this type. For example, for a B type, a sensible default might be "0": my $Size = Type::Tiny->new( name => 'Size', parent => Types::Standard::Enum[ qw( XS S M L XL ) ], type_default => sub { return 'M'; }, ); package Tshirt { use Moo; has size => ( is => 'ro', isa => $Size, default => $Size->type_default, ); } Child types will inherit a type default from their parent unless the child has a C. If a type neither has nor inherits a type default, then calling C will return undef. As a special case, this: $type->type_default( @args ) Will return: sub { local $_ = \@args; $type->type_default->( @_ ); } Many of the types defined in L and other bundled type libraries have type defaults, but discovering them is left as an exercise for the reader. =item C<< my_methods >> Experimental hashref of additional methods that can be called on the type constraint object. =item C<< exception_class >> The class used to throw an exception when a value fails its type check. Defaults to "Error::TypeTiny::Assertion", which is usually good. This class is expected to provide a C method compatible with the method of that name in L. If a parent type constraint has a custom C, then this will be "inherited" by its children. =back =head3 Attributes related to parameterizable and parameterized types The following additional attributes are used for parameterizable (e.g. C) and parameterized (e.g. C<< ArrayRef[Int] >>) type constraints. Unlike Moose, these aren't handled by separate subclasses. =over =item C<< constraint_generator >> Coderef that is called when a type constraint is parameterized. When called, it is passed the list of parameters, though any parameter which looks like a foreign type constraint (Moose type constraints, Mouse type constraints, etc, I<< and coderefs(!!!) >>) is first coerced to a native Type::Tiny object. Note that for compatibility with the Moose API, the base type is I passed to the constraint generator, but can be found in the package variable C<< $Type::Tiny::parameterize_type >>. The first parameter is also available as C<< $_ >>. Types I be parameterized with an empty parameter list. For example, in L, C is just an alias for C but C<< Tuple[] >> will only allow zero-length arrayrefs to pass the constraint. If you wish C<< YourType >> and C<< YourType[] >> to mean the same thing, then do: return $Type::Tiny::parameterize_type unless @_; The constraint generator should generate and return a new constraint coderef based on the parameters. Alternatively, the constraint generator can return a fully-formed Type::Tiny object, in which case the C, C, and C attributes documented below are ignored. Optional; providing a generator makes this type into a parameterizable type constraint. If there is no generator, attempting to parameterize the type constraint will throw an exception. =item C<< name_generator >> A coderef which generates a new display_name based on parameters. Called with the same parameters and package variables as the C. Expected to return a string. Optional; the default is reasonable. =item C<< inline_generator >> A coderef which generates a new inlining coderef based on parameters. Called with the same parameters and package variables as the C. Expected to return a coderef. Optional. =item C<< coercion_generator >> A coderef which generates a new L object based on parameters. It is passed the parent type, child type, and list of parameters. It should have access to the same package variables as the C. Expected to return a blessed object. Optional. =item C<< deep_explanation >> This API is not finalized. Coderef used by L to peek inside parameterized types and figure out why a value doesn't pass the constraint. =item C<< parameters >> In parameterized types, returns an arrayref of the parameters. =back =head3 Lazy generated attributes The following attributes should not be usually passed to the constructor; unless you're doing something especially unusual, you should rely on the default lazily-built return values. =over =item C<< compiled_check >> Coderef to validate a value (C<< $_[0] >>) against the type constraint. This coderef is expected to also handle all validation for the parent type constraints. =item C<< definition_context >> Hashref of information indicating where the type constraint was originally defined. Type::Tiny will generate this based on C if you do not supply it. The hashref will ordinarily contain keys C<"package">, C<"file">, and C<"line">. For parameterized types and compound types (e.g. unions and intersections), this may not be especially meaningful information. =item C<< complementary_type >> A complementary type for this type. For example, the complementary type for an integer type would be all things that are not integers, including floating point numbers, but also alphabetic strings, arrayrefs, filehandles, etc. =item C<< moose_type >>, C<< mouse_type >> Objects equivalent to this type constraint, but as a L or L. It should rarely be necessary to obtain a L object from L because the L object itself should be usable pretty much anywhere a L is expected. =back =head2 Methods =head3 Predicate methods These methods return booleans indicating information about the type constraint. They are each tightly associated with a particular attribute. (See L.) =over =item C, C, C, C, C, C, C, C, C, C Simple Moose-style predicate methods indicating the presence or absence of an attribute. =item C Predicate method with a little extra DWIM. Returns false if the coercion is a no-op. =item C<< is_anon >> Returns true iff the type constraint does not have a C. =item C<< is_parameterized >>, C<< is_parameterizable >> Indicates whether a type has been parameterized (e.g. C<< ArrayRef[Int] >>) or could potentially be (e.g. C<< ArrayRef >>). =item C<< has_parameterized_from >> Useless alias for C. =back =head3 Validation and coercion The following methods are used for coercing and validating values against a type constraint: =over =item C<< check($value) >> Returns true iff the value passes the type constraint. =item C<< validate($value) >> Returns the error message for the value; returns an explicit undef if the value passes the type constraint. =item C<< assert_valid($value) >> Like C<< check($value) >> but dies if the value does not pass the type constraint. Yes, that's three very similar methods. Blame L whose API I'm attempting to emulate. :-) =item C<< assert_return($value) >> Like C<< assert_valid($value) >> but returns the value if it passes the type constraint. This seems a more useful behaviour than C<< assert_valid($value) >>. I would have just changed C<< assert_valid($value) >> to do this, except that there are edge cases where it could break Moose compatibility. =item C<< get_message($value) >> Returns the error message for the value; even if the value passes the type constraint. =item C<< validate_explain($value, $varname) >> Like C but instead of a string error message, returns an arrayref of strings explaining the reasoning why the value does not meet the type constraint, examining parent types, etc. The C<< $varname >> is an optional string like C<< '$foo' >> indicating the name of the variable being checked. =item C<< coerce($value) >> Attempt to coerce C<< $value >> to this type. =item C<< assert_coerce($value) >> Attempt to coerce C<< $value >> to this type. Throws an exception if this is not possible. =back =head3 Child type constraint creation and parameterization These methods generate new type constraint objects that inherit from the constraint they are called upon: =over =item C<< create_child_type(%attributes) >> Construct a new Type::Tiny object with this object as its parent. =item C<< where($coderef) >> Shortcut for creating an anonymous child type constraint. Use it like C<< HashRef->where(sub { exists($_->{name}) }) >>. That said, you can get a similar result using overloaded C<< & >>: HashRef & sub { exists($_->{name}) } Like the C<< constraint >> attribute, this will accept a string of Perl code: HashRef->where('exists($_->{name})') =item C<< child_type_class >> The class that create_child_type will construct by default. =item C<< parameterize(@parameters) >> Creates a new parameterized type; throws an exception if called on a non-parameterizable type. =item C<< of(@parameters) >> A cute alias for C. Use it like C<< ArrayRef->of(Int) >>. =item C<< plus_coercions($type1, $code1, ...) >> Shorthand for creating a new child type constraint with the same coercions as this one, but then adding some extra coercions (at a higher priority than the existing ones). =item C<< plus_fallback_coercions($type1, $code1, ...) >> Like C, but added at a lower priority. =item C<< minus_coercions($type1, ...) >> Shorthand for creating a new child type constraint with fewer type coercions. =item C<< no_coercions >> Shorthand for creating a new child type constraint with no coercions at all. =back =head3 Type relationship introspection methods These methods allow you to determine a type constraint's relationship to other type constraints in an organised hierarchy: =over =item C<< equals($other) >>, C<< is_subtype_of($other) >>, C<< is_supertype_of($other) >>, C<< is_a_type_of($other) >> Compare two types. See L for what these all mean. (OK, Moose doesn't define C, but you get the idea, right?) Note that these have a slightly DWIM side to them. If you create two L objects which test the same class, they're considered equal. And: my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; $subtype_of_Int->is_subtype_of( $subtype_of_Num ); # true =item C<< strictly_equals($other) >>, C<< is_strictly_subtype_of($other) >>, C<< is_strictly_supertype_of($other) >>, C<< is_strictly_a_type_of($other) >> Stricter versions of the type comparison functions. These only care about explicit inheritance via C. my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; $subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num ); # false =item C<< parents >> Returns a list of all this type constraint's ancestor constraints. For example, if called on the C type constraint would return the list C<< (Value, Defined, Item, Any) >>. I<< Due to a historical misunderstanding, this differs from the Moose implementation of the C method. In Moose, C only returns the immediate parent type constraints, and because type constraints only have one immediate parent, this is effectively an alias for C. The extension module L is the only place where multiple type constraints are returned; and they are returned as an arrayref in violation of the base class' documentation. I'm keeping my behaviour as it seems more useful. >> =item C<< find_parent($coderef) >> Loops through the parent type constraints I<< including the invocant itself >> and returns the nearest ancestor type constraint where the coderef evaluates to true. Within the coderef the ancestor currently being checked is C<< $_ >>. Returns undef if there is no match. In list context also returns the number of type constraints which had been looped through before the matching constraint was found. =item C<< find_constraining_type >> Finds the nearest ancestor type constraint (including the type itself) which has a C coderef. Equivalent to: $type->find_parent(sub { not $_->_is_null_constraint }) =item C<< coercibles >> Return a type constraint which is the union of type constraints that can be coerced to this one (including this one). If this type constraint has no coercions, returns itself. =item C<< type_parameter >> In parameterized type constraints, returns the first item on the list of parameters; otherwise returns undef. For example: ( ArrayRef[Int] )->type_parameter; # returns Int ( ArrayRef[Int] )->parent; # returns ArrayRef Note that parameterizable type constraints can perfectly legitimately take multiple parameters (several of the parameterizable type constraints in L do). This method only returns the first such parameter. L documents the C attribute, which returns an arrayref of all the parameters. =item C<< parameterized_from >> Harder to spell alias for C that only works for parameterized types. =back I<< Hint for people subclassing Type::Tiny: >> Since version 1.006000, the methods for determining subtype, supertype, and type equality should I be overridden in subclasses of Type::Tiny. This is because of the problem of diamond inheritance. If X and Y are both subclasses of Type::Tiny, they I need to be consulted to figure out how type constraints are related; not just one of them should be overriding these methods. See the source code for L for an example of how subclasses can give hints about type relationships to Type::Tiny. Summary: push a coderef onto C<< @Type::Tiny::CMP >>. This coderef will be passed two type constraints. It should then return one of the constants Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type), Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type), Type::Tiny::CMP_EQUAL (the two types are exactly the same), Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or Type::Tiny::CMP_UNKNOWN (your coderef couldn't establish any relationship). =head3 Type relationship introspection function =over =item C<< Type::Tiny::cmp($type1, $type2) >> The subtype/supertype relationship between types results in a partial ordering of type constraints. This function will return one of the constants: Type::Tiny::CMP_SUBTYPE (first type is a subtype of second type), Type::Tiny::CMP_SUPERTYPE (second type is a subtype of first type), Type::Tiny::CMP_EQUAL (the two types are exactly the same), Type::Tiny::CMP_EQUIVALENT (the two types are effectively the same), or Type::Tiny::CMP_UNKNOWN (couldn't establish any relationship). In numeric contexts, these evaluate to -1, 1, 0, 0, and 0, making it potentially usable with C (though you may need to silence warnings about treating the empty string as a numeric value). =back =head3 List processing methods =over =item C<< grep(@list) >> Filters a list to return just the items that pass the type check. @integers = Int->grep(@list); =item C<< first(@list) >> Filters the list to return the first item on the list that passes the type check, or undef if none do. $first_lady = Woman->first(@people); =item C<< map(@list) >> Coerces a list of items. Only works on types which have a coercion. @truths = Bool->map(@list); =item C<< sort(@list) >> Sorts a list of items according to the type's preferred sorting mechanism, or if the type doesn't have a sorter coderef, uses the parent type. If no ancestor type constraint has a sorter, throws an exception. The C, C, C, and C type constraints include sorters. @sorted_numbers = Num->sort( Num->grep(@list) ); =item C<< rsort(@list) >> Like C but backwards. =item C<< any(@list) >> Returns true if any of the list match the type. if ( Int->any(@numbers) ) { say "there was at least one integer"; } =item C<< all(@list) >> Returns true if all of the list match the type. if ( Int->all(@numbers) ) { say "they were all integers"; } =item C<< assert_any(@list) >> Like C but instead of returning a boolean, returns the entire original list if any item on it matches the type, and dies if none does. =item C<< assert_all(@list) >> Like C but instead of returning a boolean, returns the original list if all items on it match the type, but dies as soon as it finds one that does not. =back =head3 Inlining methods =for stopwords uated The following methods are used to generate strings of Perl code which may be pasted into stringy Cuated subs to perform type checks: =over =item C<< can_be_inlined >> Returns boolean indicating if this type can be inlined. =item C<< inline_check($varname) >> Creates a type constraint check for a particular variable as a string of Perl code. For example: print( Types::Standard::Num->inline_check('$foo') ); prints the following output: (!ref($foo) && Scalar::Util::looks_like_number($foo)) For Moose-compat, there is an alias C<< _inline_check >> for this method. =item C<< inline_assert($varname) >> Much like C but outputs a statement of the form: ... or die ...; Can also be called line C<< inline_assert($varname, $typevarname, %extras) >>. In this case, it will generate a string of code that may include C<< $typevarname >> which is supposed to be the name of a variable holding the type itself. (This is kinda complicated, but it allows a useful string to still be produced if the type is not inlineable.) The C<< %extras >> are additional options to be passed to L's constructor and must be key-value pairs of strings only, no references or undefs. =back =head3 Other methods =over =item C<< qualified_name >> For non-anonymous type constraints that have a library, returns a qualified C<< "MyLib::MyType" >> sort of name. Otherwise, returns the same as C. =item C<< isa($class) >>, C<< can($method) >>, C<< AUTOLOAD(@args) >> If Moose is loaded, then the combination of these methods is used to mock a Moose::Meta::TypeConstraint. If Mouse is loaded, then C mocks Mouse::Meta::TypeConstraint. =item C<< DOES($role) >> Overridden to advertise support for various roles. See also L, etc. =item C<< TIESCALAR >>, C<< TIEARRAY >>, C<< TIEHASH >> These are provided as hooks that wrap L. They allow the following to work: use Types::Standard qw(Int); tie my @list, Int; push @list, 123, 456; # ok push @list, "Hello"; # dies =item C<< exportables( $base_name ) >> Returns a list of the functions a type library should export if it contains this type constraint. Example: [ { name => 'Int', tags => [ 'types' ], code => sub { ... } }, { name => 'is_Int', tags => [ 'is' ], code => sub { ... } }, { name => 'assert_Int', tags => [ 'assert' ], code => sub { ... } }, { name => 'to_Int', tags => [ 'to' ], code => sub { ... } }, ] C<< $base_name >> is optional, but allows you to get a list of exportables using a specific name. This is useful if the type constraint has a name which wouldn't be a legal Perl function name. =item C<< exportables_by_tag( $tag, $base_name ) >> Filters C by a specific tag name. In list context, returns all matching exportables. In scalar context returns a single matching exportable and dies if multiple exportables match, or none do! =back The following methods exist for Moose/Mouse compatibility, but do not do anything useful. =over =item C<< compile_type_constraint >> =item C<< hand_optimized_type_constraint >> =item C<< has_hand_optimized_type_constraint >> =item C<< inline_environment >> =item C<< meta >> =back =head2 Functions =over =item * C<< check_parameter_count_for_parameterized_type( $lib, $typename, $args, $max, $min ) >> Utility function used by some types from Types::Standard, etc. Will throw a L exception referencing C<< "$lib::\$typename\[]" >> if C<< $args >> is greater than C<< $max >> or less than C<< $min >>, if they're defined. If C<< $args >> is an arrayref, will use the length of the array. =back =head2 Overloading =over =item * Stringification is overloaded to return the qualified name. =item * Boolification is overloaded to always return true. =item * Coderefification is overloaded to call C. =item * On Perl 5.10.1 and above, smart match is overloaded to call C. =item * The C<< == >> operator is overloaded to call C. =item * The C<< < >> and C<< > >> operators are overloaded to call C and C. =item * The C<< ~ >> operator is overloaded to call C. =item * The C<< | >> operator is overloaded to build a union of two type constraints. See L. =item * The C<< & >> operator is overloaded to build the intersection of two type constraints. See L. =item * The C<< / >> operator provides magical L support. If C<< $ENV{PERL_STRICT} >> (or a few other environment variables) is true, then it returns the left operand. Normally it returns the right operand. =back Previous versions of Type::Tiny would overload the C<< + >> operator to call C or C as appropriate. Support for this was dropped after 0.040. =head2 Constants =over =item C<< Type::Tiny::SUPPORT_SMARTMATCH >> Indicates whether the smart match overload is supported on your version of Perl. =back =head2 Package Variables =over =item C<< $Type::Tiny::DD >> This undef by default but may be set to a coderef that Type::Tiny and related modules will use to dump data structures in things like error messages. Otherwise Type::Tiny uses it's own routine to dump data structures. C<< $DD >> may then be set to a number to limit the lengths of the dumps. (Default limit is 72.) This is a package variable (rather than get/set class methods) to allow for easy localization. =item C<< $Type::Tiny::AvoidCallbacks >> If this variable is set to true (you should usually do it in a C scope), it acts as a hint for type constraints, when generating inlined code, to avoid making any callbacks to variables and functions defined outside the inlined code itself. This should have the effect that C<< $type->inline_check('$foo') >> will return a string of code capable of checking the type on Perl installations that don't have Type::Tiny installed. This is intended to allow Type::Tiny to be used with things like L. The variable works on the honour system. Types need to explicitly check it and decide to generate different code based on its truth value. The bundled types in L, L, and L all do. (B is sometimes unable to, and will issue a warning if it needs to rely on callbacks when asked not to.) Most normal users can ignore this. =item C<< $Type::Tiny::SafePackage >> This is the string "package Type::Tiny;" which is sometimes inserted into strings of inlined code to avoid namespace clashes. In most cases, you do not need to change this. However, if you are inlining type constraint code, saving that code into Perl modules, and uploading them to CPAN, you may wish to change it to avoid problems with the CPAN indexer. Most normal users of Type::Tiny do not need to be aware of this. =back =head2 Environment =over =item C Currently this has more effect on L than Type::Tiny. In future it may be used to trigger or suppress the loading XS implementations of parts of Type::Tiny. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L. L, L, L, L. L, L, L, L, L, L. L, L. L. L, L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 THANKS Thanks to Matt S Trout for advice on L integration. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Utils.pm000664001750001750 7531315111656240 15571 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typepackage Type::Utils; use 5.008001; use strict; use warnings; BEGIN { $Type::Utils::AUTHORITY = 'cpan:TOBYINK'; $Type::Utils::VERSION = '2.008006'; } $Type::Utils::VERSION =~ tr/_//d; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Scalar::Util qw< blessed >; use Type::Library; use Type::Tiny; use Types::TypeTiny qw< TypeTiny is_TypeTiny to_TypeTiny HashLike StringLike >; our @EXPORT = qw< declare as where message inline_as class_type role_type duck_type union intersection enum coerce from via declare_coercion to_type >; our @EXPORT_OK = ( @EXPORT, qw< extends type subtype match_on_type compile_match_on_type dwim_type english_list classifier assert >, "is", ); our %EXPORT_TAGS = ( default => [@EXPORT], all => [@EXPORT_OK], ); pop @{ $EXPORT_TAGS{all} }; # remove 'is' require Exporter::Tiny; our @ISA = 'Exporter::Tiny'; sub extends { _croak "Not a type library" unless caller->isa( "Type::Library" ); my $caller = caller->meta; foreach my $lib ( @_ ) { eval "use $lib; 1" or _croak "Could not load library '$lib': $@"; if ( $lib->isa( "Type::Library" ) or $lib eq 'Types::TypeTiny' ) { $caller->add_type( $lib->get_type( $_ ) ) for sort $lib->meta->type_names; $caller->add_coercion( $lib->get_coercion( $_ ) ) for sort $lib->meta->coercion_names; } elsif ( $lib->isa( 'MooseX::Types::Base' ) ) { require Moose::Util::TypeConstraints; my $types = $lib->type_storage; for my $name ( sort keys %$types ) { my $moose = Moose::Util::TypeConstraints::find_type_constraint( $types->{$name} ); my $tt = Types::TypeTiny::to_TypeTiny( $moose ); my $c = $moose->has_coercion && @{ $moose->coercion->type_coercion_map || [] }; $caller->add_type( $tt->create_child_type( library => $caller, name => $name, coercion => $c ? 1 : 0 ) ); } #/ for my $name ( sort keys...) } #/ elsif ( $lib->isa( 'MooseX::Types::Base'...)) elsif ( $lib->isa( 'MouseX::Types::Base' ) ) { require Mouse::Util::TypeConstraints; my $types = $lib->type_storage; for my $name ( sort keys %$types ) { my $mouse = Mouse::Util::TypeConstraints::find_type_constraint( $types->{$name} ); my $tt = Types::TypeTiny::to_TypeTiny( $mouse ); $caller->add_type( $tt->create_child_type( library => $caller, name => $name, coercion => $mouse->has_coercion ? 1 : 0 ) ); } #/ for my $name ( sort keys...) } #/ elsif ( $lib->isa( 'MouseX::Types::Base'...)) elsif ( $lib->isa( 'Specio::Exporter' ) ) { my $types = $lib->Specio::Registry::exportable_types_for_package; for my $name ( sort keys %$types ) { my $specio = $types->{$name}; my $tt = Types::TypeTiny::to_TypeTiny( $specio ); $caller->add_type( $tt->create_child_type( library => $caller, name => $name ) ); } } elsif ( $lib->isa( 'Exporter' ) and my $types = do { no strict 'refs'; ${"$lib\::EXPORT_TAGS"}{'types'} } ) { for my $name ( @$types ) { my $obj = $lib->$name; my $tt = Types::TypeTiny::to_TypeTiny( $obj ); $caller->add_type( $tt->create_child_type( library => $caller, name => $name ) ); } } else { _croak( "'$lib' is not a type constraint library" ); } } #/ foreach my $lib ( @_ ) } #/ sub extends sub declare { my %opts; if ( @_ % 2 == 0 ) { %opts = @_; if ( @_ == 2 and $_[0] =~ /^_*[A-Z]/ and $_[1] =~ /^[0-9]+$/ ) { require Carp; Carp::carp( "Possible missing comma after 'declare $_[0]'" ); } } else { ( my ( $name ), %opts ) = @_; _croak "Cannot provide two names for type" if exists $opts{name}; $opts{name} = $name; } my $caller = caller( $opts{_caller_level} || 0 ); $opts{library} = $caller; if ( defined $opts{parent} ) { $opts{parent} = to_TypeTiny( $opts{parent} ); unless ( is_TypeTiny( $opts{parent} ) ) { $caller->isa( "Type::Library" ) or _croak( "Parent type cannot be a %s", ref( $opts{parent} ) || 'non-reference scalar' ); $opts{parent} = $caller->meta->get_type( $opts{parent} ) or _croak( "Could not find parent type" ); } } #/ if ( defined $opts{parent...}) my $type; if ( defined $opts{parent} ) { $type = delete( $opts{parent} )->create_child_type( %opts ); } else { my $bless = delete( $opts{bless} ) || "Type::Tiny"; eval "require $bless"; $type = $bless->new( %opts ); } if ( not $type->is_anon ) { $caller->meta->add_type( $type ) if $caller->isa( 'Type::Library' ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $opts{name} ) : ( $Type::Registry::DELAYED{$caller}{$opts{name}} = $type ); } return $type; } #/ sub declare *subtype = \&declare; *type = \&declare; sub as (@) { parent => @_; } sub where (&;@) { constraint => @_; } sub message (&;@) { message => @_; } sub inline_as (&;@) { inlined => @_; } sub class_type { my $name = ref( $_[0] ) eq 'HASH' ? undef : shift; my %opts = %{ shift or {} }; if ( defined $name ) { $opts{name} = $name unless exists $opts{name}; $opts{class} = $name unless exists $opts{class}; $opts{name} =~ s/:://g; } $opts{bless} = "Type::Tiny::Class"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub class_type sub role_type { my $name = ref( $_[0] ) eq 'HASH' ? undef : shift; my %opts = %{ shift or {} }; if ( defined $name ) { $opts{name} = $name unless exists $opts{name}; $opts{role} = $name unless exists $opts{role}; $opts{name} =~ s/:://g; } $opts{bless} = "Type::Tiny::Role"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub role_type sub duck_type { my $name = ref( $_[0] ) eq 'ARRAY' ? undef : shift; my @methods = @{ shift or [] }; my %opts; $opts{name} = $name if defined $name; $opts{methods} = \@methods; $opts{bless} = "Type::Tiny::Duck"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub duck_type sub enum { my $name = ref( $_[0] ) eq 'ARRAY' ? undef : shift; my @values = @{ shift or [] }; my %opts; $opts{name} = $name if defined $name; $opts{values} = \@values; $opts{bless} = "Type::Tiny::Enum"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub enum sub union { my $name = ref( $_[0] ) eq 'ARRAY' ? undef : shift; my @tcs = @{ shift or [] }; my %opts; $opts{name} = $name if defined $name; $opts{type_constraints} = \@tcs; $opts{bless} = "Type::Tiny::Union"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub union sub intersection { my $name = ref( $_[0] ) eq 'ARRAY' ? undef : shift; my @tcs = @{ shift or [] }; my %opts; $opts{name} = $name if defined $name; $opts{type_constraints} = \@tcs; $opts{bless} = "Type::Tiny::Intersection"; { no warnings "numeric"; $opts{_caller_level}++ } declare( %opts ); } #/ sub intersection sub declare_coercion { my %opts; $opts{name} = shift if !ref( $_[0] ); # I don't like this; it is a hack if ( ref( $_[0] ) eq 'Type::Tiny::_DeclaredType' ) { $opts{name} = '' . shift; } while ( Types::TypeTiny::is_HashLike( $_[0] ) and not is_TypeTiny( $_[0] ) ) { %opts = ( %opts, %{ +shift } ); } my $caller = caller( $opts{_caller_level} || 0 ); $opts{library} = $caller; my $bless = delete( $opts{bless} ) || "Type::Coercion"; eval "require $bless"; my $c = $bless->new( %opts ); my @C; if ( $caller->isa( "Type::Library" ) ) { my $meta = $caller->meta; $meta->add_coercion( $c ) unless $c->is_anon; while ( @_ ) { push @C, map { ref( $_ ) ? to_TypeTiny( $_ ) : $meta->get_type( $_ ) || $_ } shift; push @C, shift; } } else { @C = @_; } $c->add_type_coercions( @C ); return $c->freeze; } #/ sub declare_coercion sub coerce { if ( ( scalar caller )->isa( "Type::Library" ) ) { my $meta = ( scalar caller )->meta; my ( $type ) = map { ref( $_ ) ? to_TypeTiny( $_ ) : $meta->get_type( $_ ) || $_ } shift; my @opts; while ( @_ ) { push @opts, map { ref( $_ ) ? to_TypeTiny( $_ ) : $meta->get_type( $_ ) || $_ } shift; push @opts, shift; } return $type->coercion->add_type_coercions( @opts ); } #/ if ( ( scalar caller )...) my ( $type, @opts ) = @_; $type = to_TypeTiny( $type ); return $type->coercion->add_type_coercions( @opts ); } #/ sub coerce sub from (@) { return @_; } sub to_type (@) { my $type = shift; unless ( is_TypeTiny( $type ) ) { caller->isa( "Type::Library" ) or _croak "Target type cannot be a string"; $type = caller->meta->get_type( $type ) or _croak "Could not find target type"; } return +{ type_constraint => $type }, @_; } #/ sub to_type (@) sub via (&;@) { return @_; } sub match_on_type { my $value = shift; while ( @_ ) { my $code; if ( @_ == 1 ) { $code = shift; } else { ( my ( $type ), $code ) = splice( @_, 0, 2 ); Types::TypeTiny::assert_TypeTiny( $type )->check( $value ) or next; } if ( Types::TypeTiny::is_StringLike( $code ) ) { local $_ = $value; if ( wantarray ) { my @r = eval "$code"; die $@ if $@; return @r; } if ( defined wantarray ) { my $r = eval "$code"; die $@ if $@; return $r; } eval "$code"; die $@ if $@; return; } #/ if ( Types::TypeTiny::is_StringLike...) else { Types::TypeTiny::assert_CodeLike( $code ); local $_ = $value; return $code->( $value ); } } #/ while ( @_ ) _croak( "No cases matched for %s", Type::Tiny::_dd( $value ) ); } #/ sub match_on_type sub compile_match_on_type { require Eval::TypeTiny::CodeAccumulator; my $coderef = 'Eval::TypeTiny::CodeAccumulator'->new( description => 'compiled match', ); $coderef->add_line( 'sub {' ); $coderef->increase_indent; $coderef->add_line( 'local $_ = $_[0];' ); my $els = ''; while ( @_ ) { my ( $type, $code ); if ( @_ == 1 ) { require Types::Standard; ( $type, $code ) = ( Types::Standard::Any(), shift ); } else { ( $type, $code ) = splice( @_, 0, 2 ); Types::TypeTiny::assert_TypeTiny( $type ); } if ( $type->can_be_inlined ) { $coderef->add_line( sprintf( '%sif ( %s ) {', $els, $type->inline_check( '$_' ), ) ); } else { my $varname = $coderef->add_variable( '$type', \$type ); $coderef->add_line( sprintf( '%sif ( %s->check($_) ) {', $els, $varname, ) ); } $coderef->increase_indent; $els = 'els'; if ( Types::TypeTiny::is_StringLike( $code ) ) { $coderef->add_line( $code ); } else { Types::TypeTiny::assert_CodeLike( $code ); my $varname = $coderef->add_variable( '$action', \$code ); $coderef->add_line( sprintf( '%s->( @_ )', $varname, ) ); } $coderef->decrease_indent; $coderef->add_line( '}' ); } #/ while ( @_ ) $coderef->add_line( 'else {' ); $coderef->increase_indent; $coderef->add_line( 'Type::Utils::_croak( "No cases matched for %s", Type::Tiny::_dd( $_ ) );' ); $coderef->decrease_indent; $coderef->add_line( '}' ); $coderef->decrease_indent; $coderef->add_line( '}' ); return $coderef->compile; } #/ sub compile_match_on_type sub classifier { my $i; compile_match_on_type( +( map { my $type = $_->[0]; $type => sub { $type }; } sort { $b->[1] <=> $a->[1] or $a->[2] <=> $b->[2] } map [ $_, scalar( my @parents = $_->parents ), ++$i ], @_ ), q[ undef ], ); } #/ sub classifier { package #hide Type::Registry::DWIM; our @ISA = qw(Type::Registry); sub foreign_lookup { my $self = shift; my $r = $self->SUPER::foreign_lookup( @_ ); return $r if $r; if ( my $assume = $self->{"~~assume"} and $_[0] =~ /[A-Z_a-z][0-9A-Z_a-z]*(?:::[0-9A-Z_a-z]+)*/ ) { my @methods = ref( $assume ) ? @$assume : $assume; for my $method ( @methods ) { $r = $self->$method( @_ ); return $r if $r; } } #/ if ( my $assume = $self...) return; } #/ sub foreign_lookup sub lookup_via_moose { my $self = shift; if ( $INC{'Moose/Meta/TypeConstraint.pm'} ) { require Moose::Util::TypeConstraints; require Types::TypeTiny; my $r = Moose::Util::TypeConstraints::find_type_constraint( $_[0] ); return Types::TypeTiny::to_TypeTiny( $r ) if defined $r; } return; } #/ sub lookup_via_moose sub lookup_via_mouse { my $self = shift; if ( $INC{'Mouse.pm'} ) { require Mouse::Util::TypeConstraints; require Types::TypeTiny; my $r = Mouse::Util::TypeConstraints::find_type_constraint( $_[0] ); return Types::TypeTiny::to_TypeTiny( $r ) if defined $r; } return; } #/ sub lookup_via_mouse sub simple_lookup { my $self = shift; my $r; # If the lookup is chained to a class, then the class' own # type registry gets first refusal. # if ( defined $self->{"~~chained"} ) { my $chained = "Type::Registry"->for_class( $self->{"~~chained"} ); $r = eval { $chained->simple_lookup( @_ ) } unless $self == $chained; return $r if defined $r; } # Fall back to types in Types::Standard. require Types::Standard; return 'Types::Standard'->get_type( $_[0] ) if 'Types::Standard'->has_type( $_[0] ); # Only continue any further if we've been called from Type::Parser. return unless $_[1]; my $meta; if ( defined $self->{"~~chained"} ) { $meta ||= Moose::Util::find_meta( $self->{"~~chained"} ) if $INC{'Moose/Util.pm'}; $meta ||= Mouse::Util::find_meta( $self->{"~~chained"} ) if $INC{'Mouse.pm'}; } if ( $meta and $meta->isa( 'Class::MOP::Module' ) ) { $r = $self->lookup_via_moose( @_ ); return $r if $r; } elsif ( $meta and $meta->isa( 'Mouse::Meta::Module' ) ) { $r = $self->lookup_via_mouse( @_ ); return $r if $r; } return $self->foreign_lookup( @_ ); } #/ sub simple_lookup } our $dwimmer; sub dwim_type { my ( $string, %opts ) = @_; $opts{for} = caller unless defined $opts{for}; $dwimmer ||= do { require Type::Registry; 'Type::Registry::DWIM'->new; }; local $dwimmer->{'~~chained'} = $opts{for}; local $dwimmer->{'~~assume'} = $opts{fallback} || [ qw/ lookup_via_moose lookup_via_mouse /, $opts{does} ? 'make_role_type' : 'make_class_type', ]; local $@ = undef; my $type; unless ( eval { $type = $dwimmer->lookup( $string ); 1 } ) { my $e = $@; die( $e ) unless $e =~ /not a known type constraint/; } $type; } #/ sub dwim_type my $TEMPLATE = <<'SUBTEMPLATE'; sub SUBNAME { require Types::TypeTiny; no warnings 'uninitialized'; my ($type, $value) = @_; my $caller = caller; my $uniq = Types::TypeTiny::is_TypeTiny($type) ? $type->{uniq} : "$type"; if (not Types::TypeTiny::is_TypeTiny $type) { my $orig = $type; $type = $is_cache{$caller}{$uniq} || do { Types::TypeTiny::is_StringLike($type) ? eval { dwim_type("$type", for => $caller) } : undef; }; if (blessed $type) { $is_cache{$caller}{$uniq} ||= $type; } else { my $thing = Type::Tiny::_dd($orig); substr($thing, 0, 1) = lc substr($thing, 0, 1); require Carp; FAILURE } } my $check = ( $is_cache_coderef{$caller}{$uniq} ||= $type->compiled_check ); BODY } SUBTEMPLATE my %is_cache; my %is_cache_coderef; { my $code = $TEMPLATE; $code =~ s/SUBNAME/is/g; $code =~ s/FAILURE/Carp::carp("Expected type, but got \$thing; returning false"); return undef;/g; $code =~ s/BODY/0+!! \$check->(\$value)/; eval $code; } { my $code = $TEMPLATE; $code =~ s/SUBNAME/assert/g; $code =~ s/FAILURE/Carp::croak("Expected type, but got \$thing; stopping"); return undef;/g; $code =~ s/BODY/\$check->(\$value) ? \$value : \$type->_failed_check("\$type", \$value)/; eval $code; } sub english_list { my $conjunction = ref( $_[0] ) eq 'SCALAR' ? ${ +shift } : 'and'; my @items = sort @_; return $items[0] if @items == 1; return "$items[0] $conjunction $items[1]" if @items == 2; my $tail = pop @items; join( ', ', @items, "$conjunction $tail" ); } #/ sub english_list 1; __END__ =pod =encoding utf-8 =for stopwords smush smushed =head1 NAME Type::Utils - utility functions to make defining and using type constraints a little easier =head1 SYNOPSIS package Types::Mine; use Type::Library -base; use Type::Utils -all; BEGIN { extends "Types::Standard" }; declare "AllCaps", as "Str", where { uc($_) eq $_ }, inline_as { my $varname = $_[1]; "uc($varname) eq $varname" }; coerce "AllCaps", from "Str", via { uc($_) }; =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This module provides utility functions to make defining and using type constraints a little easier. =head2 Type declaration functions Many of the following are similar to the similarly named functions described in L. =over =item C<< declare $name, %options >> =item C<< declare %options >> Declare a named or anonymous type constraint. Use C and C to specify the parent type (if any) and (possibly) refine its definition. declare EvenInt, as Int, where { $_ % 2 == 0 }; my $EvenInt = declare as Int, where { $_ % 2 == 0 }; I<< NOTE: >> Named types will be automatically added to the caller's type registry. (See L.) If the caller package inherits from L named types will also be automatically installed into the library and made available as exports. Hidden gem: if you're inheriting from a type constraint that includes some coercions, you can include C<< coercion => 1 >> in the C<< %options >> hash to inherit the coercions. =item C<< subtype $name, %options >> =item C<< subtype %options >> Declare a named or anonymous type constraint which is descended from an existing type constraint. Use C and C to specify the parent type and refine its definition. Actually, you should use C instead; this is just an alias. This function is not exported by default. =item C<< type $name, %options >> =item C<< type %options >> Declare a named or anonymous type constraint which is not descended from an existing type constraint. Use C to provide a coderef that constrains values. Actually, you should use C instead; this is just an alias. This function is not exported by default. =item C<< as $parent >> Used with C to specify a parent type constraint: declare EvenInt, as Int, where { $_ % 2 == 0 }; =item C<< where { BLOCK } >> Used with C to provide the constraint coderef: declare EvenInt, as Int, where { $_ % 2 == 0 }; The coderef operates on C<< $_ >>, which is the value being tested. =item C<< message { BLOCK } >> Generate a custom error message when a value fails validation. declare EvenInt, as Int, where { $_ % 2 == 0 }, message { Int->validate($_) or "$_ is not divisible by two"; }; Without a custom message, the messages generated by Type::Tiny are along the lines of I<< Value "33" did not pass type constraint "EvenInt" >>, which is usually reasonable. =item C<< inline_as { BLOCK } >> Generate a string of Perl code that can be used to inline the type check into other functions. If your type check is being used within a L or L constructor or accessor methods, or used by L, this can lead to significant performance improvements. declare EvenInt, as Int, where { $_ % 2 == 0 }, inline_as { my ($constraint, $varname) = @_; my $perlcode = $constraint->parent->inline_check($varname) . "&& ($varname % 2 == 0)"; return $perlcode; }; warn EvenInt->inline_check('$xxx'); # demonstration Your C block can return a list, in which case these will be smushed together with "&&". The first item on the list may be undef, in which case the undef will be replaced by the inlined parent type constraint. (And will throw an exception if there is no parent.) declare EvenInt, as Int, where { $_ % 2 == 0 }, inline_as { return (undef, "($_ % 2 == 0)"); }; =item C<< class_type $name, { class => $package, %options } >> =item C<< class_type { class => $package, %options } >> =item C<< class_type $name >> Shortcut for declaring a L type constraint. If C<< $package >> is omitted, is assumed to be the same as C<< $name >>. If C<< $name >> contains "::" (which would be an invalid name as far as L is concerned), this will be removed. So for example, C<< class_type("Foo::Bar") >> declares a L type constraint named "FooBar" which constrains values to objects blessed into the "Foo::Bar" package. =item C<< role_type $name, { role => $package, %options } >> =item C<< role_type { role => $package, %options } >> =item C<< role_type $name >> Shortcut for declaring a L type constraint. If C<< $package >> is omitted, is assumed to be the same as C<< $name >>. If C<< $name >> contains "::" (which would be an invalid name as far as L is concerned), this will be removed. =item C<< duck_type $name, \@methods >> =item C<< duck_type \@methods >> Shortcut for declaring a L type constraint. =item C<< union $name, \@constraints >> =item C<< union \@constraints >> Shortcut for declaring a L type constraint. =item C<< enum $name, \@values >> =item C<< enum \@values >> Shortcut for declaring a L type constraint. =item C<< intersection $name, \@constraints >> =item C<< intersection \@constraints >> Shortcut for declaring a L type constraint. =back =head2 Coercion declaration functions Many of the following are similar to the similarly named functions described in L. =over =item C<< coerce $target, @coercions >> Add coercions to the target type constraint. The list of coercions is a list of type constraint, conversion code pairs. Conversion code can be either a string of Perl code or a coderef; in either case the value to be converted is C<< $_ >>. =item C<< from $source >> Sugar to specify a type constraint in a list of coercions: coerce EvenInt, from Int, via { $_ * 2 }; # As a coderef... coerce EvenInt, from Int, q { $_ * 2 }; # or as a string! =item C<< via { BLOCK } >> Sugar to specify a coderef in a list of coercions. =item C<< declare_coercion $name, \%opts, $type1, $code1, ... >> =item C<< declare_coercion \%opts, $type1, $code1, ... >> Declares a coercion that is not explicitly attached to any type in the library. For example: declare_coercion "ArrayRefFromAny", from "Any", via { [$_] }; This coercion will be exportable from the library as a L object, but the ArrayRef type exported by the library won't automatically use it. Coercions declared this way are immutable (frozen). =item C<< to_type $type >> Used with C to declare the target type constraint for a coercion, but still without explicitly attaching the coercion to the type constraint: declare_coercion "ArrayRefFromAny", to_type "ArrayRef", from "Any", via { [$_] }; You should pretty much always use this when declaring an unattached coercion because it's exceedingly useful for a type coercion to know what it will coerce to - this allows it to skip coercion when no coercion is needed (e.g. avoiding coercing C<< [] >> to C<< [ [] ] >>) and allows C to work properly. =back =head2 Type library management =over =item C<< extends @libraries >> Indicates that this type library extends other type libraries, importing their type constraints. Should usually be executed in a C<< BEGIN >> block. This is not exported by default because it's not fun to export it to Moo, Moose or Mouse classes! C<< use Type::Utils -all >> can be used to import it into your type library. =back =head2 Other =over =item C<< match_on_type $value => ($type => \&action, ..., \&default?) >> Something like a C/C or C/C construct. Dispatches along different code paths depending on the type of the incoming value. Example blatantly stolen from the Moose documentation: sub to_json { my $value = shift; return match_on_type $value => ( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ '.( join ", " => map { to_json($_) } @$array ).' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); } Note that unlike Moose, code can be specified as a string instead of a coderef. (e.g. for C, C and C above.) For improved performance, try C. This function is not exported by default. =item C<< my $coderef = compile_match_on_type($type => \&action, ..., \&default?) >> Compile a C block into a coderef. The following JSON converter is about two orders of magnitude faster than the previous example: sub to_json; *to_json = compile_match_on_type( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ '.( join ", " => map { to_json($_) } @$array ).' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, => sub { die "$_ is not acceptable json type" }, ); Remember to store the coderef somewhere fairly permanent so that you don't compile it over and over. C variables (in Perl >= 5.10) are good for this. (Same sort of idea as L.) This function is not exported by default. =item C<< my $coderef = classifier(@types) >> Returns a coderef that can be used to classify values according to their type constraint. The coderef, when passed a value, returns a type constraint which the value satisfies. use feature qw( say ); use Type::Utils qw( classifier ); use Types::Standard qw( Int Num Str Any ); my $classifier = classifier(Str, Int, Num, Any); say $classifier->( "42" )->name; # Int say $classifier->( "4.2" )->name; # Num say $classifier->( [] )->name; # Any Note that, for example, "42" satisfies Int, but it would satisfy the type constraints Num, Str, and Any as well. In this case, the classifier has picked the most specific type constraint that "42" satisfies. If no type constraint is satisfied by the value, then the classifier will return undef. =item C<< dwim_type($string, %options) >> Given a string like "ArrayRef[Int|CodeRef]", turns it into a type constraint object, hopefully doing what you mean. It uses the syntax of L. Firstly the L for the caller package is consulted; if that doesn't have a match, L is consulted for standard type constraint names. If none of the above yields a type constraint, and the caller class is a Moose-based class, then C attempts to look the type constraint up in the Moose type registry. If it's a Mouse-based class, then the Mouse type registry is used instead. If no type constraint can be found via these normal methods, several fallbacks are available: =over =item C Lookup in Moose registry even if caller is non-Moose class. =item C Lookup in Mouse registry even if caller is non-Mouse class. =item C Create a new Type::Tiny::Class constraint. =item C Create a new Type::Tiny::Role constraint. =back You can alter which should be attempted, and in which order, by passing an option to C: my $type = Type::Utils::dwim_type( "ArrayRef[Int]", fallback => [ "lookup_via_mouse" , "make_role_type" ], ); For historical reasons, by default the fallbacks attempted are: lookup_via_moose, lookup_via_mouse, make_class_type You may set C to an empty arrayref to avoid using any of these fallbacks. You can specify an alternative for the caller using the C option. my $type = dwim_type("ArrayRef", for => "Moose::Object"); While it's probably better overall to use the proper L interface for resolving type constraint strings, this function often does what you want. It should never die if it fails to find a type constraint (but may die if the type constraint string is syntactically malformed), preferring to return undef. This function is not exported by default. =item C<< is($type, $value) >> Shortcut for C<< $type->check($value) >> but also if $type is a string, will look it up via C. This function is not exported by default. This function is not even exported by C<< use Type::Utils -all >>. You must request it explicitly. use Type::Utils "is"; Beware using this in test scripts because it has the same name as a function exported by L. Note that you can rename this function if C will cause conflicts: use Type::Utils "is" => { -as => "isntnt" }; =item C<< assert($type, $value) >> Like C but instead of returning a boolean, returns C<< $value >> and dies if the value fails the type check. This function is not exported by default, but it is exported by C<< use Type::Utils -all >>. =item C<< english_list(\$conjunction, @items) >> Joins the items with commas, placing a conjunction before the final item. The conjunction is optional, defaulting to "and". english_list(qw/foo bar baz/); # "foo, bar, and baz" english_list(\"or", qw/quux quuux/); # "quux or quuux" This function is not exported by default. =back =head1 EXPORT By default, all of the functions documented above are exported, except C and C (prefer C instead), C, C, C/C, C, and C. This module uses L; see the documentation of that module for tips and tricks importing from Type::Utils. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. L, L, L, L, L. L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Common.pm000664001750001750 515215111656240 16056 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typespackage Types::Common; use 5.008001; use strict; use warnings; BEGIN { eval { require re }; if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Types::Common::AUTHORITY = 'cpan:TOBYINK'; $Types::Common::VERSION = '2.008006'; } our ( @EXPORT, @EXPORT_OK, %EXPORT_TAGS ); use Type::Library -extends => [ qw( Types::Standard Types::Common::Numeric Types::Common::String Types::TypeTiny ) ]; use Type::Params -sigs; $EXPORT_TAGS{sigs} = $Type::Params::EXPORT_TAGS{sigs}; push @EXPORT_OK, @{ $EXPORT_TAGS{sigs} }; sub _generate_t { my $package = shift; require Type::Registry; my $t = 'Type::Registry'->_generate_t( @_ ); $t->()->add_types( $package ); return $t; } push @EXPORT_OK, 't'; __PACKAGE__->meta->make_immutable; __END__ =pod =encoding utf-8 =for stopwords arrayfication hashification =head1 NAME Types::Common - the one stop shop =head1 STATUS This module is covered by the L. =head1 PLANNED FUTURE CHANGES In the future, this module may also export C and C. =head1 DESCRIPTION Types::Common doesn't provide any types or functions of its own. Instead it's a single module that re-exports: =over =item * All the types from L. =item * All the types from L and L. =item * All the types from L. =item * The C<< -sigs >> tag from L. =item * The C<< t() >> function from L. =back If you import C<< t() >>, it will also be preloaded with all the type constraints offered by Types::Common. =head1 EXPORT C<< use Types::Common qw( -types -sigs t ) >> might be a sensible place to start. C<< use Types::Common -all >> gives you everything. If you have Perl 5.37.2+, then C<< use Types::Common qw( -lexical -all ) >> won't pollute your namespace. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L; L; L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Standard.pm000664001750001750 13525715111656240 16440 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typespackage Types::Standard; use 5.008001; use strict; use warnings; BEGIN { eval { require re }; if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Types::Standard::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::VERSION = '2.008006'; } $Types::Standard::VERSION =~ tr/_//d; use Type::Library -base; our @EXPORT_OK = qw( slurpy ); use Eval::TypeTiny qw( set_subname ); use Scalar::Util qw( blessed looks_like_number ); use Type::Tiny (); use Types::TypeTiny (); my $is_class_loaded; BEGIN { $is_class_loaded = q{sub { no strict 'refs'; return !!0 if ref $_[0]; return !!0 if not $_[0]; return !!0 if ref(do { my $tmpstr = $_[0]; \$tmpstr }) ne 'SCALAR'; my $stash = \%{"$_[0]\::"}; return !!1 if exists($stash->{'ISA'}) && *{$stash->{'ISA'}}{ARRAY} && @{$_[0].'::ISA'}; return !!1 if exists($stash->{'VERSION'}); foreach my $globref (values %$stash) { return !!1 if ref \$globref eq 'GLOB' ? *{$globref}{CODE} : ref $globref; # const or sub ref } return !!0; }}; *_is_class_loaded = Type::Tiny::_USE_XS ? \&Type::Tiny::XS::Util::is_class_loaded : eval $is_class_loaded; *_HAS_REFUTILXS = eval { require Ref::Util::XS; Ref::Util::XS::->VERSION( 0.100 ); 1; } ? sub () { !!1 } : sub () { !!0 }; } #/ BEGIN my $add_core_type = sub { my $meta = shift; my ( $typedef ) = @_; my $name = $typedef->{name}; my ( $xsub, $xsubname ); # We want Map and Tuple to be XSified, even if they're not # really core. $typedef->{_is_core} = 1 unless $name eq 'Map' || $name eq 'Tuple'; if ( Type::Tiny::_USE_XS and not( $name eq 'RegexpRef' ) ) { $xsub = Type::Tiny::XS::get_coderef_for( $name ); $xsubname = Type::Tiny::XS::get_subname_for( $name ); } elsif ( Type::Tiny::_USE_MOUSE and not( $name eq 'RegexpRef' or $name eq 'Int' or $name eq 'Object' ) ) { require Mouse::Util::TypeConstraints; $xsub = "Mouse::Util::TypeConstraints"->can( $name ); $xsubname = "Mouse::Util::TypeConstraints::$name" if $xsub; } if ( Type::Tiny::_USE_XS and Type::Tiny::XS->VERSION < 0.014 and $name eq 'Bool' ) { # Broken implementation of Bool $xsub = $xsubname = undef; } if ( Type::Tiny::_USE_XS and ( Type::Tiny::XS->VERSION < 0.016 or $] < 5.018 ) and $name eq 'Int' ) { # Broken implementation of Int $xsub = $xsubname = undef; } if ( Type::Tiny::_USE_XS and $name eq 'Int' and do { use Config (); $Config::Config{usequadmath} } ) { # Broken implementation of Int $xsub = $xsubname = undef; } $typedef->{compiled_type_constraint} = $xsub if $xsub; my $orig_inlined = $typedef->{inlined}; if ( defined( $xsubname ) and ( # These should be faster than their normal inlined # equivalents $name eq 'Str' or $name eq 'Bool' or $name eq 'Int' or $name eq 'ClassName' or $name eq 'RegexpRef' or $name eq 'FileHandle' ) ) { $typedef->{inlined} = sub { $Type::Tiny::AvoidCallbacks ? goto( $orig_inlined ) : "$xsubname\($_[1])"; }; } #/ if ( defined( $xsubname...)) @_ = ( $meta, $typedef ); goto \&Type::Library::add_type; }; my $maybe_load_modules = sub { my $code = pop; if ( $Type::Tiny::AvoidCallbacks ) { $code = sprintf( 'do { %s %s; %s }', $Type::Tiny::SafePackage, join( '; ', map "use $_ ()", @_ ), $code, ); } $code; }; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } my $meta = __PACKAGE__->meta; # Stringable and LazyLoad are optimizations that complicate # this module somewhat, but they have led to performance # improvements. If Types::Standard wasn't such a key type # library, I wouldn't use them. I strongly discourage anybody # from using them in their own code. If you're looking for # examples of how to write a type library sanely, you're # better off looking at the code for Types::Common::Numeric # and Types::Common::String. { sub Stringable (&) { bless +{ code => $_[0] }, 'Types::Standard::_Stringable'; } Types::Standard::_Stringable->Type::Tiny::_install_overloads( q[""] => sub { $_[0]{text} ||= $_[0]{code}->() } ); sub LazyLoad ($$) { bless \@_, 'Types::Standard::LazyLoad'; } 'Types::Standard::LazyLoad'->Type::Tiny::_install_overloads( q[&{}] => sub { my ( $typename, $function ) = @{ $_[0] }; my $type = $meta->get_type( $typename ); my $class = "Types::Standard::$typename"; eval "require $class; 1" or die( $@ ); # Majorly break encapsulation for Type::Tiny :-O for my $key ( keys %$type ) { next unless ref( $type->{$key} ) eq 'Types::Standard::LazyLoad'; my $f = $type->{$key}[1]; $type->{$key} = $class->can( "__$f" ); } my $mm = $type->{my_methods} || {}; for my $key ( keys %$mm ) { next unless ref( $mm->{$key} ) eq 'Types::Standard::LazyLoad'; my $f = $mm->{$key}[1]; $mm->{$key} = $class->can( "__$f" ); set_subname( sprintf( "%s::my_%s", $type->qualified_name, $key ), $mm->{$key}, ); } #/ for my $key ( keys %$mm) return $class->can( "__$function" ); }, ); } no warnings; BEGIN { *STRICTNUM = $ENV{PERL_TYPES_STANDARD_STRICTNUM} ? sub() { !!1 } : sub() { !!0 } } my $_any = $meta->$add_core_type( { name => "Any", inlined => sub { "!!1" }, complement_name => 'None', type_default => sub { return undef; }, } ); my $_item = $meta->$add_core_type( { name => "Item", inlined => sub { "!!1" }, parent => $_any, } ); my $_bool = $meta->$add_core_type( { name => "Bool", parent => $_item, constraint => sub { !ref $_ and ( !defined $_ or $_ eq q() or $_ eq '0' or $_ eq '1' ); }, inlined => sub { "!ref $_[1] and (!defined $_[1] or $_[1] eq q() or $_[1] eq '0' or $_[1] eq '1')"; }, type_default => sub { return !!0; }, } ); $_bool->coercion->add_type_coercions( $_any, q{!!$_} ); my $_undef = $meta->$add_core_type( { name => "Undef", parent => $_item, constraint => sub { !defined $_ }, inlined => sub { "!defined($_[1])" }, type_default => sub { return undef; }, } ); my $_def = $meta->$add_core_type( { name => "Defined", parent => $_item, constraint => sub { defined $_ }, inlined => sub { "defined($_[1])" }, complementary_type => $_undef, } ); # hackish, but eh Scalar::Util::weaken( $_undef->{complementary_type} ||= $_def ); my $_val = $meta->$add_core_type( { name => "Value", parent => $_def, constraint => sub { not ref $_ }, inlined => sub { "defined($_[1]) and not ref($_[1])" }, } ); my $_str = $meta->$add_core_type( { name => "Str", parent => $_val, constraint => sub { ref( \$_ ) eq 'SCALAR' or ref( \( my $val = $_ ) ) eq 'SCALAR'; }, inlined => sub { "defined($_[1]) and do { ref(\\$_[1]) eq 'SCALAR' or ref(\\(my \$val = $_[1])) eq 'SCALAR' }"; }, sorter => sub { $_[0] cmp $_[1] }, type_default => sub { return ''; }, } ); my $_laxnum = $meta->add_type( { name => "LaxNum", parent => $_str, constraint => sub { looks_like_number( $_ ) and ref( \$_ ) ne 'GLOB' }, inlined => sub { $maybe_load_modules->( qw/ Scalar::Util /, 'Scalar::Util'->VERSION ge '1.18' # RT 132426 ? "defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1])" : "defined($_[1]) && !ref($_[1]) && Scalar::Util::looks_like_number($_[1]) && ref(\\($_[1])) ne 'GLOB'" ); }, sorter => sub { $_[0] <=> $_[1] }, type_default => sub { return 0; }, } ); my $_strictnum = $meta->add_type( { name => "StrictNum", parent => $_str, constraint => sub { my $val = $_; ( $val =~ /\A[+-]?[0-9]+\z/ ) || ( $val =~ /\A(?:[+-]?) #matches optional +- in the beginning (?=[0-9]|\.[0-9]) #matches previous +- only if there is something like 3 or .3 [0-9]* #matches 0-9 zero or more times (?:\.[0-9]+)? #matches optional .89 or nothing (?:[Ee](?:[+-]?[0-9]+))? #matches E1 or e1 or e-1 or e+1 etc \z/x ); }, inlined => sub { 'my $val = ' . $_[1] . ';' . Value()->inline_check( '$val' ) . ' && ( $val =~ /\A[+-]?[0-9]+\z/ || ' . '$val =~ /\A(?:[+-]?) # matches optional +- in the beginning (?=[0-9]|\.[0-9]) # matches previous +- only if there is something like 3 or .3 [0-9]* # matches 0-9 zero or more times (?:\.[0-9]+)? # matches optional .89 or nothing (?:[Ee](?:[+-]?[0-9]+))? # matches E1 or e1 or e-1 or e+1 etc \z/x ); ' }, sorter => sub { $_[0] <=> $_[1] }, type_default => sub { return 0; }, } ); my $_num = $meta->add_type( { name => "Num", parent => ( STRICTNUM ? $_strictnum : $_laxnum ), } ); $meta->$add_core_type( { name => "Int", parent => $_num, constraint => sub { /\A-?[0-9]+\z/ }, inlined => sub { "do { my \$tmp = $_[1]; defined(\$tmp) and !ref(\$tmp) and \$tmp =~ /\\A-?[0-9]+\\z/ }"; }, type_default => sub { return 0; }, } ); my $_classn = $meta->add_type( { name => "ClassName", parent => $_str, constraint => \&_is_class_loaded, inlined => sub { $Type::Tiny::AvoidCallbacks ? "($is_class_loaded)->(do { my \$tmp = $_[1] })" : "Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] })"; }, } ); $meta->add_type( { name => "RoleName", parent => $_classn, constraint => sub { not $_->can( "new" ) }, inlined => sub { $Type::Tiny::AvoidCallbacks ? "($is_class_loaded)->(do { my \$tmp = $_[1] }) and not $_[1]\->can('new')" : "Types::Standard::_is_class_loaded(do { my \$tmp = $_[1] }) and not $_[1]\->can('new')"; }, } ); my $_ref = $meta->$add_core_type( { name => "Ref", parent => $_def, constraint => sub { ref $_ }, inlined => sub { "!!ref($_[1])" }, constraint_generator => sub { return $meta->get_type( 'Ref' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Ref', \@_, 1 ); my $reftype = shift; $reftype =~ /^(SCALAR|ARRAY|HASH|CODE|REF|GLOB|LVALUE|FORMAT|IO|VSTRING|REGEXP|Regexp)$/i or _croak( "Parameter to Ref[`a] expected to be a Perl ref type; got $reftype" ); $reftype = "$reftype"; return sub { ref( $_[0] ) and Scalar::Util::reftype( $_[0] ) eq $reftype; } }, inline_generator => sub { my $reftype = shift; return sub { my $v = $_[1]; $maybe_load_modules->( qw/ Scalar::Util /, "ref($v) and Scalar::Util::reftype($v) eq q($reftype)" ); }; }, deep_explanation => sub { require B; my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; return if $type->check( $value ); my $reftype = Scalar::Util::reftype( $value ); return [ sprintf( '"%s" constrains reftype(%s) to be equal to %s', $type, $varname, B::perlstring( $param ) ), sprintf( 'reftype(%s) is %s', $varname, defined( $reftype ) ? B::perlstring( $reftype ) : "undef" ), ]; }, } ); $meta->$add_core_type( { name => "CodeRef", parent => $_ref, constraint => sub { ref $_ eq "CODE" }, inlined => sub { _HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks ? "Ref::Util::XS::is_plain_coderef($_[1])" : "ref($_[1]) eq 'CODE'"; }, type_default => sub { return sub {}; }, } ); my $_regexp = $meta->$add_core_type( { name => "RegexpRef", parent => $_ref, constraint => sub { ref( $_ ) && !!re::is_regexp( $_ ) or blessed( $_ ) && $_->isa( 'Regexp' ); }, inlined => sub { my $v = $_[1]; $maybe_load_modules->( qw/ Scalar::Util re /, "ref($v) && !!re::is_regexp($v) or Scalar::Util::blessed($v) && $v\->isa('Regexp')" ); }, type_default => sub { return qr//; }, } ); $meta->$add_core_type( { name => "GlobRef", parent => $_ref, constraint => sub { ref $_ eq "GLOB" }, inlined => sub { _HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks ? "Ref::Util::XS::is_plain_globref($_[1])" : "ref($_[1]) eq 'GLOB'"; }, } ); $meta->$add_core_type( { name => "FileHandle", parent => $_ref, constraint => sub { ( ref( $_ ) && Scalar::Util::openhandle( $_ ) ) or ( blessed( $_ ) && $_->isa( "IO::Handle" ) ); }, inlined => sub { $maybe_load_modules->( qw/ Scalar::Util /, "(ref($_[1]) && Scalar::Util::openhandle($_[1])) " . "or (Scalar::Util::blessed($_[1]) && $_[1]\->isa(\"IO::Handle\"))" ); }, } ); my $_arr = $meta->$add_core_type( { name => "ArrayRef", parent => $_ref, constraint => sub { ref $_ eq "ARRAY" }, inlined => sub { _HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks ? "Ref::Util::XS::is_plain_arrayref($_[1])" : "ref($_[1]) eq 'ARRAY'"; }, constraint_generator => LazyLoad( ArrayRef => 'constraint_generator' ), inline_generator => LazyLoad( ArrayRef => 'inline_generator' ), deep_explanation => LazyLoad( ArrayRef => 'deep_explanation' ), coercion_generator => LazyLoad( ArrayRef => 'coercion_generator' ), type_default => sub { return []; }, type_default_generator => sub { return $Type::Tiny::parameterize_type->type_default if @_ < 2; return undef; }, } ); my $_hash = $meta->$add_core_type( { name => "HashRef", parent => $_ref, constraint => sub { ref $_ eq "HASH" }, inlined => sub { _HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks ? "Ref::Util::XS::is_plain_hashref($_[1])" : "ref($_[1]) eq 'HASH'"; }, constraint_generator => LazyLoad( HashRef => 'constraint_generator' ), inline_generator => LazyLoad( HashRef => 'inline_generator' ), deep_explanation => LazyLoad( HashRef => 'deep_explanation' ), coercion_generator => LazyLoad( HashRef => 'coercion_generator' ), type_default => sub { return {}; }, type_default_generator => sub { return $Type::Tiny::parameterize_type->type_default if @_ < 2; return undef; }, my_methods => { hashref_allows_key => LazyLoad( HashRef => 'hashref_allows_key' ), hashref_allows_value => LazyLoad( HashRef => 'hashref_allows_value' ), }, } ); $meta->$add_core_type( { name => "ScalarRef", parent => $_ref, constraint => sub { ref $_ eq "SCALAR" or ref $_ eq "REF" }, inlined => sub { "ref($_[1]) eq 'SCALAR' or ref($_[1]) eq 'REF'" }, constraint_generator => LazyLoad( ScalarRef => 'constraint_generator' ), inline_generator => LazyLoad( ScalarRef => 'inline_generator' ), deep_explanation => LazyLoad( ScalarRef => 'deep_explanation' ), coercion_generator => LazyLoad( ScalarRef => 'coercion_generator' ), type_default => sub { my $x; return \$x; }, } ); my $_obj = $meta->$add_core_type( { name => "Object", parent => $_ref, constraint => sub { blessed $_ }, inlined => sub { _HAS_REFUTILXS && !$Type::Tiny::AvoidCallbacks ? "Ref::Util::XS::is_blessed_ref($_[1])" : $maybe_load_modules->( 'Scalar::Util', "Scalar::Util::blessed($_[1])" ); }, is_object => 1, } ); $meta->$add_core_type( { name => "Maybe", parent => $_item, constraint_generator => sub { return $meta->get_type( 'Maybe' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Maybe', \@_, 1 ); my $param = Types::TypeTiny::to_TypeTiny( shift ); Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to Maybe[`a] expected to be a type constraint; got $param" ); my $param_compiled_check = $param->compiled_check; my @xsub; if ( Type::Tiny::_USE_XS ) { my $paramname = Type::Tiny::XS::is_known( $param_compiled_check ); push @xsub, Type::Tiny::XS::get_coderef_for( "Maybe[$paramname]" ) if $paramname; } elsif ( Type::Tiny::_USE_MOUSE and $param->_has_xsub ) { require Mouse::Util::TypeConstraints; my $maker = "Mouse::Util::TypeConstraints"->can( "_parameterize_Maybe_for" ); push @xsub, $maker->( $param ) if $maker; } return ( sub { my $value = shift; return !!1 unless defined $value; return $param->check( $value ); }, @xsub, ); }, inline_generator => sub { my $param = shift; my $param_compiled_check = $param->compiled_check; my $xsubname; if ( Type::Tiny::_USE_XS ) { my $paramname = Type::Tiny::XS::is_known( $param_compiled_check ); $xsubname = Type::Tiny::XS::get_subname_for( "Maybe[$paramname]" ); } return unless $param->can_be_inlined; return sub { my $v = $_[1]; return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $param_check = $param->inline_check( $v ); "!defined($v) or $param_check"; }; }, deep_explanation => sub { my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; return [ sprintf( '%s is defined', Type::Tiny::_dd( $value ) ), sprintf( '"%s" constrains the value with "%s" if it is defined', $type, $param ), @{ $param->validate_explain( $value, $varname ) }, ]; }, coercion_generator => sub { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; return $param->coercion; }, type_default => sub { return undef; }, type_default_generator => sub { $_[0]->type_default || $Type::Tiny::parameterize_type->type_default ; }, } ); my $_map = $meta->$add_core_type( { name => "Map", parent => $_hash, constraint_generator => LazyLoad( Map => 'constraint_generator' ), inline_generator => LazyLoad( Map => 'inline_generator' ), deep_explanation => LazyLoad( Map => 'deep_explanation' ), coercion_generator => LazyLoad( Map => 'coercion_generator' ), my_methods => { hashref_allows_key => LazyLoad( Map => 'hashref_allows_key' ), hashref_allows_value => LazyLoad( Map => 'hashref_allows_value' ), }, type_default_generator => sub { return $Type::Tiny::parameterize_type->type_default; }, } ); my $_Optional = $meta->add_type( { name => "Optional", parent => $_item, constraint_generator => sub { return $meta->get_type( 'Optional' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Optional', \@_, 1 ); my $param = Types::TypeTiny::to_TypeTiny( shift ); Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to Optional[`a] expected to be a type constraint; got $param" ); sub { $param->check( $_[0] ) } }, inline_generator => sub { my $param = shift; return unless $param->can_be_inlined; return sub { my $v = $_[1]; $param->inline_check( $v ); }; }, deep_explanation => sub { my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; return [ sprintf( '%s exists', $varname ), sprintf( '"%s" constrains %s with "%s" if it exists', $type, $varname, $param ), @{ $param->validate_explain( $value, $varname ) }, ]; }, coercion_generator => sub { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; return $param->coercion; }, type_default_generator => sub { return $_[0]->type_default; }, } ); my $_slurpy; $_slurpy = $meta->add_type( { name => "Slurpy", slurpy => 1, parent => $_item, constraint_generator => sub { my $self = $_slurpy; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Slurpy', \@_, 1 ); my $param = @_ ? Types::TypeTiny::to_TypeTiny(shift) : $_any; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to Slurpy[`a] expected to be a type constraint; got $param" ); return $self->create_child_type( slurpy => 1, display_name => $self->name_generator->( $self, $param ), parameters => [ $param ], constraint => sub { $param->check( $_[0] ) }, type_default => $param->type_default, _build_coercion => sub { my $coercion = shift; $coercion->add_type_coercions( @{ $param->coercion->type_coercion_map } ) if $param->has_coercion; $coercion->freeze; }, $param->can_be_inlined ? ( inlined => sub { $param->inline_check( $_[1] ) } ) : (), ); }, deep_explanation => sub { my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; return [ sprintf( '%s is slurpy', $varname ), @{ $param->validate_explain( $value, $varname ) }, ]; }, my_methods => { 'unslurpy' => sub { my $self = shift; $self->{_my_unslurpy} ||= $self->find_parent( sub { $_->parent->{uniq} == $_slurpy->{uniq} } )->type_parameter; }, 'slurp_into' => sub { my $self = shift; my $parameters = $self->find_parent( sub { $_->parent->{uniq} == $_slurpy->{uniq} } )->parameters; if ( $parameters->[1] ) { return $parameters->[1]; } my $constraint = $parameters->[0]; return 'HASH' if $constraint->is_a_type_of( HashRef() ) or $constraint->is_a_type_of( Map() ) or $constraint->is_a_type_of( Dict() ); return 'ARRAY'; }, }, } ); sub slurpy { my $t = shift; my $s = $_slurpy->of( $t ); $s->{slurpy} ||= 1; wantarray ? ( $s, @_ ) : $s; } $meta->$add_core_type( { name => "Tuple", parent => $_arr, name_generator => sub { my ( $s, @a ) = @_; sprintf( '%s[%s]', $s, join q[,], @a ); }, constraint_generator => LazyLoad( Tuple => 'constraint_generator' ), inline_generator => LazyLoad( Tuple => 'inline_generator' ), deep_explanation => LazyLoad( Tuple => 'deep_explanation' ), coercion_generator => LazyLoad( Tuple => 'coercion_generator' ), } ); $meta->add_type( { name => "CycleTuple", parent => $_arr, name_generator => sub { my ( $s, @a ) = @_; sprintf( '%s[%s]', $s, join q[,], @a ); }, constraint_generator => LazyLoad( CycleTuple => 'constraint_generator' ), inline_generator => LazyLoad( CycleTuple => 'inline_generator' ), deep_explanation => LazyLoad( CycleTuple => 'deep_explanation' ), coercion_generator => LazyLoad( CycleTuple => 'coercion_generator' ), } ); $meta->add_type( { name => "Dict", parent => $_hash, name_generator => sub { my ( $s, @p ) = @_; my $l = @p && Types::TypeTiny::is_TypeTiny( $p[-1] ) && $p[-1]->is_strictly_a_type_of( Types::Standard::Slurpy() ) ? pop(@p) : undef; my %a = @p; sprintf( '%s[%s%s]', $s, join( q[,], map sprintf( "%s=>%s", $_, $a{$_} ), sort keys %a ), $l ? ",$l" : '' ); }, constraint_generator => LazyLoad( Dict => 'constraint_generator' ), inline_generator => LazyLoad( Dict => 'inline_generator' ), deep_explanation => LazyLoad( Dict => 'deep_explanation' ), coercion_generator => LazyLoad( Dict => 'coercion_generator' ), my_methods => { dict_is_slurpy => LazyLoad( Dict => 'dict_is_slurpy' ), hashref_allows_key => LazyLoad( Dict => 'hashref_allows_key' ), hashref_allows_value => LazyLoad( Dict => 'hashref_allows_value' ), }, } ); $meta->add_type( { name => "Overload", parent => $_obj, constraint => sub { require overload; overload::Overloaded( $_ ) }, inlined => sub { $maybe_load_modules->( qw/ Scalar::Util overload /, $INC{'overload.pm'} ? "Scalar::Util::blessed($_[1]) and overload::Overloaded($_[1])" : "Scalar::Util::blessed($_[1]) and do { use overload (); overload::Overloaded($_[1]) }" ); }, constraint_generator => sub { return $meta->get_type( 'Overload' ) unless @_; my @operations = map { Types::TypeTiny::is_StringLike( $_ ) ? "$_" : _croak( "Parameters to Overload[`a] expected to be a strings; got $_" ); } @_; require overload; return sub { my $value = shift; for my $op ( @operations ) { return unless overload::Method( $value, $op ); } return !!1; } }, inline_generator => sub { my @operations = @_; return sub { require overload; my $v = $_[1]; $maybe_load_modules->( qw/ Scalar::Util overload /, join " and ", "Scalar::Util::blessed($v)", map "overload::Method($v, q[$_])", @operations ); }; }, is_object => 1, } ); $meta->add_type( { name => "StrMatch", parent => $_str, constraint_generator => LazyLoad( StrMatch => 'constraint_generator' ), inline_generator => LazyLoad( StrMatch => 'inline_generator' ), } ); $meta->add_type( { name => "OptList", parent => $_arr, constraint => sub { for my $inner ( @$_ ) { return unless ref( $inner ) eq q(ARRAY); return unless @$inner == 2; return unless is_Str( $inner->[0] ); } return !!1; }, inlined => sub { my ( $self, $var ) = @_; my $Str_check = Str()->inline_check( '$inner->[0]' ); my @code = 'do { my $ok = 1; '; push @code, sprintf( 'for my $inner (@{%s}) { no warnings; ', $var ); push @code, sprintf( '($ok=0) && last unless ref($inner) eq q(ARRAY) && @$inner == 2 && (%s); ', $Str_check ); push @code, '} '; push @code, '$ok }'; return ( undef, join( q( ), @code ) ); }, type_default => sub { return [] }, } ); $meta->add_type( { name => "Tied", parent => $_ref, constraint => sub { !!tied( Scalar::Util::reftype( $_ ) eq 'HASH' ? %{$_} : Scalar::Util::reftype( $_ ) eq 'ARRAY' ? @{$_} : Scalar::Util::reftype( $_ ) =~ /^(SCALAR|REF)$/ ? ${$_} : undef ); }, inlined => sub { my ( $self, $var ) = @_; $maybe_load_modules->( qw/ Scalar::Util /, $self->parent->inline_check( $var ) . " and !!tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : Scalar::Util::reftype($var) =~ /^(SCALAR|REF)\$/ ? \${$var} : undef)" ); }, name_generator => sub { my $self = shift; my $param = Types::TypeTiny::to_TypeTiny( shift ); unless ( Types::TypeTiny::is_TypeTiny( $param ) ) { Types::TypeTiny::is_StringLike( $param ) or _croak( "Parameter to Tied[`a] expected to be a class name; got $param" ); require B; return sprintf( "%s[%s]", $self, B::perlstring( $param ) ); } return sprintf( "%s[%s]", $self, $param ); }, constraint_generator => LazyLoad( Tied => 'constraint_generator' ), inline_generator => LazyLoad( Tied => 'inline_generator' ), } ); $meta->add_type( { name => "InstanceOf", parent => $_obj, constraint_generator => sub { return $meta->get_type( 'InstanceOf' ) unless @_; require Type::Tiny::Class; my @classes = map { Types::TypeTiny::is_TypeTiny( $_ ) ? $_ : "Type::Tiny::Class"->new( class => $_, display_name => sprintf( 'InstanceOf[%s]', B::perlstring( $_ ) ) ) } @_; return $classes[0] if @classes == 1; require B; require Type::Tiny::Union; return "Type::Tiny::Union"->new( type_constraints => \@classes, display_name => sprintf( 'InstanceOf[%s]', join q[,], map B::perlstring( $_->class ), @classes ), ); }, } ); $meta->add_type( { name => "ConsumerOf", parent => $_obj, constraint_generator => sub { return $meta->get_type( 'ConsumerOf' ) unless @_; require B; require Type::Tiny::Role; my @roles = map { Types::TypeTiny::is_TypeTiny( $_ ) ? $_ : "Type::Tiny::Role"->new( role => $_, display_name => sprintf( 'ConsumerOf[%s]', B::perlstring( $_ ) ) ) } @_; return $roles[0] if @roles == 1; require Type::Tiny::Intersection; return "Type::Tiny::Intersection"->new( type_constraints => \@roles, display_name => sprintf( 'ConsumerOf[%s]', join q[,], map B::perlstring( $_->role ), @roles ), ); }, } ); $meta->add_type( { name => "HasMethods", parent => $_obj, constraint_generator => sub { return $meta->get_type( 'HasMethods' ) unless @_; require B; require Type::Tiny::Duck; return "Type::Tiny::Duck"->new( methods => \@_, display_name => sprintf( 'HasMethods[%s]', join q[,], map B::perlstring( $_ ), @_ ), ); }, } ); $meta->add_type( { name => "Enum", parent => $_str, constraint_generator => sub { return $meta->get_type( 'Enum' ) unless @_; my $coercion; if ( ref( $_[0] ) and ref( $_[0] ) eq 'SCALAR' ) { $coercion = ${ +shift }; } elsif ( ref( $_[0] ) && !blessed( $_[0] ) or blessed( $_[0] ) && $_[0]->isa( 'Type::Coercion' ) ) { $coercion = shift; } require B; require Type::Tiny::Enum; return "Type::Tiny::Enum"->new( values => \@_, display_name => sprintf( 'Enum[%s]', join q[,], map B::perlstring( $_ ), @_ ), $coercion ? ( coercion => $coercion ) : (), ); }, type_default => undef, } ); $meta->add_coercion( { name => "MkOpt", type_constraint => $meta->get_type( "OptList" ), type_coercion_map => [ $_arr, q{ Exporter::Tiny::mkopt($_) }, $_hash, q{ Exporter::Tiny::mkopt($_) }, $_undef, q{ [] }, ], } ); $meta->add_coercion( { name => "Join", type_constraint => $_str, coercion_generator => sub { my ( $self, $target, $sep ) = @_; Types::TypeTiny::is_StringLike( $sep ) or _croak( "Parameter to Join[`a] expected to be a string; got $sep" ); require B; $sep = B::perlstring( $sep ); return ( ArrayRef(), qq{ join($sep, \@\$_) } ); }, } ); $meta->add_coercion( { name => "Split", type_constraint => $_arr, coercion_generator => sub { my ( $self, $target, $re ) = @_; ref( $re ) eq q(Regexp) or _croak( "Parameter to Split[`a] expected to be a regular expression; got $re" ); my $regexp_string = "$re"; $regexp_string =~ s/\\\//\\\\\//g; # toothpicks return ( Str(), qq{ [split /$regexp_string/, \$_] } ); }, } ); __PACKAGE__->meta->make_immutable; 1; __END__ =pod =for stopwords booleans vstrings typeglobs =encoding utf-8 =for stopwords datetimes =head1 NAME Types::Standard - bundled set of built-in types for Type::Tiny =head1 SYNOPSIS use v5.36; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef Object ); use Type::Params qw( signature_for ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, required => 1, ); has gender => ( is => 'ro', isa => Enum[qw( f m )], ); has age => ( is => 'rw', isa => Int->where( '$_ >= 0' ), ); has children => ( is => 'ro', isa => ArrayRef[Object], default => sub { return [] }, ); # method signature signature_for add_child => ( method => Object, positional => [ Object ], ); sub add_child ( $self, $child ) { push $self->children->@*, $child; return $self; } } package main; my $boldruler = Horse->new( name => "Bold Ruler", gender => 'm', age => 16, ); my $secretariat = Horse->new( name => "Secretariat", gender => 'm', age => 0, ); $boldruler->add_child( $secretariat ); use Types::Standard qw( is_Object assert_Object ); # is_Object($thing) returns a boolean my $is_it_an_object = is_Object $boldruler; # assert_Object($thing) returns $thing or dies say assert_Object($boldruler)->name; # says "Bold Ruler" =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This documents the details of the L type library. L is a better starting place if you're new. L bundles a few types which seem to be useful. =head2 Moose-like The following types are similar to those described in L. =over =item * B<< Any >> Absolutely any value passes this type constraint (even undef). =item * B<< Item >> Essentially the same as B. All other type constraints in this library inherit directly or indirectly from B. =item * B<< Bool >> Values that are reasonable booleans. Accepts 1, 0, the empty string and undef. Other customers also bought: B<< BoolLike >> from L. =item * B<< Maybe[`a] >> Given another type constraint, also accepts undef. For example, B<< Maybe[Int] >> accepts all integers plus undef. =item * B<< Undef >> Only undef passes this type constraint. =item * B<< Defined >> Only undef fails this type constraint. =item * B<< Value >> Any defined, non-reference value. =item * B<< Str >> Any string. (The only difference between B and B is that the former accepts typeglobs and vstrings.) Other customers also bought: B<< StringLike >> from L. =item * B<< Num >> See B and B below. =item * B<< Int >> An integer; that is a string of digits 0 to 9, optionally prefixed with a hyphen-minus character. Expect inconsistent results for dualvars, and numbers too high (or negative numbers too low) for Perl to safely represent as an integer. =item * B<< ClassName >> The name of a loaded package. The package must have C<< @ISA >> or C<< $VERSION >> defined, or must define at least one sub to be considered a loaded package. =item * B<< RoleName >> Like B<< ClassName >>, but the package must I define a method called C. This is subtly different from Moose's type constraint of the same name; let me know if this causes you any problems. (I can't promise I'll change anything though.) =item * B<< Ref[`a] >> Any defined reference value, including blessed objects. Unlike Moose, B is a parameterized type, allowing Scalar::Util::reftype checks, a la Ref["HASH"] # hashrefs, including blessed hashrefs =item * B<< ScalarRef[`a] >> A value where C<< ref($value) eq "SCALAR" or ref($value) eq "REF" >>. If parameterized, the referred value must pass the additional constraint. For example, B<< ScalarRef[Int] >> must be a reference to a scalar which holds an integer value. =item * B<< ArrayRef[`a] >> A value where C<< ref($value) eq "ARRAY" >>. If parameterized, the elements of the array must pass the additional constraint. For example, B<< ArrayRef[Num] >> must be a reference to an array of numbers. As an extension to Moose's B type, a minimum and maximum array length can be given: ArrayRef[CodeRef, 1] # ArrayRef of at least one CodeRef ArrayRef[FileHandle, 0, 2] # ArrayRef of up to two FileHandles ArrayRef[Any, 0, 100] # ArrayRef of up to 100 elements Other customers also bought: B<< ArrayLike >> from L. =item * B<< HashRef[`a] >> A value where C<< ref($value) eq "HASH" >>. If parameterized, the values of the hash must pass the additional constraint. For example, B<< HashRef[Num] >> must be a reference to an hash where the values are numbers. The hash keys are not constrained, but Perl limits them to strings; see B below if you need to further constrain the hash values. Other customers also bought: B<< HashLike >> from L. =item * B<< CodeRef >> A value where C<< ref($value) eq "CODE" >>. Other customers also bought: B<< CodeLike >> from L. =item * B<< RegexpRef >> A reference where C<< re::is_regexp($value) >> is true, or a blessed reference where C<< $value->isa("Regexp") >> is true. =item * B<< GlobRef >> A value where C<< ref($value) eq "GLOB" >>. =item * B<< FileHandle >> A file handle. =item * B<< Object >> A blessed object. (This also accepts regexp refs.) =back =head2 Structured Okay, so I stole some ideas from L. =over =item * B<< Map[`k, `v] >> Similar to B but parameterized with type constraints for both the key and value. The constraint for keys would typically be a subtype of B. =item * B<< Tuple[...] >> Subtype of B, accepting a list of type constraints for each slot in the array. B<< Tuple[Int, HashRef] >> would match C<< [1, {}] >> but not C<< [{}, 1] >>. =item * B<< Dict[...] >> Subtype of B, accepting a list of type constraints for each slot in the hash. For example B<< Dict[name => Str, id => Int] >> allows C<< { name => "Bob", id => 42 } >>. =item * B<< Optional[`a] >> Used in conjunction with B and B to specify slots that are optional and may be omitted (but not necessarily set to an explicit undef). B<< Dict[name => Str, id => Optional[Int]] >> allows C<< { name => "Bob" } >> but not C<< { name => "Bob", id => "BOB" } >>. Note that any use of B<< Optional[`a] >> outside the context of parameterized B and B type constraints makes little sense, and its behaviour is undefined. (An exception: it is used by L for a similar purpose to how it's used in B.) =back This module also exports a B parameterized type, which can be used as follows. It can cause additional trailing values in a B to be slurped into a structure and validated. For example, slurping into an arrayref: my $type = Tuple[ Str, Slurpy[ ArrayRef[Int] ] ]; $type->( ["Hello"] ); # ok $type->( ["Hello", 1, 2, 3] ); # ok $type->( ["Hello", [1, 2, 3]] ); # not ok Or into a hashref: my $type2 = Tuple[ Str, Slurpy[ Map[Int, RegexpRef] ] ]; $type2->( ["Hello"] ); # ok $type2->( ["Hello", 1, qr/one/i, 2, qr/two/] ); # ok It can cause additional values in a B to be slurped into a hashref and validated: my $type3 = Dict[ values => ArrayRef, Slurpy[ HashRef[Str] ] ]; $type3->( { values => [] } ); # ok $type3->( { values => [], name => "Foo" } ); # ok $type3->( { values => [], name => [] } ); # not ok In either B or B, B<< Slurpy[Any] >> can be used to indicate that additional values are acceptable, but should not be constrained in any way. B<< Slurpy[Any] >> is an optimized code path. Although the following are essentially equivalent checks, the former should run a lot faster: Tuple[ Int, Slurpy[Any] ] Tuple[ Int, Slurpy[ArrayRef] ] A function C<< slurpy($type) >> is also exported which was historically how slurpy types were created. Outside of B and B, B<< Slurpy[Foo] >> should just act the same as B. But don't do that. =head2 Objects Okay, so I stole some ideas from L. =over =item * B<< InstanceOf[`a] >> Shortcut for a union of L constraints. B<< InstanceOf["Foo", "Bar"] >> allows objects blessed into the C or C classes, or subclasses of those. Given no parameters, just equivalent to B. =item * B<< ConsumerOf[`a] >> Shortcut for an intersection of L constraints. B<< ConsumerOf["Foo", "Bar"] >> allows objects where C<< $o->DOES("Foo") >> and C<< $o->DOES("Bar") >> both return true. Given no parameters, just equivalent to B. =item * B<< HasMethods[`a] >> Shortcut for a L constraint. B<< HasMethods["foo", "bar"] >> allows objects where C<< $o->can("foo") >> and C<< $o->can("bar") >> both return true. Given no parameters, just equivalent to B. =back =head2 More There are a few other types exported by this module: =over =item * B<< Overload[`a] >> With no parameters, checks that the value is an overloaded object. Can be given one or more string parameters, which are specific operations to check are overloaded. For example, the following checks for objects which overload addition and subtraction. Overload["+", "-"] =item * B<< Tied[`a] >> A reference to a tied scalar, array or hash. Can be parameterized with a type constraint which will be applied to the object returned by the C<< tied() >> function. As a convenience, can also be parameterized with a string, which will be inflated to a L. use Types::Standard qw(Tied); use Type::Utils qw(class_type); my $My_Package = class_type { class => "My::Package" }; tie my %h, "My::Package"; \%h ~~ Tied; # true \%h ~~ Tied[ $My_Package ]; # true \%h ~~ Tied["My::Package"]; # true tie my $s, "Other::Package"; \$s ~~ Tied; # true $s ~~ Tied; # false !! If you need to check that something is specifically a reference to a tied hash, use an intersection: use Types::Standard qw( Tied HashRef ); my $TiedHash = (Tied) & (HashRef); tie my %h, "My::Package"; tie my $s, "Other::Package"; \%h ~~ $TiedHash; # true \$s ~~ $TiedHash; # false =item * B<< StrMatch[`a] >> A string that matches a regular expression: declare "Distance", as StrMatch[ qr{^([0-9]+)\s*(mm|cm|m|km)$} ]; You can optionally provide a type constraint for the array of subexpressions: declare "Distance", as StrMatch[ qr{^([0-9]+)\s*(.+)$}, Tuple[ Int, enum(DistanceUnit => [qw/ mm cm m km /]), ], ]; Here's an example using L: package Local::Host { use Moose; use Regexp::Common; has ip_address => ( is => 'ro', required => 1, isa => StrMatch[qr/^$RE{net}{IPv4}$/], default => '127.0.0.1', ); } On certain versions of Perl, type constraints of the forms B<< StrMatch[qr/../ >> and B<< StrMatch[qr/\A..\z/ >> with any number of intervening dots can be optimized to simple length checks. =item * B<< Enum[`a] >> As per MooX::Types::MooseLike::Base: has size => ( is => "ro", isa => Enum[qw( S M L XL XXL )], ); You can enable coercion by passing C<< \1 >> before the list of values. has size => ( is => "ro", isa => Enum[ \1, qw( S M L XL XXL ) ], coerce => 1, ); This will use the C method in L to coerce closely matching strings. =item * B<< OptList >> An arrayref of arrayrefs in the style of L output. =item * B<< LaxNum >>, B<< StrictNum >> In Moose 2.09, the B type constraint implementation was changed from being a wrapper around L's C function to a stricter regexp (which disallows things like "-Inf" and "Nan"). Types::Standard provides I implementations. B is measurably faster. The B type constraint is currently an alias for B unless you set the C environment variable to true before loading Types::Standard, in which case it becomes an alias for B. The constant C<< Types::Standard::STRICTNUM >> can be used to check if B is being strict. Most people should probably use B or B. Don't explicitly use B unless you specifically need an attribute which will accept things like "Inf". =item * B<< CycleTuple[`a] >> Similar to B, but cyclical. CycleTuple[Int, HashRef] will allow C<< [1,{}] >> and C<< [1,{},2,{}] >> but disallow C<< [1,{},2] >> and C<< [1,{},2,"not a hashref"] >>. I think you understand B already. Currently B and B parameters are forbidden. There are fairly limited use cases for them, and it's not exactly clear what they should mean. The following is an efficient way of checking for an even-sized arrayref: CycleTuple[Any, Any] The following is an arrayref which would be suitable for coercing to a hashref: CycleTuple[Str, Any] All the examples so far have used two parameters, but the following is also a possible B: CycleTuple[Str, Int, HashRef] This will be an arrayref where the 0th, 3rd, 6th, etc values are strings, the 1st, 4th, 7th, etc values are integers, and the 2nd, 5th, 8th, etc values are hashrefs. =back =head2 Coercions Most of the types in this type library have no coercions. The exception is B as of Types::Standard 1.003_003, which coerces from B via C<< !!$_ >>. Some standalone coercions may be exported. These can be combined with type constraints using the C<< plus_coercions >> method. =over =item * B<< MkOpt >> A coercion from B, B or B to B. Example usage in a Moose attribute: use Types::Standard qw( OptList MkOpt ); has options => ( is => "ro", isa => OptList->plus_coercions( MkOpt ), coerce => 1, ); =item * B<< Split[`a] >> Split a string on a regexp. use Types::Standard qw( ArrayRef Str Split ); has name => ( is => "ro", isa => ArrayRef->of(Str)->plus_coercions(Split[qr/\s/]), coerce => 1, ); =item * B<< Join[`a] >> Join an array of strings with a delimiter. use Types::Standard qw( Str Join ); my $FileLines = Str->plus_coercions(Join["\n"]); has file_contents => ( is => "ro", isa => $FileLines, coerce => 1, ); =back =head2 Constants =over =item C<< Types::Standard::STRICTNUM >> Indicates whether B is an alias for B. (It is usually an alias for B.) =back =head2 Environment =over =item C Switches to more strict regexp-based number checking instead of using C. =item C If set to false, can be used to suppress the loading of XS implementations of some type constraints. =item C If C does not exist, can be set to true to suppress XS usage similarly. (Several other CPAN distributions also pay attention to this environment variable.) =back =begin private =item Stringable =item LazyLoad =end private =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L, L, L, L. L, L, L. L provides some type constraints based on XML Schema's data types; this includes constraints for ISO8601-formatted datetimes, integer ranges (e.g. B<< PositiveInteger[maxInclusive=>10] >> and so on. L provides B and B type constraints that were formerly found in Types::Standard. L and L provide replacements for L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =begin trustme =item slurpy =end trustme TypeTiny.pm000664001750001750 7026615111656240 16443 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Typespackage Types::TypeTiny; use 5.008001; use strict; use warnings; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; use Scalar::Util qw< blessed refaddr weaken >; BEGIN { *__XS = eval { require Type::Tiny::XS; 'Type::Tiny::XS'->VERSION( '0.022' ); 1; } ? eval "sub () { '$Type::Tiny::XS::VERSION' }" : sub () { !!0 }; } our @EXPORT_OK = ( map( @{ [ $_, "is_$_", "assert_$_" ] }, __PACKAGE__->type_names ), qw/to_TypeTiny/ ); our %EXPORT_TAGS = ( types => [ __PACKAGE__->type_names ], is => [ map "is_$_", __PACKAGE__->type_names ], assert => [ map "assert_$_", __PACKAGE__->type_names ], ); my %cache; # This `import` method is designed to avoid loading Exporter::Tiny. # This is so that if you stick to only using the purely OO parts of # Type::Tiny, you can skip loading the exporter. # sub import { # If this sub succeeds, it will replace itself. # uncoverable subroutine return unless @_ > 1; # uncoverable statement no warnings "redefine"; # uncoverable statement our @ISA = qw( Exporter::Tiny ); # uncoverable statement require Exporter::Tiny; # uncoverable statement my $next = \&Exporter::Tiny::import; # uncoverable statement *import = $next; # uncoverable statement my $class = shift; # uncoverable statement my $opts = { ref( $_[0] ) ? %{ +shift } : () }; # uncoverable statement $opts->{into} ||= scalar( caller ); # uncoverable statement _mkall(); # uncoverable statement return $class->$next( $opts, @_ ); # uncoverable statement } #/ sub import for ( __PACKAGE__->type_names ) { # uncoverable statement eval qq{ # uncoverable statement sub is_$_ { $_()->check(shift) } # uncoverable statement sub assert_$_ { $_()->assert_return(shift) } # uncoverable statement }; # uncoverable statement } # uncoverable statement sub _reinstall_subs { # uncoverable subroutine my $type = shift; # uncoverable statement no strict 'refs'; # uncoverable statement no warnings 'redefine'; # uncoverable statement *{ 'is_' . $type->name } = $type->compiled_check; # uncoverable statement *{ 'assert_' . $type->name } = \&$type; # uncoverable statement $type; # uncoverable statement } # uncoverable statement sub _mkall { # uncoverable subroutine return unless $INC{'Type/Tiny.pm'}; # uncoverable statement __PACKAGE__->get_type( $_ ) for __PACKAGE__->type_names; # uncoverable statement } # uncoverable statement sub meta { return $_[0]; } sub type_names { qw( StringLike BoolLike HashLike ArrayLike CodeLike TypeTiny _ForeignTypeConstraint ); } sub has_type { my %has = map +( $_ => 1 ), shift->type_names; !!$has{ $_[0] }; } sub get_type { my $self = shift; return unless $self->has_type( @_ ); no strict qw(refs); &{ $_[0] }(); } sub coercion_names { qw(); } sub has_coercion { my %has = map +( $_ => 1 ), shift->coercion_names; !!$has{ $_[0] }; } sub get_coercion { my $self = shift; return unless $self->has_coercion( @_ ); no strict qw(refs); &{ $_[0] }(); # uncoverable statement } my ( $__get_linear_isa_dfs, $tried_mro ); $__get_linear_isa_dfs = sub { if ( !$tried_mro && eval { require mro } ) { $__get_linear_isa_dfs = \&mro::get_linear_isa; goto $__get_linear_isa_dfs; } no strict 'refs'; my $classname = shift; my @lin = ( $classname ); my %stored; foreach my $parent ( @{"$classname\::ISA"} ) { my $plin = $__get_linear_isa_dfs->( $parent ); foreach ( @$plin ) { next if exists $stored{$_}; push( @lin, $_ ); $stored{$_} = 1; } } return \@lin; }; sub _check_overload { my $package = shift; if ( ref $package ) { $package = blessed( $package ); return !!0 if !defined $package; } my $op = shift; my $mro = $__get_linear_isa_dfs->( $package ); foreach my $p ( @$mro ) { my $fqmeth = $p . q{::(} . $op; return !!1 if defined &{$fqmeth}; } !!0; } #/ sub _check_overload sub _get_check_overload_sub { if ( $Type::Tiny::AvoidCallbacks ) { return '(sub { require overload; overload::Overloaded(ref $_[0] or $_[0]) and overload::Method((ref $_[0] or $_[0]), $_[1]) })->'; } return 'Types::TypeTiny::_check_overload'; } sub StringLike () { return $cache{StringLike} if defined $cache{StringLike}; require Type::Tiny; my %common = ( name => "StringLike", library => __PACKAGE__, constraint => sub { defined( $_ ) && !ref( $_ ) or blessed( $_ ) && _check_overload( $_, q[""] ); }, inlined => sub { qq/defined($_[1]) && !ref($_[1]) or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[""])/; }, type_default => sub { return '' }, ); if ( __XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( 'StringLike' ); my $xsubname = Type::Tiny::XS::get_subname_for( 'StringLike' ); my $inlined = $common{inlined}; $cache{StringLike} = "Type::Tiny"->new( %common, compiled_type_constraint => $xsub, inlined => sub { # uncoverable subroutine ( $Type::Tiny::AvoidCallbacks or not $xsubname ) ? goto( $inlined ) : qq/$xsubname($_[1])/ # uncoverable statement }, ); _reinstall_subs $cache{StringLike}; } #/ if ( __XS ) else { $cache{StringLike} = "Type::Tiny"->new( %common ); } } #/ sub StringLike sub HashLike (;@) { return $cache{HashLike} if defined( $cache{HashLike} ) && !@_; require Type::Tiny; my %common = ( name => "HashLike", library => __PACKAGE__, constraint => sub { ref( $_ ) eq q[HASH] or blessed( $_ ) && _check_overload( $_, q[%{}] ); }, inlined => sub { qq/ref($_[1]) eq q[HASH] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\%{}])/; }, type_default => sub { return {} }, constraint_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); my $check = $param->compiled_check; if ( __XS ge '0.025' ) { my $paramname = Type::Tiny::XS::is_known( $check ); my $xsub = defined($paramname) ? Type::Tiny::XS::get_coderef_for( "HashLike[$paramname]" ) : undef; return $xsub if $xsub; } sub { my %hash = %$_; for my $key ( sort keys %hash ) { $check->( $hash{$key} ) or return 0; } return 1; }; }, inline_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); return unless $param->can_be_inlined; my $check = $param->compiled_check; my $xsubname; if ( __XS ge '0.025' ) { my $paramname = Type::Tiny::XS::is_known( $check ); $xsubname = defined($paramname) ? Type::Tiny::XS::get_subname_for( "HashLike[$paramname]" ) : undef; } sub { my $var = pop; return "$xsubname($var)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $code = sprintf( 'do { my $ok=1; my %%h = %%{%s}; for my $k (sort keys %%h) { ($ok=0,next) unless (%s) }; $ok }', $var, $param->inline_check( '$h{$k}' ), ); return ( undef, $code ); }; }, coercion_generator => sub { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; my $coercible = $param->coercion->_source_type_union->compiled_check; my $C = "Type::Coercion"->new( type_constraint => $child ); $C->add_type_coercions( $parent => sub { my $origref = @_ ? $_[0] : $_; my %orig = %$origref; my %new; for my $k ( sort keys %orig ) { return $origref unless $coercible->( $orig{$k} ); $new{$k} = $param->coerce( $orig{$k} ); } \%new; }, ); return $C; }, ); if ( __XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( 'HashLike' ); my $xsubname = Type::Tiny::XS::get_subname_for( 'HashLike' ); my $inlined = $common{inlined}; $cache{HashLike} = "Type::Tiny"->new( %common, compiled_type_constraint => $xsub, inlined => sub { # uncoverable subroutine ( $Type::Tiny::AvoidCallbacks or not $xsubname ) ? goto( $inlined ) : qq/$xsubname($_[1])/ # uncoverable statement }, ); _reinstall_subs $cache{HashLike}; } #/ if ( __XS ) else { $cache{HashLike} = "Type::Tiny"->new( %common ); } @_ ? $cache{HashLike}->parameterize( @{ $_[0] } ) : $cache{HashLike}; } #/ sub HashLike (;@) sub ArrayLike (;@) { return $cache{ArrayLike} if defined( $cache{ArrayLike} ) && !@_; require Type::Tiny; my %common = ( name => "ArrayLike", library => __PACKAGE__, constraint => sub { ref( $_ ) eq q[ARRAY] or blessed( $_ ) && _check_overload( $_, q[@{}] ); }, inlined => sub { qq/ref($_[1]) eq q[ARRAY] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\@{}])/; }, type_default => sub { return [] }, constraint_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); my $check = $param->compiled_check; if ( __XS ge '0.025' ) { my $paramname = Type::Tiny::XS::is_known( $check ); my $xsub = defined($paramname) ? Type::Tiny::XS::get_coderef_for( "ArrayLike[$paramname]" ) : undef; return $xsub if $xsub; } sub { my @arr = @$_; for my $val ( @arr ) { $check->( $val ) or return 0; } return 1; }; }, inline_generator => sub { my $param = TypeTiny()->assert_coerce( shift ); return unless $param->can_be_inlined; my $check = $param->compiled_check; my $xsubname; if ( __XS ge '0.025' ) { my $paramname = Type::Tiny::XS::is_known( $check ); $xsubname = defined($paramname) ? Type::Tiny::XS::get_subname_for( "ArrayLike[$paramname]" ) : undef; } sub { my $var = pop; return "$xsubname($var)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $code = sprintf( 'do { my $ok=1; for my $v (@{%s}) { ($ok=0,next) unless (%s) }; $ok }', $var, $param->inline_check( '$v' ), ); return ( undef, $code ); }; }, coercion_generator => sub { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; my $coercible = $param->coercion->_source_type_union->compiled_check; my $C = "Type::Coercion"->new( type_constraint => $child ); $C->add_type_coercions( $parent => sub { my $origref = @_ ? $_[0] : $_; my @orig = @$origref; my @new; for my $v ( @orig ) { return $origref unless $coercible->( $v ); push @new, $param->coerce( $v ); } \@new; }, ); return $C; }, ); if ( __XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( 'ArrayLike' ); my $xsubname = Type::Tiny::XS::get_subname_for( 'ArrayLike' ); my $inlined = $common{inlined}; $cache{ArrayLike} = "Type::Tiny"->new( %common, compiled_type_constraint => $xsub, inlined => sub { # uncoverable subroutine ( $Type::Tiny::AvoidCallbacks or not $xsubname ) ? goto( $inlined ) : qq/$xsubname($_[1])/ # uncoverable statement }, ); _reinstall_subs $cache{ArrayLike}; } #/ if ( __XS ) else { $cache{ArrayLike} = "Type::Tiny"->new( %common ); } @_ ? $cache{ArrayLike}->parameterize( @{ $_[0] } ) : $cache{ArrayLike}; } #/ sub ArrayLike (;@) if ( $] ge '5.014' ) { &Scalar::Util::set_prototype( $_, ';$' ) for \&HashLike, \&ArrayLike; } sub CodeLike () { return $cache{CodeLike} if $cache{CodeLike}; require Type::Tiny; my %common = ( name => "CodeLike", constraint => sub { ref( $_ ) eq q[CODE] or blessed( $_ ) && _check_overload( $_, q[&{}] ); }, inlined => sub { qq/ref($_[1]) eq q[CODE] or Scalar::Util::blessed($_[1]) && ${\ +_get_check_overload_sub() }($_[1], q[\&{}])/; }, type_default => sub { return sub {} }, library => __PACKAGE__, ); if ( __XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( 'CodeLike' ); my $xsubname = Type::Tiny::XS::get_subname_for( 'CodeLike' ); my $inlined = $common{inlined}; $cache{CodeLike} = "Type::Tiny"->new( %common, compiled_type_constraint => $xsub, inlined => sub { # uncoverable subroutine ( $Type::Tiny::AvoidCallbacks or not $xsubname ) ? goto( $inlined ) : qq/$xsubname($_[1])/ # uncoverable statement }, ); _reinstall_subs $cache{CodeLike}; } #/ if ( __XS ) else { $cache{CodeLike} = "Type::Tiny"->new( %common ); } } #/ sub CodeLike sub BoolLike () { return $cache{BoolLike} if $cache{BoolLike}; require Type::Tiny; $cache{BoolLike} = "Type::Tiny"->new( name => "BoolLike", constraint => sub { !defined( $_ ) or !ref( $_ ) && ( $_ eq '' || $_ eq '0' || $_ eq '1' ) or blessed( $_ ) && ( _check_overload( $_, q[bool] ) or _check_overload( $_, q[0+] ) && do { my $n = sprintf('%d', $_); $n==0 or $n==1 } or do { my $d = $_->can('DOES') || $_->can('isa'); $_->$d('boolean') } ) }, inlined => sub { qq/do { local \$_ = $_; !defined() or !ref() && ( \$_ eq '' || \$_ eq '0' || \$_ eq '1' ) or Scalar::Util::blessed(\$_) && ( ${\ +_get_check_overload_sub() }(\$_, q[bool]) or ${\ +_get_check_overload_sub() }(\$_, q[0+]) && do { my \$n = sprintf('%d', $_); \$n==0 or \$n==1 } or do { my \$d = \$_->can('DOES') || \$_->can('isa'); \$_->\$d('boolean') } ) }/; }, type_default => sub { return !!0 }, library => __PACKAGE__, ); } #/ sub BoolLike sub TypeTiny () { return $cache{TypeTiny} if defined $cache{TypeTiny}; require Type::Tiny; $cache{TypeTiny} = "Type::Tiny"->new( name => "TypeTiny", constraint => sub { blessed( $_ ) && $_->isa( q[Type::Tiny] ) }, inlined => sub { my $var = $_[1]; "Scalar::Util::blessed($var) && $var\->isa(q[Type::Tiny])"; }, type_default => sub { require Types::Standard; return Types::Standard::Any() }, library => __PACKAGE__, _build_coercion => sub { my $c = shift; $c->add_type_coercions( _ForeignTypeConstraint(), \&to_TypeTiny ); $c->freeze; }, ); } #/ sub TypeTiny sub _ForeignTypeConstraint () { return $cache{_ForeignTypeConstraint} if defined $cache{_ForeignTypeConstraint}; require Type::Tiny; $cache{_ForeignTypeConstraint} = "Type::Tiny"->new( name => "_ForeignTypeConstraint", constraint => \&_is_ForeignTypeConstraint, inlined => sub { qq/ref($_[1]) && do { require Types::TypeTiny; Types::TypeTiny::_is_ForeignTypeConstraint($_[1]) }/; }, library => __PACKAGE__, ); } #/ sub _ForeignTypeConstraint my %ttt_cache; sub _is_ForeignTypeConstraint { my $t = @_ ? $_[0] : $_; return !!1 if ref $t eq 'CODE'; if ( my $class = blessed $t ) { return !!0 if $class->isa( "Type::Tiny" ); return !!1 if $class->isa( "Moose::Meta::TypeConstraint" ); return !!1 if $class->isa( "MooseX::Types::TypeDecorator" ); return !!1 if $class->isa( "Validation::Class::Simple" ); return !!1 if $class->isa( "Validation::Class" ); return !!1 if $t->can( "check" ); } !!0; } #/ sub _is_ForeignTypeConstraint sub to_TypeTiny { my $t = @_ ? $_[0] : $_; return $t unless ( my $ref = ref $t ); return $t if $ref =~ /^Type::Tiny\b/; return $ttt_cache{ refaddr( $t ) } if $ttt_cache{ refaddr( $t ) }; #<<< if ( my $class = blessed $t) { return $t if $class->isa( "Type::Tiny" ); return _TypeTinyFromMoose( $t ) if $class eq "MooseX::Types::TypeDecorator"; # needed before MooseX::Types 0.35. return _TypeTinyFromMoose( $t ) if $class->isa( "Moose::Meta::TypeConstraint" ); return _TypeTinyFromMoose( $t ) if $class->isa( "MooseX::Types::TypeDecorator" ); return _TypeTinyFromMouse( $t ) if $class->isa( "Mouse::Meta::TypeConstraint" ); return _TypeTinyFromValidationClass( $t ) if $class->isa( "Validation::Class::Simple" ); return _TypeTinyFromValidationClass( $t ) if $class->isa( "Validation::Class" ); return $t->to_TypeTiny if $t->can( "DOES" ) && $t->DOES( "Type::Library::Compiler::TypeConstraint" ) && $t->can( "to_TypeTiny" ); return _TypeTinyFromGeneric( $t ) if $t->can( "check" ); # i.e. Type::API::Constraint } #/ if ( my $class = blessed...) #>>> return _TypeTinyFromCodeRef( $t ) if $ref eq q(CODE); $t; } #/ sub to_TypeTiny sub _TypeTinyFromMoose { my $t = $_[0]; if ( ref $t->{"Types::TypeTiny::to_TypeTiny"} ) { return $t->{"Types::TypeTiny::to_TypeTiny"}; } if ( $t->name ne '__ANON__' ) { require Types::Standard; my $ts = 'Types::Standard'->get_type( $t->name ); return $ts if $ts->{_is_core}; } #<<< my ( $tt_class, $tt_opts ) = $t->can( 'parameterize' ) ? _TypeTinyFromMoose_parameterizable( $t ) : $t->isa( 'Moose::Meta::TypeConstraint::Enum' ) ? _TypeTinyFromMoose_enum( $t ) : $t->isa( 'Moose::Meta::TypeConstraint::Class' ) ? _TypeTinyFromMoose_class( $t ) : $t->isa( 'Moose::Meta::TypeConstraint::Role' ) ? _TypeTinyFromMoose_role( $t ) : $t->isa( 'Moose::Meta::TypeConstraint::Union' ) ? _TypeTinyFromMoose_union( $t ) : $t->isa( 'Moose::Meta::TypeConstraint::DuckType' ) ? _TypeTinyFromMoose_ducktype( $t ) : _TypeTinyFromMoose_baseclass( $t ); #>>> # Standard stuff to do with all type constraints from Moose, # regardless of variety. $tt_opts->{moose_type} = $t; $tt_opts->{display_name} = $t->name; $tt_opts->{message} = sub { $t->get_message( $_ ) } if $t->has_message; my $new = $tt_class->new( %$tt_opts ); $ttt_cache{ refaddr( $t ) } = $new; weaken( $ttt_cache{ refaddr( $t ) } ); $new->{coercion} = do { require Type::Coercion::FromMoose; 'Type::Coercion::FromMoose'->new( type_constraint => $new, moose_coercion => $t->coercion, ); } if $t->has_coercion; return $new; } #/ sub _TypeTinyFromMoose sub _TypeTinyFromMoose_baseclass { my $t = shift; my %opts; $opts{parent} = to_TypeTiny( $t->parent ) if $t->has_parent; $opts{constraint} = $t->constraint; $opts{inlined} = sub { shift; $t->_inline_check( @_ ) } if $t->can( "can_be_inlined" ) && $t->can_be_inlined; # Cowardly refuse to inline types that need to close over stuff if ( $opts{inlined} ) { my %env = %{ $t->inline_environment || {} }; delete( $opts{inlined} ) if keys %env; } require Type::Tiny; return 'Type::Tiny' => \%opts; } #/ sub _TypeTinyFromMoose_baseclass sub _TypeTinyFromMoose_union { my $t = shift; my @mapped = map _TypeTinyFromMoose( $_ ), @{ $t->type_constraints }; require Type::Tiny::Union; return 'Type::Tiny::Union' => { type_constraints => \@mapped }; } sub _TypeTinyFromMoose_enum { my $t = shift; require Type::Tiny::Enum; return 'Type::Tiny::Enum' => { values => [ @{ $t->values } ] }; } sub _TypeTinyFromMoose_class { my $t = shift; require Type::Tiny::Class; return 'Type::Tiny::Class' => { class => $t->class }; } sub _TypeTinyFromMoose_role { my $t = shift; require Type::Tiny::Role; return 'Type::Tiny::Role' => { role => $t->role }; } sub _TypeTinyFromMoose_ducktype { my $t = shift; require Type::Tiny::Duck; return 'Type::Tiny::Duck' => { methods => [ @{ $t->methods } ] }; } sub _TypeTinyFromMoose_parameterizable { my $t = shift; my ( $class, $opts ) = _TypeTinyFromMoose_baseclass( $t ); $opts->{constraint_generator} = sub { # convert args into Moose native types; not strictly necessary my @args = map { is_TypeTiny( $_ ) ? $_->moose_type : $_ } @_; _TypeTinyFromMoose( $t->parameterize( @args ) ); }; return ( $class, $opts ); } #/ sub _TypeTinyFromMoose_parameterizable sub _TypeTinyFromValidationClass { my $t = $_[0]; require Type::Tiny; require Types::Standard; my %opts = ( parent => Types::Standard::HashRef(), _validation_class => $t, ); if ( $t->VERSION >= "7.900048" ) { $opts{constraint} = sub { $t->params->clear; $t->params->add( %$_ ); my $f = $t->filtering; $t->filtering( 'off' ); my $r = eval { $t->validate }; $t->filtering( $f || 'pre' ); return $r; }; $opts{message} = sub { $t->params->clear; $t->params->add( %$_ ); my $f = $t->filtering; $t->filtering( 'off' ); my $r = ( eval { $t->validate } ? "OK" : $t->errors_to_string ); $t->filtering( $f || 'pre' ); return $r; }; } #/ if ( $t->VERSION >= "7.900048") else # need to use hackish method { $opts{constraint} = sub { $t->params->clear; $t->params->add( %$_ ); no warnings "redefine"; local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] }; eval { $t->validate }; }; $opts{message} = sub { $t->params->clear; $t->params->add( %$_ ); no warnings "redefine"; local *Validation::Class::Directive::Filters::execute_filtering = sub { $_[0] }; eval { $t->validate } ? "OK" : $t->errors_to_string; }; } #/ else [ if ( $t->VERSION >= "7.900048")] require Type::Tiny; my $new = "Type::Tiny"->new( %opts ); $new->coercion->add_type_coercions( Types::Standard::HashRef() => sub { my %params = %$_; for my $k ( keys %params ) { delete $params{$_} unless $t->get_fields( $k ) } $t->params->clear; $t->params->add( %params ); eval { $t->validate }; $t->get_hash; }, ); $ttt_cache{ refaddr( $t ) } = $new; weaken( $ttt_cache{ refaddr( $t ) } ); return $new; } #/ sub _TypeTinyFromValidationClass sub _TypeTinyFromGeneric { my $t = $_[0]; my %opts = ( constraint => sub { $t->check( @_ ? @_ : $_ ) }, ); $opts{message} = sub { $t->get_message( @_ ? @_ : $_ ) } if $t->can( "get_message" ); $opts{display_name} = $t->name if $t->can( "name" ); $opts{coercion} = sub { $t->coerce( @_ ? @_ : $_ ) } if $t->can( "has_coercion" ) && $t->has_coercion && $t->can( "coerce" ); if ( $t->can( 'can_be_inlined' ) && $t->can_be_inlined && $t->can( 'inline_check' ) ) { $opts{inlined} = sub { $t->inline_check( $_[1] ) }; } require Type::Tiny; my $new = "Type::Tiny"->new( %opts ); $ttt_cache{ refaddr( $t ) } = $new; weaken( $ttt_cache{ refaddr( $t ) } ); return $new; } #/ sub _TypeTinyFromGeneric sub _TypeTinyFromMouse { my $t = $_[0]; my %opts = ( constraint => sub { $t->check( @_ ? @_ : $_ ) }, message => sub { $t->get_message( @_ ? @_ : $_ ) }, ); $opts{display_name} = $t->name if $t->can( "name" ); $opts{coercion} = sub { $t->coerce( @_ ? @_ : $_ ) } if $t->can( "has_coercion" ) && $t->has_coercion && $t->can( "coerce" ); if ( $t->{'constraint_generator'} ) { $opts{constraint_generator} = sub { # convert args into Moose native types; not strictly necessary my @args = map { is_TypeTiny( $_ ) ? $_->mouse_type : $_ } @_; _TypeTinyFromMouse( $t->parameterize( @args ) ); }; } require Type::Tiny; my $new = "Type::Tiny"->new( %opts ); $ttt_cache{ refaddr( $t ) } = $new; weaken( $ttt_cache{ refaddr( $t ) } ); return $new; } #/ sub _TypeTinyFromMouse my $QFS; sub _TypeTinyFromCodeRef { my $t = $_[0]; my %opts = ( constraint => sub { return !!eval { $t->( $_ ) }; }, message => sub { local $@; eval { $t->( $_ ); 1 } or do { chomp $@; return $@ if $@ }; return sprintf( '%s did not pass type constraint', Type::Tiny::_dd( $_ ) ); }, ); if ( $QFS ||= "Sub::Quote"->can( "quoted_from_sub" ) ) { my ( undef, $perlstring, $captures ) = @{ $QFS->( $t ) || [] }; if ( $perlstring ) { $perlstring = "!!eval{ $perlstring }"; $opts{inlined} = sub { my $var = $_[1]; Sub::Quote::inlinify( $perlstring, $var, $var eq q($_) ? '' : "local \$_ = $var;", 1, ); } if $perlstring && !$captures; } #/ if ( $perlstring ) } #/ if ( $QFS ||= "Sub::Quote"...) require Type::Tiny; my $new = "Type::Tiny"->new( %opts ); $ttt_cache{ refaddr( $t ) } = $new; weaken( $ttt_cache{ refaddr( $t ) } ); return $new; } #/ sub _TypeTinyFromCodeRef 1; __END__ =pod =encoding utf-8 =for stopwords arrayfication hashification =head1 NAME Types::TypeTiny - type constraints used internally by Type::Tiny =head1 STATUS This module is covered by the L. The B type is currently unstable. =head1 DESCRIPTION Dogfooding. This isn't a real Type::Library-based type library; that would involve too much circularity. But it exports some type constraints which, while designed for use within Type::Tiny, may be more generally useful. =head2 Types =over =item * B<< StringLike >> Accepts strings and objects overloading stringification. =item * B<< BoolLike >> Accepts undef, "", 0, 1; accepts any blessed object overloading "bool"; accepts any blessed object overloading "0+" to return 0 or 1. (Needs to actually call the overloaded operation to check that.) Also accepts any object that inherits from C or reports that as a role (C). Warning: an object which overloads "0+" without also turning on overload fallbacks may actually be useless as a practical boolean. But some common objects such as JSON::PP's booleans overload "0+" instead of overloading "bool" (thankfully with fallbacks enabled!) so we do need to support this. The intention of this type is to be a version of B which also accepts common boolean objects such as L. It is currently unstable and the exact definition of the type may change to better implement that intended functionality. =item * B<< HashLike[`a] >> Accepts hashrefs and objects overloading hashification. Since Types::TypeTiny 1.012, may be parameterized with another type constraint like B<< HashLike[Int] >>. =item * B<< ArrayLike[`a] >> Accepts arrayrefs and objects overloading arrayfication. Since Types::TypeTiny 1.012, may be parameterized with another type constraint like B<< ArrayLike[Int] >>. =item * B<< CodeLike >> Accepts coderefs and objects overloading codification. =item * B<< TypeTiny >> Accepts blessed L objects. =item * B<< _ForeignTypeConstraint >> Any reference which to_TypeTiny recognizes as something that can be coerced to a Type::Tiny object. Yes, the underscore is included. =back =head2 Coercion Functions =over =item C<< to_TypeTiny($constraint) >> Promotes (or "demotes" if you prefer) a "foreign" type constraint to a Type::Tiny object. Can handle: =over =item * Moose types (including L objects and L objects). =item * Mouse types (including L objects). =item * L and L objects. =item * Types built using L. =item * Any object which provides C and C methods. (This includes L and L types.) If the object provides C and L methods, these will be used to handle quoting. If the object provides C and C methods, these will be used to handling inlining. If the object provides a C method, this will be assumed to return the type name. =item * Coderefs (but not blessed coderefs or objects overloading C<< &{} >> unless they provide the methods described above!) Coderefs are expected to return true iff C<< $_ >> passes the constraint. If C<< $_ >> fails the type constraint, they may either return false, or die with a helpful error message. =item * L-enabled coderefs. These are handled the same way as above, but Type::Tiny will consult Sub::Quote to determine if they can be inlined. =back =back =head2 Methods These are implemented so that C<< Types::TypeTiny->meta->get_type($foo) >> works, for rough compatibility with a real L type library. =over =item C<< meta >> =item C<< type_names >> =item C<< get_type($name) >> =item C<< has_type($name) >> =item C<< coercion_names >> =item C<< get_coercion($name) >> =item C<< has_coercion($name) >> =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Any.t000664001750001750 1472115111656240 15203 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Any ); isa_ok(Any, 'Type::Tiny', 'Any'); is(Any->name, 'Any', 'Any has correct name'); is(Any->display_name, 'Any', 'Any has correct display_name'); is(Any->library, 'Types::Standard', 'Any knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Any'), 'Types::Standard knows it has type Any'); ok(!Any->deprecated, 'Any is not deprecated'); ok(!Any->is_anon, 'Any is not anonymous'); ok(Any->can_be_inlined, 'Any can be inlined'); is(exception { Any->inline_check(q/$xyz/) }, undef, "Inlining Any doesn't throw an exception"); ok(!Any->has_coercion, "Any doesn't have a coercion"); ok(!Any->is_parameterizable, "Any isn't parameterizable"); isnt(Any->type_default, undef, "Any has a type_default"); is(Any->type_default->(), undef, "Any type_default is undef"); my @none_tests = # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Any, ucfirst("$label should pass Any")); } elsif ($expect eq 'fail') { should_fail($value, Any, ucfirst("$label should fail Any")); } else { fail("expected '$expect'?!"); } } # # The complement of Any is None, which rejects everything. # my $None = ~Any; is($None->name, "None", "Complement of Any is None."); ok($None->can_be_inlined, "None can be inlined."); subtest "None fails where Any passes and vice versa" => sub { while (@none_tests) { my ($expect, $label, $value) = splice(@none_tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_fail($value, $None, ucfirst("$label should fail None")); } elsif ($expect eq 'fail') { should_pass($value, $None, ucfirst("$label should pass None")); } else { fail("expected '$expect'?!"); } } }; done_testing; ArrayLike.t000664001750001750 2132715111656240 16337 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( ArrayLike ); isa_ok(ArrayLike, 'Type::Tiny', 'ArrayLike'); is(ArrayLike->name, 'ArrayLike', 'ArrayLike has correct name'); is(ArrayLike->display_name, 'ArrayLike', 'ArrayLike has correct display_name'); is(ArrayLike->library, 'Types::TypeTiny', 'ArrayLike knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('ArrayLike'), 'Types::TypeTiny knows it has type ArrayLike'); ok(!ArrayLike->deprecated, 'ArrayLike is not deprecated'); ok(!ArrayLike->is_anon, 'ArrayLike is not anonymous'); ok(ArrayLike->can_be_inlined, 'ArrayLike can be inlined'); is(exception { ArrayLike->inline_check(q/$xyz/) }, undef, "Inlining ArrayLike doesn't throw an exception"); ok(!ArrayLike->has_coercion, "ArrayLike doesn't have a coercion"); ok(ArrayLike->is_parameterizable, "ArrayLike is parameterizable"); isnt(ArrayLike->type_default, undef, "ArrayLike has a type_default"); is_deeply(ArrayLike->type_default->(), [], "ArrayLike type_default is []"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, ArrayLike, ucfirst("$label should pass ArrayLike")); } elsif ($expect eq 'fail') { should_fail($value, ArrayLike, ucfirst("$label should fail ArrayLike")); } else { fail("expected '$expect'?!"); } } # # Parameterizable # use Types::Standard (); my $ArrayOfInt = ArrayLike[ Types::Standard::Int() ]; ok( $ArrayOfInt->can_be_inlined ); should_pass( [1,2,3], $ArrayOfInt, ); should_pass( bless({ array=>[1,2,3] }, 'Local::OL::Array'), $ArrayOfInt, ); should_fail( [undef,2,3], $ArrayOfInt, ); should_fail( bless({ array=>[undef,2,3] }, 'Local::OL::Array'), $ArrayOfInt, ); my $ArrayOfRounded = ArrayLike[ Types::Standard::Int()->plus_coercions( Types::Standard::Num(), => q{ int($_) }, ) ]; is_deeply( $ArrayOfRounded->coerce([1.1, 2, 3]), [1,2,3], ); # Note that because of coercion, the object overloading @{} # is now a plain old arrayref. is_deeply( $ArrayOfRounded->coerce(bless({ array=>[1.1,2,3] }, 'Local::OL::Array')), [1,2,3], ); is_deeply( $ArrayOfRounded->coerce([1.1, undef, 3]), [1.1,undef,3], # cannot be coerced, so returned unchanged ); # can't use is_deeply because object doesn't overload eq # but the idea is because the coercion fails, the original # object gets returned unchanged ok( Scalar::Util::blessed( $ArrayOfRounded->coerce(bless({ array=>[1.1,undef,3] }, 'Local::OL::Array')) ), ); # # Tied arrays, and combining them with array-overloaded objects # { package MaiTai::Array; use Tie::Array; our @ISA = 'Tie::Array'; sub TIEARRAY { bless { data => [] }, $_[0]; } sub FETCH { $_[0]{data}[$_[1]]; } sub FETCHSIZE { scalar @{ $_[0]{data} } } sub STORE { $_[0]{data}[$_[1]] = $_[2]; } sub STORESIZE { $#{ $_[0]{data} } = $_[1]-1; } sub EXISTS { exists $_[0]{data}[$_[1]]; } sub DELETE { delete $_[0]{data}[$_[1]]; } ## package MaiObj::Array; use overload '@{}' => sub { my $obj = shift; my @arr; tie( @arr, 'MaiTai::Array' ) if $obj->{do_tie}; push @arr, @{ $obj->{items} }; return \@arr; }; sub new { my ( $class, $do_tie ) = ( shift, shift ); bless { do_tie => $do_tie, items => [ @_ ] }, $class; } } { my @arr; tie( @arr, 'MaiTai::Array' ); @arr = ( 1..10 ); should_pass( \@arr, $ArrayOfInt, 'tied array that should pass' ); } { my @arr; tie( @arr, 'MaiTai::Array' ); @arr = ( 'foo', 1 .. 10 ); should_fail( \@arr, $ArrayOfInt, 'tied array that should fail' ); } { my $obj = 'MaiObj::Array'->new( !!0, 1 .. 10 ); should_pass( $obj, $ArrayOfInt, 'overloaded object yielding regular array that should pass' ); } { my $obj = 'MaiObj::Array'->new( !!0, 'foo', 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding regular array that should fail' ); } { my $obj = 'MaiObj::Array'->new( !!1, 1 .. 10 ); should_pass( $obj, $ArrayOfInt, 'overloaded object yielding tied array that should pass' ); } { my $obj = 'MaiObj::Array'->new( !!1, 'foo', 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding tied array that should fail' ); } done_testing; ArrayRef.t000664001750001750 3023415111656240 16164 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( ArrayRef ); isa_ok(ArrayRef, 'Type::Tiny', 'ArrayRef'); is(ArrayRef->name, 'ArrayRef', 'ArrayRef has correct name'); is(ArrayRef->display_name, 'ArrayRef', 'ArrayRef has correct display_name'); is(ArrayRef->library, 'Types::Standard', 'ArrayRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('ArrayRef'), 'Types::Standard knows it has type ArrayRef'); ok(!ArrayRef->deprecated, 'ArrayRef is not deprecated'); ok(!ArrayRef->is_anon, 'ArrayRef is not anonymous'); ok(ArrayRef->can_be_inlined, 'ArrayRef can be inlined'); is(exception { ArrayRef->inline_check(q/$xyz/) }, undef, "Inlining ArrayRef doesn't throw an exception"); ok(!ArrayRef->has_coercion, "ArrayRef doesn't have a coercion"); ok(ArrayRef->is_parameterizable, "ArrayRef is parameterizable"); isnt(ArrayRef->type_default, undef, "ArrayRef has a type_default"); is_deeply(ArrayRef->type_default->(), [], "ArrayRef type_default is []"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, ArrayRef, ucfirst("$label should pass ArrayRef")); } elsif ($expect eq 'fail') { should_fail($value, ArrayRef, ucfirst("$label should fail ArrayRef")); } else { fail("expected '$expect'?!"); } } # # ArrayRef is parameterizable # my $ArrayOfInts = ArrayRef->of( Types::Standard::Int ); isa_ok($ArrayOfInts, 'Type::Tiny', '$ArrayOfInts'); is($ArrayOfInts->display_name, 'ArrayRef[Int]', '$ArrayOfInts has correct display_name'); ok($ArrayOfInts->is_anon, '$ArrayOfInts has no name'); ok($ArrayOfInts->can_be_inlined, '$ArrayOfInts can be inlined'); is(exception { $ArrayOfInts->inline_check(q/$xyz/) }, undef, "Inlining \$ArrayOfInts doesn't throw an exception"); ok(!$ArrayOfInts->has_coercion, "\$ArrayOfInts doesn't have a coercion"); ok(!$ArrayOfInts->is_parameterizable, "\$ArrayOfInts is not parameterizable"); isnt($ArrayOfInts->type_default, undef, "\$ArrayOfInts has a type_default"); is_deeply($ArrayOfInts->type_default->(), [], "\$ArrayOfInts type_default is []"); ok_subtype(ArrayRef, $ArrayOfInts); should_fail( 1, $ArrayOfInts ); should_fail( {}, $ArrayOfInts ); should_pass( [ ], $ArrayOfInts ); should_fail( [ [] ], $ArrayOfInts ); should_fail( [ 1.1 ], $ArrayOfInts ); should_pass( [ 1 ], $ArrayOfInts ); should_pass( [ 0 ], $ArrayOfInts ); should_pass( [ -1 ], $ArrayOfInts ); should_fail( [ \1 ], $ArrayOfInts ); should_pass( [ 1, 2 ], $ArrayOfInts ); should_fail( [ 1, [] ], $ArrayOfInts ); use Scalar::Util qw( refaddr ); my $plain = ArrayRef; my $paramd = ArrayRef[]; is( refaddr($plain), refaddr($paramd), 'parameterizing with [] has no effect' ); my $p1 = ArrayRef[Types::Standard::Int]; my $p2 = ArrayRef[Types::Standard::Int]; is(refaddr($p1), refaddr($p2), 'parameterizing is cached'); # # ArrayRef can accept a second parameter. # my $ArrayOfAtLeastTwoInts = ArrayRef->of( Types::Standard::Int, 2 ); should_fail( 1, $ArrayOfAtLeastTwoInts ); should_fail( {}, $ArrayOfAtLeastTwoInts ); should_fail( [ ], $ArrayOfAtLeastTwoInts ); should_fail( [ [] ], $ArrayOfAtLeastTwoInts ); should_fail( [ 1.1 ], $ArrayOfAtLeastTwoInts ); should_fail( [ 1 ], $ArrayOfAtLeastTwoInts ); should_fail( [ 0 ], $ArrayOfAtLeastTwoInts ); should_fail( [ -1 ], $ArrayOfAtLeastTwoInts ); should_fail( [ \1 ], $ArrayOfAtLeastTwoInts ); should_pass( [ 1, 2 ], $ArrayOfAtLeastTwoInts ); should_fail( [ 1, [] ], $ArrayOfAtLeastTwoInts ); should_pass( [ 1, -1 ], $ArrayOfAtLeastTwoInts ); should_pass( [ 1 .. 9 ], $ArrayOfAtLeastTwoInts ); is($ArrayOfAtLeastTwoInts->type_default, undef, "\$ArrayOfAtLeastTwoInts has no type_default"); # # ArrayRef has deep coercions # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, q{ int($_) } ); my $ArrayOfRounded = ArrayRef->of( $Rounded ); isa_ok($ArrayOfRounded, 'Type::Tiny', '$ArrayOfRounded'); is($ArrayOfRounded->display_name, 'ArrayRef[Int]', '$ArrayOfRounded has correct display_name'); ok($ArrayOfRounded->is_anon, '$ArrayOfRounded has no name'); ok($ArrayOfRounded->can_be_inlined, '$ArrayOfRounded can be inlined'); is(exception { $ArrayOfRounded->inline_check(q/$xyz/) }, undef, "Inlining \$ArrayOfRounded doesn't throw an exception"); ok($ArrayOfRounded->has_coercion, "\$ArrayOfRounded has a coercion"); ok($ArrayOfRounded->coercion->has_coercion_for_type(ArrayRef), '$ArrayRefOfRounded can coerce from ArrayRef'); ok($ArrayOfRounded->coercion->has_coercion_for_type(ArrayRef->of(Types::Standard::Num)), '$ArrayRefOfRounded can coerce from ArrayRef[Num]'); ok(!$ArrayOfRounded->is_parameterizable, "\$ArrayOfRounded is not parameterizable"); ok_subtype(ArrayRef, $ArrayOfRounded); should_fail( 1, $ArrayOfRounded ); should_fail( {}, $ArrayOfRounded ); should_pass( [ ], $ArrayOfRounded ); should_fail( [ [] ], $ArrayOfRounded ); should_fail( [ 1.1 ], $ArrayOfRounded ); should_pass( [ 1 ], $ArrayOfRounded ); should_pass( [ 0 ], $ArrayOfRounded ); should_pass( [ -1 ], $ArrayOfRounded ); should_fail( [ \1 ], $ArrayOfRounded ); should_pass( [ 1, 2 ], $ArrayOfRounded ); should_fail( [ 1, [] ], $ArrayOfRounded ); do { my $orig = [ 42 ]; my $coerced = $ArrayOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "just returned orig unchanged" ); }; do { my $orig = [ 42.1 ]; my $coerced = $ArrayOfRounded->coerce($orig); isnt( refaddr($orig), refaddr($coerced), "coercion happened" ); is($coerced->[0], 42, "... and data looks good"); should_pass($coerced, $ArrayOfRounded, "... and now passes type constraint"); }; do { my $orig = [ [] ]; my $coerced = $ArrayOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "coercion failed, so orig was returned" ); should_fail($coerced, $ArrayOfRounded); }; # # Tied arrays, and combining them with array-overloaded objects # { package MaiTai::Array; use Tie::Array; our @ISA = 'Tie::Array'; sub TIEARRAY { bless { data => [] }, $_[0]; } sub FETCH { $_[0]{data}[$_[1]]; } sub FETCHSIZE { scalar @{ $_[0]{data} } } sub STORE { $_[0]{data}[$_[1]] = $_[2]; } sub STORESIZE { $#{ $_[0]{data} } = $_[1]-1; } sub EXISTS { exists $_[0]{data}[$_[1]]; } sub DELETE { delete $_[0]{data}[$_[1]]; } ## package MaiObj::Array; use overload '@{}' => sub { my $obj = shift; my @arr; tie( @arr, 'MaiTai::Array' ) if $obj->{do_tie}; push @arr, @{ $obj->{items} }; return \@arr; }; sub new { my ( $class, $do_tie ) = ( shift, shift ); bless { do_tie => $do_tie, items => [ @_ ] }, $class; } } my $ArrayOfInt = $ArrayOfInts; { my @arr; tie( @arr, 'MaiTai::Array' ); @arr = ( 1..10 ); should_pass( \@arr, $ArrayOfInt, 'tied array that should pass' ); } { my @arr; tie( @arr, 'MaiTai::Array' ); @arr = ( 'foo', 1 .. 10 ); should_fail( \@arr, $ArrayOfInt, 'tied array that should fail' ); } { my $obj = 'MaiObj::Array'->new( !!0, 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding regular array that would pass if it weren\'t for the interleving overloaded object' ); } { my $obj = 'MaiObj::Array'->new( !!0, 'foo', 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding regular array that should fail' ); } { my $obj = 'MaiObj::Array'->new( !!1, 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding tied array that would pass if it weren\'t for the interleving overloaded object' ); } { my $obj = 'MaiObj::Array'->new( !!1, 'foo', 1 .. 10 ); should_fail( $obj, $ArrayOfInt, 'overloaded object yielding tied array that should fail' ); } done_testing; Bool.t000664001750001750 2510515111656240 15345 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Bool ); isa_ok(Bool, 'Type::Tiny', 'Bool'); is(Bool->name, 'Bool', 'Bool has correct name'); is(Bool->display_name, 'Bool', 'Bool has correct display_name'); is(Bool->library, 'Types::Standard', 'Bool knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Bool'), 'Types::Standard knows it has type Bool'); ok(!Bool->deprecated, 'Bool is not deprecated'); ok(!Bool->is_anon, 'Bool is not anonymous'); ok(Bool->can_be_inlined, 'Bool can be inlined'); is(exception { Bool->inline_check(q/$xyz/) }, undef, "Inlining Bool doesn't throw an exception"); ok(Bool->has_coercion, "Bool has a coercion"); ok(!Bool->is_parameterizable, "Bool isn't parameterizable"); isnt(Bool->type_default, undef, "Bool has a type_default"); is(Bool->type_default->(), !!0, "Bool type_default is false"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, pass => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Bool, ucfirst("$label should pass Bool")); } elsif ($expect eq 'fail') { should_fail($value, Bool, ucfirst("$label should fail Bool")); } else { fail("expected '$expect'?!"); } } # # Bool has coercions from everything. # my @tests2 = ( false => 'undef' => undef, false => 'false' => !!0, true => 'true' => !!1, false => 'zero' => 0, true => 'one' => 1, true => 'negative one' => -1, true => 'non integer' => 3.1416, false => 'empty string' => '', true => 'whitespace' => ' ', true => 'line break' => "\n", true => 'random string' => 'abc123', true => 'loaded package name' => 'Type::Tiny', true => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', true => 'a reference to undef' => do { my $x = undef; \$x }, true => 'a reference to false' => do { my $x = !!0; \$x }, true => 'a reference to true' => do { my $x = !!1; \$x }, true => 'a reference to zero' => do { my $x = 0; \$x }, true => 'a reference to one' => do { my $x = 1; \$x }, true => 'a reference to empty string' => do { my $x = ''; \$x }, true => 'a reference to random string' => do { my $x = 'abc123'; \$x }, true => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), true => 'empty arrayref' => [], true => 'arrayref with one zero' => [0], true => 'arrayref of integers' => [1..10], true => 'arrayref of numbers' => [1..10, 3.1416], true => 'blessed arrayref' => bless([], 'SomePkg'), true => 'empty hashref' => {}, true => 'hashref' => { foo => 1 }, true => 'blessed hashref' => bless({}, 'SomePkg'), true => 'coderef' => sub { 1 }, true => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), true => 'glob' => do { no warnings 'once'; *SOMETHING }, true => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, true => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), true => 'regexp' => qr/./, true => 'blessed regexp' => bless(qr/./, 'SomePkg'), true => 'filehandle' => do { open my $x, '<', $0 or die; $x }, true => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, true => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, true => 'ref to arrayref' => do { my $x = []; \$x }, true => 'ref to hashref' => do { my $x = {}; \$x }, true => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, true => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, true => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[bool] => sub { !!1 }; bless [] }, true => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[bool] => sub { !!1 }; bless [] }, false => 'object boolifying to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { !!0 }; bless [] }, true => 'object boolifying to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { !!1 }; bless [] }, true => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[bool] => sub { !!1 }; bless [] }, true => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[bool] => sub { !!1 }; bless [] }, true => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[bool] => sub { !!1 }; bless {array=>[]} }, true => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[bool] => sub { !!1 }; bless [{}] }, true => 'object overloading coderef' => do { package Local::OL::Code; use overload q[bool] => sub { !!1 }; bless [sub { 1 }] }, ); while (@tests2) { my ($expect, $label, $value) = splice(@tests2, 0 , 3); my $coerced; my $exception = exception { $coerced = Bool->assert_coerce($value) }; is($exception, undef, "Bool coerced $label successfully"); if ($expect eq 'true') { ok($coerced, "Bool coerced $label to true"); } elsif ($expect eq 'false') { ok(!$coerced, "Bool coerced $label to false"); } else { fail("expected '$expect'?!"); } } # # Bool and JSON::PP is worth showing. # if (eval { require JSON::PP }) { my $JSON_true = JSON::PP::true(); my $JSON_false = JSON::PP::false(); my @values; my $exception = exception { @values = map Bool->assert_coerce($_), $JSON_true, $JSON_false; }; should_fail($JSON_true, Bool, "JSON::PP::true does NOT pass Bool"); should_fail($JSON_false, Bool, "JSON::PP::false does NOT pass Bool"); is($exception, undef, "Bool coerced JSON::PP::true and JSON::PP::false"); ok($values[0], "Bool coerced JSON::PP::true to true"); ok(!$values[1], "Bool coerced JSON::PP::false to false"); } done_testing; BoolLike.t000664001750001750 1370715111656240 16157 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( BoolLike ); isa_ok(BoolLike, 'Type::Tiny', 'BoolLike'); is(BoolLike->name, 'BoolLike', 'BoolLike has correct name'); is(BoolLike->display_name, 'BoolLike', 'BoolLike has correct display_name'); is(BoolLike->library, 'Types::TypeTiny', 'BoolLike knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('BoolLike'), 'Types::TypeTiny knows it has type BoolLike'); ok(!BoolLike->deprecated, 'BoolLike is not deprecated'); ok(!BoolLike->is_anon, 'BoolLike is not anonymous'); ok(BoolLike->can_be_inlined, 'BoolLike can be inlined'); is(exception { BoolLike->inline_check(q/$xyz/) }, undef, "Inlining BoolLike doesn't throw an exception"); ok(!BoolLike->has_coercion, "BoolLike has no coercion"); ok(!BoolLike->is_parameterizable, "BoolLike isn't parameterizable"); isnt(BoolLike->type_default, undef, "BoolLike has a type_default"); is(BoolLike->type_default->(), !!0, "BoolLike type_default is false"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, pass => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, BoolLike, ucfirst("$label should pass Bool")); } elsif ($expect eq 'fail') { should_fail($value, BoolLike, ucfirst("$label should fail Bool")); } else { fail("expected '$expect'?!"); } } done_testing; ClassName.t000664001750001750 1733115111656240 16322 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( ClassName ); isa_ok(ClassName, 'Type::Tiny', 'ClassName'); is(ClassName->name, 'ClassName', 'ClassName has correct name'); is(ClassName->display_name, 'ClassName', 'ClassName has correct display_name'); is(ClassName->library, 'Types::Standard', 'ClassName knows it is in the Types::Standard library'); ok(Types::Standard->has_type('ClassName'), 'Types::Standard knows it has type ClassName'); ok(!ClassName->deprecated, 'ClassName is not deprecated'); ok(!ClassName->is_anon, 'ClassName is not anonymous'); ok(ClassName->can_be_inlined, 'ClassName can be inlined'); is(exception { ClassName->inline_check(q/$xyz/) }, undef, "Inlining ClassName doesn't throw an exception"); ok(!ClassName->has_coercion, "ClassName doesn't have a coercion"); ok(!ClassName->is_parameterizable, "ClassName isn't parameterizable"); is(ClassName->type_default, undef, "ClassName has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, ClassName, ucfirst("$label should pass ClassName")); } elsif ($expect eq 'fail') { should_fail($value, ClassName, ucfirst("$label should fail ClassName")); } else { fail("expected '$expect'?!"); } } # # ClassName accepts Class::Tiny, Moo, Moose, and Mouse classes # if (eval q{ package Local::Class::ClassTiny; use Class::Tiny; 1 }) { should_pass('Local::Class::ClassTiny', ClassName); } if (eval q{ package Local::Class::Moo; use Moo; 1 }) { should_pass('Local::Class::Moo', ClassName); } if (eval q{ package Local::Class::Moose; use Moose; 1 }) { should_pass('Local::Class::Moose', ClassName); } if (eval q{ package Local::Class::Mouse; use Mouse; 1 }) { should_pass('Local::Class::Mouse', ClassName); } # # ClassName accepts Role::Tiny, Moo::Role, Moose::Role, and Mouse::Role roles. # # This is because there's no way of knowing that these roles cannot be # used as a class. Even if there's no method called `new`, there might # be a constructor with a different name. # if (eval q{ package Local::Role::RoleTiny; use Role::Tiny; 1 }) { should_pass('Local::Role::RoleTiny', ClassName); } if (eval q{ package Local::Role::MooRole; use Moo::Role; 1 }) { should_pass('Local::Role::MooRole', ClassName); } if (eval q{ package Local::Role::MooseRole; use Moose::Role; 1 }) { should_pass('Local::Role::MooseRole', ClassName); } if (eval q{ package Local::Role::MouseRole; use Mouse::Role; 1 }) { should_pass('Local::Role::MouseRole', ClassName); } # # ClassName accepts any package with $VERSION defined. # if (eval q{ package Local::Random::Package::One; our $VERSION = 1; 1 }) { should_pass('Local::Random::Package::One', ClassName); } # # ClassName accepts any package with @ISA. # if (eval q{ package Local::Random::Package::Two; our @ISA = qw(Local::Random::Package::One); 1 }) { should_pass('Local::Random::Package::Two', ClassName); } if (eval q{ package Local::Random::Package::Three; our @ISA; 1 }) { # ... but an empty @ISA doesn't count. should_fail('Local::Random::Package::Three', ClassName); } done_testing; CodeLike.t000664001750001750 1374515111656240 16140 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( CodeLike ); isa_ok(CodeLike, 'Type::Tiny', 'CodeLike'); is(CodeLike->name, 'CodeLike', 'CodeLike has correct name'); is(CodeLike->display_name, 'CodeLike', 'CodeLike has correct display_name'); is(CodeLike->library, 'Types::TypeTiny', 'CodeLike knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('CodeLike'), 'Types::TypeTiny knows it has type CodeLike'); ok(!CodeLike->deprecated, 'CodeLike is not deprecated'); ok(!CodeLike->is_anon, 'CodeLike is not anonymous'); ok(CodeLike->can_be_inlined, 'CodeLike can be inlined'); is(exception { CodeLike->inline_check(q/$xyz/) }, undef, "Inlining CodeLike doesn't throw an exception"); ok(!CodeLike->has_coercion, "CodeLike doesn't have a coercion"); ok(!CodeLike->is_parameterizable, "CodeLike isn't parameterizable"); isnt(CodeLike->type_default, undef, "CodeLike has a type_default"); is(scalar CodeLike->type_default->()->(), undef, "CodeLike type_default is sub {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, CodeLike, ucfirst("$label should pass CodeLike")); } elsif ($expect eq 'fail') { should_fail($value, CodeLike, ucfirst("$label should fail CodeLike")); } else { fail("expected '$expect'?!"); } } done_testing; CodeRef.t000664001750001750 1370315111656240 15762 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( CodeRef ); isa_ok(CodeRef, 'Type::Tiny', 'CodeRef'); is(CodeRef->name, 'CodeRef', 'CodeRef has correct name'); is(CodeRef->display_name, 'CodeRef', 'CodeRef has correct display_name'); is(CodeRef->library, 'Types::Standard', 'CodeRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('CodeRef'), 'Types::Standard knows it has type CodeRef'); ok(!CodeRef->deprecated, 'CodeRef is not deprecated'); ok(!CodeRef->is_anon, 'CodeRef is not anonymous'); ok(CodeRef->can_be_inlined, 'CodeRef can be inlined'); is(exception { CodeRef->inline_check(q/$xyz/) }, undef, "Inlining CodeRef doesn't throw an exception"); ok(!CodeRef->has_coercion, "CodeRef doesn't have a coercion"); ok(!CodeRef->is_parameterizable, "CodeRef isn't parameterizable"); isnt(CodeRef->type_default, undef, "CodeRef has a type_default"); is(scalar CodeRef->type_default->()->(), undef, "CodeRef type_default is sub {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, CodeRef, ucfirst("$label should pass CodeRef")); } elsif ($expect eq 'fail') { should_fail($value, CodeRef, ucfirst("$label should fail CodeRef")); } else { fail("expected '$expect'?!"); } } done_testing; ConsumerOf.t000664001750001750 2025015111656240 16526 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( ConsumerOf ); isa_ok(ConsumerOf, 'Type::Tiny', 'ConsumerOf'); is(ConsumerOf->name, 'ConsumerOf', 'ConsumerOf has correct name'); is(ConsumerOf->display_name, 'ConsumerOf', 'ConsumerOf has correct display_name'); is(ConsumerOf->library, 'Types::Standard', 'ConsumerOf knows it is in the Types::Standard library'); ok(Types::Standard->has_type('ConsumerOf'), 'Types::Standard knows it has type ConsumerOf'); ok(!ConsumerOf->deprecated, 'ConsumerOf is not deprecated'); ok(!ConsumerOf->is_anon, 'ConsumerOf is not anonymous'); ok(ConsumerOf->can_be_inlined, 'ConsumerOf can be inlined'); is(exception { ConsumerOf->inline_check(q/$xyz/) }, undef, "Inlining ConsumerOf doesn't throw an exception"); ok(!ConsumerOf->has_coercion, "ConsumerOf doesn't have a coercion"); ok(ConsumerOf->is_parameterizable, "ConsumerOf is parameterizable"); is(ConsumerOf->type_default, undef, "ConsumerOf has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), xxxx => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, ConsumerOf, ucfirst("$label should pass ConsumerOf")); } elsif ($expect eq 'fail') { should_fail($value, ConsumerOf, ucfirst("$label should fail ConsumerOf")); } else { fail("expected '$expect'?!"); } } # # Parameterized ConsumerOf returns a Type::Tiny::Role. # should_pass(ConsumerOf['Foo'], ConsumerOf['Type::Tiny::Role']); should_pass(ConsumerOf['Foo'], ConsumerOf['Type::Tiny']); # # If Foo::Bar is a subclass of Foo, then Foo::Bar objects # should pass ConsumerOf['Foo'] but not the other way around. # (Note: UNIVERSAL::DOES calls $object->isa.) # @Foo::Bar::ISA = qw( Foo ); should_pass( bless([], 'Foo::Bar'), ConsumerOf['Foo::Bar'] ); should_pass( bless([], 'Foo::Bar'), ConsumerOf['Foo'] ); should_fail( bless([], 'Foo'), ConsumerOf['Foo::Bar'] ); should_pass( bless([], 'Foo'), ConsumerOf['Foo'] ); # # Parameterized ConsumerOf with two parameters returns a # Type::Tiny::Intersection of two Type::Tiny::Role objects. # my $fb = ConsumerOf['Foo','Bar']; should_pass($fb, ConsumerOf['Type::Tiny::Intersection']); should_pass($fb, ConsumerOf['Type::Tiny']); is(scalar(@$fb), 2); should_pass($fb->[0], ConsumerOf['Type::Tiny::Role']); should_pass($fb->[1], ConsumerOf['Type::Tiny::Role']); { package Foo; package Bar; } @MyConsumer::ISA = qw( Foo Bar ); should_pass( bless([], 'MyConsumer'), $fb ); # # Test using Class::Tiny and Role::Tiny # if (eval q{ package My::TinyRole; use Role::Tiny; package My::TinyClass; use Class::Tiny; use Role::Tiny::With; with 'My::TinyRole'; 1 }) { should_pass(My::TinyClass->new, ConsumerOf['My::TinyRole']); should_pass(My::TinyClass->new, ConsumerOf['My::TinyClass']); } # # Test using Moo # if (eval q{ package My::MooRole; use Moo::Role; package My::MooClass; use Moo; with 'My::MooRole'; 1 }) { should_pass(My::MooClass->new, ConsumerOf['My::MooRole']); should_pass(My::MooClass->new, ConsumerOf['My::MooClass']); } # # Test using Moose # if (eval q{ package My::MooseRole; use Moose::Role; package My::MooseClass; use Moose; with 'My::MooseRole'; 1 }) { should_pass(My::MooseClass->new, ConsumerOf['My::MooseRole']); should_pass(My::MooseClass->new, ConsumerOf['My::MooseClass']); } # # Test using Mouse # if (eval q{ package My::MouseRole; use Mouse::Role; package My::MouseClass; use Mouse; with 'My::MouseRole'; 1 }) { should_pass(My::MouseClass->new, ConsumerOf['My::MouseRole']); should_pass(My::MouseClass->new, ConsumerOf['My::MouseClass']); } done_testing; CycleTuple.t000664001750001750 1744115111656240 16527 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( CycleTuple ); isa_ok(CycleTuple, 'Type::Tiny', 'CycleTuple'); is(CycleTuple->name, 'CycleTuple', 'CycleTuple has correct name'); is(CycleTuple->display_name, 'CycleTuple', 'CycleTuple has correct display_name'); is(CycleTuple->library, 'Types::Standard', 'CycleTuple knows it is in the Types::Standard library'); ok(Types::Standard->has_type('CycleTuple'), 'Types::Standard knows it has type CycleTuple'); ok(!CycleTuple->deprecated, 'CycleTuple is not deprecated'); ok(!CycleTuple->is_anon, 'CycleTuple is not anonymous'); ok(CycleTuple->can_be_inlined, 'CycleTuple can be inlined'); is(exception { CycleTuple->inline_check(q/$xyz/) }, undef, "Inlining CycleTuple doesn't throw an exception"); ok(!CycleTuple->has_coercion, "CycleTuple doesn't have a coercion"); ok(CycleTuple->is_parameterizable, "CycleTuple is parameterizable"); isnt(CycleTuple->type_default, undef, "CycleTuple has a type_default"); is_deeply(CycleTuple->type_default->(), [], "CycleTuple type_default is []"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, CycleTuple, ucfirst("$label should pass CycleTuple")); } elsif ($expect eq 'fail') { should_fail($value, CycleTuple, ucfirst("$label should fail CycleTuple")); } else { fail("expected '$expect'?!"); } } # # Basic example. # my $type1 = CycleTuple[ Types::Standard::Int, Types::Standard::HashRef, Types::Standard::RegexpRef, ]; should_pass([ 1,{},qr// ], $type1); should_pass([ 1,{},qr// => 2,{},qr// ], $type1); should_pass([ 1,{},qr// => 2,{},qr// => 3,{},qr// ], $type1); should_pass([ 1,{},qr// => 2,{},qr// => 3,{},qr// => 4,{},qr// ], $type1); should_fail([ 1,{},qr// => 2,{},qr// => 3,{},qr// => 4,{} ], $type1); # fails because missing slot should_fail([ 1,{},qr// => 2,{},qr// => 3,{},qr// => 4,{},[] ], $type1); # fails because bad value in slot # # Explanations # my $explanation = join "\n", @{ $type1->validate_explain([1], '$VAL') }; like($explanation, qr/expects a multiple of 3 values in the array/); like($explanation, qr/1 values? found/); my $explanation2 = join "\n", @{ $type1->validate_explain([1,undef,qr//], '$VAL') }; like($explanation2, qr/constrains value at index 1 of array with "HashRef"/); # # Empty arrayref # use Types::Standard qw( ArrayRef Any ); # An empty arrayref is okay should_pass( [], $type1 ); # Here's one way to make sure the arrayref isn't empty should_fail( [], $type1->where('@$_>0') ); # Here's another way should_fail( [], ArrayRef[Any,1] & $type1 ); # # Optional is not allowed. # my $e = exception { CycleTuple[ Types::Standard::Optional[ Types::Standard::Int, ], ] }; like($e, qr/cannot be optional/, 'correct exception'); # # Deep coercions # my $type2 = CycleTuple[ Types::Standard::Int->plus_coercions( Types::Standard::Num, q{ int($_) }, ), Types::Standard::HashRef, ]; my $coerced = $type2->coerce( [ 1.1,{} => 2.1,{} => 3.1,{} => 4.1,{} ] ); is_deeply( $coerced, [ 1,{} => 2,{} => 3,{} => 4,{} ], 'coercion worked', ); done_testing; Defined.t000664001750001750 1367415111656240 16020 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Defined ); isa_ok(Defined, 'Type::Tiny', 'Defined'); is(Defined->name, 'Defined', 'Defined has correct name'); is(Defined->display_name, 'Defined', 'Defined has correct display_name'); is(Defined->library, 'Types::Standard', 'Defined knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Defined'), 'Types::Standard knows it has type Defined'); ok(!Defined->deprecated, 'Defined is not deprecated'); ok(!Defined->is_anon, 'Defined is not anonymous'); ok(Defined->can_be_inlined, 'Defined can be inlined'); is(exception { Defined->inline_check(q/$xyz/) }, undef, "Inlining Defined doesn't throw an exception"); ok(!Defined->has_coercion, "Defined doesn't have a coercion"); ok(!Defined->is_parameterizable, "Defined isn't parameterizable"); is(Defined->type_default, undef, "Defined has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Defined, ucfirst("$label should pass Defined")); } elsif ($expect eq 'fail') { should_fail($value, Defined, ucfirst("$label should fail Defined")); } else { fail("expected '$expect'?!"); } } is(~Defined, Types::Standard::Undef, 'The complement of Defined is Undef'); done_testing; DelimitedStr.t000664001750001750 1661415111656240 17050 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can rediDelimitedStribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( DelimitedStr ); isa_ok(DelimitedStr, 'Type::Tiny', 'DelimitedStr'); is(DelimitedStr->name, 'DelimitedStr', 'DelimitedStr has correct name'); is(DelimitedStr->display_name, 'DelimitedStr', 'DelimitedStr has correct display_name'); is(DelimitedStr->library, 'Types::Common::String', 'DelimitedStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('DelimitedStr'), 'Types::Common::String knows it has type DelimitedStr'); ok(!DelimitedStr->deprecated, 'DelimitedStr is not deprecated'); ok(!DelimitedStr->is_anon, 'DelimitedStr is not anonymous'); ok(DelimitedStr->can_be_inlined, 'DelimitedStr can be inlined'); is(exception { DelimitedStr->inline_check(q/$xyz/) }, undef, "Inlining DelimitedStr doesn't throw an exception"); ok(DelimitedStr->has_coercion, "DelimitedStr has a coercion"); ok(DelimitedStr->is_parameterizable, "DelimitedStr is parameterizable"); is(DelimitedStr->type_default, undef, "DelimitedStr has a type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object string to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object string to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, DelimitedStr, ucfirst("$label should pass DelimitedStr")); } elsif ($expect eq 'fail') { should_fail($value, DelimitedStr, ucfirst("$label should fail DelimitedStr")); } else { fail("expected '$expect'?!"); } } { local $" = '|'; is( DelimitedStr->coerce( [ 1..4 ] ), '1|2|3|4', 'The unparameterized type coerces by joining with $"', ); $" = ','; is( DelimitedStr->coerce( [ 1..4 ] ), '1,2,3,4', '... and again', ); $" = ''; is( DelimitedStr->coerce( [ 1..4 ] ), '1234', '... and again', ); } use Types::Standard qw( Int ArrayRef ); # Two or three integers, separated by commas, with optional whitespace # around the commas. # my $SomeInts = DelimitedStr[ q{,}, Int, 2, 3, !!1 ]; ok( $SomeInts->can_be_inlined, '$SomeInts->can_be_inlined' ); ok( $SomeInts->coercion->can_be_inlined, '$SomeInts->coercion->can_be_inlined' ); is( $SomeInts->display_name, q{DelimitedStr[",",Int,2,3,1]}, '$SomeInts->display_name is ' . $SomeInts ); should_pass( '1,2,3', $SomeInts ); should_pass( '1, 2, 3', $SomeInts ); should_pass( ' 1,2,3 ' . "\t\n\t", $SomeInts ); should_fail( '1', $SomeInts ); should_fail( '1,2,3,4', $SomeInts ); should_fail( 'foo,bar,baz', $SomeInts ); should_fail( '1,,3', $SomeInts ); ok( $SomeInts->coercion->has_coercion_for_type( ArrayRef[ Int, 2, 3 ] ), "$SomeInts has a coercion from an appropriate arrayref", ); is( $SomeInts->coerce( [ 4, 5, 6 ] ), '4,5,6', '... and it works', ); ok( !$SomeInts->coercion->has_coercion_for_type( ArrayRef[Int] ), "$SomeInts does not have a coercion from a posentially inappropriate arrayref", ); done_testing; Dict.t000664001750001750 3413215111656240 15335 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Dict ); isa_ok(Dict, 'Type::Tiny', 'Dict'); is(Dict->name, 'Dict', 'Dict has correct name'); is(Dict->display_name, 'Dict', 'Dict has correct display_name'); is(Dict->library, 'Types::Standard', 'Dict knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Dict'), 'Types::Standard knows it has type Dict'); ok(!Dict->deprecated, 'Dict is not deprecated'); ok(!Dict->is_anon, 'Dict is not anonymous'); ok(Dict->can_be_inlined, 'Dict can be inlined'); is(exception { Dict->inline_check(q/$xyz/) }, undef, "Inlining Dict doesn't throw an exception"); ok(!Dict->has_coercion, "Dict doesn't have a coercion"); ok(Dict->is_parameterizable, "Dict is parameterizable"); isnt(Dict->type_default, undef, "Dict has a type_default"); is_deeply(Dict->type_default->(), {}, "Dict type_default is {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Dict, ucfirst("$label should pass Dict")); } elsif ($expect eq 'fail') { should_fail($value, Dict, ucfirst("$label should fail Dict")); } else { fail("expected '$expect'?!"); } } # # Basic parameterized example # my $type1 = Dict[ foo => Types::Standard::Int, bar => Types::Standard::RegexpRef, ]; should_pass( { foo => 42, bar => qr// }, $type1 ); should_fail( { foo => [], bar => qr// }, $type1 ); should_fail( { foo => 42, bar => 1234 }, $type1 ); should_fail( { foo => [], bar => 1234 }, $type1 ); should_fail( { foo => 42 }, $type1 ); should_fail( { bar => qr// }, $type1 ); should_fail( [ foo => 42, bar => qr// ], $type1 ); should_fail( { foo => 42, bar => qr//, baz => undef }, $type1 ); ok( $type1->my_hashref_allows_key('bar'), 'my_hashref_allows_key("bar")' ); ok( !$type1->my_hashref_allows_key('baz'), '!my_hashref_allows_key("baz")' ); ok( $type1->my_hashref_allows_value('bar', qr//), 'my_hashref_allows_value("bar", qr//)' ); ok( !$type1->my_hashref_allows_value('bar', 1234), '!my_hashref_allows_value("bar", 1234)' ); is($type1->type_default, undef, "$type1 has no type_default"); # # Optional parameterized example # use Types::Standard qw( Optional ); # this is mostly the same as $type1... my $type2 = Dict[ foo => Types::Standard::Int, bar => Optional[ Types::Standard::RegexpRef ], ]; should_pass( { foo => 42, bar => qr// }, $type2 ); should_fail( { foo => [], bar => qr// }, $type2 ); should_fail( { foo => 42, bar => 1234 }, $type2 ); should_fail( { foo => [], bar => 1234 }, $type2 ); should_pass( { foo => 42 }, $type2 ); # this fails with $type1 should_fail( { bar => qr// }, $type2 ); should_fail( [ foo => 42, bar => qr// ], $type2 ); should_fail( { foo => 42, bar => qr//, baz => undef }, $type2 ); ok( $type2->my_hashref_allows_key('bar'), 'my_hashref_allows_key("bar")' ); ok( !$type2->my_hashref_allows_key('baz'), '!my_hashref_allows_key("baz")' ); ok( $type2->my_hashref_allows_value('bar', qr//), 'my_hashref_allows_value("bar", qr//)' ); ok( !$type2->my_hashref_allows_value('bar', 1234), '!my_hashref_allows_value("bar", 1234)' ); # # Example with Slurpy # use Types::Standard qw( Slurpy Map ); my $type3 = Dict[ foo => Types::Standard::Int, bar => Types::Standard::RegexpRef, () => Slurpy[ Map[ Types::Standard::Int, Types::Standard::ArrayRef ] ], ]; should_pass( { foo => 42, bar => qr// }, $type3 ); should_fail( { foo => [], bar => qr// }, $type3 ); should_fail( { foo => 42, bar => 1234 }, $type3 ); should_fail( { foo => [], bar => 1234 }, $type3 ); should_fail( { foo => 42 }, $type3 ); should_fail( { bar => qr// }, $type3 ); should_fail( [ foo => 42, bar => qr// ], $type3 ); should_fail( { foo => 42, bar => qr//, baz => undef }, $type3 ); should_pass( { foo => 42, bar => qr//, 123 => [] }, $type3 ); should_pass( { foo => 42, bar => qr//, 123 => [], 456 => [] }, $type3 ); should_fail( { foo => 42, bar => qr//, 123 => qr// }, $type3 ); should_fail( { foo => 42, bar => qr//, 123 => qr//, 456 => [] }, $type3 ); ok( $type3->my_hashref_allows_key('bar'), 'my_hashref_allows_key("bar")' ); ok( !$type3->my_hashref_allows_key('baz'), '!my_hashref_allows_key("baz")' ); ok( $type3->my_hashref_allows_value('bar', qr//), 'my_hashref_allows_value("bar", qr//)' ); ok( !$type3->my_hashref_allows_value('bar', 1234), '!my_hashref_allows_value("bar", 1234)' ); ok( $type3->my_hashref_allows_key('123'), 'my_hashref_allows_key("123")' ); ok( $type3->my_hashref_allows_value('123', []), 'my_hashref_allows_value("123", [])' ); ok( !$type3->my_hashref_allows_value('123', qr//), '!my_hashref_allows_value("123", qr//)' ); # # Example with slurpy and Optional # my $type4 = Dict[ foo => Types::Standard::Int->where(sub { $_ % 2 == 0 }), bar => Optional[ Types::Standard::RegexpRef ], () => Slurpy[ Map[ Types::Standard::Int, Types::Standard::ArrayRef ] ], ]; should_pass( { foo => 42, bar => qr// }, $type4 ); should_fail( { foo => 41, bar => qr// }, $type4 ); should_fail( { foo => [], bar => qr// }, $type4 ); should_fail( { foo => 42, bar => 1234 }, $type4 ); should_fail( { foo => [], bar => 1234 }, $type4 ); should_pass( { foo => 42 }, $type4 ); # this fails with $type3 should_fail( { bar => qr// }, $type4 ); should_fail( [ foo => 42, bar => qr// ], $type4 ); should_fail( { foo => 42, bar => qr//, baz => undef }, $type4 ); should_pass( { foo => 42, bar => qr//, 123 => [] }, $type4 ); should_pass( { foo => 42, bar => qr//, 123 => [], 456 => [] }, $type4 ); should_fail( { foo => 42, bar => qr//, 123 => qr// }, $type4 ); should_fail( { foo => 42, bar => qr//, 123 => qr//, 456 => [] }, $type4 ); ok( $type4->my_hashref_allows_key('bar'), 'my_hashref_allows_key("bar")' ); ok( !$type4->my_hashref_allows_key('baz'), '!my_hashref_allows_key("baz")' ); ok( $type4->my_hashref_allows_value('bar', qr//), 'my_hashref_allows_value("bar", qr//)' ); ok( !$type4->my_hashref_allows_value('bar', 1234), '!my_hashref_allows_value("bar", 1234)' ); ok( $type4->my_hashref_allows_key('123'), 'my_hashref_allows_key("123")' ); ok( $type4->my_hashref_allows_value('123', []), 'my_hashref_allows_value("123", [])' ); ok( !$type4->my_hashref_allows_value('123', qr//), '!my_hashref_allows_value("123", qr//)' ); ok( $type4->my_hashref_allows_value('foo', 20), 'my_hashref_allows_value("foo", 20)' ); ok( !$type4->my_hashref_allows_value('foo', 21), '!my_hashref_allows_value("foo", 21)' ); # # Simple deep coercion # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, q{ int($_) } ); my $type5 = Dict[foo => $Rounded]; is_deeply( $type5->coerce({ foo => 4.1 }), { foo => 4 }, 'deep coercion', ); is_deeply( $type5->coerce({ foo => 4.1, bar => 'xyz' }), { foo => 4.1, bar => 'xyz' }, 'cowardly refuses to drop keys to allow coercion to work', ); # # Deep coercion with Optional # my $type6 = Dict[ foo => $Rounded, bar => Optional[$Rounded], ]; is_deeply( $type6->coerce({ foo => 4.1 }), { foo => 4 }, 'deep coercion', ); is_deeply( $type6->coerce({ foo => 4.1, bar => 5.1 }), { foo => 4, bar => 5 }, 'can coerce optional slots', ); is_deeply( $type6->coerce({ foo => 4.1, bar => 'xyz' }), { foo => 4.1, bar => 'xyz' }, 'cowardly refuses to drop keys to allow coercion to work', ); # # Deep coercion with slurpy # my $type7 = Dict[ foo => $Rounded, bar => Optional[$Rounded], () => Slurpy[ Types::Standard::HashRef[$Rounded] ], ]; is_deeply( $type7->coerce({ foo => 4.1 }), { foo => 4 }, 'deep coercion', ); is_deeply( $type7->coerce({ foo => 4.1, bar => 5.1 }), { foo => 4, bar => 5 }, 'can coerce optional slots', ); is_deeply( $type7->coerce({ foo => 4.1, quux => 6.1 }), { foo => 4, quux => 6 }, 'can coerce slurpy', ); is_deeply( $type7->coerce({ foo => 4.1, bar => 'xyz' }), { foo => 4.1, bar => 'xyz' }, 'cowardly refuses to drop keys to allow coercion to work', ); # # Deep coercion with CHILD OF slurpy # my $type8 = Dict[ foo => $Rounded, bar => Optional[$Rounded], () => ( Slurpy[ Types::Standard::HashRef[$Rounded] ] )->where( 1 )->where( 1 ), ]; is_deeply( $type8->coerce({ foo => 4.1 }), { foo => 4 }, 'deep coercion', ); is_deeply( $type8->coerce({ foo => 4.1, bar => 5.1 }), { foo => 4, bar => 5 }, 'can coerce optional slots', ); is_deeply( $type8->coerce({ foo => 4.1, quux => 6.1 }), { foo => 4, quux => 6 }, 'can coerce slurpy', ); is_deeply( $type8->coerce({ foo => 4.1, bar => 'xyz' }), { foo => 4.1, bar => 'xyz' }, 'cowardly refuses to drop keys to allow coercion to work', ); # Combine Dicts my $combined = Types::Standard::Dict::combine( Dict[ name => Types::Standard::Str ], Dict[ age => Types::Standard::Int, Types::Standard::Slurpy[Types::Standard::HashRef[Types::Standard::Int]] ], Dict[ id => Types::Standard::Str, name => Types::Standard::ArrayRef, Types::Standard::Slurpy[Types::Standard::ArrayRef] ], Dict[], )->create_child_type( display_name => 'CombinedDetails' ); ok( $combined->is_a_type_of( Dict ) ); should_pass( { name => 'X', age => 1, id => 'ABC', foo => 1 }, $combined ); should_pass( { name => [ 'X' ], age => 1, id => 'ABC', foo => 1 }, $combined ); should_fail( { name => 'X', age => [ 1 ], id => 'ABC', foo => 1 }, $combined ); my $combined2 = Types::Standard::Dict::combine( Dict[ name => Types::Standard::Str ], Dict[ name => Types::Standard::Str ], ); is( $combined2->display_name, 'Dict[name=>Str]' ); my $combined3 = Types::Standard::Dict::combine( Dict[ name => Types::Standard::Str ], Dict[ name => Types::Standard::Int ], ); is( $combined3->display_name, 'Dict[name=>Str|Int]' ); done_testing; Enum.t000664001750001750 2016615111656240 15360 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Enum ); isa_ok(Enum, 'Type::Tiny', 'Enum'); is(Enum->name, 'Enum', 'Enum has correct name'); is(Enum->display_name, 'Enum', 'Enum has correct display_name'); is(Enum->library, 'Types::Standard', 'Enum knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Enum'), 'Types::Standard knows it has type Enum'); ok(!Enum->deprecated, 'Enum is not deprecated'); ok(!Enum->is_anon, 'Enum is not anonymous'); ok(Enum->can_be_inlined, 'Enum can be inlined'); is(exception { Enum->inline_check(q/$xyz/) }, undef, "Inlining Enum doesn't throw an exception"); ok(!Enum->has_coercion, "Enum doesn't have a coercion"); ok(Enum->is_parameterizable, "Enum is parameterizable"); is(Enum->type_default, undef, "Enum has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Enum, ucfirst("$label should pass Enum")); } elsif ($expect eq 'fail') { should_fail($value, Enum, ucfirst("$label should fail Enum")); } else { fail("expected '$expect'?!"); } } # # Parameterize with some strings. # my $enum1 = Enum[qw/ foo bar bar baz /]; should_pass('foo', $enum1); should_pass('bar', $enum1); should_pass('baz', $enum1); should_fail('bat', $enum1); is_deeply($enum1->values, [qw/ foo bar bar baz /]); is_deeply($enum1->unique_values, [qw/ bar baz foo /]); is_deeply([@$enum1], [qw/ foo bar bar baz /]); # # Regexp. # my $re = $enum1->as_regexp; ok('foo' =~ $re); ok('bar' =~ $re); ok('baz' =~ $re); ok('FOO' !~ $re); ok('xyz' !~ $re); ok('foo bar baz' !~ $re); my $re_i = $enum1->as_regexp('i'); # case-insensitive ok('foo' =~ $re_i); ok('bar' =~ $re_i); ok('baz' =~ $re_i); ok('FOO' =~ $re_i); ok('xyz' !~ $re_i); ok('foo bar baz' !~ $re_i); like( exception { $enum1->as_regexp('42') }, qr/Unknown regexp flags/, 'Unknown flags passed to as_regexp' ); # # Enum allows you to pass objects overloading stringification when # creating the type, but rejects blessed objects (even overloaded) # when checking values. # { package Local::Stringy; use overload q[""] => sub { ${$_[0]} }; sub new { my ($class, $str) = @_; bless \$str, $class } } my $enum2 = Enum[ map Local::Stringy->new($_), qw/ foo bar bar baz / ]; should_pass('foo', $enum2); should_pass('bar', $enum2); should_pass('baz', $enum2); should_fail('bat', $enum2); should_fail(Local::Stringy->new('foo'), $enum2); is_deeply($enum2->values, [qw/ foo bar bar baz /]); is_deeply($enum2->unique_values, [qw/ bar baz foo /]); is_deeply([@$enum2], [qw/ foo bar bar baz /]); # # Enum-wise sorting # is_deeply( [ $enum1->sort( 'baz', 'foo' ) ], [ 'foo', 'baz' ], '"foo" comes before "baz" because they were listed in that order when $enum1 was defined', ); # # Auto coercion # my $enum3 = Enum[ \1, qw( FOO BAR BAZ ) ]; is $enum3->coerce('FOO'), 'FOO'; is $enum3->coerce('foo'), 'FOO'; is $enum3->coerce('f'), 'FOO'; is $enum3->coerce('ba'), 'BAR'; is $enum3->coerce('baz'), 'BAZ'; is $enum3->coerce(0), 'FOO'; is $enum3->coerce(1), 'BAR'; is $enum3->coerce(2), 'BAZ'; is $enum3->coerce(-1), 'BAZ'; is $enum3->coerce('XYZ'), 'XYZ'; is_deeply $enum3->coerce([123]), [123]; # # Manual coercion # my $enum4 = Enum[ [ Types::Standard::ArrayRef() => sub { 'FOO' }, Types::Standard::HashRef() => sub { 'BAR' }, Types::Standard::Str() => sub { 'BAZ' }, ], qw( FOO BAR BAZ ) ]; is $enum4->coerce([]), 'FOO'; is $enum4->coerce({}), 'BAR'; is $enum4->coerce(''), 'BAZ'; done_testing; FileHandle.t000664001750001750 1371715111656240 16453 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( FileHandle ); isa_ok(FileHandle, 'Type::Tiny', 'FileHandle'); is(FileHandle->name, 'FileHandle', 'FileHandle has correct name'); is(FileHandle->display_name, 'FileHandle', 'FileHandle has correct display_name'); is(FileHandle->library, 'Types::Standard', 'FileHandle knows it is in the Types::Standard library'); ok(Types::Standard->has_type('FileHandle'), 'Types::Standard knows it has type FileHandle'); ok(!FileHandle->deprecated, 'FileHandle is not deprecated'); ok(!FileHandle->is_anon, 'FileHandle is not anonymous'); ok(FileHandle->can_be_inlined, 'FileHandle can be inlined'); is(exception { FileHandle->inline_check(q/$xyz/) }, undef, "Inlining FileHandle doesn't throw an exception"); ok(!FileHandle->has_coercion, "FileHandle doesn't have a coercion"); ok(!FileHandle->is_parameterizable, "FileHandle isn't parameterizable"); is(FileHandle->type_default, undef, "FileHandle has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, FileHandle, ucfirst("$label should pass FileHandle")); } elsif ($expect eq 'fail') { should_fail($value, FileHandle, ucfirst("$label should fail FileHandle")); } else { fail("expected '$expect'?!"); } } done_testing; GlobRef.t000664001750001750 1355715111656240 16002 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( GlobRef ); isa_ok(GlobRef, 'Type::Tiny', 'GlobRef'); is(GlobRef->name, 'GlobRef', 'GlobRef has correct name'); is(GlobRef->display_name, 'GlobRef', 'GlobRef has correct display_name'); is(GlobRef->library, 'Types::Standard', 'GlobRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('GlobRef'), 'Types::Standard knows it has type GlobRef'); ok(!GlobRef->deprecated, 'GlobRef is not deprecated'); ok(!GlobRef->is_anon, 'GlobRef is not anonymous'); ok(GlobRef->can_be_inlined, 'GlobRef can be inlined'); is(exception { GlobRef->inline_check(q/$xyz/) }, undef, "Inlining GlobRef doesn't throw an exception"); ok(!GlobRef->has_coercion, "GlobRef doesn't have a coercion"); ok(!GlobRef->is_parameterizable, "GlobRef isn't parameterizable"); is(GlobRef->type_default, undef, "GlobRef has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, GlobRef, ucfirst("$label should pass GlobRef")); } elsif ($expect eq 'fail') { should_fail($value, GlobRef, ucfirst("$label should fail GlobRef")); } else { fail("expected '$expect'?!"); } } done_testing; HasMethods.t000664001750001750 1724715111656240 16521 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( HasMethods ); isa_ok(HasMethods, 'Type::Tiny', 'HasMethods'); is(HasMethods->name, 'HasMethods', 'HasMethods has correct name'); is(HasMethods->display_name, 'HasMethods', 'HasMethods has correct display_name'); is(HasMethods->library, 'Types::Standard', 'HasMethods knows it is in the Types::Standard library'); ok(Types::Standard->has_type('HasMethods'), 'Types::Standard knows it has type HasMethods'); ok(!HasMethods->deprecated, 'HasMethods is not deprecated'); ok(!HasMethods->is_anon, 'HasMethods is not anonymous'); ok(HasMethods->can_be_inlined, 'HasMethods can be inlined'); is(exception { HasMethods->inline_check(q/$xyz/) }, undef, "Inlining HasMethods doesn't throw an exception"); ok(!HasMethods->has_coercion, "HasMethods doesn't have a coercion"); ok(HasMethods->is_parameterizable, "HasMethods is parameterizable"); is(HasMethods->type_default, undef, "HasMethods has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), xxxx => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, HasMethods, ucfirst("$label should pass HasMethods")); } elsif ($expect eq 'fail') { should_fail($value, HasMethods, ucfirst("$label should fail HasMethods")); } else { fail("expected '$expect'?!"); } } use Scalar::Util qw( refaddr ); my $plain = HasMethods; my $paramd = HasMethods[]; is( refaddr($plain), refaddr($paramd), 'parameterizing with [] has no effect' ); my $p1 = HasMethods['foo']; my $p2 = HasMethods['foo']; is(refaddr($p1), refaddr($p2), 'parameterizing is cached'); # # We need a real object to test HasMethods on. # Luckily HasMethods IS an object! # should_pass( HasMethods, HasMethods['constraint'], "Parameterized with one method name", ); should_pass( HasMethods, HasMethods['constraint', 'name'], "Parameterized with multiple method names", ); should_fail( HasMethods, HasMethods['constraint', 'should_not_exist'], "... acts as intersection (requires the object to support ALL the methods)" ); { # A package where $thing->foo works but # $thing->can("foo") is false. package Local::Liar1; sub foo { 1 } sub can { return if $_[1] eq 'foo'; goto \&UNIVERSAL::can; } } should_fail( bless([], 'Local::Liar1'), HasMethods['foo'], "HasMethods should believe \$object->can() if it returns false." ); { # A package where $thing->foo breaks but # $thing->can("foo") is true. package Local::Liar2; sub can { return sub { 1 } if $_[1] eq 'foo'; goto \&UNIVERSAL::can; } } should_pass( bless([], 'Local::Liar2'), HasMethods['foo'], "HasMethods should believe \$object->can() if it returns true." ); # # HasMethods is for blessed objects only. # should_fail( 'Local::Liar2', HasMethods['foo'], "HasMethods does't work on class names, even if they can do a method." ); # # Intersections # my $foo = HasMethods['foo']; my $bar = HasMethods['bar']; my $foo_bar = ($foo) & ($bar); ok( $foo_bar->isa( 'Type::Tiny::Duck' ) ); is_deeply( [ sort @{ $foo_bar->methods } ], [qw/bar foo/] ); done_testing; HashLike.t000664001750001750 2177615111656240 16154 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( HashLike ); isa_ok(HashLike, 'Type::Tiny', 'HashLike'); is(HashLike->name, 'HashLike', 'HashLike has correct name'); is(HashLike->display_name, 'HashLike', 'HashLike has correct display_name'); is(HashLike->library, 'Types::TypeTiny', 'HashLike knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('HashLike'), 'Types::TypeTiny knows it has type HashLike'); ok(!HashLike->deprecated, 'HashLike is not deprecated'); ok(!HashLike->is_anon, 'HashLike is not anonymous'); ok(HashLike->can_be_inlined, 'HashLike can be inlined'); is(exception { HashLike->inline_check(q/$xyz/) }, undef, "Inlining HashLike doesn't throw an exception"); ok(!HashLike->has_coercion, "HashLike doesn't have a coercion"); ok(HashLike->is_parameterizable, "HashLike is parameterizable"); isnt(HashLike->type_default, undef, "HashLike has a type_default"); is_deeply(HashLike->type_default->(), {}, "HashLike type_default is {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, HashLike, ucfirst("$label should pass HashLike")); } elsif ($expect eq 'fail') { should_fail($value, HashLike, ucfirst("$label should fail HashLike")); } else { fail("expected '$expect'?!"); } } # # Parameterizable # use Types::Standard (); my $HashOfInt = HashLike[ Types::Standard::Int() ]; ok( $HashOfInt->can_be_inlined ); should_pass( { foo => 1, bar => 2 }, $HashOfInt, ); should_pass( bless([{ foo => 1, bar => 2 }], 'Local::OL::Hash'), $HashOfInt, ); should_fail( { foo => 1, bar => undef }, $HashOfInt, ); should_fail( bless([{ foo => 1, bar => undef }], 'Local::OL::Hash'), $HashOfInt, ); my $HashOfRounded = HashLike[ Types::Standard::Int()->plus_coercions( Types::Standard::Num(), => q{ int($_) }, ) ]; is_deeply( $HashOfRounded->coerce({ foo => 1, bar => 2.1 }), { foo => 1, bar => 2 }, ); # Note that because of coercion, the object overloading %{} # is now a plain old hashref. is_deeply( $HashOfRounded->coerce(bless([{ foo => 1, bar => 2.1 }], 'Local::OL::Hash')), { foo => 1, bar => 2 }, ); is_deeply( $HashOfRounded->coerce({ foo => undef, bar => 2.1 }), { foo => undef, bar => 2.1 }, # cannot be coerced, so returned unchanged ); # can't use is_deeply because object doesn't overload eq # but the idea is because the coercion fails, the original # object gets returned unchanged ok( Scalar::Util::blessed( $HashOfRounded->coerce(bless([{ foo => undef, bar => 2.1 }], 'Local::OL::Hash')) ), ); # # Tied hashes, and combining them with hash-overloaded objects # { package MaiTai::Hash; use Tie::Hash; our @ISA = 'Tie::Hash'; sub TIEHASH { bless [ {} ], $_[0]; } sub FETCH { $_[0][0]{$_[1]}; } sub STORE { $_[0][0]{$_[1]} = $_[2]; } sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } sub NEXTKEY { each %{$_[0][0]} } sub EXISTS { exists $_[0][0]{$_[1]}; } sub DELETE { delete $_[0][0]{$_[1]}; } sub CLEAR { %{$_[0][0]} = () } sub SCALAR { scalar %{$_[0][0]} } ## package MaiObj::Hash; use overload '%{}' => sub { my $obj = shift; my %h; tie( %h, 'MaiTai::Hash' ) if $obj->[0]; my @keys = @{ $obj->[1] }; my @values = @{ $obj->[2] }; @h{ @keys } = @values; return \%h; }; sub new { my ( $class, $do_tie ) = ( shift, shift ); my ( @keys, @values ); while ( @_ ) { push @keys, shift; push @values, shift; } bless [ $do_tie, \@keys, \@values ], $class; } } { my %h; tie( %h, 'MaiTai::Hash' ); $h{foo} = 12; $h{bar} = 34; should_pass( \%h, $HashOfInt, 'tied hash that should pass' ); } { my %h; tie( %h, 'MaiTai::Hash' ); $h{foo} = 12; $h{bar} = 'xxx'; should_fail( \%h, $HashOfInt, 'tied hash that should fail' ); } { my $obj = 'MaiObj::Hash'->new( !!0, foo => 12, bar => 34 ); should_pass( $obj, $HashOfInt, 'overloaded object yielding regular hash that should pass' ); } { my $obj = 'MaiObj::Hash'->new( !!0, foo => 12, bar => 'xyz' ); should_fail( $obj, $HashOfInt, 'overloaded object yielding regular hash that should fail' ); } { my $obj = 'MaiObj::Hash'->new( !!1, foo => 12, bar => 34 ); should_pass( $obj, $HashOfInt, 'overloaded object yielding tied hash that should pass' ); } { my $obj = 'MaiObj::Hash'->new( !!1, foo => 12, bar => 'xyz' ); should_fail( $obj, $HashOfInt, 'overloaded object yielding tied hash that should fail' ); } done_testing; HashRef.t000664001750001750 3025415111656240 15773 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( HashRef ); isa_ok(HashRef, 'Type::Tiny', 'HashRef'); is(HashRef->name, 'HashRef', 'HashRef has correct name'); is(HashRef->display_name, 'HashRef', 'HashRef has correct display_name'); is(HashRef->library, 'Types::Standard', 'HashRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('HashRef'), 'Types::Standard knows it has type HashRef'); ok(!HashRef->deprecated, 'HashRef is not deprecated'); ok(!HashRef->is_anon, 'HashRef is not anonymous'); ok(HashRef->can_be_inlined, 'HashRef can be inlined'); is(exception { HashRef->inline_check(q/$xyz/) }, undef, "Inlining HashRef doesn't throw an exception"); ok(!HashRef->has_coercion, "HashRef doesn't have a coercion"); ok(HashRef->is_parameterizable, "HashRef is parameterizable"); isnt(HashRef->type_default, undef, "HashRef has a type_default"); is_deeply(HashRef->type_default->(), {}, "HashRef type_default is {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, HashRef, ucfirst("$label should pass HashRef")); } elsif ($expect eq 'fail') { should_fail($value, HashRef, ucfirst("$label should fail HashRef")); } else { fail("expected '$expect'?!"); } } # # HashRef is parameterizable # my $HashOfInts = HashRef->of( Types::Standard::Int ); isa_ok($HashOfInts, 'Type::Tiny', '$HashOfInts'); is($HashOfInts->display_name, 'HashRef[Int]', '$HashOfInts has correct display_name'); ok($HashOfInts->is_anon, '$HashOfInts has no name'); ok($HashOfInts->can_be_inlined, '$HashOfInts can be inlined'); is(exception { $HashOfInts->inline_check(q/$xyz/) }, undef, "Inlining \$HashOfInts doesn't throw an exception"); ok(!$HashOfInts->has_coercion, "\$HashOfInts doesn't have a coercion"); ok(!$HashOfInts->is_parameterizable, "\$HashOfInts is not parameterizable"); isnt($HashOfInts->type_default, undef, "\$HashOfInts has a type_default"); is_deeply($HashOfInts->type_default->(), {}, "\$HashOfInts type_default is {}"); ok_subtype(HashRef, $HashOfInts); should_fail( 1, $HashOfInts ); should_fail( [], $HashOfInts ); should_pass( { }, $HashOfInts ); should_fail( { foo => [] }, $HashOfInts ); should_fail( { foo => 1.1 }, $HashOfInts ); should_pass( { foo => 1 }, $HashOfInts ); should_pass( { foo => 0 }, $HashOfInts ); should_pass( { foo => -1 }, $HashOfInts ); should_fail( { foo => \1 }, $HashOfInts ); should_fail( { 123 => \1 }, $HashOfInts ); should_pass( { 123 => 1 }, $HashOfInts ); should_pass( { foo => 1, bar => 2 }, $HashOfInts ); should_fail( { foo => 1, bar => [] }, $HashOfInts ); # # HashRef has these cool extra methods... # ok( $HashOfInts->my_hashref_allows_key('foo'), "my_hashref_allows_key('foo')", ); ok( $HashOfInts->my_hashref_allows_value('foo', 1234), "my_hashref_allows_value('foo', 1234)", ); ok( ! $HashOfInts->my_hashref_allows_value('foo', qr//), "!my_hashref_allows_value('foo', qr//)", ); # # HashRef has deep coercions # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, q{ int($_) } ); my $HashOfRounded = HashRef->of( $Rounded ); isa_ok($HashOfRounded, 'Type::Tiny', '$HashOfRounded'); is($HashOfRounded->display_name, 'HashRef[Int]', '$HashOfRounded has correct display_name'); ok($HashOfRounded->is_anon, '$HashOfRounded has no name'); ok($HashOfRounded->can_be_inlined, '$HashOfRounded can be inlined'); is(exception { $HashOfRounded->inline_check(q/$xyz/) }, undef, "Inlining \$HashOfRounded doesn't throw an exception"); ok($HashOfRounded->has_coercion, "\$HashOfRounded has a coercion"); ok($HashOfRounded->coercion->has_coercion_for_type(HashRef), '$HashRefOfRounded can coerce from HashRef'); ok($HashOfRounded->coercion->has_coercion_for_type(HashRef->of(Types::Standard::Num)), '$HashRefOfRounded can coerce from HashRef[Num]'); ok(!$HashOfRounded->is_parameterizable, "\$HashOfRounded is not parameterizable"); ok_subtype(HashRef, $HashOfRounded); should_fail( 1, $HashOfRounded ); should_fail( [], $HashOfRounded ); should_pass( { }, $HashOfRounded ); should_fail( { foo => [] }, $HashOfRounded ); should_fail( { foo => 1.1 }, $HashOfRounded ); should_pass( { foo => 1 }, $HashOfRounded ); should_pass( { foo => 0 }, $HashOfRounded ); should_pass( { foo => -1 }, $HashOfRounded ); should_fail( { foo => \1 }, $HashOfRounded ); should_fail( { 123 => \1 }, $HashOfRounded ); should_pass( { 123 => 1 }, $HashOfRounded ); should_pass( { foo => 1, bar => 2 }, $HashOfRounded ); should_fail( { foo => 1, bar => [] }, $HashOfRounded ); use Scalar::Util qw(refaddr); do { my $orig = { foo => 42 }; my $coerced = $HashOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "just returned orig unchanged" ); }; do { my $orig = { foo => 42.1 }; my $coerced = $HashOfRounded->coerce($orig); isnt( refaddr($orig), refaddr($coerced), "coercion happened" ); is($coerced->{foo}, 42, "... and data looks good"); should_pass($coerced, $HashOfRounded, "... and now passes type constraint"); }; do { my $orig = { foo => [] }; my $coerced = $HashOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "coercion failed, so orig was returned" ); should_fail($coerced, $HashOfRounded); }; # # Parameterization fails with bad parameters # do { my $e = exception { HashRef['hello world'] }; like($e, qr/expected to be a type constraint/, 'can only be parameterized with another type'); }; # this should probably issue an exception, but doesn't currently... #do { # my $e = exception { HashRef[HashRef, HashRef] }; # isnt($e, undef); #}; # # Tied hashes, and combining them with hash-overloaded objects # { package MaiTai::Hash; use Tie::Hash; our @ISA = 'Tie::Hash'; sub TIEHASH { bless [ {} ], $_[0]; } sub FETCH { $_[0][0]{$_[1]}; } sub STORE { $_[0][0]{$_[1]} = $_[2]; } sub FIRSTKEY { my $a = scalar keys %{$_[0][0]}; each %{$_[0][0]} } sub NEXTKEY { each %{$_[0][0]} } sub EXISTS { exists $_[0][0]{$_[1]}; } sub DELETE { delete $_[0][0]{$_[1]}; } sub CLEAR { %{$_[0][0]} = () } sub SCALAR { scalar %{$_[0][0]} } ## package MaiObj::Hash; use overload '%{}' => sub { my $obj = shift; my %h; tie( %h, 'MaiTai::Hash' ) if $obj->[0]; my @keys = @{ $obj->[1] }; my @values = @{ $obj->[2] }; @h{ @keys } = @values; return \%h; }; sub new { my ( $class, $do_tie ) = ( shift, shift ); my ( @keys, @values ); while ( @_ ) { push @keys, shift; push @values, shift; } bless [ $do_tie, \@keys, \@values ], $class; } } { my %h; tie( %h, 'MaiTai::Hash' ); $h{foo} = 12; $h{bar} = 34; should_pass( \%h, $HashOfInts, 'tied hash that should pass' ); } { my %h; tie( %h, 'MaiTai::Hash' ); $h{foo} = 12; $h{bar} = 'xxx'; should_fail( \%h, $HashOfInts, 'tied hash that should fail' ); } { my $obj = 'MaiObj::Hash'->new( !!0, foo => 12, bar => 34 ); should_fail( $obj, $HashOfInts, 'overloaded object yielding regular hash that would pass if it weren\'t for the interleving overloaded object' ); } { my $obj = 'MaiObj::Hash'->new( !!0, foo => 12, bar => 'xyz' ); should_fail( $obj, $HashOfInts, 'overloaded object yielding regular hash that should fail' ); } { my $obj = 'MaiObj::Hash'->new( !!1, foo => 12, bar => 34 ); should_fail( $obj, $HashOfInts, 'overloaded object yielding tied hash that would pass if it weren\'t for the interleving overloaded object' ); } { my $obj = 'MaiObj::Hash'->new( !!1, foo => 12, bar => 'xyz' ); should_fail( $obj, $HashOfInts, 'overloaded object yielding tied hash that should fail' ); } done_testing; InstanceOf.t000664001750001750 1774415111656240 16515 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( InstanceOf ); isa_ok(InstanceOf, 'Type::Tiny', 'InstanceOf'); is(InstanceOf->name, 'InstanceOf', 'InstanceOf has correct name'); is(InstanceOf->display_name, 'InstanceOf', 'InstanceOf has correct display_name'); is(InstanceOf->library, 'Types::Standard', 'InstanceOf knows it is in the Types::Standard library'); ok(Types::Standard->has_type('InstanceOf'), 'Types::Standard knows it has type InstanceOf'); ok(!InstanceOf->deprecated, 'InstanceOf is not deprecated'); ok(!InstanceOf->is_anon, 'InstanceOf is not anonymous'); ok(InstanceOf->can_be_inlined, 'InstanceOf can be inlined'); is(exception { InstanceOf->inline_check(q/$xyz/) }, undef, "Inlining InstanceOf doesn't throw an exception"); ok(!InstanceOf->has_coercion, "InstanceOf doesn't have a coercion"); ok(InstanceOf->is_parameterizable, "InstanceOf is parameterizable"); is(InstanceOf->type_default, undef, "InstanceOf has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), xxxx => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, InstanceOf, ucfirst("$label should pass InstanceOf")); } elsif ($expect eq 'fail') { should_fail($value, InstanceOf, ucfirst("$label should fail InstanceOf")); } else { fail("expected '$expect'?!"); } } # # Parameterized InstanceOf returns a Type::Tiny::Class. # should_pass(InstanceOf['Foo'], InstanceOf['Type::Tiny::Class']); should_pass(InstanceOf['Foo'], InstanceOf['Type::Tiny']); # # If Foo::Bar is a subclass of Foo, then Foo::Bar objects # should pass InstanceOf['Foo'] but not the other way around. # @Foo::Bar::ISA = qw( Foo ); should_pass( bless([], 'Foo::Bar'), InstanceOf['Foo::Bar'] ); should_pass( bless([], 'Foo::Bar'), InstanceOf['Foo'] ); should_fail( bless([], 'Foo'), InstanceOf['Foo::Bar'] ); should_pass( bless([], 'Foo'), InstanceOf['Foo'] ); # # Foo::Baz claims to be a Foo. # { package Foo::Baz; sub isa { return 1 if $_[1] eq 'Foo'; shift->SUPER::isa(@_); } } should_pass( bless([], 'Foo::Baz'), InstanceOf['Foo::Baz'] ); should_pass( bless([], 'Foo::Baz'), InstanceOf['Foo'] ); should_fail( bless([], 'Foo'), InstanceOf['Foo::Baz'] ); should_pass( bless([], 'Foo'), InstanceOf['Foo'] ); # # Parameterized InstanceOf with two parameters returns # a Type::Tiny::Union of two Type::Tiny::Class objects. # my $fb = InstanceOf['Foo','Bar']; should_pass($fb, InstanceOf['Type::Tiny::Union']); should_pass($fb, InstanceOf['Type::Tiny']); is(scalar(@$fb), 2); should_pass($fb->[0], InstanceOf['Type::Tiny::Class']); should_pass($fb->[1], InstanceOf['Type::Tiny::Class']); should_pass( bless([], 'Foo'), $fb ); should_pass( bless([], 'Bar'), $fb ); # # with_attribute_values # { package Local::Person; sub new { my $class = shift; my %args = (@_==1) ? %{$_[0]} : @_; bless \%args, $class; } sub name { shift->{name} } sub gender { shift->{gender} } } my $Person = InstanceOf['Local::Person']; ok( $Person->can('with_attribute_values') ); my $Man = $Person->with_attribute_values( gender => Types::Standard::Enum['m'] ); my $alice = 'Local::Person'->new( name => 'Alice', gender => 'f' ); my $bob = 'Local::Person'->new( name => 'Bob', gender => 'm' ); should_pass($alice, $Person); should_pass($bob, $Person); should_fail($alice, $Man); should_pass($bob, $Man); done_testing; Int.t000664001750001750 1345215111656240 15206 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Int ); isa_ok(Int, 'Type::Tiny', 'Int'); is(Int->name, 'Int', 'Int has correct name'); is(Int->display_name, 'Int', 'Int has correct display_name'); is(Int->library, 'Types::Standard', 'Int knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Int'), 'Types::Standard knows it has type Int'); ok(!Int->deprecated, 'Int is not deprecated'); ok(!Int->is_anon, 'Int is not anonymous'); ok(Int->can_be_inlined, 'Int can be inlined'); is(exception { Int->inline_check(q/$xyz/) }, undef, "Inlining Int doesn't throw an exception"); ok(!Int->has_coercion, "Int doesn't have a coercion"); ok(!Int->is_parameterizable, "Int isn't parameterizable"); isnt(Int->type_default, undef, "Int has a type_default"); is(Int->type_default->(), 0, "Int type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, xxxx => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Int, ucfirst("$label should pass Int")); } elsif ($expect eq 'fail') { should_fail($value, Int, ucfirst("$label should fail Int")); } else { fail("expected '$expect'?!"); } } done_testing; IntRange.t000664001750001750 1677015111656240 16171 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( IntRange ); isa_ok(IntRange, 'Type::Tiny', 'IntRange'); is(IntRange->name, 'IntRange', 'IntRange has correct name'); is(IntRange->display_name, 'IntRange', 'IntRange has correct display_name'); is(IntRange->library, 'Types::Common::Numeric', 'IntRange knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('IntRange'), 'Types::Common::Numeric knows it has type IntRange'); ok(!IntRange->deprecated, 'IntRange is not deprecated'); ok(!IntRange->is_anon, 'IntRange is not anonymous'); ok(IntRange->can_be_inlined, 'IntRange can be inlined'); is(exception { IntRange->inline_check(q/$xyz/) }, undef, "Inlining IntRange doesn't throw an exception"); ok(!IntRange->has_coercion, "IntRange doesn't have a coercion"); ok(IntRange->is_parameterizable, "IntRange is parameterizable"); isnt(IntRange->type_default, undef, "IntRange has a type_default"); is(IntRange->type_default->(), 0, "IntRange type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, xxxx => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, IntRange, ucfirst("$label should pass IntRange")); } elsif ($expect eq 'fail') { should_fail($value, IntRange, ucfirst("$label should fail IntRange")); } else { fail("expected '$expect'?!"); } } # # If there's one parameter, it is an inclusive minimum. # my $IntRange_2 = IntRange[2]; should_fail(-2, $IntRange_2); should_fail(-1, $IntRange_2); should_fail( 0, $IntRange_2); should_fail( 1, $IntRange_2); should_pass( 2, $IntRange_2); should_pass( 3, $IntRange_2); should_pass( 4, $IntRange_2); should_pass( 5, $IntRange_2); should_pass( 6, $IntRange_2); should_fail(3.1416, $IntRange_2); should_fail([], $IntRange_2); is($IntRange_2->type_default, undef, "$IntRange_2 has no type_default"); # # If there's two parameters, they are inclusive minimum and maximum. # my $IntRange_2_4 = IntRange[2, 4]; should_fail(-2, $IntRange_2_4); should_fail(-1, $IntRange_2_4); should_fail( 0, $IntRange_2_4); should_fail( 1, $IntRange_2_4); should_pass( 2, $IntRange_2_4); should_pass( 3, $IntRange_2_4); should_pass( 4, $IntRange_2_4); should_fail( 5, $IntRange_2_4); should_fail( 6, $IntRange_2_4); should_fail(3.1416, $IntRange_2_4); should_fail([], $IntRange_2_4); # # Can set an exclusive minimum and maximum. # my $IntRange_2_4_ex = IntRange[2, 4, 1, 1]; should_fail(-2, $IntRange_2_4_ex); should_fail(-1, $IntRange_2_4_ex); should_fail( 0, $IntRange_2_4_ex); should_fail( 1, $IntRange_2_4_ex); should_fail( 2, $IntRange_2_4_ex); should_pass( 3, $IntRange_2_4_ex); should_fail( 4, $IntRange_2_4_ex); should_fail( 5, $IntRange_2_4_ex); should_fail( 6, $IntRange_2_4_ex); should_fail(3.1416, $IntRange_2_4_ex); should_fail([], $IntRange_2_4_ex); my $e = exception { IntRange[1.1] }; like($e, qr/min must be/, 'bad parameter'); done_testing; Item.t000664001750001750 1352115111656240 15347 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Item ); isa_ok(Item, 'Type::Tiny', 'Item'); is(Item->name, 'Item', 'Item has correct name'); is(Item->display_name, 'Item', 'Item has correct display_name'); is(Item->library, 'Types::Standard', 'Item knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Item'), 'Types::Standard knows it has type Item'); ok(!Item->deprecated, 'Item is not deprecated'); ok(!Item->is_anon, 'Item is not anonymous'); ok(Item->can_be_inlined, 'Item can be inlined'); is(exception { Item->inline_check(q/$xyz/) }, undef, "Inlining Item doesn't throw an exception"); ok(!Item->has_coercion, "Item doesn't have a coercion"); ok(!Item->is_parameterizable, "Item isn't parameterizable"); isnt(Item->type_default, undef, "Item has a type_default"); is(Item->type_default->(), undef, "Item type_default is undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Item, ucfirst("$label should pass Item")); } elsif ($expect eq 'fail') { should_fail($value, Item, ucfirst("$label should fail Item")); } else { fail("expected '$expect'?!"); } } done_testing; LaxNum.t000664001750001750 1406615111656240 15662 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( LaxNum ); isa_ok(LaxNum, 'Type::Tiny', 'LaxNum'); is(LaxNum->name, 'LaxNum', 'LaxNum has correct name'); is(LaxNum->display_name, 'LaxNum', 'LaxNum has correct display_name'); is(LaxNum->library, 'Types::Standard', 'LaxNum knows it is in the Types::Standard library'); ok(Types::Standard->has_type('LaxNum'), 'Types::Standard knows it has type LaxNum'); ok(!LaxNum->deprecated, 'LaxNum is not deprecated'); ok(!LaxNum->is_anon, 'LaxNum is not anonymous'); ok(LaxNum->can_be_inlined, 'LaxNum can be inlined'); is(exception { LaxNum->inline_check(q/$xyz/) }, undef, "Inlining LaxNum doesn't throw an exception"); ok(!LaxNum->has_coercion, "LaxNum doesn't have a coercion"); ok(!LaxNum->is_parameterizable, "LaxNum isn't parameterizable"); isnt(LaxNum->type_default, undef, "LaxNum has a type_default"); is(LaxNum->type_default->(), 0, "LaxNum type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, LaxNum, ucfirst("$label should pass LaxNum")); } elsif ($expect eq 'fail') { should_fail($value, LaxNum, ucfirst("$label should fail LaxNum")); } else { fail("expected '$expect'?!"); } } # # Numeric sorting # is_deeply( [ LaxNum->sort( 11, 2, 1 ) ], [ 1, 2, 11 ], 'Numeric sorting', ); # this also works with subtypes, like Int, PositiveInt, etc. done_testing; LowerCaseSimpleStr.t000664001750001750 1700415111656240 20200 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( LowerCaseSimpleStr ); isa_ok(LowerCaseSimpleStr, 'Type::Tiny', 'LowerCaseSimpleStr'); is(LowerCaseSimpleStr->name, 'LowerCaseSimpleStr', 'LowerCaseSimpleStr has correct name'); is(LowerCaseSimpleStr->display_name, 'LowerCaseSimpleStr', 'LowerCaseSimpleStr has correct display_name'); is(LowerCaseSimpleStr->library, 'Types::Common::String', 'LowerCaseSimpleStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('LowerCaseSimpleStr'), 'Types::Common::String knows it has type LowerCaseSimpleStr'); ok(!LowerCaseSimpleStr->deprecated, 'LowerCaseSimpleStr is not deprecated'); ok(!LowerCaseSimpleStr->is_anon, 'LowerCaseSimpleStr is not anonymous'); ok(LowerCaseSimpleStr->can_be_inlined, 'LowerCaseSimpleStr can be inlined'); is(exception { LowerCaseSimpleStr->inline_check(q/$xyz/) }, undef, "Inlining LowerCaseSimpleStr doesn't throw an exception"); ok(LowerCaseSimpleStr->has_coercion, "LowerCaseSimpleStr has a coercion"); ok(!LowerCaseSimpleStr->is_parameterizable, "LowerCaseSimpleStr isn't parameterizable"); is(LowerCaseSimpleStr->type_default, undef, "LowerCaseSimpleStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', fail => 'line break' => "\n", pass => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, LowerCaseSimpleStr, ucfirst("$label should pass LowerCaseSimpleStr")); } elsif ($expect eq 'fail') { should_fail($value, LowerCaseSimpleStr, ucfirst("$label should fail LowerCaseSimpleStr")); } else { fail("expected '$expect'?!"); } } # Cyrillic Small Letter Zhe should_pass("\x{0436}", LowerCaseSimpleStr); # Cyrillic Capital Letter Zhe should_fail("\x{0416}", LowerCaseSimpleStr); # # SimpleStr is limited to 255 characters # should_pass("a" x 255, LowerCaseSimpleStr); should_fail("a" x 256, LowerCaseSimpleStr); # # Length counts are characters, not bytes, # so test with a multibyte character. # should_pass("\x{0436}" x 255, LowerCaseSimpleStr); should_fail("\x{0436}" x 256, LowerCaseSimpleStr); # # These examples are probably obvious. # should_fail('ABCDEF', LowerCaseSimpleStr); should_fail('ABC123', LowerCaseSimpleStr); should_pass('abc123', LowerCaseSimpleStr); should_pass('abcdef', LowerCaseSimpleStr); # # A string with only non-letter characters passes. # should_pass('123456', LowerCaseSimpleStr); should_pass(' ', LowerCaseSimpleStr); # # But the empty string fails. # (Which is weird, but consistent with MooseX::Types::Common::String.) # should_fail('', LowerCaseSimpleStr); # # Can coerce from uppercase strings. # is(LowerCaseSimpleStr->coerce('ABC123'), 'abc123', 'coercion success'); # # Won't even attempt to coerce non-strings. # use Scalar::Util qw( refaddr ); my $arr = []; my $coerced = LowerCaseSimpleStr->coerce($arr); is(refaddr($coerced), refaddr($arr), 'does not coerce non-strings'); done_testing; LowerCaseStr.t000664001750001750 1567615111656240 17043 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( LowerCaseStr ); isa_ok(LowerCaseStr, 'Type::Tiny', 'LowerCaseStr'); is(LowerCaseStr->name, 'LowerCaseStr', 'LowerCaseStr has correct name'); is(LowerCaseStr->display_name, 'LowerCaseStr', 'LowerCaseStr has correct display_name'); is(LowerCaseStr->library, 'Types::Common::String', 'LowerCaseStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('LowerCaseStr'), 'Types::Common::String knows it has type LowerCaseStr'); ok(!LowerCaseStr->deprecated, 'LowerCaseStr is not deprecated'); ok(!LowerCaseStr->is_anon, 'LowerCaseStr is not anonymous'); ok(LowerCaseStr->can_be_inlined, 'LowerCaseStr can be inlined'); is(exception { LowerCaseStr->inline_check(q/$xyz/) }, undef, "Inlining LowerCaseStr doesn't throw an exception"); ok(LowerCaseStr->has_coercion, "LowerCaseStr has a coercion"); ok(!LowerCaseStr->is_parameterizable, "LowerCaseStr isn't parameterizable"); is(LowerCaseStr->type_default, undef, "LowerCaseStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, LowerCaseStr, ucfirst("$label should pass LowerCaseStr")); } elsif ($expect eq 'fail') { should_fail($value, LowerCaseStr, ucfirst("$label should fail LowerCaseStr")); } else { fail("expected '$expect'?!"); } } # Cyrillic Small Letter Zhe should_pass("\x{0436}", LowerCaseStr); # Cyrillic Capital Letter Zhe should_fail("\x{0416}", LowerCaseStr); # # These examples are probably obvious. # should_fail('ABCDEF', LowerCaseStr); should_fail('ABC123', LowerCaseStr); should_pass('abc123', LowerCaseStr); should_pass('abcdef', LowerCaseStr); # # A string with only non-letter characters passes. # should_pass('123456', LowerCaseStr); should_pass(' ', LowerCaseStr); # # But the empty string fails. # (Which is weird, but consistent with MooseX::Types::Common::String.) # should_fail('', LowerCaseStr); # # Can coerce from uppercase strings. # is(LowerCaseStr->coerce('ABC123'), 'abc123', 'coercion success'); # # Won't even attempt to coerce non-strings. # use Scalar::Util qw( refaddr ); my $arr = []; my $coerced = LowerCaseStr->coerce($arr); is(refaddr($coerced), refaddr($arr), 'does not coerce non-strings'); done_testing; Map.t000664001750001750 2440615111656240 15172 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Map ); isa_ok(Map, 'Type::Tiny', 'Map'); is(Map->name, 'Map', 'Map has correct name'); is(Map->display_name, 'Map', 'Map has correct display_name'); is(Map->library, 'Types::Standard', 'Map knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Map'), 'Types::Standard knows it has type Map'); ok(!Map->deprecated, 'Map is not deprecated'); ok(!Map->is_anon, 'Map is not anonymous'); ok(Map->can_be_inlined, 'Map can be inlined'); is(exception { Map->inline_check(q/$xyz/) }, undef, "Inlining Map doesn't throw an exception"); ok(!Map->has_coercion, "Map doesn't have a coercion"); ok(Map->is_parameterizable, "Map is parameterizable"); isnt(Map->type_default, undef, "Map has a type_default"); is_deeply(Map->type_default->(), {}, "Map type_default is {}"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Map, ucfirst("$label should pass Map")); } elsif ($expect eq 'fail') { should_fail($value, Map, ucfirst("$label should fail Map")); } else { fail("expected '$expect'?!"); } } # # Map to constrain keys of hash # my $MapWithIntKeys = Map->of( Types::Standard::Int, Types::Standard::Any ); isa_ok($MapWithIntKeys, 'Type::Tiny', '$MapWithIntKeys'); is($MapWithIntKeys->display_name, 'Map[Int,Any]', '$MapWithIntKeys has correct display_name'); ok($MapWithIntKeys->is_anon, '$MapWithIntKeys has no name'); ok($MapWithIntKeys->can_be_inlined, '$MapWithIntKeys can be inlined'); is(exception { $MapWithIntKeys->inline_check(q/$xyz/) }, undef, "Inlining \$MapWithIntKeys doesn't throw an exception"); ok(!$MapWithIntKeys->has_coercion, "\$MapWithIntKeys doesn't have a coercion"); ok(!$MapWithIntKeys->is_parameterizable, "\$MapWithIntKeys is not parameterizable"); isnt($MapWithIntKeys->type_default, undef, "\$MapWithIntKeys has a type_default"); is_deeply($MapWithIntKeys->type_default->(), {}, "\$MapWithIntKeys type_default is {}"); ok_subtype(Types::Standard::HashRef, $MapWithIntKeys); should_fail( 1, $MapWithIntKeys ); should_fail( [], $MapWithIntKeys ); should_pass( { }, $MapWithIntKeys ); should_fail( { 1.1 => [] }, $MapWithIntKeys ); should_pass( { 1 => 1 }, $MapWithIntKeys ); should_pass( { 1 => 0 }, $MapWithIntKeys ); should_pass( { 1 => -1 }, $MapWithIntKeys ); should_pass( { 1 => \1 }, $MapWithIntKeys ); should_pass( { -1 => -1 }, $MapWithIntKeys ); should_fail( { foo => 1 }, $MapWithIntKeys ); # # Map has these cool extra methods... # ok( $MapWithIntKeys->my_hashref_allows_key('1234'), "my_hashref_allows_key('1234')", ); ok( !$MapWithIntKeys->my_hashref_allows_key('abc'), "!my_hashref_allows_key('abc')", ); # # Map to constrain values of hash. # Basically like HashRef[Int] # my $HashOfInts = Map->of( Types::Standard::Any, Types::Standard::Int ); isa_ok($HashOfInts, 'Type::Tiny', '$HashOfInts'); is($HashOfInts->display_name, 'Map[Any,Int]', '$HashOfInts has correct display_name'); ok($HashOfInts->is_anon, '$HashOfInts has no name'); ok($HashOfInts->can_be_inlined, '$HashOfInts can be inlined'); is(exception { $HashOfInts->inline_check(q/$xyz/) }, undef, "Inlining \$HashOfInts doesn't throw an exception"); ok(!$HashOfInts->has_coercion, "\$HashOfInts doesn't have a coercion"); ok(!$HashOfInts->is_parameterizable, "\$HashOfInts is not parameterizable"); ok_subtype(Types::Standard::HashRef, $HashOfInts); should_fail( 1, $HashOfInts ); should_fail( [], $HashOfInts ); should_pass( { }, $HashOfInts ); should_fail( { foo => [] }, $HashOfInts ); should_fail( { foo => 1.1 }, $HashOfInts ); should_pass( { foo => 1 }, $HashOfInts ); should_pass( { foo => 0 }, $HashOfInts ); should_pass( { foo => -1 }, $HashOfInts ); should_fail( { foo => \1 }, $HashOfInts ); should_fail( { 123 => \1 }, $HashOfInts ); should_pass( { 123 => 1 }, $HashOfInts ); should_pass( { foo => 1, bar => 2 }, $HashOfInts ); should_fail( { foo => 1, bar => [] }, $HashOfInts ); # # More Map extra methods... # ok( $HashOfInts->my_hashref_allows_key('foo'), "my_hashref_allows_key('foo')", ); ok( $HashOfInts->my_hashref_allows_value('foo', 1234), "my_hashref_allows_value('foo', 1234)", ); ok( ! $HashOfInts->my_hashref_allows_value('foo', qr//), "!my_hashref_allows_value('foo', qr//)", ); # # Map has deep coercions # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, q{ int($_) } ); my $HashOfRounded = Map->of( $Rounded, $Rounded ); use Scalar::Util qw(refaddr); do { my $orig = { 3 => 4 }; my $coerced = $HashOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "just returned orig unchanged" ); }; do { my $orig = { 3.1 => 4.2 }; my $coerced = $HashOfRounded->coerce($orig); # {3=>4} isnt( refaddr($orig), refaddr($coerced), "coercion happened" ); is($coerced->{3}, 4, "... and data looks good"); should_pass($coerced, $HashOfRounded, "... and now passes type constraint"); }; do { my $orig = { foo => [] }; my $coerced = $HashOfRounded->coerce($orig); is( refaddr($orig), refaddr($coerced), "coercion failed, so orig was returned" ); should_fail($coerced, $HashOfRounded); }; # # Parameterization fails with bad parameters # do { my $e = exception { Map[qw(hello world)] }; like($e, qr/expected to be a type constraint/, 'bad parameters'); }; do { my $e = exception { Map[Types::Standard::Int] }; like($e, qr/got 1; expected 2/, 'bad parameters'); }; do { my $e = exception { Map[Types::Standard::Int, Types::Standard::Int, Types::Standard::Int] }; like($e, qr/got 3; expected 2/, 'bad parameters'); }; done_testing; Maybe.t000664001750001750 1461515111656240 15513 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Maybe ); isa_ok(Maybe, 'Type::Tiny', 'Maybe'); is(Maybe->name, 'Maybe', 'Maybe has correct name'); is(Maybe->display_name, 'Maybe', 'Maybe has correct display_name'); is(Maybe->library, 'Types::Standard', 'Maybe knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Maybe'), 'Types::Standard knows it has type Maybe'); ok(!Maybe->deprecated, 'Maybe is not deprecated'); ok(!Maybe->is_anon, 'Maybe is not anonymous'); ok(Maybe->can_be_inlined, 'Maybe can be inlined'); is(exception { Maybe->inline_check(q/$xyz/) }, undef, "Inlining Maybe doesn't throw an exception"); ok(!Maybe->has_coercion, "Maybe doesn't have a coercion"); ok(Maybe->is_parameterizable, "Maybe is parameterizable"); isnt(Maybe->type_default, undef, "Maybe has a type_default"); is(Maybe->type_default->(), undef, "Maybe type_default is undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Maybe, ucfirst("$label should pass Maybe")); } elsif ($expect eq 'fail') { should_fail($value, Maybe, ucfirst("$label should fail Maybe")); } else { fail("expected '$expect'?!"); } } # # Maybe[X] is an undef-tolerant version of X. # my $type = Maybe[ Types::Standard::Int ]; should_pass(0, $type); should_pass(1, $type); should_fail(1.1, $type); should_pass(undef, $type); isnt($type->type_default, undef, "$type has a type_default, because Int does"); is($type->type_default->(), 0, "$type type_default is 0"); my $type2 = Maybe[ Types::Standard::Defined ]; isnt($type2->type_default, undef, "$type2 has a type_default, even though Defined doesn't"); is($type2->type_default->(), undef, "$type2 type_default is undef"); done_testing; NegativeInt.t000664001750001750 1403115111656240 16663 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( NegativeInt ); isa_ok(NegativeInt, 'Type::Tiny', 'NegativeInt'); is(NegativeInt->name, 'NegativeInt', 'NegativeInt has correct name'); is(NegativeInt->display_name, 'NegativeInt', 'NegativeInt has correct display_name'); is(NegativeInt->library, 'Types::Common::Numeric', 'NegativeInt knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('NegativeInt'), 'Types::Common::Numeric knows it has type NegativeInt'); ok(!NegativeInt->deprecated, 'NegativeInt is not deprecated'); ok(!NegativeInt->is_anon, 'NegativeInt is not anonymous'); ok(NegativeInt->can_be_inlined, 'NegativeInt can be inlined'); is(exception { NegativeInt->inline_check(q/$xyz/) }, undef, "Inlining NegativeInt doesn't throw an exception"); ok(!NegativeInt->has_coercion, "NegativeInt doesn't have a coercion"); ok(!NegativeInt->is_parameterizable, "NegativeInt isn't parameterizable"); is(NegativeInt->type_default, undef, "NegativeInt has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NegativeInt, ucfirst("$label should pass NegativeInt")); } elsif ($expect eq 'fail') { should_fail($value, NegativeInt, ucfirst("$label should fail NegativeInt")); } else { fail("expected '$expect'?!"); } } done_testing; NegativeNum.t000664001750001750 1403115111656240 16670 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( NegativeNum ); isa_ok(NegativeNum, 'Type::Tiny', 'NegativeNum'); is(NegativeNum->name, 'NegativeNum', 'NegativeNum has correct name'); is(NegativeNum->display_name, 'NegativeNum', 'NegativeNum has correct display_name'); is(NegativeNum->library, 'Types::Common::Numeric', 'NegativeNum knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('NegativeNum'), 'Types::Common::Numeric knows it has type NegativeNum'); ok(!NegativeNum->deprecated, 'NegativeNum is not deprecated'); ok(!NegativeNum->is_anon, 'NegativeNum is not anonymous'); ok(NegativeNum->can_be_inlined, 'NegativeNum can be inlined'); is(exception { NegativeNum->inline_check(q/$xyz/) }, undef, "Inlining NegativeNum doesn't throw an exception"); ok(!NegativeNum->has_coercion, "NegativeNum doesn't have a coercion"); ok(!NegativeNum->is_parameterizable, "NegativeNum isn't parameterizable"); is(NegativeNum->type_default, undef, "NegativeNum has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NegativeNum, ucfirst("$label should pass NegativeNum")); } elsif ($expect eq 'fail') { should_fail($value, NegativeNum, ucfirst("$label should fail NegativeNum")); } else { fail("expected '$expect'?!"); } } done_testing; NegativeOrZeroInt.t000664001750001750 1446015111656240 20032 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( NegativeOrZeroInt ); isa_ok(NegativeOrZeroInt, 'Type::Tiny', 'NegativeOrZeroInt'); is(NegativeOrZeroInt->name, 'NegativeOrZeroInt', 'NegativeOrZeroInt has correct name'); is(NegativeOrZeroInt->display_name, 'NegativeOrZeroInt', 'NegativeOrZeroInt has correct display_name'); is(NegativeOrZeroInt->library, 'Types::Common::Numeric', 'NegativeOrZeroInt knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('NegativeOrZeroInt'), 'Types::Common::Numeric knows it has type NegativeOrZeroInt'); ok(!NegativeOrZeroInt->deprecated, 'NegativeOrZeroInt is not deprecated'); ok(!NegativeOrZeroInt->is_anon, 'NegativeOrZeroInt is not anonymous'); ok(NegativeOrZeroInt->can_be_inlined, 'NegativeOrZeroInt can be inlined'); is(exception { NegativeOrZeroInt->inline_check(q/$xyz/) }, undef, "Inlining NegativeOrZeroInt doesn't throw an exception"); ok(!NegativeOrZeroInt->has_coercion, "NegativeOrZeroInt doesn't have a coercion"); ok(!NegativeOrZeroInt->is_parameterizable, "NegativeOrZeroInt isn't parameterizable"); isnt(NegativeOrZeroInt->type_default, undef, "NegativeOrZeroInt has a type_default"); is(NegativeOrZeroInt->type_default->(), 0, "NegativeOrZeroInt type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, pass => 'zero' => 0, fail => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NegativeOrZeroInt, ucfirst("$label should pass NegativeOrZeroInt")); } elsif ($expect eq 'fail') { should_fail($value, NegativeOrZeroInt, ucfirst("$label should fail NegativeOrZeroInt")); } else { fail("expected '$expect'?!"); } } done_testing; NegativeOrZeroNum.t000664001750001750 1446015111656240 20037 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( NegativeOrZeroNum ); isa_ok(NegativeOrZeroNum, 'Type::Tiny', 'NegativeOrZeroNum'); is(NegativeOrZeroNum->name, 'NegativeOrZeroNum', 'NegativeOrZeroNum has correct name'); is(NegativeOrZeroNum->display_name, 'NegativeOrZeroNum', 'NegativeOrZeroNum has correct display_name'); is(NegativeOrZeroNum->library, 'Types::Common::Numeric', 'NegativeOrZeroNum knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('NegativeOrZeroNum'), 'Types::Common::Numeric knows it has type NegativeOrZeroNum'); ok(!NegativeOrZeroNum->deprecated, 'NegativeOrZeroNum is not deprecated'); ok(!NegativeOrZeroNum->is_anon, 'NegativeOrZeroNum is not anonymous'); ok(NegativeOrZeroNum->can_be_inlined, 'NegativeOrZeroNum can be inlined'); is(exception { NegativeOrZeroNum->inline_check(q/$xyz/) }, undef, "Inlining NegativeOrZeroNum doesn't throw an exception"); ok(!NegativeOrZeroNum->has_coercion, "NegativeOrZeroNum doesn't have a coercion"); ok(!NegativeOrZeroNum->is_parameterizable, "NegativeOrZeroNum isn't parameterizable"); isnt(NegativeOrZeroNum->type_default, undef, "NegativeOrZeroNum has a type_default"); is(NegativeOrZeroNum->type_default->(), 0, "NegativeOrZeroNum type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, pass => 'zero' => 0, fail => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NegativeOrZeroNum, ucfirst("$label should pass NegativeOrZeroNum")); } elsif ($expect eq 'fail') { should_fail($value, NegativeOrZeroNum, ucfirst("$label should fail NegativeOrZeroNum")); } else { fail("expected '$expect'?!"); } } done_testing; NonEmptySimpleStr.t000664001750001750 1432315111656240 20066 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( NonEmptySimpleStr ); isa_ok(NonEmptySimpleStr, 'Type::Tiny', 'NonEmptySimpleStr'); is(NonEmptySimpleStr->name, 'NonEmptySimpleStr', 'NonEmptySimpleStr has correct name'); is(NonEmptySimpleStr->display_name, 'NonEmptySimpleStr', 'NonEmptySimpleStr has correct display_name'); is(NonEmptySimpleStr->library, 'Types::Common::String', 'NonEmptySimpleStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('NonEmptySimpleStr'), 'Types::Common::String knows it has type NonEmptySimpleStr'); ok(!NonEmptySimpleStr->deprecated, 'NonEmptySimpleStr is not deprecated'); ok(!NonEmptySimpleStr->is_anon, 'NonEmptySimpleStr is not anonymous'); ok(NonEmptySimpleStr->can_be_inlined, 'NonEmptySimpleStr can be inlined'); is(exception { NonEmptySimpleStr->inline_check(q/$xyz/) }, undef, "Inlining NonEmptySimpleStr doesn't throw an exception"); ok(!NonEmptySimpleStr->has_coercion, "NonEmptySimpleStr doesn't have a coercion"); ok(!NonEmptySimpleStr->is_parameterizable, "NonEmptySimpleStr isn't parameterizable"); is(NonEmptySimpleStr->type_default, undef, "NonEmptySimpleStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', fail => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NonEmptySimpleStr, ucfirst("$label should pass NonEmptySimpleStr")); } elsif ($expect eq 'fail') { should_fail($value, NonEmptySimpleStr, ucfirst("$label should fail NonEmptySimpleStr")); } else { fail("expected '$expect'?!"); } } done_testing; NonEmptyStr.t000664001750001750 1402315111656240 16711 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( NonEmptyStr ); isa_ok(NonEmptyStr, 'Type::Tiny', 'NonEmptyStr'); is(NonEmptyStr->name, 'NonEmptyStr', 'NonEmptyStr has correct name'); is(NonEmptyStr->display_name, 'NonEmptyStr', 'NonEmptyStr has correct display_name'); is(NonEmptyStr->library, 'Types::Common::String', 'NonEmptyStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('NonEmptyStr'), 'Types::Common::String knows it has type NonEmptyStr'); ok(!NonEmptyStr->deprecated, 'NonEmptyStr is not deprecated'); ok(!NonEmptyStr->is_anon, 'NonEmptyStr is not anonymous'); ok(NonEmptyStr->can_be_inlined, 'NonEmptyStr can be inlined'); is(exception { NonEmptyStr->inline_check(q/$xyz/) }, undef, "Inlining NonEmptyStr doesn't throw an exception"); ok(!NonEmptyStr->has_coercion, "NonEmptyStr doesn't have a coercion"); ok(!NonEmptyStr->is_parameterizable, "NonEmptyStr isn't parameterizable"); is(NonEmptyStr->type_default, undef, "NonEmptyStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NonEmptyStr, ucfirst("$label should pass NonEmptyStr")); } elsif ($expect eq 'fail') { should_fail($value, NonEmptyStr, ucfirst("$label should fail NonEmptyStr")); } else { fail("expected '$expect'?!"); } } done_testing; Num.t000664001750001750 1345215111656240 15213 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Num ); isa_ok(Num, 'Type::Tiny', 'Num'); is(Num->name, 'Num', 'Num has correct name'); is(Num->display_name, 'Num', 'Num has correct display_name'); is(Num->library, 'Types::Standard', 'Num knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Num'), 'Types::Standard knows it has type Num'); ok(!Num->deprecated, 'Num is not deprecated'); ok(!Num->is_anon, 'Num is not anonymous'); ok(Num->can_be_inlined, 'Num can be inlined'); is(exception { Num->inline_check(q/$xyz/) }, undef, "Inlining Num doesn't throw an exception"); ok(!Num->has_coercion, "Num doesn't have a coercion"); ok(!Num->is_parameterizable, "Num isn't parameterizable"); isnt(Num->type_default, undef, "Num has a type_default"); is(Num->type_default->(), 0, "Num type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Num, ucfirst("$label should pass Num")); } elsif ($expect eq 'fail') { should_fail($value, Num, ucfirst("$label should fail Num")); } else { fail("expected '$expect'?!"); } } done_testing; NumRange.t000664001750001750 1774615111656240 16202 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( NumRange ); isa_ok(NumRange, 'Type::Tiny', 'NumRange'); is(NumRange->name, 'NumRange', 'NumRange has correct name'); is(NumRange->display_name, 'NumRange', 'NumRange has correct display_name'); is(NumRange->library, 'Types::Common::Numeric', 'NumRange knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('NumRange'), 'Types::Common::Numeric knows it has type NumRange'); ok(!NumRange->deprecated, 'NumRange is not deprecated'); ok(!NumRange->is_anon, 'NumRange is not anonymous'); ok(NumRange->can_be_inlined, 'NumRange can be inlined'); is(exception { NumRange->inline_check(q/$xyz/) }, undef, "Inlining NumRange doesn't throw an exception"); ok(!NumRange->has_coercion, "NumRange doesn't have a coercion"); ok(NumRange->is_parameterizable, "NumRange is parameterizable"); isnt(NumRange->type_default, undef, "NumRange has a type_default"); is(NumRange->type_default->(), 0, "NumRange type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NumRange, ucfirst("$label should pass NumRange")); } elsif ($expect eq 'fail') { should_fail($value, NumRange, ucfirst("$label should fail NumRange")); } else { fail("expected '$expect'?!"); } } # # If there's one parameter, it is an inclusive minimum. # my $NumRange_2 = NumRange[2]; should_fail(-2, $NumRange_2); should_fail(-1, $NumRange_2); should_fail( 0, $NumRange_2); should_fail( 1, $NumRange_2); should_pass( 2, $NumRange_2); should_pass( 3, $NumRange_2); should_pass( 4, $NumRange_2); should_pass( 5, $NumRange_2); should_pass( 6, $NumRange_2); should_pass(3.1416, $NumRange_2); should_fail([], $NumRange_2); is($NumRange_2->type_default, undef, "$NumRange_2 has no type_default"); # # If there's two parameters, they are inclusive minimum and maximum. # my $NumRange_2_4 = NumRange[2, 4]; should_fail(-2, $NumRange_2_4); should_fail(-1, $NumRange_2_4); should_fail( 0, $NumRange_2_4); should_fail( 1, $NumRange_2_4); should_pass( 2, $NumRange_2_4); should_pass( 3, $NumRange_2_4); should_pass( 4, $NumRange_2_4); should_fail( 5, $NumRange_2_4); should_fail( 6, $NumRange_2_4); should_pass(3.1416, $NumRange_2_4); should_fail([], $NumRange_2_4); # # Can set an exclusive minimum and maximum. # my $NumRange_2_4_ex = NumRange[2, 4, 1, 1]; should_fail(-2, $NumRange_2_4_ex); should_fail(-1, $NumRange_2_4_ex); should_fail( 0, $NumRange_2_4_ex); should_fail( 1, $NumRange_2_4_ex); should_fail( 2, $NumRange_2_4_ex); should_pass( 3, $NumRange_2_4_ex); should_fail( 4, $NumRange_2_4_ex); should_fail( 5, $NumRange_2_4_ex); should_fail( 6, $NumRange_2_4_ex); should_pass(3.1416, $NumRange_2_4_ex); should_fail([], $NumRange_2_4_ex); # # NumRange allows minimum and maximum to be non-integers # my $NumRange_nonint = NumRange[1.5, 3.5]; should_fail(-2, $NumRange_nonint); should_fail(-1, $NumRange_nonint); should_fail( 0, $NumRange_nonint); should_fail( 1, $NumRange_nonint); should_pass( 2, $NumRange_nonint); should_pass( 3, $NumRange_nonint); should_fail( 4, $NumRange_nonint); should_fail( 5, $NumRange_nonint); should_fail( 6, $NumRange_nonint); should_pass(3.1416, $NumRange_nonint); should_fail([], $NumRange_nonint); my $e = exception { NumRange[{}] }; like($e, qr/min must be/, 'bad parameter'); done_testing; NumericCode.t000664001750001750 1413215111656240 16645 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( NumericCode ); isa_ok(NumericCode, 'Type::Tiny', 'NumericCode'); is(NumericCode->name, 'NumericCode', 'NumericCode has correct name'); is(NumericCode->display_name, 'NumericCode', 'NumericCode has correct display_name'); is(NumericCode->library, 'Types::Common::String', 'NumericCode knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('NumericCode'), 'Types::Common::String knows it has type NumericCode'); ok(!NumericCode->deprecated, 'NumericCode is not deprecated'); ok(!NumericCode->is_anon, 'NumericCode is not anonymous'); ok(NumericCode->can_be_inlined, 'NumericCode can be inlined'); is(exception { NumericCode->inline_check(q/$xyz/) }, undef, "Inlining NumericCode doesn't throw an exception"); ok(NumericCode->has_coercion, "NumericCode has a coercion"); ok(!NumericCode->is_parameterizable, "NumericCode isn't parameterizable"); is(NumericCode->type_default, undef, "NumericCode has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, NumericCode, ucfirst("$label should pass NumericCode")); } elsif ($expect eq 'fail') { should_fail($value, NumericCode, ucfirst("$label should fail NumericCode")); } else { fail("expected '$expect'?!"); } } is(NumericCode->coerce('123-456 789-0'), '1234567890', 'coercion from string'); done_testing; Object.t000664001750001750 1464515111656240 15667 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Object ); isa_ok(Object, 'Type::Tiny', 'Object'); is(Object->name, 'Object', 'Object has correct name'); is(Object->display_name, 'Object', 'Object has correct display_name'); is(Object->library, 'Types::Standard', 'Object knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Object'), 'Types::Standard knows it has type Object'); ok(!Object->deprecated, 'Object is not deprecated'); ok(!Object->is_anon, 'Object is not anonymous'); ok(Object->can_be_inlined, 'Object can be inlined'); is(exception { Object->inline_check(q/$xyz/) }, undef, "Inlining Object doesn't throw an exception"); ok(!Object->has_coercion, "Object doesn't have a coercion"); ok(!Object->is_parameterizable, "Object isn't parameterizable"); is(Object->type_default, undef, "Object has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), xxxx => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Object, ucfirst("$label should pass Object")); } elsif ($expect eq 'fail') { should_fail($value, Object, ucfirst("$label should fail Object")); } else { fail("expected '$expect'?!"); } } # # with_attribute_values # { package Local::Person; sub new { my $class = shift; my %args = (@_==1) ? %{$_[0]} : @_; bless \%args, $class; } sub name { shift->{name} } sub gender { shift->{gender} } } ok( Object->can('with_attribute_values') ); my $Man = Object->with_attribute_values( gender => Types::Standard::Enum['m'] ); my $alice = 'Local::Person'->new( name => 'Alice', gender => 'f' ); my $bob = 'Local::Person'->new( name => 'Bob', gender => 'm' ); should_pass($alice, Object); should_pass($bob, Object); should_fail($alice, $Man); should_pass($bob, $Man); done_testing; OptList.t000664001750001750 1367015111656240 16054 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( OptList ); isa_ok(OptList, 'Type::Tiny', 'OptList'); is(OptList->name, 'OptList', 'OptList has correct name'); is(OptList->display_name, 'OptList', 'OptList has correct display_name'); is(OptList->library, 'Types::Standard', 'OptList knows it is in the Types::Standard library'); ok(Types::Standard->has_type('OptList'), 'Types::Standard knows it has type OptList'); ok(!OptList->deprecated, 'OptList is not deprecated'); ok(!OptList->is_anon, 'OptList is not anonymous'); ok(OptList->can_be_inlined, 'OptList can be inlined'); is(exception { OptList->inline_check(q/$xyz/) }, undef, "Inlining OptList doesn't throw an exception"); ok(!OptList->has_coercion, "OptList doesn't have a coercion"); ok(!OptList->is_parameterizable, "OptList isn't parameterizable"); isnt(OptList->type_default, undef, "OptList has a type_default"); is_deeply(OptList->type_default->(), [], "OptList type_default is []"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, OptList, ucfirst("$label should pass OptList")); } elsif ($expect eq 'fail') { should_fail($value, OptList, ucfirst("$label should fail OptList")); } else { fail("expected '$expect'?!"); } } done_testing; Optional.t000664001750001750 1777115111656240 16251 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Optional ); isa_ok(Optional, 'Type::Tiny', 'Optional'); is(Optional->name, 'Optional', 'Optional has correct name'); is(Optional->display_name, 'Optional', 'Optional has correct display_name'); is(Optional->library, 'Types::Standard', 'Optional knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Optional'), 'Types::Standard knows it has type Optional'); ok(!Optional->deprecated, 'Optional is not deprecated'); ok(!Optional->is_anon, 'Optional is not anonymous'); ok(Optional->can_be_inlined, 'Optional can be inlined'); is(exception { Optional->inline_check(q/$xyz/) }, undef, "Inlining Optional doesn't throw an exception"); ok(!Optional->has_coercion, "Optional doesn't have a coercion"); ok(Optional->is_parameterizable, "Optional is parameterizable"); isnt(Optional->type_default, undef, "Optional has a type_default"); is(Optional->type_default->(), undef, "Optional type_default is undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Optional, ucfirst("$label should pass Optional")); } elsif ($expect eq 'fail') { should_fail($value, Optional, ucfirst("$label should fail Optional")); } else { fail("expected '$expect'?!"); } } # # Optional[X] is basically just the same as X. Optional acts like a no-op. # Optional is just a hint to Dict/Tuple/CycleTuple and Type::Params. # my $type = Optional[ Types::Standard::Int ]; should_pass(0, $type); should_pass(1, $type); should_fail(1.1, $type); should_fail(undef, $type); isnt($type->type_default, undef, "$type has a type_default"); is($type->type_default->(), 0, "$type type_default is zero, because of Int's type_default"); if (eval q{ package Local::MyClass::Moo; use Moo; use Types::Standard qw( Int Optional ); has xyz => ( is => 'ro', isa => Optional[Int] ); 1; }) { my $e; $e = exception { Local::MyClass::Moo->new( xyz => 0 ); }; is($e, undef); $e = exception { Local::MyClass::Moo->new( xyz => 1 ); }; is($e, undef); $e = exception { Local::MyClass::Moo->new( xyz => 1.1 ); }; like($e, qr/type constraint/); $e = exception { Local::MyClass::Moo->new( xyz => undef ); }; like($e, qr/type constraint/); } if (eval q{ package Local::MyClass::Moose; use Moose; use Types::Standard qw( Int Optional ); has xyz => ( is => 'ro', isa => Optional[Int] ); 1; }) { my $e; $e = exception { Local::MyClass::Moose->new( xyz => 0 ); }; is($e, undef); $e = exception { Local::MyClass::Moose->new( xyz => 1 ); }; is($e, undef); $e = exception { Local::MyClass::Moose->new( xyz => 1.1 ); }; like($e, qr/type constraint/); $e = exception { Local::MyClass::Moose->new( xyz => undef ); }; like($e, qr/type constraint/); } if (eval q{ package Local::MyClass::Mouse; use Mouse; use Types::Standard qw( Int Optional ); has xyz => ( is => 'ro', isa => Optional[Int] ); 1; }) { my $e; $e = exception { Local::MyClass::Mouse->new( xyz => 0 ); }; is($e, undef); $e = exception { Local::MyClass::Mouse->new( xyz => 1 ); }; is($e, undef); $e = exception { Local::MyClass::Mouse->new( xyz => 1.1 ); }; like($e, qr/type constraint/); $e = exception { Local::MyClass::Mouse->new( xyz => undef ); }; like($e, qr/type constraint/); } # # See also: Dict.t, Tuple.t, CycleTuple.t. # done_testing; Overload.t000664001750001750 1570415111656240 16231 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Overload ); isa_ok(Overload, 'Type::Tiny', 'Overload'); is(Overload->name, 'Overload', 'Overload has correct name'); is(Overload->display_name, 'Overload', 'Overload has correct display_name'); is(Overload->library, 'Types::Standard', 'Overload knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Overload'), 'Types::Standard knows it has type Overload'); ok(!Overload->deprecated, 'Overload is not deprecated'); ok(!Overload->is_anon, 'Overload is not anonymous'); ok(Overload->can_be_inlined, 'Overload can be inlined'); is(exception { Overload->inline_check(q/$xyz/) }, undef, "Inlining Overload doesn't throw an exception"); ok(!Overload->has_coercion, "Overload doesn't have a coercion"); ok(Overload->is_parameterizable, "Overload is parameterizable"); is(Overload->type_default, undef, "Overload has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Overload, ucfirst("$label should pass Overload")); } elsif ($expect eq 'fail') { should_fail($value, Overload, ucfirst("$label should fail Overload")); } else { fail("expected '$expect'?!"); } } # # Type::Tiny itself overloads q[&{}] and q[""] but not q[${}]. # should_pass(Overload, Overload[ q[&{}] ]); should_pass(Overload, Overload[ q[""] ]); should_fail(Overload, Overload[ q[${}] ]); # # It's possible to check multiple overloaded operations. # should_pass(Overload, Overload[ q[&{}], q[""] ]); should_fail(Overload, Overload[ q[""], q[${}] ]); should_fail(Overload, Overload[ q[&{}], q[${}] ]); # # In the following example, $fortytwo_withfallback doesn't overload # '+' but still passes Overload['+'] because it provides a numification # overload and allows fallbacks. # my $fortytwo_nofallback = do { package Local::OL::NoFallback; use overload q[0+] => sub { ${$_[0]} }; my $x = 42; bless \$x; }; my $fortytwo_withfallback = do { package Local::OL::WithFallback; use overload q[0+] => sub { ${$_[0]} }, fallback => 1; my $x = 42; bless \$x; }; should_pass($fortytwo_nofallback, Overload['0+']); should_pass($fortytwo_withfallback, Overload['0+']); should_fail($fortytwo_nofallback, Overload['+']); should_fail($fortytwo_withfallback, Overload['+']); done_testing; Password.t000664001750001750 1366315111656240 16262 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( Password ); isa_ok(Password, 'Type::Tiny', 'Password'); is(Password->name, 'Password', 'Password has correct name'); is(Password->display_name, 'Password', 'Password has correct display_name'); is(Password->library, 'Types::Common::String', 'Password knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('Password'), 'Types::Common::String knows it has type Password'); ok(!Password->deprecated, 'Password is not deprecated'); ok(!Password->is_anon, 'Password is not anonymous'); ok(Password->can_be_inlined, 'Password can be inlined'); is(exception { Password->inline_check(q/$xyz/) }, undef, "Inlining Password doesn't throw an exception"); ok(!Password->has_coercion, "Password doesn't have a coercion"); ok(!Password->is_parameterizable, "Password isn't parameterizable"); is(Password->type_default, undef, "Password has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Password, ucfirst("$label should pass Password")); } elsif ($expect eq 'fail') { should_fail($value, Password, ucfirst("$label should fail Password")); } else { fail("expected '$expect'?!"); } } done_testing; PositiveInt.t000664001750001750 1403115111656240 16723 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( PositiveInt ); isa_ok(PositiveInt, 'Type::Tiny', 'PositiveInt'); is(PositiveInt->name, 'PositiveInt', 'PositiveInt has correct name'); is(PositiveInt->display_name, 'PositiveInt', 'PositiveInt has correct display_name'); is(PositiveInt->library, 'Types::Common::Numeric', 'PositiveInt knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('PositiveInt'), 'Types::Common::Numeric knows it has type PositiveInt'); ok(!PositiveInt->deprecated, 'PositiveInt is not deprecated'); ok(!PositiveInt->is_anon, 'PositiveInt is not anonymous'); ok(PositiveInt->can_be_inlined, 'PositiveInt can be inlined'); is(exception { PositiveInt->inline_check(q/$xyz/) }, undef, "Inlining PositiveInt doesn't throw an exception"); ok(!PositiveInt->has_coercion, "PositiveInt doesn't have a coercion"); ok(!PositiveInt->is_parameterizable, "PositiveInt isn't parameterizable"); is(PositiveInt->type_default, undef, "PositiveInt has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, fail => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, PositiveInt, ucfirst("$label should pass PositiveInt")); } elsif ($expect eq 'fail') { should_fail($value, PositiveInt, ucfirst("$label should fail PositiveInt")); } else { fail("expected '$expect'?!"); } } done_testing; PositiveNum.t000664001750001750 1403115111656240 16730 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( PositiveNum ); isa_ok(PositiveNum, 'Type::Tiny', 'PositiveNum'); is(PositiveNum->name, 'PositiveNum', 'PositiveNum has correct name'); is(PositiveNum->display_name, 'PositiveNum', 'PositiveNum has correct display_name'); is(PositiveNum->library, 'Types::Common::Numeric', 'PositiveNum knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('PositiveNum'), 'Types::Common::Numeric knows it has type PositiveNum'); ok(!PositiveNum->deprecated, 'PositiveNum is not deprecated'); ok(!PositiveNum->is_anon, 'PositiveNum is not anonymous'); ok(PositiveNum->can_be_inlined, 'PositiveNum can be inlined'); is(exception { PositiveNum->inline_check(q/$xyz/) }, undef, "Inlining PositiveNum doesn't throw an exception"); ok(!PositiveNum->has_coercion, "PositiveNum doesn't have a coercion"); ok(!PositiveNum->is_parameterizable, "PositiveNum isn't parameterizable"); is(PositiveNum->type_default, undef, "PositiveNum has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, fail => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, PositiveNum, ucfirst("$label should pass PositiveNum")); } elsif ($expect eq 'fail') { should_fail($value, PositiveNum, ucfirst("$label should fail PositiveNum")); } else { fail("expected '$expect'?!"); } } done_testing; PositiveOrZeroInt.t000664001750001750 1446015111656240 20072 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( PositiveOrZeroInt ); isa_ok(PositiveOrZeroInt, 'Type::Tiny', 'PositiveOrZeroInt'); is(PositiveOrZeroInt->name, 'PositiveOrZeroInt', 'PositiveOrZeroInt has correct name'); is(PositiveOrZeroInt->display_name, 'PositiveOrZeroInt', 'PositiveOrZeroInt has correct display_name'); is(PositiveOrZeroInt->library, 'Types::Common::Numeric', 'PositiveOrZeroInt knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('PositiveOrZeroInt'), 'Types::Common::Numeric knows it has type PositiveOrZeroInt'); ok(!PositiveOrZeroInt->deprecated, 'PositiveOrZeroInt is not deprecated'); ok(!PositiveOrZeroInt->is_anon, 'PositiveOrZeroInt is not anonymous'); ok(PositiveOrZeroInt->can_be_inlined, 'PositiveOrZeroInt can be inlined'); is(exception { PositiveOrZeroInt->inline_check(q/$xyz/) }, undef, "Inlining PositiveOrZeroInt doesn't throw an exception"); ok(!PositiveOrZeroInt->has_coercion, "PositiveOrZeroInt doesn't have a coercion"); ok(!PositiveOrZeroInt->is_parameterizable, "PositiveOrZeroInt isn't parameterizable"); isnt(PositiveOrZeroInt->type_default, undef, "PositiveOrZeroInt has a type_default"); is(PositiveOrZeroInt->type_default->(), 0, "PositiveOrZeroInt type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, PositiveOrZeroInt, ucfirst("$label should pass PositiveOrZeroInt")); } elsif ($expect eq 'fail') { should_fail($value, PositiveOrZeroInt, ucfirst("$label should fail PositiveOrZeroInt")); } else { fail("expected '$expect'?!"); } } done_testing; PositiveOrZeroNum.t000664001750001750 1446015111656240 20077 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( PositiveOrZeroNum ); isa_ok(PositiveOrZeroNum, 'Type::Tiny', 'PositiveOrZeroNum'); is(PositiveOrZeroNum->name, 'PositiveOrZeroNum', 'PositiveOrZeroNum has correct name'); is(PositiveOrZeroNum->display_name, 'PositiveOrZeroNum', 'PositiveOrZeroNum has correct display_name'); is(PositiveOrZeroNum->library, 'Types::Common::Numeric', 'PositiveOrZeroNum knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('PositiveOrZeroNum'), 'Types::Common::Numeric knows it has type PositiveOrZeroNum'); ok(!PositiveOrZeroNum->deprecated, 'PositiveOrZeroNum is not deprecated'); ok(!PositiveOrZeroNum->is_anon, 'PositiveOrZeroNum is not anonymous'); ok(PositiveOrZeroNum->can_be_inlined, 'PositiveOrZeroNum can be inlined'); is(exception { PositiveOrZeroNum->inline_check(q/$xyz/) }, undef, "Inlining PositiveOrZeroNum doesn't throw an exception"); ok(!PositiveOrZeroNum->has_coercion, "PositiveOrZeroNum doesn't have a coercion"); ok(!PositiveOrZeroNum->is_parameterizable, "PositiveOrZeroNum isn't parameterizable"); isnt(PositiveOrZeroNum->type_default, undef, "PositiveOrZeroNum has a type_default"); is(PositiveOrZeroNum->type_default->(), 0, "PositiveOrZeroNum type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, fail => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, PositiveOrZeroNum, ucfirst("$label should pass PositiveOrZeroNum")); } elsif ($expect eq 'fail') { should_fail($value, PositiveOrZeroNum, ucfirst("$label should fail PositiveOrZeroNum")); } else { fail("expected '$expect'?!"); } } done_testing; Ref.t000664001750001750 1632615111656240 15173 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Ref ); isa_ok(Ref, 'Type::Tiny', 'Ref'); is(Ref->name, 'Ref', 'Ref has correct name'); is(Ref->display_name, 'Ref', 'Ref has correct display_name'); is(Ref->library, 'Types::Standard', 'Ref knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Ref'), 'Types::Standard knows it has type Ref'); ok(!Ref->deprecated, 'Ref is not deprecated'); ok(!Ref->is_anon, 'Ref is not anonymous'); ok(Ref->can_be_inlined, 'Ref can be inlined'); is(exception { Ref->inline_check(q/$xyz/) }, undef, "Inlining Ref doesn't throw an exception"); ok(!Ref->has_coercion, "Ref doesn't have a coercion"); ok(Ref->is_parameterizable, "Ref is parameterizable"); is(Ref->type_default, undef, "Ref has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Ref, ucfirst("$label should pass Ref")); } elsif ($expect eq 'fail') { should_fail($value, Ref, ucfirst("$label should fail Ref")); } else { fail("expected '$expect'?!"); } } # # Tests for parameterized Ref # Ref['HASH'] # Ref['ARRAY'] # Ref['SCALAR'] # Ref['CODE'] # Ref['GLOB'] # Ref['LVALUE'] # my $x = 1; my %more_tests = ( HASH => [ {}, bless({}, 'Foo') ], ARRAY => [ [], bless([], 'Foo') ], SCALAR => [ do { my $x; \$x }, bless(do { my $x; \$x }, 'Foo') ], CODE => [ sub { 1 }, bless(sub { 1 }, 'Foo') ], GLOB => do { no warnings;[ \*BLEH, bless(\*BLEH2, 'Foo') ] }, # LVALUE => [ \substr($x, 0, 1), bless(\substr($x, 0, 1), 'Foo') ], ); my @reftypes = sort keys %more_tests; # The LVALUE examples *do* work, but generating output for the test # via Data::Dumper results in annoying warning messages, so the tests # are disabled. # Regexp, IO, FORMAT, VSTRING are all "todo". for my $reftype (@reftypes) { my $type = Ref[$reftype]; note("== $type =="); isa_ok($type, 'Type::Tiny', '$type'); ok($type->is_anon, '$type is not anonymous'); ok($type->can_be_inlined, '$type can be inlined'); is(exception { $type->inline_check(q/$xyz/) }, undef, "Inlining \$type doesn't throw an exception"); ok(!$type->has_coercion, "\$type doesn't have a coercion"); ok(!$type->is_parameterizable, "\$type isn't parameterizable"); ok($type->is_parameterized, "\$type is parameterized"); is($type->parameterized_from, Ref, "\$type's parent is Ref"); foreach my $other (@reftypes) { my @values = @{ $more_tests{$other} }; if ($reftype eq $other) { should_pass($_, $type) for @values; } else { should_fail($_, $type) for @values; } } } done_testing; RegexpRef.t000664001750001750 1400415111656240 16335 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( RegexpRef ); isa_ok(RegexpRef, 'Type::Tiny', 'RegexpRef'); is(RegexpRef->name, 'RegexpRef', 'RegexpRef has correct name'); is(RegexpRef->display_name, 'RegexpRef', 'RegexpRef has correct display_name'); is(RegexpRef->library, 'Types::Standard', 'RegexpRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('RegexpRef'), 'Types::Standard knows it has type RegexpRef'); ok(!RegexpRef->deprecated, 'RegexpRef is not deprecated'); ok(!RegexpRef->is_anon, 'RegexpRef is not anonymous'); ok(RegexpRef->can_be_inlined, 'RegexpRef can be inlined'); is(exception { RegexpRef->inline_check(q/$xyz/) }, undef, "Inlining RegexpRef doesn't throw an exception"); ok(!RegexpRef->has_coercion, "RegexpRef doesn't have a coercion"); ok(!RegexpRef->is_parameterizable, "RegexpRef isn't parameterizable"); isnt(RegexpRef->type_default, undef, "RegexpRef has a type_default"); is( '' . RegexpRef->type_default->(), '' . qr//, "RegexpRef type_default is qr//"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, RegexpRef, ucfirst("$label should pass RegexpRef")); } elsif ($expect eq 'fail') { should_fail($value, RegexpRef, ucfirst("$label should fail RegexpRef")); } else { fail("expected '$expect'?!"); } } done_testing; RoleName.t000664001750001750 1567315111656240 16165 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( RoleName ); isa_ok(RoleName, 'Type::Tiny', 'RoleName'); is(RoleName->name, 'RoleName', 'RoleName has correct name'); is(RoleName->display_name, 'RoleName', 'RoleName has correct display_name'); is(RoleName->library, 'Types::Standard', 'RoleName knows it is in the Types::Standard library'); ok(Types::Standard->has_type('RoleName'), 'Types::Standard knows it has type RoleName'); ok(!RoleName->deprecated, 'RoleName is not deprecated'); ok(!RoleName->is_anon, 'RoleName is not anonymous'); ok(RoleName->can_be_inlined, 'RoleName can be inlined'); is(exception { RoleName->inline_check(q/$xyz/) }, undef, "Inlining RoleName doesn't throw an exception"); ok(!RoleName->has_coercion, "RoleName doesn't have a coercion"); ok(!RoleName->is_parameterizable, "RoleName isn't parameterizable"); is(RoleName->type_default, undef, "RoleName has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, RoleName, ucfirst("$label should pass RoleName")); } elsif ($expect eq 'fail') { should_fail($value, RoleName, ucfirst("$label should fail RoleName")); } else { fail("expected '$expect'?!"); } } # # RoleName accepts Role::Tiny, Moo::Role, Moose::Role, and Mouse::Role roles # if (eval q{ package Local::Role::RoleTiny; use Role::Tiny; 1 }) { should_pass('Local::Role::RoleTiny', RoleName); } if (eval q{ package Local::Role::MooRole; use Moo::Role; 1 }) { should_pass('Local::Role::MooRole', RoleName); } if (eval q{ package Local::Role::MooseRole; use Moose::Role; 1 }) { should_pass('Local::Role::MooseRole', RoleName); } if (eval q{ package Local::Role::MouseRole; use Mouse::Role; 1 }) { should_pass('Local::Role::MouseRole', RoleName); } # # RoleName rejects Class::Tiny, Moo, Moose, and Mouse classes # if (eval q{ package Local::Class::ClassTiny; use Class::Tiny; 1 }) { should_fail('Local::Class::ClassTiny', RoleName); } if (eval q{ package Local::Class::Moo; use Moo; 1 }) { should_fail('Local::Class::Moo', RoleName); } if (eval q{ package Local::Class::Moose; use Moose; 1 }) { should_fail('Local::Class::Moose', RoleName); } if (eval q{ package Local::Class::Mouse; use Mouse; 1 }) { should_fail('Local::Class::Mouse', RoleName); } done_testing; ScalarRef.t000664001750001750 1634515111656240 16322 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( ScalarRef ); isa_ok(ScalarRef, 'Type::Tiny', 'ScalarRef'); is(ScalarRef->name, 'ScalarRef', 'ScalarRef has correct name'); is(ScalarRef->display_name, 'ScalarRef', 'ScalarRef has correct display_name'); is(ScalarRef->library, 'Types::Standard', 'ScalarRef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('ScalarRef'), 'Types::Standard knows it has type ScalarRef'); ok(!ScalarRef->deprecated, 'ScalarRef is not deprecated'); ok(!ScalarRef->is_anon, 'ScalarRef is not anonymous'); ok(ScalarRef->can_be_inlined, 'ScalarRef can be inlined'); is(exception { ScalarRef->inline_check(q/$xyz/) }, undef, "Inlining ScalarRef doesn't throw an exception"); ok(!ScalarRef->has_coercion, "ScalarRef doesn't have a coercion"); ok(ScalarRef->is_parameterizable, "ScalarRef is parameterizable"); isnt(ScalarRef->type_default, undef, "ScalarRef has a type_default"); is_deeply(ScalarRef->type_default->(), \undef, "ScalarRef type_default is a reference to undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, ScalarRef, ucfirst("$label should pass ScalarRef")); } elsif ($expect eq 'fail') { should_fail($value, ScalarRef, ucfirst("$label should fail ScalarRef")); } else { fail("expected '$expect'?!"); } } use Scalar::Util qw( refaddr ); my $plain = ScalarRef; my $paramd = ScalarRef[]; is( refaddr($plain), refaddr($paramd), 'parameterizing with [] has no effect' ); # # Parameterization with a type constraint # my $IntRef = ScalarRef[ Types::Standard::Int ]; should_pass(\"1", $IntRef); should_fail(\"1.2", $IntRef); should_fail(\"abc", $IntRef); # # Deep coercion # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, 'int($_)' ); my $RoundedRef = ScalarRef[ $Rounded ]; should_pass(\"1", $RoundedRef); should_fail(\"1.2", $RoundedRef); should_fail(\"abc", $RoundedRef); ok($RoundedRef->has_coercion); is_deeply($RoundedRef->coerce(\"3.1"), \"3"); # # Let's do it with a reference to a reference. # my $RoundedArrayRefRef = ScalarRef[ Types::Standard::ArrayRef[$Rounded] ]; should_pass(\[], $RoundedArrayRefRef); should_pass(\["1"], $RoundedArrayRefRef); should_fail(\["1.2"], $RoundedArrayRefRef); should_fail(\["abc"], $RoundedArrayRefRef); should_fail([], $RoundedArrayRefRef); should_fail(["1"], $RoundedArrayRefRef); should_fail(["1.2"], $RoundedArrayRefRef); should_fail(["abc"], $RoundedArrayRefRef); ok($RoundedArrayRefRef->has_coercion); is_deeply($RoundedArrayRefRef->coerce(\["3.1"]), \["3"]); done_testing; SimpleStr.t000664001750001750 1404715111656240 16377 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( SimpleStr ); isa_ok(SimpleStr, 'Type::Tiny', 'SimpleStr'); is(SimpleStr->name, 'SimpleStr', 'SimpleStr has correct name'); is(SimpleStr->display_name, 'SimpleStr', 'SimpleStr has correct display_name'); is(SimpleStr->library, 'Types::Common::String', 'SimpleStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('SimpleStr'), 'Types::Common::String knows it has type SimpleStr'); ok(!SimpleStr->deprecated, 'SimpleStr is not deprecated'); ok(!SimpleStr->is_anon, 'SimpleStr is not anonymous'); ok(SimpleStr->can_be_inlined, 'SimpleStr can be inlined'); is(exception { SimpleStr->inline_check(q/$xyz/) }, undef, "Inlining SimpleStr doesn't throw an exception"); ok(!SimpleStr->has_coercion, "SimpleStr doesn't have a coercion"); ok(!SimpleStr->is_parameterizable, "SimpleStr isn't parameterizable"); isnt(SimpleStr->type_default, undef, "SimpleStr has a type_default"); is(SimpleStr->type_default->(), '', "SimpleStr type_default is the empty string"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', fail => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, SimpleStr, ucfirst("$label should pass SimpleStr")); } elsif ($expect eq 'fail') { should_fail($value, SimpleStr, ucfirst("$label should fail SimpleStr")); } else { fail("expected '$expect'?!"); } } done_testing; SingleDigit.t000664001750001750 1414415111656240 16655 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::Numeric qw( SingleDigit ); isa_ok(SingleDigit, 'Type::Tiny', 'SingleDigit'); is(SingleDigit->name, 'SingleDigit', 'SingleDigit has correct name'); is(SingleDigit->display_name, 'SingleDigit', 'SingleDigit has correct display_name'); is(SingleDigit->library, 'Types::Common::Numeric', 'SingleDigit knows it is in the Types::Common::Numeric library'); ok(Types::Common::Numeric->has_type('SingleDigit'), 'Types::Common::Numeric knows it has type SingleDigit'); ok(!SingleDigit->deprecated, 'SingleDigit is not deprecated'); ok(!SingleDigit->is_anon, 'SingleDigit is not anonymous'); ok(SingleDigit->can_be_inlined, 'SingleDigit can be inlined'); is(exception { SingleDigit->inline_check(q/$xyz/) }, undef, "Inlining SingleDigit doesn't throw an exception"); ok(!SingleDigit->has_coercion, "SingleDigit doesn't have a coercion"); ok(!SingleDigit->is_parameterizable, "SingleDigit isn't parameterizable"); isnt(SingleDigit->type_default, undef, "SingleDigit has a type_default"); is(SingleDigit->type_default->(), 0, "SingleDigit type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, SingleDigit, ucfirst("$label should pass SingleDigit")); } elsif ($expect eq 'fail') { should_fail($value, SingleDigit, ucfirst("$label should fail SingleDigit")); } else { fail("expected '$expect'?!"); } } done_testing; Slurpy.t000664001750001750 2355715111656240 15761 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Slurpy ); isa_ok(Slurpy, 'Type::Tiny', 'Slurpy'); is(Slurpy->name, 'Slurpy', 'Slurpy has correct name'); is(Slurpy->display_name, 'Slurpy', 'Slurpy has correct display_name'); is(Slurpy->library, 'Types::Standard', 'Slurpy knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Slurpy'), 'Types::Standard knows it has type Slurpy'); ok(!Slurpy->deprecated, 'Slurpy is not deprecated'); ok(!Slurpy->is_anon, 'Slurpy is not anonymous'); ok(Slurpy->can_be_inlined, 'Slurpy can be inlined'); is(exception { Slurpy->inline_check(q/$xyz/) }, undef, "Inlining Slurpy doesn't throw an exception"); ok(!Slurpy->has_coercion, "Slurpy doesn't have a coercion"); ok(Slurpy->is_parameterizable, "Slurpy is parameterizable"); isnt(Slurpy->type_default, undef, "Slurpy has a type_default"); is(Slurpy->type_default->(), undef, "Slurpy type_default is undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', pass => 'a reference to undef' => do { my $x = undef; \$x }, pass => 'a reference to false' => do { my $x = !!0; \$x }, pass => 'a reference to true' => do { my $x = !!1; \$x }, pass => 'a reference to zero' => do { my $x = 0; \$x }, pass => 'a reference to one' => do { my $x = 1; \$x }, pass => 'a reference to empty string' => do { my $x = ''; \$x }, pass => 'a reference to random string' => do { my $x = 'abc123'; \$x }, pass => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], pass => 'blessed arrayref' => bless([], 'SomePkg'), pass => 'empty hashref' => {}, pass => 'hashref' => { foo => 1 }, pass => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, pass => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, pass => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, pass => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), pass => 'regexp' => qr/./, pass => 'blessed regexp' => bless(qr/./, 'SomePkg'), pass => 'filehandle' => do { open my $x, '<', $0 or die; $x }, pass => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, pass => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, pass => 'ref to arrayref' => do { my $x = []; \$x }, pass => 'ref to hashref' => do { my $x = {}; \$x }, pass => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, pass => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, pass => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, pass => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, pass => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, pass => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, pass => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, pass => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, pass => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Slurpy, ucfirst("$label should pass Slurpy")); } elsif ($expect eq 'fail') { should_fail($value, Slurpy, ucfirst("$label should fail Slurpy")); } else { fail("expected '$expect'?!"); } } # Should just pass through to the CodeRef check. # my $SlurpyCodeRef = Slurpy[ Types::Standard::CodeRef ]; my @tests_from_CodeRef = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, ); while (@tests_from_CodeRef) { my ($expect, $label, $value) = splice(@tests_from_CodeRef, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, $SlurpyCodeRef, ucfirst("$label should pass $SlurpyCodeRef")); } elsif ($expect eq 'fail') { should_fail($value, $SlurpyCodeRef, ucfirst("$label should fail $SlurpyCodeRef")); } else { fail("expected '$expect'?!"); } } isnt(Slurpy->of( Types::Standard::HashRef )->type_default, undef, "Slurpy[HashRef] has a type_default"); is_deeply(Slurpy->of( Types::Standard::HashRef )->type_default->(), {}, "Slurpy[HashRef] type_default is {}"); is(Slurpy->of( Types::Standard::Defined )->type_default, undef, "Slurpy[Defined] has no type_default"); # Convenience method: # is( Slurpy->of( Types::Standard::Any )->my_slurp_into, 'ARRAY' ); is( Slurpy->of( Types::Standard::HashRef )->my_slurp_into, 'HASH' ); is( Slurpy->of( Types::Standard::Dict )->my_slurp_into, 'HASH' ); is( Slurpy->of( Types::Standard::Map )->my_slurp_into, 'HASH' ); is( Slurpy->of( Types::Standard::ArrayRef )->my_slurp_into, 'ARRAY' ); is( Slurpy->of( Types::Standard::Tuple )->my_slurp_into, 'ARRAY' ); is( Slurpy->of( Types::Standard::CycleTuple )->my_slurp_into, 'ARRAY' ); # # See also: Dict.t, Tuple.t, CycleTuple.t. # done_testing; Str.t000664001750001750 1372315111656240 15225 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Str ); isa_ok(Str, 'Type::Tiny', 'Str'); is(Str->name, 'Str', 'Str has correct name'); is(Str->display_name, 'Str', 'Str has correct display_name'); is(Str->library, 'Types::Standard', 'Str knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Str'), 'Types::Standard knows it has type Str'); ok(!Str->deprecated, 'Str is not deprecated'); ok(!Str->is_anon, 'Str is not anonymous'); ok(Str->can_be_inlined, 'Str can be inlined'); is(exception { Str->inline_check(q/$xyz/) }, undef, "Inlining Str doesn't throw an exception"); ok(!Str->has_coercion, "Str doesn't have a coercion"); ok(!Str->is_parameterizable, "Str isn't parameterizable"); isnt(Str->type_default, undef, "Str has a type_default"); is(Str->type_default->(), '', "Str type_default is the empty string"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Str, ucfirst("$label should pass Str")); } elsif ($expect eq 'fail') { should_fail($value, Str, ucfirst("$label should fail Str")); } else { fail("expected '$expect'?!"); } } # # String sorting # is_deeply( [ Str->sort( 11, 2, 1 ) ], [ 1, 11, 2 ], 'String sorting', ); # this also works with subtypes, like NonEmptyStr, etc. done_testing; StrLength.t000664001750001750 2034215111656240 16362 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( StrLength ); isa_ok(StrLength, 'Type::Tiny', 'StrLength'); is(StrLength->name, 'StrLength', 'StrLength has correct name'); is(StrLength->display_name, 'StrLength', 'StrLength has correct display_name'); is(StrLength->library, 'Types::Common::String', 'StrLength knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('StrLength'), 'Types::Common::String knows it has type StrLength'); ok(!StrLength->deprecated, 'StrLength is not deprecated'); ok(!StrLength->is_anon, 'StrLength is not anonymous'); ok(StrLength->can_be_inlined, 'StrLength can be inlined'); is(exception { StrLength->inline_check(q/$xyz/) }, undef, "Inlining StrLength doesn't throw an exception"); ok(!StrLength->has_coercion, "StrLength doesn't have a coercion"); ok(StrLength->is_parameterizable, "StrLength is parameterizable"); isnt(StrLength->type_default, undef, "StrLength has a type_default"); is(StrLength->type_default->(), '', "StrLength type_default is the empty string"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, StrLength, ucfirst("$label should pass StrLength")); } elsif ($expect eq 'fail') { should_fail($value, StrLength, ucfirst("$label should fail StrLength")); } else { fail("expected '$expect'?!"); } } # # String with a minimum length # my $StrLength_2 = StrLength[2]; should_fail('', $StrLength_2); should_fail('1', $StrLength_2); should_pass('12', $StrLength_2); should_pass('123', $StrLength_2); should_pass('1234', $StrLength_2); should_pass('12345', $StrLength_2); should_pass('123456', $StrLength_2); should_pass('1234567', $StrLength_2); should_pass('12345678', $StrLength_2); should_pass('123456789', $StrLength_2); is($StrLength_2->type_default, undef, "$StrLength_2 has no type_default"); # Cyrillic Small Letter Zhe - two bytes as UTF-8 but only one character should_fail("\x{0436}" x 1, $StrLength_2); should_pass("\x{0436}" x 2, $StrLength_2); should_pass("\x{0436}" x 6, $StrLength_2); # # String with a minimum and maximum length # my $StrLength_2_5 = StrLength[2, 5]; should_fail('', $StrLength_2_5); should_fail('1', $StrLength_2_5); should_pass('12', $StrLength_2_5); should_pass('123', $StrLength_2_5); should_pass('1234', $StrLength_2_5); should_pass('12345', $StrLength_2_5); should_fail('123456', $StrLength_2_5); should_fail('1234567', $StrLength_2_5); should_fail('12345678', $StrLength_2_5); should_fail('123456789', $StrLength_2_5); should_fail("\x{0436}" x 1, $StrLength_2_5); should_pass("\x{0436}" x 2, $StrLength_2_5); should_fail("\x{0436}" x 6, $StrLength_2_5); # # Overloaded objects are not allowed # { package Local::OL::Stringy; use overload q[""] => sub { ${$_[0]} }; sub new { my ($class, $str) = @_; bless(\$str, $class) } } my $abc_obj = Local::OL::Stringy->new('abc'); is("$abc_obj", "abc"); should_fail($abc_obj, $StrLength_2_5); # # But you can do this to create a type accepting a overloaded objects # that stringify to a string matching $StrLength_2_5. # use Types::Standard qw(Overload); my $Overloaded_StrLength_2_5 = Overload->of(q[""])->stringifies_to($StrLength_2_5); should_pass($abc_obj, $Overloaded_StrLength_2_5); # ... though that doesn't accept real strings. should_fail('abc', $Overloaded_StrLength_2_5); # # Union type constraint to the rescue! # my $Union_2_5 = $StrLength_2_5 | $Overloaded_StrLength_2_5; should_pass($abc_obj, $Union_2_5); should_pass('abc', $Union_2_5); done_testing; StrMatch-more.t000664001750001750 343715111656240 17123 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE More tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires '5.020'; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( StrMatch ); use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings ':all'; # # This is a regexp containing embedded Perl code. # It's interesting because it cannot easily be inlined. # my $xxx = 0; my $matchfoo = StrMatch[ qr/f(?{ ++$xxx })oo/ ]; # Wrap this in a warnings block because it will generate warnings under # EXTENDED_TESTING! The warnings will be tested later. warnings { should_pass('foo', $matchfoo); should_fail('bar', $matchfoo); }; ok($xxx > 0, 'Embedded code executed'); note('$xxx is ' . $xxx); ok($matchfoo->can_be_inlined, 'It can still be inlined!'); note( $matchfoo->inline_check('$STRING') ); { local $Type::Tiny::AvoidCallbacks = 1; my $w = warning { $matchfoo->inline_check('$STRING') }; like( $w, qr/serializing using callbacks/, 'The inlining needed to use a callback!', ); } # # Including this mostly for the benefit of Devel::Cover... # my $matchfoo2 = StrMatch[ qr/f(?{ ++$xxx })(oo)/, Types::Standard::Enum['oo'] ]; warnings { should_pass('foo', $matchfoo); should_fail('bar', $matchfoo); }; { local $Type::Tiny::AvoidCallbacks = 1; my $w = warning { $matchfoo2->inline_check('$STRING') }; like( $w, qr/serializing using callbacks/, 'The inlining needed to use a callback!', ); } done_testing; StrMatch.t000664001750001750 2025215111656240 16175 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 SEE ALSO StrMatch-more.t =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( StrMatch ); isa_ok(StrMatch, 'Type::Tiny', 'StrMatch'); is(StrMatch->name, 'StrMatch', 'StrMatch has correct name'); is(StrMatch->display_name, 'StrMatch', 'StrMatch has correct display_name'); is(StrMatch->library, 'Types::Standard', 'StrMatch knows it is in the Types::Standard library'); ok(Types::Standard->has_type('StrMatch'), 'Types::Standard knows it has type StrMatch'); ok(!StrMatch->deprecated, 'StrMatch is not deprecated'); ok(!StrMatch->is_anon, 'StrMatch is not anonymous'); ok(StrMatch->can_be_inlined, 'StrMatch can be inlined'); is(exception { StrMatch->inline_check(q/$xyz/) }, undef, "Inlining StrMatch doesn't throw an exception"); ok(!StrMatch->has_coercion, "StrMatch doesn't have a coercion"); ok(StrMatch->is_parameterizable, "StrMatch is parameterizable"); isnt(StrMatch->type_default, undef, "StrMatch has a type_default"); is(StrMatch->type_default->(), '', "StrMatch type_default is the empty string"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, StrMatch, ucfirst("$label should pass StrMatch")); } elsif ($expect eq 'fail') { should_fail($value, StrMatch, ucfirst("$label should fail StrMatch")); } else { fail("expected '$expect'?!"); } } # # This should be pretty obvious. # my $type1 = StrMatch[ qr/a[b]c/i ]; should_pass('abc', $type1); should_pass('ABC', $type1); should_pass('fooabcbar', $type1); should_pass('fooABCbar', $type1); should_fail('a[b]c', $type1); is($type1->type_default, undef, "$type1 has no type_default"); # # StrMatch only accepts true strings. # { package Local::OL::Stringy; use overload q[""] => sub { ${$_[0]} }; sub new { my ($class, $str) = @_; bless(\$str, $class) } } my $abc_obj = Local::OL::Stringy->new('abc'); is("$abc_obj", "abc"); should_fail($abc_obj, $type1); # # But you can do this to create a type accepting a overloaded objects # that stringify to a string matching $type1. # use Types::Standard qw(Overload); my $type2 = Overload->of(q[""])->stringifies_to($type1); should_pass($abc_obj, $type2); should_fail('abc', $type2); # ... though that doesn't accept real strings. # # Union type constraint to the rescue! # my $type3 = $type1 | $type2; should_pass($abc_obj, $type3); should_pass('abc', $type3); # # Okay, it was fun looking at overloaded objects, but let's look at # something else... # use Types::Standard qw( +Num Enum Tuple ); my $metric_distance = StrMatch[ # Strings must match this regexp qr/^(\S+) (\S+)$/, # Captures get checked against this constraint Tuple[ Num, Enum[qw/ mm cm m km /], ], ]; should_pass('1 km', $metric_distance); should_pass('-1.6 cm', $metric_distance); should_fail('xyz km', $metric_distance); should_fail('7 miles', $metric_distance); should_fail('7 km ', $metric_distance); # # You could implement it like this instead because a coderef # returning a boolean can be used like a type constraint. # $metric_distance = StrMatch[ # Strings must match this regexp qr/^(\S+) (\S+)$/, sub { my $captures = shift; return !!0 unless is_Num $captures->[0]; return !!1 if $captures->[1] eq 'mm'; return !!1 if $captures->[1] eq 'cm'; return !!1 if $captures->[1] eq 'm'; return !!1 if $captures->[1] eq 'km'; return !!0; } ]; should_pass('1 km', $metric_distance); should_pass('-1.6 cm', $metric_distance); should_fail('xyz km', $metric_distance); should_fail('7 miles', $metric_distance); should_fail('7 km ', $metric_distance); done_testing; StrictNum.t000664001750001750 1423715111656240 16406 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( StrictNum ); isa_ok(StrictNum, 'Type::Tiny', 'StrictNum'); is(StrictNum->name, 'StrictNum', 'StrictNum has correct name'); is(StrictNum->display_name, 'StrictNum', 'StrictNum has correct display_name'); is(StrictNum->library, 'Types::Standard', 'StrictNum knows it is in the Types::Standard library'); ok(Types::Standard->has_type('StrictNum'), 'Types::Standard knows it has type StrictNum'); ok(!StrictNum->deprecated, 'StrictNum is not deprecated'); ok(!StrictNum->is_anon, 'StrictNum is not anonymous'); ok(StrictNum->can_be_inlined, 'StrictNum can be inlined'); is(exception { StrictNum->inline_check(q/$xyz/) }, undef, "Inlining StrictNum doesn't throw an exception"); ok(!StrictNum->has_coercion, "StrictNum doesn't have a coercion"); ok(!StrictNum->is_parameterizable, "StrictNum isn't parameterizable"); isnt(StrictNum->type_default, undef, "StrictNum has a type_default"); is(StrictNum->type_default->(), 0, "StrictNum type_default is zero"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, xxxx => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, StrictNum, ucfirst("$label should pass StrictNum")); } elsif ($expect eq 'fail') { should_fail($value, StrictNum, ucfirst("$label should fail StrictNum")); } else { fail("expected '$expect'?!"); } } # # Numeric sorting # is_deeply( [ StrictNum->sort( 11, 2, 1 ) ], [ 1, 2, 11 ], 'Numeric sorting', ); # this also works with subtypes, like Int, PositiveInt, etc. done_testing; StringLike.t000664001750001750 1404415111656240 16525 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 20192025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( StringLike ); isa_ok(StringLike, 'Type::Tiny', 'StringLike'); is(StringLike->name, 'StringLike', 'StringLike has correct name'); is(StringLike->display_name, 'StringLike', 'StringLike has correct display_name'); is(StringLike->library, 'Types::TypeTiny', 'StringLike knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('StringLike'), 'Types::TypeTiny knows it has type StringLike'); ok(!StringLike->deprecated, 'StringLike is not deprecated'); ok(!StringLike->is_anon, 'StringLike is not anonymous'); ok(StringLike->can_be_inlined, 'StringLike can be inlined'); is(exception { StringLike->inline_check(q/$xyz/) }, undef, "Inlining StringLike doesn't throw an exception"); ok(!StringLike->has_coercion, "StringLike doesn't have a coercion"); ok(!StringLike->is_parameterizable, "StringLike isn't parameterizable"); isnt(StringLike->type_default, undef, "StringLike has a type_default"); is(StringLike->type_default->(), '', "StringLike type_default is the empty string"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), xxxx => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, pass => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, pass => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, pass => 'boolean::false' => boolean::false, pass => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, StringLike, ucfirst("$label should pass StringLike")); } elsif ($expect eq 'fail') { should_fail($value, StringLike, ucfirst("$label should fail StringLike")); } else { fail("expected '$expect'?!"); } } done_testing; StrongPassword.t000664001750001750 1416315111656240 17453 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( StrongPassword ); isa_ok(StrongPassword, 'Type::Tiny', 'StrongPassword'); is(StrongPassword->name, 'StrongPassword', 'StrongPassword has correct name'); is(StrongPassword->display_name, 'StrongPassword', 'StrongPassword has correct display_name'); is(StrongPassword->library, 'Types::Common::String', 'StrongPassword knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('StrongPassword'), 'Types::Common::String knows it has type StrongPassword'); ok(!StrongPassword->deprecated, 'StrongPassword is not deprecated'); ok(!StrongPassword->is_anon, 'StrongPassword is not anonymous'); ok(StrongPassword->can_be_inlined, 'StrongPassword can be inlined'); is(exception { StrongPassword->inline_check(q/$xyz/) }, undef, "Inlining StrongPassword doesn't throw an exception"); ok(!StrongPassword->has_coercion, "StrongPassword doesn't have a coercion"); ok(!StrongPassword->is_parameterizable, "StrongPassword isn't parameterizable"); is(StrongPassword->type_default, undef, "StrongPassword has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, StrongPassword, ucfirst("$label should pass StrongPassword")); } elsif ($expect eq 'fail') { should_fail($value, StrongPassword, ucfirst("$label should fail StrongPassword")); } else { fail("expected '$expect'?!"); } } done_testing; Tied.t000664001750001750 1620715111656240 15342 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Tied ); isa_ok(Tied, 'Type::Tiny', 'Tied'); is(Tied->name, 'Tied', 'Tied has correct name'); is(Tied->display_name, 'Tied', 'Tied has correct display_name'); is(Tied->library, 'Types::Standard', 'Tied knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Tied'), 'Types::Standard knows it has type Tied'); ok(!Tied->deprecated, 'Tied is not deprecated'); ok(!Tied->is_anon, 'Tied is not anonymous'); ok(Tied->can_be_inlined, 'Tied can be inlined'); is(exception { Tied->inline_check(q/$xyz/) }, undef, "Inlining Tied doesn't throw an exception"); ok(!Tied->has_coercion, "Tied doesn't have a coercion"); ok(Tied->is_parameterizable, "Tied is parameterizable"); is(Tied->type_default, undef, "Tied has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Tied, ucfirst("$label should pass Tied")); } elsif ($expect eq 'fail') { should_fail($value, Tied, ucfirst("$label should fail Tied")); } else { fail("expected '$expect'?!"); } } # # Test with tied scalar # require Tie::Scalar; tie my $var, 'Tie::StdScalar'; should_pass( \$var, Tied ); should_pass( \$var, Tied['Tie::StdScalar'] ); should_pass( \$var, Tied['Tie::Scalar'] ); should_fail( \$var, Tied['IO::File'] ); # Tie::StdScalar inherits # # Blessed scalarrefs can still be tied # bless(\$var, 'Bleh'); should_pass( \$var, Tied['Tie::Scalar'] ); should_fail( \$var, Tied['Bleh'] ); # # Tied is for blessed references only! # Couldn't reliably test non-reference even if we wanted to. # ok(tied($var), '$var is tied'); should_fail( $var, Tied ); # # Test with tied array # require Tie::Array; tie my @arr, 'Tie::StdArray'; should_pass( \@arr, Tied ); should_pass( \@arr, Tied['Tie::StdArray'] ); should_pass( \@arr, Tied['Tie::Array'] ); should_fail( \@arr, Tied['IO::File'] ); # Tie::StdArray inherits # # Blessed arrayrefs can still be tied # bless(\@arr, 'Bleh'); should_pass( \@arr, Tied['Tie::Array'] ); should_fail( \@arr, Tied['Bleh'] ); # # Test with tied hash # require Tie::Hash; @Tie::StdHash::ISA = qw(Tie::Hash); tie my %h, 'Tie::StdHash'; should_pass( \%h, Tied ); should_pass( \%h, Tied['Tie::StdHash'] ); should_pass( \%h, Tied['Tie::Hash'] ); should_fail( \%h, Tied['IO::File'] ); # Tie::StdHash inherits # # Blessed hashrefs can still be tied # bless(\%h, 'Bleh'); should_pass( \%h, Tied['Tie::Hash'] ); should_fail( \%h, Tied['Bleh'] ); done_testing; Tuple.t000664001750001750 2766015111656240 15553 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Tuple ); isa_ok(Tuple, 'Type::Tiny', 'Tuple'); is(Tuple->name, 'Tuple', 'Tuple has correct name'); is(Tuple->display_name, 'Tuple', 'Tuple has correct display_name'); is(Tuple->library, 'Types::Standard', 'Tuple knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Tuple'), 'Types::Standard knows it has type Tuple'); ok(!Tuple->deprecated, 'Tuple is not deprecated'); ok(!Tuple->is_anon, 'Tuple is not anonymous'); ok(Tuple->can_be_inlined, 'Tuple can be inlined'); is(exception { Tuple->inline_check(q/$xyz/) }, undef, "Inlining Tuple doesn't throw an exception"); ok(!Tuple->has_coercion, "Tuple doesn't have a coercion"); ok(Tuple->is_parameterizable, "Tuple is parameterizable"); isnt(Tuple->type_default, undef, "Tuple has a type_default"); is_deeply(Tuple->type_default->(), [], "Tuple type_default is []"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), pass => 'empty arrayref' => [], pass => 'arrayref with one zero' => [0], pass => 'arrayref of integers' => [1..10], pass => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Tuple, ucfirst("$label should pass Tuple")); } elsif ($expect eq 'fail') { should_fail($value, Tuple, ucfirst("$label should fail Tuple")); } else { fail("expected '$expect'?!"); } } # # A basic tuple. # my $type1 = Tuple[ Types::Standard::Int, Types::Standard::ArrayRef, Types::Standard::Undef, ]; should_pass( [42,[1..4],undef], $type1 ); should_fail( [{},[1..4],undef], $type1 ); # first slot fails should_fail( [42,{ },undef], $type1 ); # second slot fails should_fail( [42,[1..4],{ } ], $type1 ); # third slot fails should_fail( [42,[1..4],undef,1], $type1 ); # too many slots should_fail( [42,[1..4]], $type1 ); # not enough slots should_fail( [], $type1 ); # not enough slots (empty arrayref) should_fail( 42, $type1 ); # not even an arrayref should_fail( bless([42,[1..10],undef], 'Foo'), $type1 ); # blessed is($type1->type_default, undef, "$type1 has no type_default"); # # Some Optional slots. # use Types::Standard qw( Optional ); my $type2 = Tuple[ Types::Standard::Int, Types::Standard::ArrayRef, Optional[ Types::Standard::HashRef ], Optional[ Types::Standard::ScalarRef ], ]; should_pass([42,[],{},\0], $type2); should_pass([42,[],{}], $type2); # missing optional fourth slot should_pass([42,[]], $type2); # missing optional third slot should_fail([42], $type2); # missing required second slot should_fail([], $type2); # missing required first slot # can't put undef in slot 3 as a way to supply a value for slot 4 should_fail([42,[],undef,\0], $type2); # # The difference between Optional and Maybe # use Types::Standard qw( Maybe ); my $type3 = Tuple[ Types::Standard::Int, Types::Standard::ArrayRef, Maybe[ Types::Standard::HashRef ], Maybe[ Types::Standard::ScalarRef ], ]; should_fail([42,[],{}], $type3); # missing fourth slot fails! should_pass([42,[],{},undef], $type3); # ... but undef is okay # # Simple Slurpy example # use Types::Standard qw(Slurpy); my $type4 = Tuple[ Types::Standard::RegexpRef, Slurpy[ Types::Standard::ArrayRef[ Types::Standard::Int ] ], ]; should_pass([qr//], $type4); should_pass([qr//,1..4], $type4); should_fail([qr//,1..4,qr//], $type4); # note that the Slurpy slurps stuff into an arrayref to check # so it will fail when there's an actual arrayref there. should_fail([qr//,[1..4]], $type4); # # Optional + Slurpy example # my $type5 = Tuple[ Types::Standard::RegexpRef, Optional[ Types::Standard::HashRef ], Slurpy[ Types::Standard::ArrayRef[ Types::Standard::Int ] ], ]; should_pass([qr//], $type5); should_pass([qr//,{}], $type5); should_pass([qr//,{},1..4], $type5); # can't omit Optional element but still provide slurpy should_fail([qr//,1..4], $type5); # # Slurpy Tuple inside a Tuple # my $type6 = Tuple[ Types::Standard::RegexpRef, Slurpy[ Types::Standard::Tuple[ Types::Standard::Int, Types::Standard::Int ] ], ]; should_pass([qr//], $type6); should_fail([qr//,1], $type6); should_pass([qr//,1,2], $type6); # pass because two ints should_fail([qr//,1,2,3], $type6); should_fail([qr//,1,2,3,4], $type6); should_fail([qr//,1,2,3,4,5], $type6); # # Optional + Slurpy Tuple inside a Tuple # my $type7 = Tuple[ Types::Standard::RegexpRef, Optional[ Types::Standard::RegexpRef ], Slurpy[ Types::Standard::Tuple[ Types::Standard::Int, Types::Standard::Int ] ], ]; should_pass([qr//], $type7); should_pass([qr//,qr//], $type7); should_fail([qr//,qr//,1], $type7); should_pass([qr//,qr//,1,2], $type7); # pass because two ints after optional should_fail([qr//,1,2], $type7); # fail because two ints with no optional should_fail([qr//,qr//,1,2,3], $type7); should_fail([qr//,qr//,1,2,3,4], $type7); should_fail([qr//,qr//,1,2,3,4,5], $type7); # # Simple Slurpy hashref example # my $type8 = Tuple[ Types::Standard::RegexpRef, Slurpy[ Types::Standard::HashRef[ Types::Standard::Int ] ], ]; should_pass([qr//], $type8); should_pass([qr//,foo=>1,bar=>2], $type8); should_fail([qr//,foo=>1,bar=>2,qr//], $type8); # note that the slurpy slurps stuff into an hashref to check # so it will fail when there's an actual hashref there. should_fail([qr//,{foo=>1,bar=>2}], $type8); should_fail([qr//,'foo'], $type8); # # Optional + slurpy hashref example # my $type9 = Tuple[ Types::Standard::RegexpRef, Optional[ Types::Standard::ScalarRef ], Slurpy[ Types::Standard::HashRef[ Types::Standard::Int ] ], ]; should_pass([qr//], $type9); should_pass([qr//,\1], $type9); should_pass([qr//,\1,foo=>1,bar=>2], $type9); # can't omit Optional element but still provide Slurpy should_fail([qr//,foo=>1,bar=>2], $type9); # # Deep coercions # my $Rounded = Types::Standard::Int->plus_coercions( Types::Standard::Num, sub{ int($_) }, ); my $type10 = Tuple[ $Rounded, Types::Standard::ArrayRef[$Rounded], Optional[$Rounded], Slurpy[ Types::Standard::HashRef[$Rounded] ], ]; my $coerced = $type10->coerce([ 3.1, [ 1.1, 1.2, 1.3 ], 4.2, foo => 5.1, bar => 6.1, ]); subtest 'coercion happened as expected' => sub { is($coerced->[0], 3); is_deeply($coerced->[1], [1,1,1]); is($coerced->[2], 4); is_deeply({@$coerced[3..6]}, {foo=>5,bar=>6}); }; # One thing to note is that coercions succeed as a whole or fail as a whole. # The tuple had to coerce the first element to an integer, the second to an # arrayref of integers, the third (if it existed) to an integer, and whatever # was left, it slurped into a temp hashef, coerced that to a hashref of # integers, and then flattened that back into the tuple it was returning. # If any single part of it had ended up not conforming to the target type, # then the original tuple would have been returned with no coercions done # at all! # # slurpy starting at an index greater or equal to 2 # my $type11 = Tuple[ Types::Standard::Int, Types::Standard::ScalarRef, Slurpy[ Types::Standard::HashRef ], ]; should_pass([1,\1], $type11); should_pass([1,\1,foo=>3], $type11); should_fail([1,\1,'foo'], $type11); # # Coercion with CHILD OF slurpy # my $type12 = Tuple[ $Rounded, Types::Standard::ArrayRef[$Rounded], Optional[$Rounded], ( Slurpy[ Types::Standard::HashRef[$Rounded] ] )->create_child_type( coercion => 1 ), ]; my $coerced2 = $type12->coerce([ 3.1, [ 1.1, 1.2, 1.3 ], 4.2, foo => 5.1, bar => 6.1, ]); subtest 'coercion happened as expected' => sub { is($coerced2->[0], 3); is_deeply($coerced2->[1], [1,1,1]); is($coerced2->[2], 4); is_deeply({@$coerced2[3..6]}, {foo=>5,bar=>6}); }; done_testing; TypeTiny.t000664001750001750 1711215111656240 16236 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( TypeTiny ); isa_ok(TypeTiny, 'Type::Tiny', 'TypeTiny'); is(TypeTiny->name, 'TypeTiny', 'TypeTiny has correct name'); is(TypeTiny->display_name, 'TypeTiny', 'TypeTiny has correct display_name'); is(TypeTiny->library, 'Types::TypeTiny', 'TypeTiny knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('TypeTiny'), 'Types::TypeTiny knows it has type TypeTiny'); ok(!TypeTiny->deprecated, 'TypeTiny is not deprecated'); ok(!TypeTiny->is_anon, 'TypeTiny is not anonymous'); ok(TypeTiny->can_be_inlined, 'TypeTiny can be inlined'); is(exception { TypeTiny->inline_check(q/$xyz/) }, undef, "Inlining TypeTiny doesn't throw an exception"); ok(TypeTiny->has_coercion, "TypeTiny has a coercion"); ok(!TypeTiny->is_parameterizable, "TypeTiny isn't parameterizable"); isnt(TypeTiny->type_default, undef, "TypeTiny has a type_default"); is(TypeTiny->type_default->(), do { require Types::Standard; Types::Standard::Any() }, "TypeTiny type_default is Any"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, TypeTiny, ucfirst("$label should pass TypeTiny")); } elsif ($expect eq 'fail') { should_fail($value, TypeTiny, ucfirst("$label should fail TypeTiny")); } else { fail("expected '$expect'?!"); } } should_pass(TypeTiny, TypeTiny); # dogfooding subtest "Can coerce from coderef to TypeTiny" => sub { my $Arrayref = TypeTiny->coerce( sub { ref($_) eq 'ARRAY' } ); should_pass( $Arrayref, TypeTiny ); should_pass( [], $Arrayref ); should_fail( {}, $Arrayref ); }; subtest "Can coerce from Type::Nano to TypeTiny" => sub { my $Arrayref = TypeTiny->coerce( Local::Dummy1::ArrayRef() ); should_pass( $Arrayref, TypeTiny ); should_pass( [], $Arrayref ); should_fail( {}, $Arrayref ); } if eval q{ package Local::Dummy1; use Type::Nano qw(ArrayRef); 1 }; subtest "Can coerce from MooseX::Types to TypeTiny" => sub { my $Arrayref = TypeTiny->coerce( Local::Dummy2::ArrayRef() ); should_pass( $Arrayref, TypeTiny ); should_pass( [], $Arrayref ); should_fail( {}, $Arrayref ); ok($Arrayref->is_parameterizable); ok($Arrayref->can_be_inlined); } if eval q{ package Local::Dummy2; use MooseX::Types::Moose qw(ArrayRef); 1 }; subtest "Can coerce from MouseX::Types to TypeTiny" => sub { my $Arrayref = TypeTiny->coerce( Local::Dummy3::ArrayRef() ); should_pass( $Arrayref, TypeTiny ); should_pass( [], $Arrayref ); should_fail( {}, $Arrayref ); ok($Arrayref->is_parameterizable); } if eval q{ package Local::Dummy3; use MouseX::Types::Mouse qw(ArrayRef); 1 }; subtest "Can coerce from Specio to TypeTiny" => sub { my $Arrayref = TypeTiny->coerce( Local::Dummy4::t('ArrayRef') ); should_pass( $Arrayref, TypeTiny ); should_pass( [], $Arrayref ); should_fail( {}, $Arrayref ); ok($Arrayref->can_be_inlined); } if eval q{ package Local::Dummy4; use Specio::Library::Builtins; 1 }; done_testing; Undef.t000664001750001750 1370015111656240 15511 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Undef ); isa_ok(Undef, 'Type::Tiny', 'Undef'); is(Undef->name, 'Undef', 'Undef has correct name'); is(Undef->display_name, 'Undef', 'Undef has correct display_name'); is(Undef->library, 'Types::Standard', 'Undef knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Undef'), 'Types::Standard knows it has type Undef'); ok(!Undef->deprecated, 'Undef is not deprecated'); ok(!Undef->is_anon, 'Undef is not anonymous'); ok(Undef->can_be_inlined, 'Undef can be inlined'); is(exception { Undef->inline_check(q/$xyz/) }, undef, "Inlining Undef doesn't throw an exception"); ok(!Undef->has_coercion, "Undef doesn't have a coercion"); ok(!Undef->is_parameterizable, "Undef isn't parameterizable"); isnt(Undef->type_default, undef, "Undef has a type_default"); is(Undef->type_default->(), undef, "Undef type_default is undef"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( pass => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Undef, ucfirst("$label should pass Undef")); } elsif ($expect eq 'fail') { should_fail($value, Undef, ucfirst("$label should fail Undef")); } else { fail("expected '$expect'?!"); } } is(~Undef, Types::Standard::Defined, 'The complement of Undef is Defined'); done_testing; UpperCaseSimpleStr.t000664001750001750 1700315111656240 20202 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( UpperCaseSimpleStr ); isa_ok(UpperCaseSimpleStr, 'Type::Tiny', 'UpperCaseSimpleStr'); is(UpperCaseSimpleStr->name, 'UpperCaseSimpleStr', 'UpperCaseSimpleStr has correct name'); is(UpperCaseSimpleStr->display_name, 'UpperCaseSimpleStr', 'UpperCaseSimpleStr has correct display_name'); is(UpperCaseSimpleStr->library, 'Types::Common::String', 'UpperCaseSimpleStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('UpperCaseSimpleStr'), 'Types::Common::String knows it has type UpperCaseSimpleStr'); ok(!UpperCaseSimpleStr->deprecated, 'UpperCaseSimpleStr is not deprecated'); ok(!UpperCaseSimpleStr->is_anon, 'UpperCaseSimpleStr is not anonymous'); ok(UpperCaseSimpleStr->can_be_inlined, 'UpperCaseSimpleStr can be inlined'); is(exception { UpperCaseSimpleStr->inline_check(q/$xyz/) }, undef, "Inlining UpperCaseSimpleStr doesn't throw an exception"); ok(UpperCaseSimpleStr->has_coercion, "UpperCaseSimpleStr has a coercion"); ok(!UpperCaseSimpleStr->is_parameterizable, "UpperCaseSimpleStr isn't parameterizable"); is(UpperCaseSimpleStr->type_default, undef, "UpperCaseSimpleStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, UpperCaseSimpleStr, ucfirst("$label should pass UpperCaseSimpleStr")); } elsif ($expect eq 'fail') { should_fail($value, UpperCaseSimpleStr, ucfirst("$label should fail UpperCaseSimpleStr")); } else { fail("expected '$expect'?!"); } } # Cyrillic Small Letter Zhe should_fail("\x{0436}", UpperCaseSimpleStr); # Cyrillic Capital Letter Zhe should_pass("\x{0416}", UpperCaseSimpleStr); # # SimpleStr is limited to 255 characters # should_pass("A" x 255, UpperCaseSimpleStr); should_fail("A" x 256, UpperCaseSimpleStr); # # Length counts are characters, not bytes, # so test with a multibyte character. # should_pass("\x{0416}" x 255, UpperCaseSimpleStr); should_fail("\x{0416}" x 256, UpperCaseSimpleStr); # # These examples are probably obvious. # should_pass('ABCDEF', UpperCaseSimpleStr); should_pass('ABC123', UpperCaseSimpleStr); should_fail('abc123', UpperCaseSimpleStr); should_fail('abcdef', UpperCaseSimpleStr); # # A string with only non-letter characters passes. # should_pass('123456', UpperCaseSimpleStr); should_pass(' ', UpperCaseSimpleStr); # # But the empty string fails. # (Which is weird, but consistent with MooseX::Types::Common::String.) # should_fail('', UpperCaseSimpleStr); # # Can coerce from lowercase strings. # is(UpperCaseSimpleStr->coerce('abc123'), 'ABC123', 'coercion success'); # # Won't even attempt to coerce non-strings. # use Scalar::Util qw( refaddr ); my $arr = []; my $coerced = UpperCaseSimpleStr->coerce($arr); is(refaddr($coerced), refaddr($arr), 'does not coerce non-strings'); done_testing; UpperCaseStr.t000664001750001750 1567615111656240 17046 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Common::String qw( UpperCaseStr ); isa_ok(UpperCaseStr, 'Type::Tiny', 'UpperCaseStr'); is(UpperCaseStr->name, 'UpperCaseStr', 'UpperCaseStr has correct name'); is(UpperCaseStr->display_name, 'UpperCaseStr', 'UpperCaseStr has correct display_name'); is(UpperCaseStr->library, 'Types::Common::String', 'UpperCaseStr knows it is in the Types::Common::String library'); ok(Types::Common::String->has_type('UpperCaseStr'), 'Types::Common::String knows it has type UpperCaseStr'); ok(!UpperCaseStr->deprecated, 'UpperCaseStr is not deprecated'); ok(!UpperCaseStr->is_anon, 'UpperCaseStr is not anonymous'); ok(UpperCaseStr->can_be_inlined, 'UpperCaseStr can be inlined'); is(exception { UpperCaseStr->inline_check(q/$xyz/) }, undef, "Inlining UpperCaseStr doesn't throw an exception"); ok(UpperCaseStr->has_coercion, "UpperCaseStr has a coercion"); ok(!UpperCaseStr->is_parameterizable, "UpperCaseStr isn't parameterizable"); is(UpperCaseStr->type_default, undef, "UpperCaseStr has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, fail => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, xxxx => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, UpperCaseStr, ucfirst("$label should pass UpperCaseStr")); } elsif ($expect eq 'fail') { should_fail($value, UpperCaseStr, ucfirst("$label should fail UpperCaseStr")); } else { fail("expected '$expect'?!"); } } # Cyrillic Small Letter Zhe should_fail("\x{0436}", UpperCaseStr); # Cyrillic Capital Letter Zhe should_pass("\x{0416}", UpperCaseStr); # # These examples are probably obvious. # should_pass('ABCDEF', UpperCaseStr); should_pass('ABC123', UpperCaseStr); should_fail('abc123', UpperCaseStr); should_fail('abcdef', UpperCaseStr); # # A string with only non-letter characters passes. # should_pass('123456', UpperCaseStr); should_pass(' ', UpperCaseStr); # # But the empty string fails. # (Which is weird, but consistent with MooseX::Types::Common::String.) # should_fail('', UpperCaseStr); # # Can coerce from lowercase strings. # is(UpperCaseStr->coerce('abc123'), 'ABC123', 'coercion success'); # # Won't even attempt to coerce non-strings. # use Scalar::Util qw( refaddr ); my $arr = []; my $coerced = UpperCaseStr->coerce($arr); is(refaddr($coerced), refaddr($arr), 'does not coerce non-strings'); done_testing; Value.t000664001750001750 1345715111656240 15535 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::Standard qw( Value ); isa_ok(Value, 'Type::Tiny', 'Value'); is(Value->name, 'Value', 'Value has correct name'); is(Value->display_name, 'Value', 'Value has correct display_name'); is(Value->library, 'Types::Standard', 'Value knows it is in the Types::Standard library'); ok(Types::Standard->has_type('Value'), 'Types::Standard knows it has type Value'); ok(!Value->deprecated, 'Value is not deprecated'); ok(!Value->is_anon, 'Value is not anonymous'); ok(Value->can_be_inlined, 'Value can be inlined'); is(exception { Value->inline_check(q/$xyz/) }, undef, "Inlining Value doesn't throw an exception"); ok(!Value->has_coercion, "Value doesn't have a coercion"); ok(!Value->is_parameterizable, "Value isn't parameterizable"); is(Value->type_default, undef, "Value has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, pass => 'false' => !!0, pass => 'true' => !!1, pass => 'zero' => 0, pass => 'one' => 1, pass => 'negative one' => -1, pass => 'non integer' => 3.1416, pass => 'empty string' => '', pass => 'whitespace' => ' ', pass => 'line break' => "\n", pass => 'random string' => 'abc123', pass => 'loaded package name' => 'Type::Tiny', pass => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), fail => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), pass => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, pass => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, pass => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0 , 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, Value, ucfirst("$label should pass Value")); } elsif ($expect eq 'fail') { should_fail($value, Value, ucfirst("$label should fail Value")); } else { fail("expected '$expect'?!"); } } done_testing; _ForeignTypeConstraint.t000664001750001750 1563115111656240 21114 0ustar00taitai000000000000Type-Tiny-2.008006/t/21-types=pod =encoding utf-8 =head1 PURPOSE Basic tests for B<_ForeignTypeConstraint> from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Test::Requires qw(boolean); use Types::TypeTiny qw( _ForeignTypeConstraint ); isa_ok(_ForeignTypeConstraint, 'Type::Tiny', '_ForeignTypeConstraint'); is(_ForeignTypeConstraint->name, '_ForeignTypeConstraint', '_ForeignTypeConstraint has correct name'); is(_ForeignTypeConstraint->display_name, '_ForeignTypeConstraint', '_ForeignTypeConstraint has correct display_name'); is(_ForeignTypeConstraint->library, 'Types::TypeTiny', '_ForeignTypeConstraint knows it is in the Types::TypeTiny library'); ok(Types::TypeTiny->has_type('_ForeignTypeConstraint'), 'Types::TypeTiny knows it has type _ForeignTypeConstraint'); ok(!_ForeignTypeConstraint->deprecated, '_ForeignTypeConstraint is not deprecated'); ok(!_ForeignTypeConstraint->is_anon, '_ForeignTypeConstraint is not anonymous'); ok(_ForeignTypeConstraint->can_be_inlined, '_ForeignTypeConstraint can be inlined'); is(exception { _ForeignTypeConstraint->inline_check(q/$xyz/) }, undef, "Inlining _ForeignTypeConstraint doesn't throw an exception"); ok(!_ForeignTypeConstraint->has_coercion, "_ForeignTypeConstraint doesn't have a coercion"); ok(!_ForeignTypeConstraint->is_parameterizable, "_ForeignTypeConstraint isn't parameterizable"); is(_ForeignTypeConstraint->type_default, undef, "_ForeignTypeConstraint has no type_default"); # # The @tests array is a list of triples: # # 1. Expected result - pass, fail, or xxxx (undefined). # 2. A description of the value being tested. # 3. The value being tested. # my @tests = ( fail => 'undef' => undef, fail => 'false' => !!0, fail => 'true' => !!1, fail => 'zero' => 0, fail => 'one' => 1, fail => 'negative one' => -1, fail => 'non integer' => 3.1416, fail => 'empty string' => '', fail => 'whitespace' => ' ', fail => 'line break' => "\n", fail => 'random string' => 'abc123', fail => 'loaded package name' => 'Type::Tiny', fail => 'unloaded package name' => 'This::Has::Probably::Not::Been::Loaded', fail => 'a reference to undef' => do { my $x = undef; \$x }, fail => 'a reference to false' => do { my $x = !!0; \$x }, fail => 'a reference to true' => do { my $x = !!1; \$x }, fail => 'a reference to zero' => do { my $x = 0; \$x }, fail => 'a reference to one' => do { my $x = 1; \$x }, fail => 'a reference to empty string' => do { my $x = ''; \$x }, fail => 'a reference to random string' => do { my $x = 'abc123'; \$x }, fail => 'blessed scalarref' => bless(do { my $x = undef; \$x }, 'SomePkg'), fail => 'empty arrayref' => [], fail => 'arrayref with one zero' => [0], fail => 'arrayref of integers' => [1..10], fail => 'arrayref of numbers' => [1..10, 3.1416], fail => 'blessed arrayref' => bless([], 'SomePkg'), fail => 'empty hashref' => {}, fail => 'hashref' => { foo => 1 }, fail => 'blessed hashref' => bless({}, 'SomePkg'), pass => 'coderef' => sub { 1 }, fail => 'blessed coderef' => bless(sub { 1 }, 'SomePkg'), fail => 'glob' => do { no warnings 'once'; *SOMETHING }, fail => 'globref' => do { no warnings 'once'; my $x = *SOMETHING; \$x }, fail => 'blessed globref' => bless(do { no warnings 'once'; my $x = *SOMETHING; \$x }, 'SomePkg'), fail => 'regexp' => qr/./, fail => 'blessed regexp' => bless(qr/./, 'SomePkg'), fail => 'filehandle' => do { open my $x, '<', $0 or die; $x }, fail => 'filehandle object' => do { require IO::File; 'IO::File'->new($0, 'r') }, fail => 'ref to scalarref' => do { my $x = undef; my $y = \$x; \$y }, fail => 'ref to arrayref' => do { my $x = []; \$x }, fail => 'ref to hashref' => do { my $x = {}; \$x }, fail => 'ref to coderef' => do { my $x = sub { 1 }; \$x }, fail => 'ref to blessed hashref' => do { my $x = bless({}, 'SomePkg'); \$x }, fail => 'object stringifying to ""' => do { package Local::OL::StringEmpty; use overload q[""] => sub { "" }; bless [] }, fail => 'object stringifying to "1"' => do { package Local::OL::StringOne; use overload q[""] => sub { "1" }; bless [] }, fail => 'object numifying to 0' => do { package Local::OL::NumZero; use overload q[0+] => sub { 0 }; bless [] }, fail => 'object numifying to 1' => do { package Local::OL::NumOne; use overload q[0+] => sub { 1 }; bless [] }, fail => 'object overloading arrayref' => do { package Local::OL::Array; use overload q[@{}] => sub { $_[0]{array} }; bless {array=>[]} }, fail => 'object overloading hashref' => do { package Local::OL::Hash; use overload q[%{}] => sub { $_[0][0] }; bless [{}] }, fail => 'object overloading coderef' => do { package Local::OL::Code; use overload q[&{}] => sub { $_[0][0] }; bless [sub { 1 }] }, fail => 'object booling to false' => do { package Local::OL::BoolFalse; use overload q[bool] => sub { 0 }; bless [] }, fail => 'object booling to true' => do { package Local::OL::BoolTrue; use overload q[bool] => sub { 1 }; bless [] }, fail => 'boolean::false' => boolean::false, fail => 'boolean::true' => boolean::true, fail => 'builtin::false' => do { no warnings; builtin->can('false') ? builtin::false() : !!0 }, fail => 'builtin::true' => do { no warnings; builtin->can('true') ? builtin::true() : !!1 }, #TESTS ); while (@tests) { my ($expect, $label, $value) = splice(@tests, 0, 3); if ($expect eq 'xxxx') { note("UNDEFINED OUTCOME: $label"); } elsif ($expect eq 'pass') { should_pass($value, _ForeignTypeConstraint, ucfirst("$label should pass _ForeignTypeConstraint")); } elsif ($expect eq 'fail') { should_fail($value, _ForeignTypeConstraint, ucfirst("$label should fail _ForeignTypeConstraint")); } else { fail("expected '$expect'?!"); } } # # _ForeignTypeConstraint accepts foreign type constraint objects # like MooseX::Type, MouseX::Type, Specio, and Type::Nano. # { package Local::MyTypeConstraint; sub new { my ($class, $code, $msg) = @_; bless [$code, $msg], $class } sub get_message { shift->[1] or 'Failed type constraint check' } sub check { shift->[0]->(local $_ = pop) } } my $foreigntype = 'Local::MyTypeConstraint'->new( sub { no warnings; ref($_) eq 'HASH'; }, 'Not a hashref' ); ok( $foreigntype->check( {} ) ); ok( ! $foreigntype->check( [] ) ); should_pass( $foreigntype, _ForeignTypeConstraint ); done_testing; 73f51e2d.pl000664001750001750 116315111656240 15535 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Helper file for C<< 73f51e2d.t >>. =head1 AUTHOR Graham Knop Ehaarg@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Graham Knop. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use threads; use strict; use warnings; use Type::Tiny; my $int = Type::Tiny->new( name => "Integer", constraint => sub { /^(?:-?[1-9][0-9]*|0)$|/ }, message => sub { "$_ isn't an integer" }, ); threads->create(sub { my $type = $int; 1; })->join; 73f51e2d.t000664001750001750 147415111656240 15372 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Possible issue causing segfaults on threaded Perl 5.18.x. =head1 AUTHOR Graham Knop Ehaarg@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Graham Knop. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Config; BEGIN { if ( $] < 5.020 and defined $ENV{RUNNER_OS} and $ENV{RUNNER_OS} =~ /windows/i ) { plan skip_all => "skipping on CI due to known issues!"; } elsif ( not $Config{useithreads} ) { plan skip_all => "ithreads only test"; } }; (my $script = __FILE__) =~ s/t\z/pl/; for (1..100) { my $out = system $^X, (map {; '-I', $_ } @INC), $script; is($out, 0); } done_testing; gh1.t000664001750001750 154715111656240 14712 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test that subtypes of Type::Tiny::Class work. =head1 SEE ALSO L, L. =head1 AUTHOR Richard Simões Ersimoes@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Richard Simões. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Type::Utils; use Math::BigFloat; my $pc = declare as class_type({ class => 'Math::BigFloat' }), where { 1 }; my $value = Math::BigFloat->new(0.5); ok $pc->($value); should_pass($value, $pc); should_fail(0.5, $pc); done_testing; gh14.t000664001750001750 266615111656240 15001 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test for non-inlined coercions in Moo. The issue that prompted this test was actually invalid, caused by a typo in the bug reporter's code. But I wrote the test case, so I might as well include it. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { Moo => '1.006' }; { package FinancialTypes; use Type::Library -base; use Type::Utils -all; BEGIN { extends "Types::Standard" }; declare 'BankAccountNo', as Str, where { /^\d{26}$/ or /^[A-Z]{2}\d{18,26}$/ or /^\d{8}-\d+(-\d+)+$/ }, message { "Bad account: $_"}; coerce 'BankAccountNo', from Str, via { $_ =~ s{\s+}{}g; $_; }; } { package BankAccount; use Moo; has account_number => ( is => 'ro', required => !!1, isa => FinancialTypes::BankAccountNo(), coerce => FinancialTypes::BankAccountNo()->coercion, ); } my $x; my $e = exception { $x = BankAccount::->new( account_number => "10 2030 4050 1111 2222 3333 4444" ); }; is($e, undef); is($x->account_number, "10203040501111222233334444"); done_testing(); gh140.t000664001750001750 176015111656240 15053 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Type::Params's C and C together. =head1 SEE ALSO L. =head1 AUTHOR XSven L. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by XSven. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Common -types, -sigs; use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings ':all'; my $sig; sub add_nums { $sig ||= signature( positional => [ Num, ArrayRef[Num,1], { optional => !!1, slurpy => !!1 }, ], ); my ( $first_num, $other_nums ) = $sig->( @_ ); my $sum = $first_num; $sum += $_ for @$other_nums; return $sum; } my $w = warning { is add_nums( 1, 0 ), 1; }; like $w, qr/^Warning: the optional for the slurpy parameter will be ignored, continuing anyway/; done_testing; gh143.t000664001750001750 142615111656240 15055 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test initializing tied variables. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2024-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Common -types; use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings ':all'; { tie my $x, Int, 143; is $x, 143; } { tie my @x, Int, 1 .. 3; is_deeply \@x, [ 1 .. 3 ]; } { tie my %x, Int, foo => 666, bar => 999; is_deeply \%x, { foo => 666, bar => 999 }; } { tie my $x, Int; is $x, 0; } done_testing; gh158.t000664001750001750 150115111656240 15055 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Ensure no warning on certain shallow stack traces. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius L. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2024-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Common -types, -sigs; use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings ':all'; my $e; signature_for get_products => ( named => [ bar => Optional[Str] ], on_die => sub { $e = shift }, ); sub get_products {} get_products( rs => 3 ); like( $e->message, qr/^Unrecognized parameter/ ); done_testing; gh180.t000664001750001750 144515111656240 15057 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Ensure that Type::Tiny::Union's C method works when Moose is loaded. =head1 SEE ALSO L. =head1 AUTHOR Robert Moore L. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Robert Moore. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; { package Local::Dummy; use Test::Requires 'Moose'; use Test::Requires 'Moose::Meta::TypeConstraint'; use Test::Requires 'Moose::Meta::TypeConstraint::Union'; }; use Types::Standard qw/Str Int/; my $type = Str|Int; my @data = (1,'test'); ok $type->all(@data); done_testing; gh80.t000664001750001750 151515111656240 14774 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test that stringifying Error::TypeTiny doesn't clobber $@. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE based on code by @bokutin L. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2021-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tiny; my $Type1 = Type::Tiny->new( name => "Type1", constraint => sub { 0 } ); eval { $Type1->('val1') }; isa_ok( $@, 'Error::TypeTiny', '$@' ); my $x1 = "$@"; my $x2 = "$@"; like( "$@", qr/did not pass type/, '$@ is still defined and stringifies properly' ); done_testing; gh96.t000664001750001750 137515111656240 15007 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Type::Tiny's C should never wrap lines! =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard qw( StrMatch ); my $UUID_RE = qr{ ^ [0-9a-fA-F]{8}- [0-9a-fA-F]{4}- [0-9a-fA-F]{4}- [0-9a-fA-F]{4}- [0-9a-fA-F]{12} $ }sxm; my $type = StrMatch[ $UUID_RE ]; unlike $type->display_name, qr/\n/sm, "don't include linebreaks!"; done_testing; hg166.t000664001750001750 133615111656240 15062 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Ensure that stringifying L doesn't clobber C<< $@ >>. =head1 SEE ALSO L. =head1 AUTHOR Karen Etheridge L. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Karen Etheridge. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard 'Str'; my $type = Str; eval { $type->({}); }; like "### e string: '$@'\n", qr{did not pass type constraint}; like "### e string: '$@'\n", qr{did not pass type constraint}; done_testing; rt102748.t000664001750001750 164515111656240 15345 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Tests inheriting from a MooseX::Types library that uses L and L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Local::XYZ1; use Test::Requires 'MooseX::Types'; } { package Local::XYZ2; use Test::Requires 'MooseX::Types::DBIx::Class'; } my $e = exception { package MyApp::Types; use namespace::autoclean; use Type::Library -base; use Type::Utils 'extends'; extends 'MooseX::Types::DBIx::Class'; }; is($e, undef); done_testing; rt104154.t000664001750001750 412615111656240 15333 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Tests for deep coercion. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Type::Tiny; use Test::More; my $type_without = "Type::Tiny"->new( name => "HasParam_without", message => sub { "$_ ain't got a number" }, constraint_generator => sub { sub { 0 } }, # Reject everything deep_explanation => sub { ["love to contradict"] }, ); my $type_with = "Type::Tiny"->new( constraint => sub { 1 }, # Un-parameterized accepts al name => "HasParam_with", message => sub { "$_ ain't got a number" }, constraint_generator => sub { sub { 0 } }, # Reject everything deep_explanation => sub { ["love to contradict"] }, ); my $type_parent = "Type::Tiny"->new( parent => $type_without, name => "HasParam_parent", message => sub { "$_ ain't got a number" }, constraint_generator => sub { sub { 0 } }, # Reject everything deep_explanation => sub { ["love to contradict"] }, ); my $s = 'a string'; my $param_with = $type_with->parameterize('an ignored parameter'); my $param_parent = $type_parent->parameterize('an ignored parameter'); my $param_without = $type_without->parameterize('an ignored parameter'); my $explain_with=join("\n ",@{$param_with->validate_explain($s,'$s')}); my $explain_parent=join("\n ",@{$param_parent->validate_explain($s,'$s')}); my $explain_without=join("\n ",@{$param_without->validate_explain($s,'$s')}); #diag "With a plain constraint:\n $explain_with\n"; #diag "With a parent constraint:\n $explain_parent\n"; #diag "Without a plain constraint:\n $explain_without\n"; $explain_with =~ s/(HasParam)_\w+/$1/g; $explain_parent =~ s/(HasParam)_\w+/$1/g; $explain_without =~ s/(HasParam)_\w+/$1/g; ok $explain_with eq $explain_without; ok $explain_parent eq $explain_without; done_testing; rt121763.t000664001750001750 155715111656240 15345 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test to make sure C keeps a reference to all the types that get compiled, to avoid them going away before exceptions can be thrown for them. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard -types; use Type::Params qw(compile); my $x; my $sub; my $check; my $e = exception { $sub = sub { $check = compile(Dict[key => Int]); $check->(@_); }; $sub->({key => 'yeah'}); }; is($e->type->display_name, 'Dict[key=>Int]'); done_testing; rt125132.t000664001750001750 304615111656240 15332 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test inlined Int type check clobbering C<< $1 >>. =head1 SEE ALSO L. =head1 AUTHOR Marc Ballarin . Some modifications by Toby Inkster . =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Marc Ballarin. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Params qw(compile); use Types::Standard qw(Str Int); { my $check; sub check_int_tt_compile { $check ||= compile(Int); my ($int) = $check->(@_); is($int, 123, 'check_int_tt_compile'); } } { my $check; sub check_str_tt { $check ||= compile(Str); my ($int) = $check->(@_); is($int, 123, 'check_str_tt'); } } { sub check_int_manual { my ($int) = @_; die "no Int!" unless $int =~ /^\d+$/; is($int, 123, 'check_int_manual'); } } { sub check_int_tt_no_compile { my ($int) = @_; Int->assert_valid($int); is($int, 123, 'check_int_tt_no_compile'); } } my $string = 'a123'; subtest 'using temporary variable' => sub { if ($string =~ /a(\d+)/) { my $matched = $1; check_int_tt_compile($matched); check_int_manual($matched); check_str_tt($matched); check_int_tt_no_compile($matched); } }; subtest 'using direct $1' => sub { if ($string =~ /a(\d+)/) { check_int_tt_compile($1); check_int_manual($1); check_str_tt($1); check_int_tt_no_compile($1); } }; done_testing; rt125765.t000664001750001750 243315111656240 15345 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Check weird error doesn't happen with deep explain. =head1 SEE ALSO L. =head1 AUTHOR KB Jørgensen . Some modifications by Toby Inkster . =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by KB Jørgensen. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw(Dict Tuple Any); BEGIN { plan skip_all => "cperl's `shadow` warnings catgeory breaks this test; skipping" if "$^V" =~ /c$/; }; my @warnings; $SIG{__WARN__} = sub { push @warnings, $_[0]; }; my $type = Dict->of(foo => Any); my $e = exception { $type->assert_valid({ foo => 1, asd => 1 }); }; like($e, qr/Reference .+ did not pass type constraint/, "got correct error for Dict"); is_deeply(\@warnings, [], 'no warnings') or diag explain \@warnings; @warnings = (); $type = Tuple->of(Any); $e = exception { $type->assert_valid([1, 2]); }; like($e, qr/Reference .+ did not pass type constraint/, "got correct error for Tuple"); is_deeply(\@warnings, [], 'no warnings') or diag explain \@warnings; done_testing; rt129729.t000664001750001750 145715111656240 15356 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test that Enum types containing hyphens work. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Standard qw[ Bool Enum ]; my $x = Bool | Enum [ 'start-end', 'end' ]; should_pass 1, $x; should_pass 0, $x; should_fail 2, $x; should_pass 'end', $x; should_fail 'bend', $x; should_fail 'start', $x; should_fail 'start-', $x; should_fail '-end', $x; should_pass 'start-end', $x; done_testing; rt130823.t000664001750001750 115215111656240 15331 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Check for memory cycles. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster . =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Test::Memory::Cycle'; use Test::Memory::Cycle; use Types::Standard qw(Bool); memory_cycle_ok(Bool, 'Bool has no cycles'); done_testing; rt131401.t000664001750001750 113315111656240 15321 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that L loads L early enough for bareword constants to be okay. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More tests => 1; use Type::Tiny::Class; ok 1; rt131576.t000664001750001750 230415111656240 15337 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test that inlined type checks don't generate issuing warning when compiled in packages that override built-ins. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings; { package Local::Dummy1; use Test::Requires 'Moo'; use Test::Requires 'MooX::TypeTiny'; } BEGIN { $ENV{PERL_ONLY} = 1 }; # no XS { package Foo; use Moo; use MooX::TypeTiny; use Types::Standard qw(HashRef Str); has _data => ( is => 'ro', isa => HashRef[Str], required => 1, init_arg => 'data', ); sub values { @_==1 or die 'too many parameters'; CORE::values %{shift->_data}; } sub keys { @_==1 or die 'too many parameters'; CORE::keys %{shift->_data}; } } my $obj = Foo->new(data => {foo => 42}); print "$_\n" for $obj->values; ok 1; done_testing; rt133141.t000664001750001750 314415111656240 15330 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that L can initialize in XS =head1 SEE ALSO L. =head1 AUTHOR Andrew Ruder Eandy@aeruder.net =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Andrew Ruder This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More; use Type::Tiny; use Types::Standard qw[ Tuple Enum ]; use Type::Parser qw( eval_type ); use Type::Registry; plan tests => 10; my $type1 = Tuple[Enum[qw(a b)]]; ok $type1->check(["a"]), '"a" matches Enum[qw(a b)]'; ok !$type1->check(["c"]), '"c" does not match Enum[qw(a b)]'; my $type2 = Tuple[Enum["foo bar"]]; ok $type2->check(["foo bar"]), '"foo bar" matches Enum["foo bar"]'; ok !$type2->check(["baz"]), '"baz" does not match Enum["foo bar"]'; my $type3 = Tuple[Enum["test\""]]; ok $type3->check(["test\""]), '"test\"" matches Enum["test\""]'; ok !$type3->check(["baz"]), '"baz" does not match Enum["test\""]'; my $type4 = Tuple[Enum["hello, world"]]; ok $type4->check(["hello, world"]), '"hello, world" matches Enum["hello, world"]'; ok !$type4->check(["baz"]), '"baz" does not match Enum["hello, world"]'; my $reg = Type::Registry->for_me; $reg->add_types("Types::Standard"); my $type5 = eval_type("Tuple[Enum[\"hello, world\"]]", $reg); ok $type5->check(["hello, world"]), "eval_type() evaluates quoted strings"; ok !$type5->check(["baz"]), "eval_type() evaluates quoted strings and doesn't pass 'baz'"; rt85911.t000664001750001750 221415111656240 15260 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test L with deep Dict coercion. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; BEGIN { package MyTypes; use Type::Library -base, -declare => qw[ StrList ]; use Type::Utils; use Types::Standard qw[ ArrayRef Str ]; declare StrList, as ArrayRef[Str]; coerce StrList, from Str, via { [$_] }; } use Type::Params qw[ compile ]; use Types::Standard qw[ Dict slurpy Optional ]; sub foo { my $check = compile( slurpy Dict [ foo => MyTypes::StrList ] ); return [ $check->( @_ ) ]; } sub bar { my $check = compile( MyTypes::StrList ); return [ $check->( @_ ) ]; } is_deeply( bar( 'b' ), [ ["b"] ], ); is_deeply( foo( foo => 'a' ), [ { foo=>["a"] } ], ); done_testing; rt86004.t000664001750001750 512715111656240 15260 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test L with more complex Dict coercion. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { package Types; use Type::Library -base, -declare => qw[ StrList ]; use Type::Utils; use Types::Standard qw[ ArrayRef Str ]; declare StrList, as ArrayRef [Str]; coerce StrList, from Str, q { [$_] }; }; use Test::More; use Test::Fatal; use Type::Params qw[ validate compile ]; use Types::Standard -all; sub a { validate( \@_, slurpy Dict [ connect => Optional [Bool], encoding => Optional [Str], hg => Optional [Types::StrList], ] ); } sub b { validate( \@_, slurpy Dict [ connect => Optional [Bool], hg => Optional [Types::StrList], ] ); } sub c { validate( \@_, slurpy Dict [ connect => Optional [Bool], encoding => Optional [Str], hg2 => Optional [Types::StrList->no_coercions->plus_coercions(Types::Standard::Str, sub {[$_]})], ] ); } my $expect = { connect => 1, hg => ['a'], }; my $expect2 = { connect => 1, hg2 => ['a'], }; # 1 { my ( $opts, $e ); $e = exception { ( $opts ) = a( connect => 1, hg => ['a'] ) } and diag $e; is_deeply( $opts, $expect, "StrList ArrayRef" ); } # 2 { my ( $opts, $e ); $e = exception { ( $opts ) = a( connect => 1, hg => 'a' ) } and diag $e; is_deeply( $opts, $expect, "StrList scalar" ); } # 3 { my ( $opts, $e ); $e = exception { ( $opts ) = b( connect => 1, hg => ['a'] ) } and diag $e; is_deeply( $opts, $expect, "StrList ArrayRef" ); } # 4 { my ( $opts, $e ); $e = exception { ( $opts ) = b( connect => 1, hg => 'a' ) } and diag $e; is_deeply( $opts, $expect, "StrList scalar" ); } # 5 { my ( $opts, $e ); $e = exception { ( $opts ) = c( connect => 1, hg2 => ['a'] ) } and diag $e; is_deeply( $opts, $expect2, "StrList ArrayRef - noninline" ); } # 6 { my ( $opts, $e ); $e = exception { ( $opts ) = c( connect => 1, hg2 => 'a' ) } and diag $e; is_deeply( $opts, $expect2, "StrList scalar - noninline" ); } #note compile( # { want_source => 1 }, # slurpy Dict [ # connect => Optional[Bool], # encoding => Optional[Str], # hg => Optional[Types::StrList], # ], #); done_testing; rt86233.t000664001750001750 202515111656240 15256 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Fix: "Cannot inline type constraint check" error with compile and Dict. =head1 SEE ALSO L. =head1 AUTHOR Vyacheslav Matyukhin Emmcleric@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Vyacheslav Matyukhin. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package Types; use Type::Library -base, -declare => qw[ Login ]; use Type::Utils; use Types::Standard qw[ Str ]; declare Login, as Str, where { /^\w+$/ }; }; use Type::Params qw[ compile ]; use Types::Standard qw[ Dict ]; my $type = Dict[login => Types::Login]; ok not( $type->can_be_inlined ); ok not( $type->coercion->can_be_inlined ); is(exception { compile($type) }, undef); done_testing; rt86239.t000664001750001750 232215111656240 15264 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Fix: Optional constraints ignored if wrapped in Dict. =head1 SEE ALSO L. =head1 AUTHOR Vyacheslav Matyukhin Emmcleric@cpan.orgE. (Minor changes by Toby Inkster Etobyink@cpan.orgE.) =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Vyacheslav Matyukhin. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(validate compile); use Types::Standard qw(ArrayRef Dict Optional Str); my $i = 0; sub announce { note sprintf("Test %d ########", ++$i) } sub got { note "got: " . join ", ", explain(@_) } sub f { announce(); got validate( \@_, Optional[Str], ); } is exception { f("foo") }, undef; is exception { f() }, undef; like exception { f(["abc"]) }, qr/type constraint/; sub g { announce(); got validate( \@_, Dict[foo => Optional[Str]], ); } is exception { g({ foo => "foo" }) }, undef; is exception { g({}) }, undef; like exception { g({ foo => ["abc"] }) }, qr/type constraint/; done_testing; rt90096-2.t000664001750001750 157715111656240 15432 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Additional tests related to RT#90096. Make sure that L localizes C<< $_ >>. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Params qw[ compile ]; use Types::Standard -all; { my $check = compile( Dict [ a => Num ] ); grep { $_->( { a => 3 } ) } $check; is( ref $check, 'CODE', "check is still code" ); } { my $check = compile( slurpy Dict [ a => Num ] ); grep { $_->( a => 3 ) } $check; is( ref $check, 'CODE', "slurpy check is still code" ); } done_testing; rt90096.t000664001750001750 137115111656240 15263 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that L localizes C<< $_ >>. =head1 SEE ALSO L. =head1 AUTHOR Samuel Kaufman Eskaufman@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Samuel Kaufman. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More tests => 3; use Type::Params qw[ compile ]; use Types::Standard qw[ slurpy Dict Bool ]; my $check = compile slurpy Dict [ with_connection => Bool ]; for (qw[ 1 2 3 ]) { # $_ is read-only in here ok $check->( with_connection => 1 ); } rt92571-2.t000664001750001750 130715111656240 15421 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that the weakening of the reference from a Type::Coercion::Union object back to its "owner" type constraint does not break functionality. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More; use Types::Standard -all; my $sub = (Str | Str)->coercion; is( $sub->('x'), 'x', ); done_testing; rt92571.t000664001750001750 234115111656240 15261 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that the weakening of the reference from a Type::Coercion object back to its "owner" type constraint does not break functionality. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More; use Type::Library -base, -declare => qw[ ArrayRefFromAny ]; use Types::Standard -all; use Type::Utils -all; declare_coercion ArrayRefFromAny, to_type ArrayRef, from Any, via { [$_] } ; my $x = ArrayRef->plus_coercions(ArrayRefFromAny); is_deeply( $x->coerce( ['a'] ), ['a'], ); # types hang around until after the coerce method is run is_deeply( ArrayRef->plus_coercions(ArrayRefFromAny)->coerce( ['a'] ), ['a'], ); # types go away after generation of coercion sub, breaking it my $coerce = ArrayRef->plus_coercions(ArrayRefFromAny)->coercion; is_deeply( $coerce->( ['a'] ), ['a'], ) or diag explain($coerce->( ['a'] )); done_testing; rt92591.t000664001750001750 242415111656240 15265 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Make sure that C works outside type libraries. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. Some additions by Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More; { package Local::TypeLib; use Type::Library -base; use Types::Standard -all; use Type::Utils -all; my $foo = declare_coercion to_type ArrayRef, from Any, via { [$_] }; ::is( $foo->type_constraint, 'ArrayRef', "Type library, coercion target", ); ::is( $foo->type_coercion_map->[0], 'Any', "Type library, coercion type map", ); } { package Local::NotTypeLib; use Types::Standard -all; use Type::Utils -all; my $foo = declare_coercion to_type ArrayRef, from Any, via { [$_] }; ::is( $foo->type_constraint, 'ArrayRef', "Not type library, coercion target", ); ::is( $foo->type_coercion_map->[0], 'Any', "Not type library, coercion type map", ); } done_testing; rt94196.t000664001750001750 160015111656240 15263 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Problematic inlining using C<< $_ >>. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL=> 'all'; use Test::More; use Test::Fatal; use Type::Params qw( validate ); use Types::Standard qw( -types slurpy ); { package Foo; sub new { bless {}, shift } sub send { } }; my $type = Dict[ encoder => HasMethods ['send'] ]; is( exception { my @params = ( encoder => Foo->new ); validate(\@params, slurpy($type)); }, undef, "slurpy Dict w/ HasMethods", ) or note( $type->inline_check('$_') ); done_testing; rt97684.t000664001750001750 207715111656240 15301 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE The "too few arguments for type constraint check functions" error. =head1 SEE ALSO L. =head1 AUTHOR Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Diab Jerius. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BEGIN { $ENV{'DEVEL_HIDE_VERBOSE'} = 0 }; use strict; use warnings; use Test::More; use Test::Requires 'Devel::Hide'; use Test::Requires { Mouse => '1.0000' }; use Devel::Hide qw(Type::Tiny::XS); { package Local::Class; use Mouse; } { package Local::Types; use Type::Library -base, -declare => qw( Coord ExistingCoord ); use Type::Utils -all; use Types::Standard -all; declare ExistingCoord, as Str, where { 0 }; declare Coord, as Str; } use Types::Standard -all; use Type::Params qw( validate ); validate( [], slurpy Dict[ with => Optional[Local::Types::ExistingCoord] ], ); ok 1; done_testing; rt98113.t000664001750001750 156615111656240 15267 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test overload fallback =head1 SEE ALSO L. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Dagfinn Ilmari Mannsåker Eilmari@ilmari.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Dagfinn Ilmari Mannsåker This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use BiggerLib -types, -coercions; is( exception { no warnings 'numeric'; BigInteger + 42 }, undef, 'Type::Tiny overload fallback works', ); is( exception { BigInteger->coercion eq '1' }, undef, 'Type::Coercion overload fallback works', ); done_testing; ttxs-gh1.t000664001750001750 225715111656240 15711 0ustar00taitai000000000000Type-Tiny-2.008006/t/40-bugs=pod =encoding utf-8 =head1 PURPOSE Test that was failing with Type::Tiny::XS prior to 0.009. =head1 AUTHOR Jed Lund Ejandrew@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Jed Lund. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; { package MyTest; use Type::Utils 0.046 -all; use Type::Library 0.046 -base, -declare => qw(TestDictionary SuperClassesList NameSpace); use Types::Standard 0.046 -types; declare NameSpace, as Str, where { $_ =~ /^[A-Za-z:]+$/ }, # inline_as { undef, "$_ =~ /^[A-Za-z:]+\$/" }, message { "-$_- does not match: " . qr/^[A-Za-z:]+$/ }; declare SuperClassesList, as ArrayRef[ ClassName ], # inline_as { undef, "\@{$_} > 0" }, where { scalar( @$_ ) > 0 }; declare TestDictionary, as Dict[ package => Optional[ NameSpace ], superclasses => Optional[ SuperClassesList ], ]; } ok( MyTest::TestDictionary->check( { package => 'My::Package' } ), "Test TestDictionary" ); #diag MyTest::TestDictionary->inline_check('$dict'); done_testing; BiggerLib.pm000664001750001750 345715111656240 15621 0ustar00taitai000000000000Type-Tiny-2.008006/t/lib=pod =encoding utf-8 =head1 PURPOSE Type library used in several test cases. Defines types C, C and C. Defines classes C and C along with corresponding C and C class type constraints; defines role C and the C role type constraint. Library extends DemoLib.pm. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut package BiggerLib; use strict; use warnings; use Type::Utils qw(:all); use Type::Library -base; extends "DemoLib"; extends "Types::Standard"; declare "SmallInteger", as "Integer", where { no warnings; $_ < 10 } message { no warnings; "$_ is too big" }; declare "BigInteger", as "Integer", where { no warnings; $_ >= 10 }; { package Quux; our $VERSION = 1; } role_type "DoesQuux", { role => "Quux" }; { package Foo::Bar; sub new { my $c = shift; bless {@_}, $c } sub foo { 1 } sub bar { 2 } } class_type "FooBar", { class => "Foo::Bar" }; { package Foo::Baz; our @ISA = "Foo::Bar"; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } sub foo { 3 } sub baz { 4 } } class_type "Foo::Baz"; duck_type "CanFooBar", [qw/ foo bar /]; duck_type "CanFooBaz", [qw/ foo baz /]; coerce "SmallInteger", from BigInteger => via { abs($_) % 10 }, from ArrayRef => via { 1 }; coerce "BigInteger", from SmallInteger => via { abs($_) + 10 }, from ArrayRef => via { 100 }; declare_coercion "ArrayRefFromAny", to_type "ArrayRef", from "Any", q { [$_] }; declare_coercion "ArrayRefFromPiped", to_type "ArrayRef", from "Str", q { [split /\\|/] }; 1; CompiledLib.pm000664001750001750 1176615111656240 16200 0ustar00taitai000000000000Type-Tiny-2.008006/t/libuse 5.008001; use strict; use warnings; package CompiledLib; use Exporter (); use Carp qw( croak ); our @ISA = qw( Exporter ); our @EXPORT; our @EXPORT_OK; our %EXPORT_TAGS = ( is => [], types => [], assert => [], ); BEGIN { package CompiledLib::TypeConstraint; our $LIBRARY = "CompiledLib"; use overload ( fallback => !!1, '|' => 'union', bool => sub { !! 1 }, '""' => sub { shift->[1] }, '&{}' => sub { my $self = shift; return sub { $self->assert_return( @_ ) }; }, ); sub union { my @types = grep ref( $_ ), @_; my @codes = map $_->[0], @types; bless [ sub { for ( @codes ) { return 1 if $_->(@_) } return 0 }, join( '|', map $_->[1], @types ), \@types, ], __PACKAGE__; } sub check { $_[0][0]->( $_[1] ); } sub get_message { sprintf '%s did not pass type constraint "%s"', defined( $_[1] ) ? $_[1] : 'Undef', $_[0][1]; } sub validate { $_[0][0]->( $_[1] ) ? undef : $_[0]->get_message( $_[1] ); } sub assert_valid { $_[0][0]->( $_[1] ) ? 1 : Carp::croak( $_[0]->get_message( $_[1] ) ); } sub assert_return { $_[0][0]->( $_[1] ) ? $_[1] : Carp::croak( $_[0]->get_message( $_[1] ) ); } sub to_TypeTiny { my ( $coderef, $name, $library, $origname ) = @{ +shift }; if ( ref $library eq 'ARRAY' ) { require Type::Tiny::Union; return 'Type::Tiny::Union'->new( type_constraints => [ map $_->to_TypeTiny, @$library ], ); } if ( $library ) { local $@; eval "require $library; 1" or die $@; my $type = $library->get_type( $origname ); return $type if $type; } require Type::Tiny; return 'Type::Tiny'->new( name => $name, constraint => sub { $coderef->( $_ ) }, inlined => sub { sprintf '%s::is_%s(%s)', $LIBRARY, $name, pop } ); } sub DOES { return 1 if $_[1] eq 'Type::API::Constraint'; return 1 if $_[1] eq 'Type::Library::Compiler::TypeConstraint'; shift->DOES( @_ ); } }; # Int { my $type; sub Int () { $type ||= bless( [ \&is_Int, "Int", "Types::Standard", "Int" ], "CompiledLib::TypeConstraint" ); } sub is_Int ($) { (do { my $tmp = $_[0]; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ }) } sub assert_Int ($) { (do { my $tmp = $_[0]; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ }) ? $_[0] : Int->get_message( $_[0] ); } $EXPORT_TAGS{"Int"} = [ qw( Int is_Int assert_Int ) ]; push @EXPORT_OK, @{ $EXPORT_TAGS{"Int"} }; push @{ $EXPORT_TAGS{"types"} }, "Int"; push @{ $EXPORT_TAGS{"is"} }, "is_Int"; push @{ $EXPORT_TAGS{"assert"} }, "assert_Int"; } # Str { my $type; sub Str () { $type ||= bless( [ \&is_Str, "Str", "Types::Standard", "Str" ], "CompiledLib::TypeConstraint" ); } sub is_Str ($) { do { defined($_[0]) and do { ref(\$_[0]) eq 'SCALAR' or ref(\(my $val = $_[0])) eq 'SCALAR' } } } sub assert_Str ($) { do { defined($_[0]) and do { ref(\$_[0]) eq 'SCALAR' or ref(\(my $val = $_[0])) eq 'SCALAR' } } ? $_[0] : Str->get_message( $_[0] ); } $EXPORT_TAGS{"Str"} = [ qw( Str is_Str assert_Str ) ]; push @EXPORT_OK, @{ $EXPORT_TAGS{"Str"} }; push @{ $EXPORT_TAGS{"types"} }, "Str"; push @{ $EXPORT_TAGS{"is"} }, "is_Str"; push @{ $EXPORT_TAGS{"assert"} }, "assert_Str"; } # Undef { my $type; sub Undef () { $type ||= bless( [ \&is_Undef, "Undef", "Types::Standard", "Undef" ], "CompiledLib::TypeConstraint" ); } sub is_Undef ($) { (!defined($_[0])) } sub assert_Undef ($) { (!defined($_[0])) ? $_[0] : Undef->get_message( $_[0] ); } $EXPORT_TAGS{"Undef"} = [ qw( Undef is_Undef assert_Undef ) ]; push @EXPORT_OK, @{ $EXPORT_TAGS{"Undef"} }; push @{ $EXPORT_TAGS{"types"} }, "Undef"; push @{ $EXPORT_TAGS{"is"} }, "is_Undef"; push @{ $EXPORT_TAGS{"assert"} }, "assert_Undef"; } 1; __END__ =head1 NAME CompiledLib - type constraint library =head1 TYPES This type constraint library is even more basic that L. Exported types may be combined using C<< Foo | Bar >> but parameterized type constraints like C<< Foo[Bar] >> are not supported. =head2 B Based on B in L. The C<< Int >> constant returns a blessed type constraint object. C<< is_Int($value) >> checks a value against the type and returns a boolean. C<< assert_Int($value) >> checks a value against the type and throws an error. To import all of these functions: use CompiledLib qw( :Int ); =head2 B Based on B in L. The C<< Str >> constant returns a blessed type constraint object. C<< is_Str($value) >> checks a value against the type and returns a boolean. C<< assert_Str($value) >> checks a value against the type and throws an error. To import all of these functions: use CompiledLib qw( :Str ); =head2 B Based on B in L. The C<< Undef >> constant returns a blessed type constraint object. C<< is_Undef($value) >> checks a value against the type and returns a boolean. C<< assert_Undef($value) >> checks a value against the type and throws an error. To import all of these functions: use CompiledLib qw( :Undef ); =cut DemoLib.pm000664001750001750 152015111656240 15273 0ustar00taitai000000000000Type-Tiny-2.008006/t/lib=pod =encoding utf-8 =head1 PURPOSE Type library used in several test cases. Defines types C, C and C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut package DemoLib; use strict; use warnings; use Scalar::Util "looks_like_number"; use Type::Utils; use Type::Library -base; declare "String", where { no warnings; not ref $_ } message { "is not a string" }; declare "Number", as "String", where { no warnings; looks_like_number $_ }, message { "'$_' doesn't look like a number" }; declare "Integer", as "Number", where { no warnings; $_ eq int($_) }; 1; Builder.pm000664001750001750 16545115111656240 17475 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Testpackage Test::Builder; use 5.006; use strict; use warnings; our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) BEGIN { if( $] < 5.008 ) { require Test::Builder::IO::Scalar; } } # Make Test::Builder thread-safe for ithreads. BEGIN { use Config; # Load threads::shared when threads are turned on. # 5.8.0's threads are so busted we no longer support them. if( $] >= 5.008001 && $Config{useithreads} && $INC{'threads.pm'} ) { require threads::shared; # Hack around YET ANOTHER threads::shared bug. It would # occasionally forget the contents of the variable when sharing it. # So we first copy the data, then share, then put our copy back. *share = sub (\[$@%]) { my $type = ref $_[0]; my $data; if( $type eq 'HASH' ) { %$data = %{ $_[0] }; } elsif( $type eq 'ARRAY' ) { @$data = @{ $_[0] }; } elsif( $type eq 'SCALAR' ) { $$data = ${ $_[0] }; } else { die( "Unknown type: " . $type ); } $_[0] = &threads::shared::share( $_[0] ); if( $type eq 'HASH' ) { %{ $_[0] } = %$data; } elsif( $type eq 'ARRAY' ) { @{ $_[0] } = @$data; } elsif( $type eq 'SCALAR' ) { ${ $_[0] } = $$data; } else { die( "Unknown type: " . $type ); } return $_[0]; }; } # 5.8.0's threads::shared is busted when threads are off # and earlier Perls just don't have that module at all. else { *share = sub { return $_[0] }; *lock = sub { 0 }; } } =head1 NAME Test::Builder - Backend for building test libraries =head1 SYNOPSIS package My::Test::Module; use base 'Test::Builder::Module'; my $CLASS = __PACKAGE__; sub ok { my($test, $name) = @_; my $tb = $CLASS->builder; $tb->ok($test, $name); } =head1 DESCRIPTION Test::Simple and Test::More have proven to be popular testing modules, but they're not always flexible enough. Test::Builder provides a building block upon which to write your own test libraries I. =head2 Construction =over 4 =item B my $Test = Test::Builder->new; Returns a Test::Builder object representing the current state of the test. Since you only run one test per program C always returns the same Test::Builder object. No matter how many times you call C, you're getting the same object. This is called a singleton. This is done so that multiple modules share such global information as the test counter and where test output is going. If you want a completely new Test::Builder object different from the singleton, use C. =cut our $Test = Test::Builder->new; sub new { my($class) = shift; $Test ||= $class->create; return $Test; } =item B my $Test = Test::Builder->create; Ok, so there can be more than one Test::Builder object and this is how you get it. You might use this instead of C if you're testing a Test::Builder based module, but otherwise you probably want C. B: the implementation is not complete. C, for example, is still shared amongst B Test::Builder objects, even ones created using this method. Also, the method name may change in the future. =cut sub create { my $class = shift; my $self = bless {}, $class; $self->reset; return $self; } =item B my $child = $builder->child($name_of_child); $child->plan( tests => 4 ); $child->ok(some_code()); ... $child->finalize; Returns a new instance of C. Any output from this child will be indented four spaces more than the parent's indentation. When done, the C method I be called explicitly. Trying to create a new child with a previous child still active (i.e., C not called) will C. Trying to run a test when you have an open child will also C and cause the test suite to fail. =cut sub child { my( $self, $name ) = @_; if( $self->{Child_Name} ) { $self->croak("You already have a child named ($self->{Child_Name}) running"); } my $parent_in_todo = $self->in_todo; # Clear $TODO for the child. my $orig_TODO = $self->find_TODO(undef, 1, undef); my $child = bless {}, ref $self; $child->reset; # Add to our indentation $child->_indent( $self->_indent . ' ' ); $child->{$_} = $self->{$_} foreach qw{Out_FH Todo_FH Fail_FH}; if ($parent_in_todo) { $child->{Fail_FH} = $self->{Todo_FH}; } # This will be reset in finalize. We do this here lest one child failure # cause all children to fail. $child->{Child_Error} = $?; $? = 0; $child->{Parent} = $self; $child->{Parent_TODO} = $orig_TODO; $child->{Name} = $name || "Child of " . $self->name; $self->{Child_Name} = $child->name; return $child; } =item B $builder->subtest($name, \&subtests); See documentation of C in Test::More. =cut sub subtest { my $self = shift; my($name, $subtests) = @_; if ('CODE' ne ref $subtests) { $self->croak("subtest()'s second argument must be a code ref"); } # Turn the child into the parent so anyone who has stored a copy of # the Test::Builder singleton will get the child. my($error, $child, %parent); { # child() calls reset() which sets $Level to 1, so we localize # $Level first to limit the scope of the reset to the subtest. local $Test::Builder::Level = $Test::Builder::Level + 1; $child = $self->child($name); %parent = %$self; %$self = %$child; my $run_the_subtests = sub { $subtests->(); $self->done_testing unless $self->_plan_handled; 1; }; if( !eval { $run_the_subtests->() } ) { $error = $@; } } # Restore the parent and the copied child. %$child = %$self; %$self = %parent; # Restore the parent's $TODO $self->find_TODO(undef, 1, $child->{Parent_TODO}); # Die *after* we restore the parent. die $error if $error and !eval { $error->isa('Test::Builder::Exception') }; local $Test::Builder::Level = $Test::Builder::Level + 1; return $child->finalize; } =begin _private =item B<_plan_handled> if ( $Test->_plan_handled ) { ... } Returns true if the developer has explicitly handled the plan via: =over 4 =item * Explicitly setting the number of tests =item * Setting 'no_plan' =item * Set 'skip_all'. =back This is currently used in subtests when we implicitly call C<< $Test->done_testing >> if the developer has not set a plan. =end _private =cut sub _plan_handled { my $self = shift; return $self->{Have_Plan} || $self->{No_Plan} || $self->{Skip_All}; } =item B my $ok = $child->finalize; When your child is done running tests, you must call C to clean up and tell the parent your pass/fail status. Calling finalize on a child with open children will C. If the child falls out of scope before C is called, a failure diagnostic will be issued and the child is considered to have failed. No attempt to call methods on a child after C is called is guaranteed to succeed. Calling this on the root builder is a no-op. =cut sub finalize { my $self = shift; return unless $self->parent; if( $self->{Child_Name} ) { $self->croak("Can't call finalize() with child ($self->{Child_Name}) active"); } local $? = 0; # don't fail if $subtests happened to set $? nonzero $self->_ending; # XXX This will only be necessary for TAP envelopes (we think) #$self->_print( $self->is_passing ? "PASS\n" : "FAIL\n" ); local $Test::Builder::Level = $Test::Builder::Level + 1; my $ok = 1; $self->parent->{Child_Name} = undef; if ( $self->{Skip_All} ) { $self->parent->skip($self->{Skip_All}); } elsif ( not @{ $self->{Test_Results} } ) { $self->parent->ok( 0, sprintf q[No tests run for subtest "%s"], $self->name ); } else { $self->parent->ok( $self->is_passing, $self->name ); } $? = $self->{Child_Error}; delete $self->{Parent}; return $self->is_passing; } sub _indent { my $self = shift; if( @_ ) { $self->{Indent} = shift; } return $self->{Indent}; } =item B if ( my $parent = $builder->parent ) { ... } Returns the parent C instance, if any. Only used with child builders for nested TAP. =cut sub parent { shift->{Parent} } =item B diag $builder->name; Returns the name of the current builder. Top level builders default to C<$0> (the name of the executable). Child builders are named via the C method. If no name is supplied, will be named "Child of $parent->name". =cut sub name { shift->{Name} } sub DESTROY { my $self = shift; if ( $self->parent and $$ == $self->{Original_Pid} ) { my $name = $self->name; $self->diag(<<"FAIL"); Child ($name) exited without calling finalize() FAIL $self->parent->{In_Destroy} = 1; $self->parent->ok(0, $name); } } =item B $Test->reset; Reinitializes the Test::Builder singleton to its original state. Mostly useful for tests run in persistent environments where the same test might be run multiple times in the same process. =cut our $Level; sub reset { ## no critic (Subroutines::ProhibitBuiltinHomonyms) my($self) = @_; # We leave this a global because it has to be localized and localizing # hash keys is just asking for pain. Also, it was documented. $Level = 1; $self->{Name} = $0; $self->is_passing(1); $self->{Ending} = 0; $self->{Have_Plan} = 0; $self->{No_Plan} = 0; $self->{Have_Output_Plan} = 0; $self->{Done_Testing} = 0; $self->{Original_Pid} = $$; $self->{Child_Name} = undef; $self->{Indent} ||= ''; share( $self->{Curr_Test} ); $self->{Curr_Test} = 0; $self->{Test_Results} = &share( [] ); $self->{Exported_To} = undef; $self->{Expected_Tests} = 0; $self->{Skip_All} = 0; $self->{Use_Nums} = 1; $self->{No_Header} = 0; $self->{No_Ending} = 0; $self->{Todo} = undef; $self->{Todo_Stack} = []; $self->{Start_Todo} = 0; $self->{Opened_Testhandles} = 0; $self->_dup_stdhandles; return; } =back =head2 Setting up tests These methods are for setting up tests and declaring how many there are. You usually only want to call one of these methods. =over 4 =item B $Test->plan('no_plan'); $Test->plan( skip_all => $reason ); $Test->plan( tests => $num_tests ); A convenient way to set up your tests. Call this and Test::Builder will print the appropriate headers and take the appropriate actions. If you call C, don't call any of the other methods below. If a child calls "skip_all" in the plan, a C is thrown. Trap this error, call C and don't run any more tests on the child. my $child = $Test->child('some child'); eval { $child->plan( $condition ? ( skip_all => $reason ) : ( tests => 3 ) ) }; if ( eval { $@->isa('Test::Builder::Exception') } ) { $child->finalize; return; } # run your tests =cut my %plan_cmds = ( no_plan => \&no_plan, skip_all => \&skip_all, tests => \&_plan_tests, ); sub plan { my( $self, $cmd, $arg ) = @_; return unless $cmd; local $Level = $Level + 1; $self->croak("You tried to plan twice") if $self->{Have_Plan}; if( my $method = $plan_cmds{$cmd} ) { local $Level = $Level + 1; $self->$method($arg); } else { my @args = grep { defined } ( $cmd, $arg ); $self->croak("plan() doesn't understand @args"); } return 1; } sub _plan_tests { my($self, $arg) = @_; if($arg) { local $Level = $Level + 1; return $self->expected_tests($arg); } elsif( !defined $arg ) { $self->croak("Got an undefined number of tests"); } else { $self->croak("You said to run 0 tests"); } return; } =item B my $max = $Test->expected_tests; $Test->expected_tests($max); Gets/sets the number of tests we expect this test to run and prints out the appropriate headers. =cut sub expected_tests { my $self = shift; my($max) = @_; if(@_) { $self->croak("Number of tests must be a positive integer. You gave it '$max'") unless $max =~ /^\+?\d+$/; $self->{Expected_Tests} = $max; $self->{Have_Plan} = 1; $self->_output_plan($max) unless $self->no_header; } return $self->{Expected_Tests}; } =item B $Test->no_plan; Declares that this test will run an indeterminate number of tests. =cut sub no_plan { my($self, $arg) = @_; $self->carp("no_plan takes no arguments") if $arg; $self->{No_Plan} = 1; $self->{Have_Plan} = 1; return 1; } =begin private =item B<_output_plan> $tb->_output_plan($max); $tb->_output_plan($max, $directive); $tb->_output_plan($max, $directive => $reason); Handles displaying the test plan. If a C<$directive> and/or C<$reason> are given they will be output with the plan. So here's what skipping all tests looks like: $tb->_output_plan(0, "SKIP", "Because I said so"); It sets C<< $tb->{Have_Output_Plan} >> and will croak if the plan was already output. =end private =cut sub _output_plan { my($self, $max, $directive, $reason) = @_; $self->carp("The plan was already output") if $self->{Have_Output_Plan}; my $plan = "1..$max"; $plan .= " # $directive" if defined $directive; $plan .= " $reason" if defined $reason; $self->_print("$plan\n"); $self->{Have_Output_Plan} = 1; return; } =item B $Test->done_testing(); $Test->done_testing($num_tests); Declares that you are done testing, no more tests will be run after this point. If a plan has not yet been output, it will do so. $num_tests is the number of tests you planned to run. If a numbered plan was already declared, and if this contradicts, a failing test will be run to reflect the planning mistake. If C was declared, this will override. If C is called twice, the second call will issue a failing test. If C<$num_tests> is omitted, the number of tests run will be used, like no_plan. C is, in effect, used when you'd want to use C, but safer. You'd use it like so: $Test->ok($a == $b); $Test->done_testing(); Or to plan a variable number of tests: for my $test (@tests) { $Test->ok($test); } $Test->done_testing(@tests); =cut sub done_testing { my($self, $num_tests) = @_; # If done_testing() specified the number of tests, shut off no_plan. if( defined $num_tests ) { $self->{No_Plan} = 0; } else { $num_tests = $self->current_test; } if( $self->{Done_Testing} ) { my($file, $line) = @{$self->{Done_Testing}}[1,2]; $self->ok(0, "done_testing() was already called at $file line $line"); return; } $self->{Done_Testing} = [caller]; if( $self->expected_tests && $num_tests != $self->expected_tests ) { $self->ok(0, "planned to run @{[ $self->expected_tests ]} ". "but done_testing() expects $num_tests"); } else { $self->{Expected_Tests} = $num_tests; } $self->_output_plan($num_tests) unless $self->{Have_Output_Plan}; $self->{Have_Plan} = 1; # The wrong number of tests were run $self->is_passing(0) if $self->{Expected_Tests} != $self->{Curr_Test}; # No tests were run $self->is_passing(0) if $self->{Curr_Test} == 0; return 1; } =item B $plan = $Test->has_plan Find out whether a plan has been defined. C<$plan> is either C (no plan has been set), C (indeterminate # of tests) or an integer (the number of expected tests). =cut sub has_plan { my $self = shift; return( $self->{Expected_Tests} ) if $self->{Expected_Tests}; return('no_plan') if $self->{No_Plan}; return(undef); } =item B $Test->skip_all; $Test->skip_all($reason); Skips all the tests, using the given C<$reason>. Exits immediately with 0. =cut sub skip_all { my( $self, $reason ) = @_; $self->{Skip_All} = $self->parent ? $reason : 1; $self->_output_plan(0, "SKIP", $reason) unless $self->no_header; if ( $self->parent ) { die bless {} => 'Test::Builder::Exception'; } exit(0); } =item B my $pack = $Test->exported_to; $Test->exported_to($pack); Tells Test::Builder what package you exported your functions to. This method isn't terribly useful since modules which share the same Test::Builder object might get exported to different packages and only the last one will be honored. =cut sub exported_to { my( $self, $pack ) = @_; if( defined $pack ) { $self->{Exported_To} = $pack; } return $self->{Exported_To}; } =back =head2 Running tests These actually run the tests, analogous to the functions in Test::More. They all return true if the test passed, false if the test failed. C<$name> is always optional. =over 4 =item B $Test->ok($test, $name); Your basic test. Pass if C<$test> is true, fail if $test is false. Just like Test::Simple's C. =cut sub ok { my( $self, $test, $name ) = @_; if ( $self->{Child_Name} and not $self->{In_Destroy} ) { $name = 'unnamed test' unless defined $name; $self->is_passing(0); $self->croak("Cannot run test ($name) with active children"); } # $test might contain an object which we don't want to accidentally # store, so we turn it into a boolean. $test = $test ? 1 : 0; lock $self->{Curr_Test}; $self->{Curr_Test}++; # In case $name is a string overloaded object, force it to stringify. $self->_unoverload_str( \$name ); $self->diag(<<"ERR") if defined $name and $name =~ /^[\d\s]+$/; You named your test '$name'. You shouldn't use numbers for your test names. Very confusing. ERR # Capture the value of $TODO for the rest of this ok() call # so it can more easily be found by other routines. my $todo = $self->todo(); my $in_todo = $self->in_todo; local $self->{Todo} = $todo if $in_todo; $self->_unoverload_str( \$todo ); my $out; my $result = &share( {} ); unless($test) { $out .= "not "; @$result{ 'ok', 'actual_ok' } = ( ( $self->in_todo ? 1 : 0 ), 0 ); } else { @$result{ 'ok', 'actual_ok' } = ( 1, $test ); } $out .= "ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; if( defined $name ) { $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness. $out .= " - $name"; $result->{name} = $name; } else { $result->{name} = ''; } if( $self->in_todo ) { $out .= " # TODO $todo"; $result->{reason} = $todo; $result->{type} = 'todo'; } else { $result->{reason} = ''; $result->{type} = ''; } $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = $result; $out .= "\n"; $self->_print($out); unless($test) { my $msg = $self->in_todo ? "Failed (TODO)" : "Failed"; $self->_print_to_fh( $self->_diag_fh, "\n" ) if $ENV{HARNESS_ACTIVE}; my( undef, $file, $line ) = $self->caller; if( defined $name ) { $self->diag(qq[ $msg test '$name'\n]); $self->diag(qq[ at $file line $line.\n]); } else { $self->diag(qq[ $msg test at $file line $line.\n]); } } $self->is_passing(0) unless $test || $self->in_todo; # Check that we haven't violated the plan $self->_check_is_passing_plan(); return $test ? 1 : 0; } # Check that we haven't yet violated the plan and set # is_passing() accordingly sub _check_is_passing_plan { my $self = shift; my $plan = $self->has_plan; return unless defined $plan; # no plan yet defined return unless $plan !~ /\D/; # no numeric plan $self->is_passing(0) if $plan < $self->{Curr_Test}; } sub _unoverload { my $self = shift; my $type = shift; $self->_try(sub { require overload; }, die_on_fail => 1); foreach my $thing (@_) { if( $self->_is_object($$thing) ) { if( my $string_meth = overload::Method( $$thing, $type ) ) { $$thing = $$thing->$string_meth(); } } } return; } sub _is_object { my( $self, $thing ) = @_; return $self->_try( sub { ref $thing && $thing->isa('UNIVERSAL') } ) ? 1 : 0; } sub _unoverload_str { my $self = shift; return $self->_unoverload( q[""], @_ ); } sub _unoverload_num { my $self = shift; $self->_unoverload( '0+', @_ ); for my $val (@_) { next unless $self->_is_dualvar($$val); $$val = $$val + 0; } return; } # This is a hack to detect a dualvar such as $! sub _is_dualvar { my( $self, $val ) = @_; # Objects are not dualvars. return 0 if ref $val; no warnings 'numeric'; my $numval = $val + 0; return $numval != 0 and $numval ne $val ? 1 : 0; } =item B $Test->is_eq($got, $expected, $name); Like Test::More's C. Checks if C<$got eq $expected>. This is the string version. C only ever matches another C. =item B $Test->is_num($got, $expected, $name); Like Test::More's C. Checks if C<$got == $expected>. This is the numeric version. C only ever matches another C. =cut sub is_eq { my( $self, $got, $expect, $name ) = @_; local $Level = $Level + 1; if( !defined $got || !defined $expect ) { # undef only matches undef and nothing else my $test = !defined $got && !defined $expect; $self->ok( $test, $name ); $self->_is_diag( $got, 'eq', $expect ) unless $test; return $test; } return $self->cmp_ok( $got, 'eq', $expect, $name ); } sub is_num { my( $self, $got, $expect, $name ) = @_; local $Level = $Level + 1; if( !defined $got || !defined $expect ) { # undef only matches undef and nothing else my $test = !defined $got && !defined $expect; $self->ok( $test, $name ); $self->_is_diag( $got, '==', $expect ) unless $test; return $test; } return $self->cmp_ok( $got, '==', $expect, $name ); } sub _diag_fmt { my( $self, $type, $val ) = @_; if( defined $$val ) { if( $type eq 'eq' or $type eq 'ne' ) { # quote and force string context $$val = "'$$val'"; } else { # force numeric context $self->_unoverload_num($val); } } else { $$val = 'undef'; } return; } sub _is_diag { my( $self, $got, $type, $expect ) = @_; $self->_diag_fmt( $type, $_ ) for \$got, \$expect; local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); got: $got expected: $expect DIAGNOSTIC } sub _isnt_diag { my( $self, $got, $type ) = @_; $self->_diag_fmt( $type, \$got ); local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); got: $got expected: anything else DIAGNOSTIC } =item B $Test->isnt_eq($got, $dont_expect, $name); Like Test::More's C. Checks if C<$got ne $dont_expect>. This is the string version. =item B $Test->isnt_num($got, $dont_expect, $name); Like Test::More's C. Checks if C<$got ne $dont_expect>. This is the numeric version. =cut sub isnt_eq { my( $self, $got, $dont_expect, $name ) = @_; local $Level = $Level + 1; if( !defined $got || !defined $dont_expect ) { # undef only matches undef and nothing else my $test = defined $got || defined $dont_expect; $self->ok( $test, $name ); $self->_isnt_diag( $got, 'ne' ) unless $test; return $test; } return $self->cmp_ok( $got, 'ne', $dont_expect, $name ); } sub isnt_num { my( $self, $got, $dont_expect, $name ) = @_; local $Level = $Level + 1; if( !defined $got || !defined $dont_expect ) { # undef only matches undef and nothing else my $test = defined $got || defined $dont_expect; $self->ok( $test, $name ); $self->_isnt_diag( $got, '!=' ) unless $test; return $test; } return $self->cmp_ok( $got, '!=', $dont_expect, $name ); } =item B $Test->like($this, qr/$regex/, $name); $Test->like($this, '/$regex/', $name); Like Test::More's C. Checks if $this matches the given C<$regex>. =item B $Test->unlike($this, qr/$regex/, $name); $Test->unlike($this, '/$regex/', $name); Like Test::More's C. Checks if $this B the given C<$regex>. =cut sub like { my( $self, $this, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $this, $regex, '=~', $name ); } sub unlike { my( $self, $this, $regex, $name ) = @_; local $Level = $Level + 1; return $self->_regex_ok( $this, $regex, '!~', $name ); } =item B $Test->cmp_ok($this, $type, $that, $name); Works just like Test::More's C. $Test->cmp_ok($big_num, '!=', $other_big_num); =cut my %numeric_cmps = map { ( $_, 1 ) } ( "<", "<=", ">", ">=", "==", "!=", "<=>" ); sub cmp_ok { my( $self, $got, $type, $expect, $name ) = @_; my $test; my $error; { ## no critic (BuiltinFunctions::ProhibitStringyEval) local( $@, $!, $SIG{__DIE__} ); # isolate eval my($pack, $file, $line) = $self->caller(); # This is so that warnings come out at the caller's level $test = eval qq[ #line $line "(eval in cmp_ok) $file" \$got $type \$expect; ]; $error = $@; } local $Level = $Level + 1; my $ok = $self->ok( $test, $name ); # Treat overloaded objects as numbers if we're asked to do a # numeric comparison. my $unoverload = $numeric_cmps{$type} ? '_unoverload_num' : '_unoverload_str'; $self->diag(<<"END") if $error; An error occurred while using $type: ------------------------------------ $error ------------------------------------ END unless($ok) { $self->$unoverload( \$got, \$expect ); if( $type =~ /^(eq|==)$/ ) { $self->_is_diag( $got, $type, $expect ); } elsif( $type =~ /^(ne|!=)$/ ) { $self->_isnt_diag( $got, $type ); } else { $self->_cmp_diag( $got, $type, $expect ); } } return $ok; } sub _cmp_diag { my( $self, $got, $type, $expect ) = @_; $got = defined $got ? "'$got'" : 'undef'; $expect = defined $expect ? "'$expect'" : 'undef'; local $Level = $Level + 1; return $self->diag(<<"DIAGNOSTIC"); $got $type $expect DIAGNOSTIC } sub _caller_context { my $self = shift; my( $pack, $file, $line ) = $self->caller(1); my $code = ''; $code .= "#line $line $file\n" if defined $file and defined $line; return $code; } =back =head2 Other Testing Methods These are methods which are used in the course of writing a test but are not themselves tests. =over 4 =item B $Test->BAIL_OUT($reason); Indicates to the Test::Harness that things are going so badly all testing should terminate. This includes running any additional test scripts. It will exit with 255. =cut sub BAIL_OUT { my( $self, $reason ) = @_; $self->{Bailed_Out} = 1; $self->_print("Bail out! $reason"); exit 255; } =for deprecated BAIL_OUT() used to be BAILOUT() =cut { no warnings 'once'; *BAILOUT = \&BAIL_OUT; } =item B $Test->skip; $Test->skip($why); Skips the current test, reporting C<$why>. =cut sub skip { my( $self, $why ) = @_; $why ||= ''; $self->_unoverload_str( \$why ); lock( $self->{Curr_Test} ); $self->{Curr_Test}++; $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( { 'ok' => 1, actual_ok => 1, name => '', type => 'skip', reason => $why, } ); my $out = "ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # skip"; $out .= " $why" if length $why; $out .= "\n"; $self->_print($out); return 1; } =item B $Test->todo_skip; $Test->todo_skip($why); Like C, only it will declare the test as failing and TODO. Similar to print "not ok $tnum # TODO $why\n"; =cut sub todo_skip { my( $self, $why ) = @_; $why ||= ''; lock( $self->{Curr_Test} ); $self->{Curr_Test}++; $self->{Test_Results}[ $self->{Curr_Test} - 1 ] = &share( { 'ok' => 1, actual_ok => 0, name => '', type => 'todo_skip', reason => $why, } ); my $out = "not ok"; $out .= " $self->{Curr_Test}" if $self->use_numbers; $out .= " # TODO & SKIP $why\n"; $self->_print($out); return 1; } =begin _unimplemented =item B $Test->skip_rest; $Test->skip_rest($reason); Like C, only it skips all the rest of the tests you plan to run and terminates the test. If you're running under C, it skips once and terminates the test. =end _unimplemented =back =head2 Test building utility methods These methods are useful when writing your own test methods. =over 4 =item B $Test->maybe_regex(qr/$regex/); $Test->maybe_regex('/$regex/'); This method used to be useful back when Test::Builder worked on Perls before 5.6 which didn't have qr//. Now its pretty useless. Convenience method for building testing functions that take regular expressions as arguments. Takes a quoted regular expression produced by C, or a string representing a regular expression. Returns a Perl value which may be used instead of the corresponding regular expression, or C if its argument is not recognised. For example, a version of C, sans the useful diagnostic messages, could be written as: sub laconic_like { my ($self, $this, $regex, $name) = @_; my $usable_regex = $self->maybe_regex($regex); die "expecting regex, found '$regex'\n" unless $usable_regex; $self->ok($this =~ m/$usable_regex/, $name); } =cut sub maybe_regex { my( $self, $regex ) = @_; my $usable_regex = undef; return $usable_regex unless defined $regex; my( $re, $opts ); # Check for qr/foo/ if( _is_qr($regex) ) { $usable_regex = $regex; } # Check for '/foo/' or 'm,foo,' elsif(( $re, $opts ) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or ( undef, $re, $opts ) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx ) { $usable_regex = length $opts ? "(?$opts)$re" : $re; } return $usable_regex; } sub _is_qr { my $regex = shift; # is_regexp() checks for regexes in a robust manner, say if they're # blessed. return re::is_regexp($regex) if defined &re::is_regexp; return ref $regex eq 'Regexp'; } sub _regex_ok { my( $self, $this, $regex, $cmp, $name ) = @_; my $ok = 0; my $usable_regex = $self->maybe_regex($regex); unless( defined $usable_regex ) { local $Level = $Level + 1; $ok = $self->ok( 0, $name ); $self->diag(" '$regex' doesn't look much like a regex to me."); return $ok; } { ## no critic (BuiltinFunctions::ProhibitStringyEval) my $test; my $context = $self->_caller_context; local( $@, $!, $SIG{__DIE__} ); # isolate eval $test = eval $context . q{$test = $this =~ /$usable_regex/ ? 1 : 0}; $test = !$test if $cmp eq '!~'; local $Level = $Level + 1; $ok = $self->ok( $test, $name ); } unless($ok) { $this = defined $this ? "'$this'" : 'undef'; my $match = $cmp eq '=~' ? "doesn't match" : "matches"; local $Level = $Level + 1; $self->diag( sprintf <<'DIAGNOSTIC', $this, $match, $regex ); %s %13s '%s' DIAGNOSTIC } return $ok; } # I'm not ready to publish this. It doesn't deal with array return # values from the code or context. =begin private =item B<_try> my $return_from_code = $Test->try(sub { code }); my($return_from_code, $error) = $Test->try(sub { code }); Works like eval BLOCK except it ensures it has no effect on the rest of the test (ie. C<$@> is not set) nor is effected by outside interference (ie. C<$SIG{__DIE__}>) and works around some quirks in older Perls. C<$error> is what would normally be in C<$@>. It is suggested you use this in place of eval BLOCK. =cut sub _try { my( $self, $code, %opts ) = @_; my $error; my $return; { local $!; # eval can mess up $! local $@; # don't set $@ in the test local $SIG{__DIE__}; # don't trip an outside DIE handler. $return = eval { $code->() }; $error = $@; } die $error if $error and $opts{die_on_fail}; return wantarray ? ( $return, $error ) : $return; } =end private =item B my $is_fh = $Test->is_fh($thing); Determines if the given C<$thing> can be used as a filehandle. =cut sub is_fh { my $self = shift; my $maybe_fh = shift; return 0 unless defined $maybe_fh; return 1 if ref $maybe_fh eq 'GLOB'; # its a glob ref return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob return eval { $maybe_fh->isa("IO::Handle") } || eval { tied($maybe_fh)->can('TIEHANDLE') }; } =back =head2 Test style =over 4 =item B $Test->level($how_high); How far up the call stack should C<$Test> look when reporting where the test failed. Defaults to 1. Setting L<$Test::Builder::Level> overrides. This is typically useful localized: sub my_ok { my $test = shift; local $Test::Builder::Level = $Test::Builder::Level + 1; $TB->ok($test); } To be polite to other functions wrapping your own you usually want to increment C<$Level> rather than set it to a constant. =cut sub level { my( $self, $level ) = @_; if( defined $level ) { $Level = $level; } return $Level; } =item B $Test->use_numbers($on_or_off); Whether or not the test should output numbers. That is, this if true: ok 1 ok 2 ok 3 or this if false ok ok ok Most useful when you can't depend on the test output order, such as when threads or forking is involved. Defaults to on. =cut sub use_numbers { my( $self, $use_nums ) = @_; if( defined $use_nums ) { $self->{Use_Nums} = $use_nums; } return $self->{Use_Nums}; } =item B $Test->no_diag($no_diag); If set true no diagnostics will be printed. This includes calls to C. =item B $Test->no_ending($no_ending); Normally, Test::Builder does some extra diagnostics when the test ends. It also changes the exit code as described below. If this is true, none of that will be done. =item B $Test->no_header($no_header); If set to true, no "1..N" header will be printed. =cut foreach my $attribute (qw(No_Header No_Ending No_Diag)) { my $method = lc $attribute; my $code = sub { my( $self, $no ) = @_; if( defined $no ) { $self->{$attribute} = $no; } return $self->{$attribute}; }; no strict 'refs'; ## no critic *{ __PACKAGE__ . '::' . $method } = $code; } =back =head2 Output Controlling where the test output goes. It's ok for your test to change where STDOUT and STDERR point to, Test::Builder's default output settings will not be affected. =over 4 =item B $Test->diag(@msgs); Prints out the given C<@msgs>. Like C, arguments are simply appended together. Normally, it uses the C handle, but if this is for a TODO test, the C handle is used. Output will be indented and marked with a # so as not to interfere with test output. A newline will be put on the end if there isn't one already. We encourage using this rather than calling print directly. Returns false. Why? Because C is often used in conjunction with a failing test (C) it "passes through" the failure. return ok(...) || diag(...); =for blame transfer Mark Fowler =cut sub diag { my $self = shift; $self->_print_comment( $self->_diag_fh, @_ ); } =item B $Test->note(@msgs); Like C, but it prints to the C handle so it will not normally be seen by the user except in verbose mode. =cut sub note { my $self = shift; $self->_print_comment( $self->output, @_ ); } sub _diag_fh { my $self = shift; local $Level = $Level + 1; return $self->in_todo ? $self->todo_output : $self->failure_output; } sub _print_comment { my( $self, $fh, @msgs ) = @_; return if $self->no_diag; return unless @msgs; # Prevent printing headers when compiling (i.e. -c) return if $^C; # Smash args together like print does. # Convert undef to 'undef' so its readable. my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs; # Escape the beginning, _print will take care of the rest. $msg =~ s/^/# /; local $Level = $Level + 1; $self->_print_to_fh( $fh, $msg ); return 0; } =item B my @dump = $Test->explain(@msgs); Will dump the contents of any references in a human readable format. Handy for things like... is_deeply($have, $want) || diag explain $have; or is_deeply($have, $want) || note explain $have; =cut sub explain { my $self = shift; return map { ref $_ ? do { $self->_try(sub { require Data::Dumper }, die_on_fail => 1); my $dumper = Data::Dumper->new( [$_] ); $dumper->Indent(1)->Terse(1); $dumper->Sortkeys(1) if $dumper->can("Sortkeys"); $dumper->Dump; } : $_ } @_; } =begin _private =item B<_print> $Test->_print(@msgs); Prints to the C filehandle. =end _private =cut sub _print { my $self = shift; return $self->_print_to_fh( $self->output, @_ ); } sub _print_to_fh { my( $self, $fh, @msgs ) = @_; # Prevent printing headers when only compiling. Mostly for when # tests are deparsed with B::Deparse return if $^C; my $msg = join '', @msgs; my $indent = $self->_indent; local( $\, $", $, ) = ( undef, ' ', '' ); # Escape each line after the first with a # so we don't # confuse Test::Harness. $msg =~ s{\n(?!\z)}{\n$indent# }sg; # Stick a newline on the end if it needs it. $msg .= "\n" unless $msg =~ /\n\z/; return print $fh $indent, $msg; } =item B =item B =item B my $filehandle = $Test->output; $Test->output($filehandle); $Test->output($filename); $Test->output(\$scalar); These methods control where Test::Builder will print its output. They take either an open C<$filehandle>, a C<$filename> to open and write to or a C<$scalar> reference to append to. It will always return a C<$filehandle>. B is where normal "ok/not ok" test output goes. Defaults to STDOUT. B is where diagnostic output on test failures and C goes. It is normally not read by Test::Harness and instead is displayed to the user. Defaults to STDERR. C is used instead of C for the diagnostics of a failing TODO test. These will not be seen by the user. Defaults to STDOUT. =cut sub output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Out_FH} = $self->_new_fh($fh); } return $self->{Out_FH}; } sub failure_output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Fail_FH} = $self->_new_fh($fh); } return $self->{Fail_FH}; } sub todo_output { my( $self, $fh ) = @_; if( defined $fh ) { $self->{Todo_FH} = $self->_new_fh($fh); } return $self->{Todo_FH}; } sub _new_fh { my $self = shift; my($file_or_fh) = shift; my $fh; if( $self->is_fh($file_or_fh) ) { $fh = $file_or_fh; } elsif( ref $file_or_fh eq 'SCALAR' ) { # Scalar refs as filehandles was added in 5.8. if( $] >= 5.008 ) { open $fh, ">>", $file_or_fh or $self->croak("Can't open scalar ref $file_or_fh: $!"); } # Emulate scalar ref filehandles with a tie. else { $fh = Test::Builder::IO::Scalar->new($file_or_fh) or $self->croak("Can't tie scalar ref $file_or_fh"); } } else { open $fh, ">", $file_or_fh or $self->croak("Can't open test output log $file_or_fh: $!"); _autoflush($fh); } return $fh; } sub _autoflush { my($fh) = shift; my $old_fh = select $fh; $| = 1; select $old_fh; return; } my( $Testout, $Testerr ); sub _dup_stdhandles { my $self = shift; $self->_open_testhandles; # Set everything to unbuffered else plain prints to STDOUT will # come out in the wrong order from our own prints. _autoflush($Testout); _autoflush( \*STDOUT ); _autoflush($Testerr); _autoflush( \*STDERR ); $self->reset_outputs; return; } sub _open_testhandles { my $self = shift; return if $self->{Opened_Testhandles}; # We dup STDOUT and STDERR so people can change them in their # test suites while still getting normal test output. open( $Testout, ">&STDOUT" ) or die "Can't dup STDOUT: $!"; open( $Testerr, ">&STDERR" ) or die "Can't dup STDERR: $!"; $self->_copy_io_layers( \*STDOUT, $Testout ); $self->_copy_io_layers( \*STDERR, $Testerr ); $self->{Opened_Testhandles} = 1; return; } sub _copy_io_layers { my( $self, $src, $dst ) = @_; $self->_try( sub { require PerlIO; my @src_layers = PerlIO::get_layers($src); _apply_layers($dst, @src_layers) if @src_layers; } ); return; } sub _apply_layers { my ($fh, @layers) = @_; my %seen; my @unique = grep { $_ ne 'unix' and !$seen{$_}++ } @layers; binmode($fh, join(":", "", "raw", @unique)); } =item reset_outputs $tb->reset_outputs; Resets all the output filehandles back to their defaults. =cut sub reset_outputs { my $self = shift; $self->output ($Testout); $self->failure_output($Testerr); $self->todo_output ($Testout); return; } =item carp $tb->carp(@message); Warns with C<@message> but the message will appear to come from the point where the original test function was called (C<< $tb->caller >>). =item croak $tb->croak(@message); Dies with C<@message> but the message will appear to come from the point where the original test function was called (C<< $tb->caller >>). =cut sub _message_at_caller { my $self = shift; local $Level = $Level + 1; my( $pack, $file, $line ) = $self->caller; return join( "", @_ ) . " at $file line $line.\n"; } sub carp { my $self = shift; return warn $self->_message_at_caller(@_); } sub croak { my $self = shift; return die $self->_message_at_caller(@_); } =back =head2 Test Status and Info =over 4 =item B my $curr_test = $Test->current_test; $Test->current_test($num); Gets/sets the current test number we're on. You usually shouldn't have to set this. If set forward, the details of the missing tests are filled in as 'unknown'. if set backward, the details of the intervening tests are deleted. You can erase history if you really want to. =cut sub current_test { my( $self, $num ) = @_; lock( $self->{Curr_Test} ); if( defined $num ) { $self->{Curr_Test} = $num; # If the test counter is being pushed forward fill in the details. my $test_results = $self->{Test_Results}; if( $num > @$test_results ) { my $start = @$test_results ? @$test_results : 0; for( $start .. $num - 1 ) { $test_results->[$_] = &share( { 'ok' => 1, actual_ok => undef, reason => 'incrementing test number', type => 'unknown', name => undef } ); } } # If backward, wipe history. Its their funeral. elsif( $num < @$test_results ) { $#{$test_results} = $num - 1; } } return $self->{Curr_Test}; } =item B my $ok = $builder->is_passing; Indicates if the test suite is currently passing. More formally, it will be false if anything has happened which makes it impossible for the test suite to pass. True otherwise. For example, if no tests have run C will be true because even though a suite with no tests is a failure you can add a passing test to it and start passing. Don't think about it too much. =cut sub is_passing { my $self = shift; if( @_ ) { $self->{Is_Passing} = shift; } return $self->{Is_Passing}; } =item B my @tests = $Test->summary; A simple summary of the tests so far. True for pass, false for fail. This is a logical pass/fail, so todos are passes. Of course, test #1 is $tests[0], etc... =cut sub summary { my($self) = shift; return map { $_->{'ok'} } @{ $self->{Test_Results} }; } =item B
my @tests = $Test->details; Like C, but with a lot more detail. $tests[$test_num - 1] = { 'ok' => is the test considered a pass? actual_ok => did it literally say 'ok'? name => name of the test (if any) type => type of test (if any, see below). reason => reason for the above (if any) }; 'ok' is true if Test::Harness will consider the test to be a pass. 'actual_ok' is a reflection of whether or not the test literally printed 'ok' or 'not ok'. This is for examining the result of 'todo' tests. 'name' is the name of the test. 'type' indicates if it was a special test. Normal tests have a type of ''. Type can be one of the following: skip see skip() todo see todo() todo_skip see todo_skip() unknown see below Sometimes the Test::Builder test counter is incremented without it printing any test output, for example, when C is changed. In these cases, Test::Builder doesn't know the result of the test, so its type is 'unknown'. These details for these tests are filled in. They are considered ok, but the name and actual_ok is left C. For example "not ok 23 - hole count # TODO insufficient donuts" would result in this structure: $tests[22] = # 23 - 1, since arrays start from 0. { ok => 1, # logically, the test passed since its todo actual_ok => 0, # in absolute terms, it failed name => 'hole count', type => 'todo', reason => 'insufficient donuts' }; =cut sub details { my $self = shift; return @{ $self->{Test_Results} }; } =item B my $todo_reason = $Test->todo; my $todo_reason = $Test->todo($pack); If the current tests are considered "TODO" it will return the reason, if any. This reason can come from a C<$TODO> variable or the last call to C. Since a TODO test does not need a reason, this function can return an empty string even when inside a TODO block. Use C<< $Test->in_todo >> to determine if you are currently inside a TODO block. C is about finding the right package to look for C<$TODO> in. It's pretty good at guessing the right package to look at. It first looks for the caller based on C<$Level + 1>, since C is usually called inside a test function. As a last resort it will use C. Sometimes there is some confusion about where todo() should be looking for the C<$TODO> variable. If you want to be sure, tell it explicitly what $pack to use. =cut sub todo { my( $self, $pack ) = @_; return $self->{Todo} if defined $self->{Todo}; local $Level = $Level + 1; my $todo = $self->find_TODO($pack); return $todo if defined $todo; return ''; } =item B my $todo_reason = $Test->find_TODO(); my $todo_reason = $Test->find_TODO($pack); Like C but only returns the value of C<$TODO> ignoring C. Can also be used to set C<$TODO> to a new value while returning the old value: my $old_reason = $Test->find_TODO($pack, 1, $new_reason); =cut sub find_TODO { my( $self, $pack, $set, $new_value ) = @_; $pack = $pack || $self->caller(1) || $self->exported_to; return unless $pack; no strict 'refs'; ## no critic my $old_value = ${ $pack . '::TODO' }; $set and ${ $pack . '::TODO' } = $new_value; return $old_value; } =item B my $in_todo = $Test->in_todo; Returns true if the test is currently inside a TODO block. =cut sub in_todo { my $self = shift; local $Level = $Level + 1; return( defined $self->{Todo} || $self->find_TODO ) ? 1 : 0; } =item B $Test->todo_start(); $Test->todo_start($message); This method allows you declare all subsequent tests as TODO tests, up until the C method has been called. The C and C<$TODO> syntax is generally pretty good about figuring out whether or not we're in a TODO test. However, often we find that this is not possible to determine (such as when we want to use C<$TODO> but the tests are being executed in other packages which can't be inferred beforehand). Note that you can use this to nest "todo" tests $Test->todo_start('working on this'); # lots of code $Test->todo_start('working on that'); # more code $Test->todo_end; $Test->todo_end; This is generally not recommended, but large testing systems often have weird internal needs. We've tried to make this also work with the TODO: syntax, but it's not guaranteed and its use is also discouraged: TODO: { local $TODO = 'We have work to do!'; $Test->todo_start('working on this'); # lots of code $Test->todo_start('working on that'); # more code $Test->todo_end; $Test->todo_end; } Pick one style or another of "TODO" to be on the safe side. =cut sub todo_start { my $self = shift; my $message = @_ ? shift : ''; $self->{Start_Todo}++; if( $self->in_todo ) { push @{ $self->{Todo_Stack} } => $self->todo; } $self->{Todo} = $message; return; } =item C $Test->todo_end; Stops running tests as "TODO" tests. This method is fatal if called without a preceding C method call. =cut sub todo_end { my $self = shift; if( !$self->{Start_Todo} ) { $self->croak('todo_end() called without todo_start()'); } $self->{Start_Todo}--; if( $self->{Start_Todo} && @{ $self->{Todo_Stack} } ) { $self->{Todo} = pop @{ $self->{Todo_Stack} }; } else { delete $self->{Todo}; } return; } =item B my $package = $Test->caller; my($pack, $file, $line) = $Test->caller; my($pack, $file, $line) = $Test->caller($height); Like the normal C, except it reports according to your C. C<$height> will be added to the C. If C winds up off the top of the stack it report the highest context. =cut sub caller { ## no critic (Subroutines::ProhibitBuiltinHomonyms) my( $self, $height ) = @_; $height ||= 0; my $level = $self->level + $height + 1; my @caller; do { @caller = CORE::caller( $level ); $level--; } until @caller; return wantarray ? @caller : $caller[0]; } =back =cut =begin _private =over 4 =item B<_sanity_check> $self->_sanity_check(); Runs a bunch of end of test sanity checks to make sure reality came through ok. If anything is wrong it will die with a fairly friendly error message. =cut #'# sub _sanity_check { my $self = shift; $self->_whoa( $self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!' ); $self->_whoa( $self->{Curr_Test} != @{ $self->{Test_Results} }, 'Somehow you got a different number of results than tests ran!' ); return; } =item B<_whoa> $self->_whoa($check, $description); A sanity check, similar to C. If the C<$check> is true, something has gone horribly wrong. It will die with the given C<$description> and a note to contact the author. =cut sub _whoa { my( $self, $check, $desc ) = @_; if($check) { local $Level = $Level + 1; $self->croak(<<"WHOA"); WHOA! $desc This should never happen! Please contact the author immediately! WHOA } return; } =item B<_my_exit> _my_exit($exit_num); Perl seems to have some trouble with exiting inside an C block. 5.6.1 does some odd things. Instead, this function edits C<$?> directly. It should B be called from inside an C block. It doesn't actually exit, that's your job. =cut sub _my_exit { $? = $_[0]; ## no critic (Variables::RequireLocalizedPunctuationVars) return 1; } =back =end _private =cut sub _ending { my $self = shift; return if $self->no_ending; return if $self->{Ending}++; my $real_exit_code = $?; # Don't bother with an ending if this is a forked copy. Only the parent # should do the ending. if( $self->{Original_Pid} != $$ ) { return; } # Ran tests but never declared a plan or hit done_testing if( !$self->{Have_Plan} and $self->{Curr_Test} ) { $self->is_passing(0); $self->diag("Tests were run but no plan was declared and done_testing() was not seen."); } # Exit if plan() was never called. This is so "require Test::Simple" # doesn't puke. if( !$self->{Have_Plan} ) { return; } # Don't do an ending if we bailed out. if( $self->{Bailed_Out} ) { $self->is_passing(0); return; } # Figure out if we passed or failed and print helpful messages. my $test_results = $self->{Test_Results}; if(@$test_results) { # The plan? We have no plan. if( $self->{No_Plan} ) { $self->_output_plan($self->{Curr_Test}) unless $self->no_header; $self->{Expected_Tests} = $self->{Curr_Test}; } # Auto-extended arrays and elements which aren't explicitly # filled in with a shared reference will puke under 5.8.0 # ithreads. So we have to fill them in by hand. :( my $empty_result = &share( {} ); for my $idx ( 0 .. $self->{Expected_Tests} - 1 ) { $test_results->[$idx] = $empty_result unless defined $test_results->[$idx]; } my $num_failed = grep !$_->{'ok'}, @{$test_results}[ 0 .. $self->{Curr_Test} - 1 ]; my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests}; if( $num_extra != 0 ) { my $s = $self->{Expected_Tests} == 1 ? '' : 's'; $self->diag(<<"FAIL"); Looks like you planned $self->{Expected_Tests} test$s but ran $self->{Curr_Test}. FAIL $self->is_passing(0); } if($num_failed) { my $num_tests = $self->{Curr_Test}; my $s = $num_failed == 1 ? '' : 's'; my $qualifier = $num_extra == 0 ? '' : ' run'; $self->diag(<<"FAIL"); Looks like you failed $num_failed test$s of $num_tests$qualifier. FAIL $self->is_passing(0); } if($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code just after $self->{Curr_Test}. FAIL $self->is_passing(0); _my_exit($real_exit_code) && return; } my $exit_code; if($num_failed) { $exit_code = $num_failed <= 254 ? $num_failed : 254; } elsif( $num_extra != 0 ) { $exit_code = 255; } else { $exit_code = 0; } _my_exit($exit_code) && return; } elsif( $self->{Skip_All} ) { _my_exit(0) && return; } elsif($real_exit_code) { $self->diag(<<"FAIL"); Looks like your test exited with $real_exit_code before it could output anything. FAIL $self->is_passing(0); _my_exit($real_exit_code) && return; } else { $self->diag("No tests run!\n"); $self->is_passing(0); _my_exit(255) && return; } $self->is_passing(0); $self->_whoa( 1, "We fell off the end of _ending()" ); } END { $Test->_ending if defined $Test; } =head1 EXIT CODES If all your tests passed, Test::Builder will exit with zero (which is normal). If anything failed it will exit with how many failed. If you run less (or more) tests than you planned, the missing (or extras) will be considered failures. If no tests were ever run Test::Builder will throw a warning and exit with 255. If the test died, even after having successfully completed all its tests, it will still be considered a failure and will exit with 255. So the exit codes are... 0 all tests successful 255 test died or all passed but wrong # of tests run any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. =head1 THREADS In perl 5.8.1 and later, Test::Builder is thread-safe. The test number is shared amongst all threads. This means if one thread sets the test number using C they will all be effected. While versions earlier than 5.8.1 had threads they contain too many bugs to support. Test::Builder is only thread-aware if threads.pm is loaded I Test::Builder. =head1 MEMORY An informative hash, accessible via C<>, is stored for each test you perform. So memory usage will scale linearly with each test run. Although this is not a problem for most test suites, it can become an issue if you do large (hundred thousands to million) combinatorics tests in the same run. In such cases, you are advised to either split the test file into smaller ones, or use a reverse approach, doing "normal" (code) compares and triggering fail() should anything go unexpected. Future versions of Test::Builder will have a way to turn history off. =head1 EXAMPLES CPAN can provide the best examples. Test::Simple, Test::More, Test::Exception and Test::Differences all use Test::Builder. =head1 SEE ALSO Test::Simple, Test::More, Test::Harness =head1 AUTHORS Original code by chromatic, maintained by Michael G Schwern Eschwern@pobox.comE =head1 COPYRIGHT Copyright 2002-2008 by chromatic Echromatic@wgz.orgE and Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; More.pm000664001750001750 13313615111656240 17004 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Testpackage Test::More; use 5.006; use strict; use warnings; #---- perlcritic exemptions. ----# # We use a lot of subroutine prototypes ## no critic (Subroutines::ProhibitSubroutinePrototypes) # Can't use Carp because it might cause use_ok() to accidentally succeed # even though the module being used forgot to use Carp. Yes, this # actually happened. sub _carp { my( $file, $line ) = ( caller(1) )[ 1, 2 ]; return warn @_, " at $file line $line\n"; } our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok use_ok require_ok is isnt like unlike is_deeply cmp_ok skip todo todo_skip pass fail eq_array eq_hash eq_set $TODO plan done_testing can_ok isa_ok new_ok diag note explain subtest BAIL_OUT ); =head1 NAME Test::More - yet another framework for writing test scripts =head1 SYNOPSIS use Test::More tests => 23; # or use Test::More skip_all => $reason; # or use Test::More; # see done_testing() BEGIN { use_ok( 'Some::Module' ); } require_ok( 'Some::Module' ); # Various ways to say "ok" ok($got eq $expected, $test_name); is ($got, $expected, $test_name); isnt($got, $expected, $test_name); # Rather than print STDERR "# here's what went wrong\n" diag("here's what went wrong"); like ($got, qr/expected/, $test_name); unlike($got, qr/expected/, $test_name); cmp_ok($got, '==', $expected, $test_name); is_deeply($got_complex_structure, $expected_complex_structure, $test_name); SKIP: { skip $why, $how_many unless $have_some_feature; ok( foo(), $test_name ); is( foo(42), 23, $test_name ); }; TODO: { local $TODO = $why; ok( foo(), $test_name ); is( foo(42), 23, $test_name ); }; can_ok($module, @methods); isa_ok($object, $class); pass($test_name); fail($test_name); BAIL_OUT($why); # UNIMPLEMENTED!!! my @status = Test::More::status; =head1 DESCRIPTION B If you're just getting started writing tests, have a look at L first. This is a drop in replacement for Test::Simple which you can switch to once you get the hang of basic testing. The purpose of this module is to provide a wide range of testing utilities. Various ways to say "ok" with better diagnostics, facilities to skip tests, test future features and compare complicated data structures. While you can do almost anything with a simple C function, it doesn't provide good diagnostic output. =head2 I love it when a plan comes together Before anything else, you need a testing plan. This basically declares how many tests your script is going to run to protect against premature failure. The preferred way to do this is to declare a plan when you C. use Test::More tests => 23; There are cases when you will not know beforehand how many tests your script is going to run. In this case, you can declare your tests at the end. use Test::More; ... run your tests ... done_testing( $number_of_tests_run ); Sometimes you really don't know how many tests were run, or it's too difficult to calculate. In which case you can leave off $number_of_tests_run. In some cases, you'll want to completely skip an entire testing script. use Test::More skip_all => $skip_reason; Your script will declare a skip with the reason why you skipped and exit immediately with a zero (success). See L for details. If you want to control what functions Test::More will export, you have to use the 'import' option. For example, to import everything but 'fail', you'd do: use Test::More tests => 23, import => ['!fail']; Alternatively, you can use the plan() function. Useful for when you have to calculate the number of tests. use Test::More; plan tests => keys %Stuff * 3; or for deciding between running the tests at all: use Test::More; if( $^O eq 'MacOS' ) { plan skip_all => 'Test irrelevant on MacOS'; } else { plan tests => 42; } =cut sub plan { my $tb = Test::More->builder; return $tb->plan(@_); } # This implements "use Test::More 'no_diag'" but the behavior is # deprecated. sub import_extra { my $class = shift; my $list = shift; my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'no_diag' ) { $class->builder->no_diag(1); } else { push @other, $item; } $idx++; } @$list = @other; return; } =over 4 =item B done_testing(); done_testing($number_of_tests); If you don't know how many tests you're going to run, you can issue the plan when you're done running tests. $number_of_tests is the same as plan(), it's the number of tests you expected to run. You can omit this, in which case the number of tests you ran doesn't matter, just the fact that your tests ran to conclusion. This is safer than and replaces the "no_plan" plan. =back =cut sub done_testing { my $tb = Test::More->builder; $tb->done_testing(@_); } =head2 Test names By convention, each test is assigned a number in order. This is largely done automatically for you. However, it's often very useful to assign a name to each test. Which would you rather see: ok 4 not ok 5 ok 6 or ok 4 - basic multi-variable not ok 5 - simple exponential ok 6 - force == mass * acceleration The later gives you some idea of what failed. It also makes it easier to find the test in your script, simply search for "simple exponential". All test functions take a name argument. It's optional, but highly suggested that you use it. =head2 I'm ok, you're not ok. The basic purpose of this module is to print out either "ok #" or "not ok #" depending on if a given test succeeded or failed. Everything else is just gravy. All of the following print "ok" or "not ok" depending on if the test succeeded or failed. They all also return true or false, respectively. =over 4 =item B ok($got eq $expected, $test_name); This simply evaluates any expression (C<$got eq $expected> is just a simple example) and uses that to determine if the test succeeded or failed. A true expression passes, a false one fails. Very simple. For example: ok( $exp{9} == 81, 'simple exponential' ); ok( Film->can('db_Main'), 'set_db()' ); ok( $p->tests == 4, 'saw tests' ); ok( !grep !defined $_, @items, 'items populated' ); (Mnemonic: "This is ok.") $test_name is a very short description of the test that will be printed out. It makes it very easy to find a test in your script when it fails and gives others an idea of your intentions. $test_name is optional, but we B strongly encourage its use. Should an ok() fail, it will produce some diagnostics: not ok 18 - sufficient mucus # Failed test 'sufficient mucus' # in foo.t at line 42. This is the same as Test::Simple's ok() routine. =cut sub ok ($;$) { my( $test, $name ) = @_; my $tb = Test::More->builder; return $tb->ok( $test, $name ); } =item B =item B is ( $got, $expected, $test_name ); isnt( $got, $expected, $test_name ); Similar to ok(), is() and isnt() compare their two arguments with C and C respectively and use the result of that to determine if the test succeeded or failed. So these: # Is the ultimate answer 42? is( ultimate_answer(), 42, "Meaning of Life" ); # $foo isn't empty isnt( $foo, '', "Got some foo" ); are similar to these: ok( ultimate_answer() eq 42, "Meaning of Life" ); ok( $foo ne '', "Got some foo" ); C will only ever match C. So you can test a value agains C like this: is($not_defined, undef, "undefined as expected"); (Mnemonic: "This is that." "This isn't that.") So why use these? They produce better diagnostics on failure. ok() cannot know what you are testing for (beyond the name), but is() and isnt() know what the test was and why it failed. For example this test: my $foo = 'waffle'; my $bar = 'yarblokos'; is( $foo, $bar, 'Is foo the same as bar?' ); Will produce something like this: not ok 17 - Is foo the same as bar? # Failed test 'Is foo the same as bar?' # in foo.t at line 139. # got: 'waffle' # expected: 'yarblokos' So you can figure out what went wrong without rerunning the test. You are encouraged to use is() and isnt() over ok() where possible, however do not be tempted to use them to find out if something is true or false! # XXX BAD! is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' ); This does not check if C is true, it checks if it returns 1. Very different. Similar caveats exist for false and 0. In these cases, use ok(). ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' ); A simple call to isnt() usually does not provide a strong test but there are cases when you cannot say much more about a value than that it is different from some other value: new_ok $obj, "Foo"; my $clone = $obj->clone; isa_ok $obj, "Foo", "Foo->clone"; isnt $obj, $clone, "clone() produces a different object"; For those grammatical pedants out there, there's an C function which is an alias of isnt(). =cut sub is ($$;$) { my $tb = Test::More->builder; return $tb->is_eq(@_); } sub isnt ($$;$) { my $tb = Test::More->builder; return $tb->isnt_eq(@_); } *isn't = \&isnt; =item B like( $got, qr/expected/, $test_name ); Similar to ok(), like() matches $got against the regex C. So this: like($got, qr/expected/, 'this is like that'); is similar to: ok( $got =~ /expected/, 'this is like that'); (Mnemonic "This is like that".) The second argument is a regular expression. It may be given as a regex reference (i.e. C) or (for better compatibility with older perls) as a string that looks like a regex (alternative delimiters are currently not supported): like( $got, '/expected/', 'this is like that' ); Regex options may be placed on the end (C<'/expected/i'>). Its advantages over ok() are similar to that of is() and isnt(). Better diagnostics on failure. =cut sub like ($$;$) { my $tb = Test::More->builder; return $tb->like(@_); } =item B unlike( $got, qr/expected/, $test_name ); Works exactly as like(), only it checks if $got B match the given pattern. =cut sub unlike ($$;$) { my $tb = Test::More->builder; return $tb->unlike(@_); } =item B cmp_ok( $got, $op, $expected, $test_name ); Halfway between ok() and is() lies cmp_ok(). This allows you to compare two arguments using any binary perl operator. # ok( $got eq $expected ); cmp_ok( $got, 'eq', $expected, 'this eq that' ); # ok( $got == $expected ); cmp_ok( $got, '==', $expected, 'this == that' ); # ok( $got && $expected ); cmp_ok( $got, '&&', $expected, 'this && that' ); ...etc... Its advantage over ok() is when the test fails you'll know what $got and $expected were: not ok 1 # Failed test in foo.t at line 12. # '23' # && # undef It's also useful in those cases where you are comparing numbers and is()'s use of C will interfere: cmp_ok( $big_hairy_number, '==', $another_big_hairy_number ); It's especially useful when comparing greater-than or smaller-than relation between values: cmp_ok( $some_value, '<=', $upper_limit ); =cut sub cmp_ok($$$;$) { my $tb = Test::More->builder; return $tb->cmp_ok(@_); } =item B can_ok($module, @methods); can_ok($object, @methods); Checks to make sure the $module or $object can do these @methods (works with functions, too). can_ok('Foo', qw(this that whatever)); is almost exactly like saying: ok( Foo->can('this') && Foo->can('that') && Foo->can('whatever') ); only without all the typing and with a better interface. Handy for quickly testing an interface. No matter how many @methods you check, a single can_ok() call counts as one test. If you desire otherwise, use: foreach my $meth (@methods) { can_ok('Foo', $meth); } =cut sub can_ok ($@) { my( $proto, @methods ) = @_; my $class = ref $proto || $proto; my $tb = Test::More->builder; unless($class) { my $ok = $tb->ok( 0, "->can(...)" ); $tb->diag(' can_ok() called with empty class or reference'); return $ok; } unless(@methods) { my $ok = $tb->ok( 0, "$class->can(...)" ); $tb->diag(' can_ok() called with no methods'); return $ok; } my @nok = (); foreach my $method (@methods) { $tb->_try( sub { $proto->can($method) } ) or push @nok, $method; } my $name = (@methods == 1) ? "$class->can('$methods[0]')" : "$class->can(...)" ; my $ok = $tb->ok( !@nok, $name ); $tb->diag( map " $class->can('$_') failed\n", @nok ); return $ok; } =item B isa_ok($object, $class, $object_name); isa_ok($subclass, $class, $object_name); isa_ok($ref, $type, $ref_name); Checks to see if the given C<< $object->isa($class) >>. Also checks to make sure the object was defined in the first place. Handy for this sort of thing: my $obj = Some::Module->new; isa_ok( $obj, 'Some::Module' ); where you'd otherwise have to write my $obj = Some::Module->new; ok( defined $obj && $obj->isa('Some::Module') ); to safeguard against your test script blowing up. You can also test a class, to make sure that it has the right ancestor: isa_ok( 'Vole', 'Rodent' ); It works on references, too: isa_ok( $array_ref, 'ARRAY' ); The diagnostics of this test normally just refer to 'the object'. If you'd like them to be more specific, you can supply an $object_name (for example 'Test customer'). =cut sub isa_ok ($$;$) { my( $object, $class, $obj_name ) = @_; my $tb = Test::More->builder; my $diag; if( !defined $object ) { $obj_name = 'The thing' unless defined $obj_name; $diag = "$obj_name isn't defined"; } else { my $whatami = ref $object ? 'object' : 'class'; # We can't use UNIVERSAL::isa because we want to honor isa() overrides my( $rslt, $error ) = $tb->_try( sub { $object->isa($class) } ); if($error) { if( $error =~ /^Can't call method "isa" on unblessed reference/ ) { # Its an unblessed reference $obj_name = 'The reference' unless defined $obj_name; if( !UNIVERSAL::isa( $object, $class ) ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } elsif( $error =~ /Can't call method "isa" without a package/ ) { # It's something that can't even be a class $obj_name = 'The thing' unless defined $obj_name; $diag = "$obj_name isn't a class or reference"; } else { die <isa on your $whatami and got some weird error. Here's the error. $error WHOA } } else { $obj_name = "The $whatami" unless defined $obj_name; if( !$rslt ) { my $ref = ref $object; $diag = "$obj_name isn't a '$class' it's a '$ref'"; } } } my $name = "$obj_name isa $class"; my $ok; if($diag) { $ok = $tb->ok( 0, $name ); $tb->diag(" $diag\n"); } else { $ok = $tb->ok( 1, $name ); } return $ok; } =item B my $obj = new_ok( $class ); my $obj = new_ok( $class => \@args ); my $obj = new_ok( $class => \@args, $object_name ); A convenience function which combines creating an object and calling isa_ok() on that object. It is basically equivalent to: my $obj = $class->new(@args); isa_ok $obj, $class, $object_name; If @args is not given, an empty list will be used. This function only works on new() and it assumes new() will return just a single object which isa C<$class>. =cut sub new_ok { my $tb = Test::More->builder; $tb->croak("new_ok() must be given at least a class") unless @_; my( $class, $args, $object_name ) = @_; $args ||= []; $object_name = "The object" unless defined $object_name; my $obj; my( $success, $error ) = $tb->_try( sub { $obj = $class->new(@$args); 1 } ); if($success) { local $Test::Builder::Level = $Test::Builder::Level + 1; isa_ok $obj, $class, $object_name; } else { $tb->ok( 0, "new() died" ); $tb->diag(" Error was: $error"); } return $obj; } =item B subtest $name => \&code; subtest() runs the &code as its own little test with its own plan and its own result. The main test counts this as a single test using the result of the whole subtest to determine if its ok or not ok. For example... use Test::More tests => 3; pass("First test"); subtest 'An example subtest' => sub { plan tests => 2; pass("This is a subtest"); pass("So is this"); }; pass("Third test"); This would produce. 1..3 ok 1 - First test 1..2 ok 1 - This is a subtest ok 2 - So is this ok 2 - An example subtest ok 3 - Third test A subtest may call "skip_all". No tests will be run, but the subtest is considered a skip. subtest 'skippy' => sub { plan skip_all => 'cuz I said so'; pass('this test will never be run'); }; Returns true if the subtest passed, false otherwise. Due to how subtests work, you may omit a plan if you desire. This adds an implicit C to the end of your subtest. The following two subtests are equivalent: subtest 'subtest with implicit done_testing()', sub { ok 1, 'subtests with an implicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; }; subtest 'subtest with explicit done_testing()', sub { ok 1, 'subtests with an explicit done testing should work'; ok 1, '... and support more than one test'; ok 1, '... no matter how many tests are run'; done_testing(); }; =cut sub subtest { my ($name, $subtests) = @_; my $tb = Test::More->builder; return $tb->subtest(@_); } =item B =item B pass($test_name); fail($test_name); Sometimes you just want to say that the tests have passed. Usually the case is you've got some complicated condition that is difficult to wedge into an ok(). In this case, you can simply use pass() (to declare the test ok) or fail (for not ok). They are synonyms for ok(1) and ok(0). Use these very, very, very sparingly. =cut sub pass (;$) { my $tb = Test::More->builder; return $tb->ok( 1, @_ ); } sub fail (;$) { my $tb = Test::More->builder; return $tb->ok( 0, @_ ); } =back =head2 Module tests You usually want to test if the module you're testing loads ok, rather than just vomiting if its load fails. For such purposes we have C and C. =over 4 =item B BEGIN { use_ok($module); } BEGIN { use_ok($module, @imports); } These simply use the given $module and test to make sure the load happened ok. It's recommended that you run use_ok() inside a BEGIN block so its functions are exported at compile-time and prototypes are properly honored. If @imports are given, they are passed through to the use. So this: BEGIN { use_ok('Some::Module', qw(foo bar)) } is like doing this: use Some::Module qw(foo bar); Version numbers can be checked like so: # Just like "use Some::Module 1.02" BEGIN { use_ok('Some::Module', 1.02) } Don't try to do this: BEGIN { use_ok('Some::Module'); ...some code that depends on the use... ...happening at compile time... } because the notion of "compile-time" is relative. Instead, you want: BEGIN { use_ok('Some::Module') } BEGIN { ...some code that depends on the use... } If you want the equivalent of C, use a module but not import anything, use C. BEGIN { require_ok "Foo" } =cut sub use_ok ($;@) { my( $module, @imports ) = @_; @imports = () unless @imports; my $tb = Test::More->builder; my( $pack, $filename, $line ) = caller; my $code; if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) { # probably a version check. Perl needs to see the bare number # for it to work with non-Exporter based modules. $code = <ok( $eval_result, "use $module;" ); unless($ok) { chomp $eval_error; $@ =~ s{^BEGIN failed--compilation aborted at .*$} {BEGIN failed--compilation aborted at $filename line $line.}m; $tb->diag(< require_ok($module); require_ok($file); Like use_ok(), except it requires the $module or $file. =cut sub require_ok ($) { my($module) = shift; my $tb = Test::More->builder; my $pack = caller; # Try to determine if we've been given a module name or file. # Module names must be barewords, files not. $module = qq['$module'] unless _is_module_name($module); my $code = <ok( $eval_result, "require $module;" ); unless($ok) { chomp $eval_error; $tb->diag(< I'm not quite sure what will happen with filehandles. =over 4 =item B is_deeply( $got, $expected, $test_name ); Similar to is(), except that if $got and $expected are references, it does a deep comparison walking each data structure to see if they are equivalent. If the two structures are different, it will display the place where they start differing. is_deeply() compares the dereferenced values of references, the references themselves (except for their type) are ignored. This means aspects such as blessing and ties are not considered "different". is_deeply() currently has very limited handling of function reference and globs. It merely checks if they have the same referent. This may improve in the future. L and L provide more in-depth functionality along these lines. =cut our( @Data_Stack, %Refs_Seen ); my $DNE = bless [], 'Does::Not::Exist'; sub _dne { return ref $_[0] eq ref $DNE; } ## no critic (Subroutines::RequireArgUnpacking) sub is_deeply { my $tb = Test::More->builder; unless( @_ == 2 or @_ == 3 ) { my $msg = <<'WARNING'; is_deeply() takes two or three args, you gave %d. This usually means you passed an array or hash instead of a reference to it WARNING chop $msg; # clip off newline so carp() will put in line/file _carp sprintf $msg, scalar @_; return $tb->ok(0); } my( $got, $expected, $name ) = @_; $tb->_unoverload_str( \$expected, \$got ); my $ok; if( !ref $got and !ref $expected ) { # neither is a reference $ok = $tb->is_eq( $got, $expected, $name ); } elsif( !ref $got xor !ref $expected ) { # one's a reference, one isn't $ok = $tb->ok( 0, $name ); $tb->diag( _format_stack({ vals => [ $got, $expected ] }) ); } else { # both references local @Data_Stack = (); if( _deep_check( $got, $expected ) ) { $ok = $tb->ok( 1, $name ); } else { $ok = $tb->ok( 0, $name ); $tb->diag( _format_stack(@Data_Stack) ); } } return $ok; } sub _format_stack { my(@Stack) = @_; my $var = '$FOO'; my $did_arrow = 0; foreach my $entry (@Stack) { my $type = $entry->{type} || ''; my $idx = $entry->{'idx'}; if( $type eq 'HASH' ) { $var .= "->" unless $did_arrow++; $var .= "{$idx}"; } elsif( $type eq 'ARRAY' ) { $var .= "->" unless $did_arrow++; $var .= "[$idx]"; } elsif( $type eq 'REF' ) { $var = "\${$var}"; } } my @vals = @{ $Stack[-1]{vals} }[ 0, 1 ]; my @vars = (); ( $vars[0] = $var ) =~ s/\$FOO/ \$got/; ( $vars[1] = $var ) =~ s/\$FOO/\$expected/; my $out = "Structures begin differing at:\n"; foreach my $idx ( 0 .. $#vals ) { my $val = $vals[$idx]; $vals[$idx] = !defined $val ? 'undef' : _dne($val) ? "Does not exist" : ref $val ? "$val" : "'$val'"; } $out .= "$vars[0] = $vals[0]\n"; $out .= "$vars[1] = $vals[1]\n"; $out =~ s/^/ /msg; return $out; } sub _type { my $thing = shift; return '' if !ref $thing; for my $type (qw(Regexp ARRAY HASH REF SCALAR GLOB CODE)) { return $type if UNIVERSAL::isa( $thing, $type ); } return ''; } =back =head2 Diagnostics If you pick the right test function, you'll usually get a good idea of what went wrong when it failed. But sometimes it doesn't work out that way. So here we have ways for you to write your own diagnostic messages which are safer than just C. =over 4 =item B diag(@diagnostic_message); Prints a diagnostic message which is guaranteed not to interfere with test output. Like C @diagnostic_message is simply concatenated together. Returns false, so as to preserve failure. Handy for this sort of thing: ok( grep(/foo/, @users), "There's a foo user" ) or diag("Since there's no foo, check that /etc/bar is set up right"); which would produce: not ok 42 - There's a foo user # Failed test 'There's a foo user' # in foo.t at line 52. # Since there's no foo, check that /etc/bar is set up right. You might remember C with the mnemonic C. B The exact formatting of the diagnostic output is still changing, but it is guaranteed that whatever you throw at it it won't interfere with the test. =item B note(@diagnostic_message); Like diag(), except the message will not be seen when the test is run in a harness. It will only be visible in the verbose TAP stream. Handy for putting in notes which might be useful for debugging, but don't indicate a problem. note("Tempfile is $tempfile"); =cut sub diag { return Test::More->builder->diag(@_); } sub note { return Test::More->builder->note(@_); } =item B my @dump = explain @diagnostic_message; Will dump the contents of any references in a human readable format. Usually you want to pass this into C or C. Handy for things like... is_deeply($have, $want) || diag explain $have; or note explain \%args; Some::Class->method(%args); =cut sub explain { return Test::More->builder->explain(@_); } =back =head2 Conditional tests Sometimes running a test under certain conditions will cause the test script to die. A certain function or method isn't implemented (such as fork() on MacOS), some resource isn't available (like a net connection) or a module isn't available. In these cases it's necessary to skip tests, or declare that they are supposed to fail but will work in the future (a todo test). For more details on the mechanics of skip and todo tests see L. The way Test::More handles this is with a named block. Basically, a block of tests which can be skipped over or made todo. It's best if I just show you... =over 4 =item B SKIP: { skip $why, $how_many if $condition; ...normal testing code goes here... } This declares a block of tests that might be skipped, $how_many tests there are, $why and under what $condition to skip them. An example is the easiest way to illustrate: SKIP: { eval { require HTML::Lint }; skip "HTML::Lint not installed", 2 if $@; my $lint = new HTML::Lint; isa_ok( $lint, "HTML::Lint" ); $lint->parse( $html ); is( $lint->errors, 0, "No errors found in HTML" ); } If the user does not have HTML::Lint installed, the whole block of code I. Test::More will output special ok's which Test::Harness interprets as skipped, but passing, tests. It's important that $how_many accurately reflects the number of tests in the SKIP block so the # of tests run will match up with your plan. If your plan is C $how_many is optional and will default to 1. It's perfectly safe to nest SKIP blocks. Each SKIP block must have the label C, or Test::More can't work its magic. You don't skip tests which are failing because there's a bug in your program, or for which you don't yet have code written. For that you use TODO. Read on. =cut ## no critic (Subroutines::RequireFinalReturn) sub skip { my( $why, $how_many ) = @_; my $tb = Test::More->builder; unless( defined $how_many ) { # $how_many can only be avoided when no_plan is in use. _carp "skip() needs to know \$how_many tests are in the block" unless $tb->has_plan eq 'no_plan'; $how_many = 1; } if( defined $how_many and $how_many =~ /\D/ ) { _carp "skip() was passed a non-numeric number of tests. Did you get the arguments backwards?"; $how_many = 1; } for( 1 .. $how_many ) { $tb->skip($why); } no warnings 'exiting'; last SKIP; } =item B TODO: { local $TODO = $why if $condition; ...normal testing code goes here... } Declares a block of tests you expect to fail and $why. Perhaps it's because you haven't fixed a bug or haven't finished a new feature: TODO: { local $TODO = "URI::Geller not finished"; my $card = "Eight of clubs"; is( URI::Geller->your_card, $card, 'Is THIS your card?' ); my $spoon; URI::Geller->bend_spoon; is( $spoon, 'bent', "Spoon bending, that's original" ); } With a todo block, the tests inside are expected to fail. Test::More will run the tests normally, but print out special flags indicating they are "todo". Test::Harness will interpret failures as being ok. Should anything succeed, it will report it as an unexpected success. You then know the thing you had todo is done and can remove the TODO flag. The nice part about todo tests, as opposed to simply commenting out a block of tests, is it's like having a programmatic todo list. You know how much work is left to be done, you're aware of what bugs there are, and you'll know immediately when they're fixed. Once a todo test starts succeeding, simply move it outside the block. When the block is empty, delete it. =item B TODO: { todo_skip $why, $how_many if $condition; ...normal testing code... } With todo tests, it's best to have the tests actually run. That way you'll know when they start passing. Sometimes this isn't possible. Often a failing test will cause the whole program to die or hang, even inside an C with and using C. In these extreme cases you have no choice but to skip over the broken tests entirely. The syntax and behavior is similar to a C except the tests will be marked as failing but todo. Test::Harness will interpret them as passing. =cut sub todo_skip { my( $why, $how_many ) = @_; my $tb = Test::More->builder; unless( defined $how_many ) { # $how_many can only be avoided when no_plan is in use. _carp "todo_skip() needs to know \$how_many tests are in the block" unless $tb->has_plan eq 'no_plan'; $how_many = 1; } for( 1 .. $how_many ) { $tb->todo_skip($why); } no warnings 'exiting'; last TODO; } =item When do I use SKIP vs. TODO? B, use SKIP. This includes optional modules that aren't installed, running under an OS that doesn't have some feature (like fork() or symlinks), or maybe you need an Internet connection and one isn't available. B, use TODO. This is for any code you haven't written yet, or bugs you have yet to fix, but want to put tests in your testing script (always a good idea). =back =head2 Test control =over 4 =item B BAIL_OUT($reason); Indicates to the harness that things are going so badly all testing should terminate. This includes the running of any additional test scripts. This is typically used when testing cannot continue such as a critical module failing to compile or a necessary external utility not being available such as a database connection failing. The test will exit with 255. For even better control look at L. =cut sub BAIL_OUT { my $reason = shift; my $tb = Test::More->builder; $tb->BAIL_OUT($reason); } =back =head2 Discouraged comparison functions The use of the following functions is discouraged as they are not actually testing functions and produce no diagnostics to help figure out what went wrong. They were written before is_deeply() existed because I couldn't figure out how to display a useful diff of two arbitrary data structures. These functions are usually used inside an ok(). ok( eq_array(\@got, \@expected) ); C can do that better and with diagnostics. is_deeply( \@got, \@expected ); They may be deprecated in future versions. =over 4 =item B my $is_eq = eq_array(\@got, \@expected); Checks if two arrays are equivalent. This is a deep check, so multi-level structures are handled correctly. =cut #'# sub eq_array { local @Data_Stack = (); _deep_check(@_); } sub _eq_array { my( $a1, $a2 ) = @_; if( grep _type($_) ne 'ARRAY', $a1, $a2 ) { warn "eq_array passed a non-array ref"; return 0; } return 1 if $a1 eq $a2; my $ok = 1; my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2; for( 0 .. $max ) { my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_]; my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_]; next if _equal_nonrefs($e1, $e2); push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [ $e1, $e2 ] }; $ok = _deep_check( $e1, $e2 ); pop @Data_Stack if $ok; last unless $ok; } return $ok; } sub _equal_nonrefs { my( $e1, $e2 ) = @_; return if ref $e1 or ref $e2; if ( defined $e1 ) { return 1 if defined $e2 and $e1 eq $e2; } else { return 1 if !defined $e2; } return; } sub _deep_check { my( $e1, $e2 ) = @_; my $tb = Test::More->builder; my $ok = 0; # Effectively turn %Refs_Seen into a stack. This avoids picking up # the same referenced used twice (such as [\$a, \$a]) to be considered # circular. local %Refs_Seen = %Refs_Seen; { $tb->_unoverload_str( \$e1, \$e2 ); # Either they're both references or both not. my $same_ref = !( !ref $e1 xor !ref $e2 ); my $not_ref = ( !ref $e1 and !ref $e2 ); if( defined $e1 xor defined $e2 ) { $ok = 0; } elsif( !defined $e1 and !defined $e2 ) { # Shortcut if they're both undefined. $ok = 1; } elsif( _dne($e1) xor _dne($e2) ) { $ok = 0; } elsif( $same_ref and( $e1 eq $e2 ) ) { $ok = 1; } elsif($not_ref) { push @Data_Stack, { type => '', vals => [ $e1, $e2 ] }; $ok = 0; } else { if( $Refs_Seen{$e1} ) { return $Refs_Seen{$e1} eq $e2; } else { $Refs_Seen{$e1} = "$e2"; } my $type = _type($e1); $type = 'DIFFERENT' unless _type($e2) eq $type; if( $type eq 'DIFFERENT' ) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = 0; } elsif( $type eq 'ARRAY' ) { $ok = _eq_array( $e1, $e2 ); } elsif( $type eq 'HASH' ) { $ok = _eq_hash( $e1, $e2 ); } elsif( $type eq 'REF' ) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = _deep_check( $$e1, $$e2 ); pop @Data_Stack if $ok; } elsif( $type eq 'SCALAR' ) { push @Data_Stack, { type => 'REF', vals => [ $e1, $e2 ] }; $ok = _deep_check( $$e1, $$e2 ); pop @Data_Stack if $ok; } elsif($type) { push @Data_Stack, { type => $type, vals => [ $e1, $e2 ] }; $ok = 0; } else { _whoa( 1, "No type in _deep_check" ); } } } return $ok; } sub _whoa { my( $check, $desc ) = @_; if($check) { die <<"WHOA"; WHOA! $desc This should never happen! Please contact the author immediately! WHOA } } =item B my $is_eq = eq_hash(\%got, \%expected); Determines if the two hashes contain the same keys and values. This is a deep check. =cut sub eq_hash { local @Data_Stack = (); return _deep_check(@_); } sub _eq_hash { my( $a1, $a2 ) = @_; if( grep _type($_) ne 'HASH', $a1, $a2 ) { warn "eq_hash passed a non-hash ref"; return 0; } return 1 if $a1 eq $a2; my $ok = 1; my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2; foreach my $k ( keys %$bigger ) { my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE; my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE; next if _equal_nonrefs($e1, $e2); push @Data_Stack, { type => 'HASH', idx => $k, vals => [ $e1, $e2 ] }; $ok = _deep_check( $e1, $e2 ); pop @Data_Stack if $ok; last unless $ok; } return $ok; } =item B my $is_eq = eq_set(\@got, \@expected); Similar to eq_array(), except the order of the elements is B important. This is a deep check, but the irrelevancy of order only applies to the top level. ok( eq_set(\@got, \@expected) ); Is better written: is_deeply( [sort @got], [sort @expected] ); B By historical accident, this is not a true set comparison. While the order of elements does not matter, duplicate elements do. B eq_set() does not know how to deal with references at the top level. The following is an example of a comparison which might not work: eq_set([\1, \2], [\2, \1]); L contains much better set comparison functions. =cut sub eq_set { my( $a1, $a2 ) = @_; return 0 unless @$a1 == @$a2; no warnings 'uninitialized'; # It really doesn't matter how we sort them, as long as both arrays are # sorted with the same algorithm. # # Ensure that references are not accidentally treated the same as a # string containing the reference. # # Have to inline the sort routine due to a threading/sort bug. # See [rt.cpan.org 6782] # # I don't know how references would be sorted so we just don't sort # them. This means eq_set doesn't really work with refs. return eq_array( [ grep( ref, @$a1 ), sort( grep( !ref, @$a1 ) ) ], [ grep( ref, @$a2 ), sort( grep( !ref, @$a2 ) ) ], ); } =back =head2 Extending and Embedding Test::More Sometimes the Test::More interface isn't quite enough. Fortunately, Test::More is built on top of Test::Builder which provides a single, unified backend for any test library to use. This means two test libraries which both use Test::Builder B. If you simply want to do a little tweaking of how the tests behave, you can access the underlying Test::Builder object like so: =over 4 =item B my $test_builder = Test::More->builder; Returns the Test::Builder object underlying Test::More for you to play with. =back =head1 EXIT CODES If all your tests passed, Test::Builder will exit with zero (which is normal). If anything failed it will exit with how many failed. If you run less (or more) tests than you planned, the missing (or extras) will be considered failures. If no tests were ever run Test::Builder will throw a warning and exit with 255. If the test died, even after having successfully completed all its tests, it will still be considered a failure and will exit with 255. So the exit codes are... 0 all tests successful 255 test died or all passed but wrong # of tests run any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. B This behavior may go away in future versions. =head1 CAVEATS and NOTES =over 4 =item Backwards compatibility Test::More works with Perls as old as 5.6.0. =item utf8 / "Wide character in print" If you use utf8 or other non-ASCII characters with Test::More you might get a "Wide character in print" warning. Using C will not fix it. Test::Builder (which powers Test::More) duplicates STDOUT and STDERR. So any changes to them, including changing their output disciplines, will not be seem by Test::More. The work around is to change the filehandles used by Test::Builder directly. my $builder = Test::More->builder; binmode $builder->output, ":utf8"; binmode $builder->failure_output, ":utf8"; binmode $builder->todo_output, ":utf8"; =item Overloaded objects String overloaded objects are compared B (or in cmp_ok()'s case, strings or numbers as appropriate to the comparison op). This prevents Test::More from piercing an object's interface allowing better blackbox testing. So if a function starts returning overloaded objects instead of bare strings your tests won't notice the difference. This is good. However, it does mean that functions like is_deeply() cannot be used to test the internals of string overloaded objects. In this case I would suggest L which contains more flexible testing functions for complex data structures. =item Threads Test::More will only be aware of threads if "use threads" has been done I Test::More is loaded. This is ok: use threads; use Test::More; This may cause problems: use Test::More use threads; 5.8.1 and above are supported. Anything below that has too many bugs. =back =head1 HISTORY This is a case of convergent evolution with Joshua Pritikin's Test module. I was largely unaware of its existence when I'd first written my own ok() routines. This module exists because I can't figure out how to easily wedge test names into Test's interface (along with a few other problems). The goal here is to have a testing utility that's simple to learn, quick to use and difficult to trip yourself up with while still providing more flexibility than the existing Test.pm. As such, the names of the most common routines are kept tiny, special cases and magic side-effects are kept to a minimum. WYSIWYG. =head1 SEE ALSO L if all this confuses you and you just want to write some tests. You can upgrade to Test::More later (it's forward compatible). L is the test runner and output interpreter for Perl. It's the thing that powers C and where the C utility comes from. L tests written with Test.pm, the original testing module, do not play well with other testing libraries. Test::Legacy emulates the Test.pm interface and does play well with others. L for more ways to test complex data structures. And it plays well with Test::More. L is like xUnit but more perlish. L gives you more powerful complex data structure testing. L shows the idea of embedded testing. L installs a whole bunch of useful test modules. =head1 AUTHORS Michael G Schwern Eschwern@pobox.comE with much inspiration from Joshua Pritikin's Test module and lots of help from Barrie Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and the perl-qa gang. =head1 BUGS See F to report and view bugs. =head1 SOURCE The source code repository for Test::More can be found at F. =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Simple.pm000664001750001750 1447615111656240 17320 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Testpackage Test::Simple; use 5.006; use strict; our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); our @EXPORT = qw(ok); my $CLASS = __PACKAGE__; =head1 NAME Test::Simple - Basic utilities for writing tests. =head1 SYNOPSIS use Test::Simple tests => 1; ok( $foo eq $bar, 'foo is bar' ); =head1 DESCRIPTION ** If you are unfamiliar with testing B first! ** This is an extremely simple, extremely basic module for writing tests suitable for CPAN modules and other pursuits. If you wish to do more complicated testing, use the Test::More module (a drop-in replacement for this one). The basic unit of Perl testing is the ok. For each thing you want to test your program will print out an "ok" or "not ok" to indicate pass or fail. You do this with the ok() function (see below). The only other constraint is you must pre-declare how many tests you plan to run. This is in case something goes horribly wrong during the test and your test program aborts, or skips a test or whatever. You do this like so: use Test::Simple tests => 23; You must have a plan. =over 4 =item B ok( $foo eq $bar, $name ); ok( $foo eq $bar ); ok() is given an expression (in this case C<$foo eq $bar>). If it's true, the test passed. If it's false, it didn't. That's about it. ok() prints out either "ok" or "not ok" along with a test number (it keeps track of that for you). # This produces "ok 1 - Hell not yet frozen over" (or not ok) ok( get_temperature($hell) > 0, 'Hell not yet frozen over' ); If you provide a $name, that will be printed along with the "ok/not ok" to make it easier to find your test when if fails (just search for the name). It also makes it easier for the next guy to understand what your test is for. It's highly recommended you use test names. All tests are run in scalar context. So this: ok( @stuff, 'I have some stuff' ); will do what you mean (fail if stuff is empty) =cut sub ok ($;$) { ## no critic (Subroutines::ProhibitSubroutinePrototypes) return $CLASS->builder->ok(@_); } =back Test::Simple will start by printing number of tests run in the form "1..M" (so "1..5" means you're going to run 5 tests). This strange format lets Test::Harness know how many tests you plan on running in case something goes horribly wrong. If all your tests passed, Test::Simple will exit with zero (which is normal). If anything failed it will exit with how many failed. If you run less (or more) tests than you planned, the missing (or extras) will be considered failures. If no tests were ever run Test::Simple will throw a warning and exit with 255. If the test died, even after having successfully completed all its tests, it will still be considered a failure and will exit with 255. So the exit codes are... 0 all tests successful 255 test died or all passed but wrong # of tests run any other number how many failed (including missing or extras) If you fail more than 254 tests, it will be reported as 254. This module is by no means trying to be a complete testing system. It's just to get you started. Once you're off the ground its recommended you look at L. =head1 EXAMPLE Here's an example of a simple .t file for the fictional Film module. use Test::Simple tests => 5; use Film; # What you're testing. my $btaste = Film->new({ Title => 'Bad Taste', Director => 'Peter Jackson', Rating => 'R', NumExplodingSheep => 1 }); ok( defined($btaste) && ref $btaste eq 'Film', 'new() works' ); ok( $btaste->Title eq 'Bad Taste', 'Title() get' ); ok( $btaste->Director eq 'Peter Jackson', 'Director() get' ); ok( $btaste->Rating eq 'R', 'Rating() get' ); ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' ); It will produce output like this: 1..5 ok 1 - new() works ok 2 - Title() get ok 3 - Director() get not ok 4 - Rating() get # Failed test 'Rating() get' # in t/film.t at line 14. ok 5 - NumExplodingSheep() get # Looks like you failed 1 tests of 5 Indicating the Film::Rating() method is broken. =head1 CAVEATS Test::Simple will only report a maximum of 254 failures in its exit code. If this is a problem, you probably have a huge test script. Split it into multiple files. (Otherwise blame the Unix folks for using an unsigned short integer as the exit status). Because VMS's exit codes are much, much different than the rest of the universe, and perl does horrible mangling to them that gets in my way, it works like this on VMS. 0 SS$_NORMAL all tests successful 4 SS$_ABORT something went wrong Unfortunately, I can't differentiate any further. =head1 NOTES Test::Simple is B tested all the way back to perl 5.6.0. Test::Simple is thread-safe in perl 5.8.1 and up. =head1 HISTORY This module was conceived while talking with Tony Bowden in his kitchen one night about the problems I was having writing some really complicated feature into the new Testing module. He observed that the main problem is not dealing with these edge cases but that people hate to write tests B. What was needed was a dead simple module that took all the hard work out of testing and was really, really easy to learn. Paul Johnson simultaneously had this idea (unfortunately, he wasn't in Tony's kitchen). This is it. =head1 SEE ALSO =over 4 =item L More testing functions! Once you outgrow Test::Simple, look at Test::More. Test::Simple is 100% forward compatible with Test::More (i.e. you can just use Test::More instead of Test::Simple in your programs and things will still work). =back Look in Test::More's SEE ALSO for more testing modules. =head1 AUTHORS Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern Eschwern@pobox.comE, wardrobe by Calvin Klein. =head1 COPYRIGHT Copyright 2001-2008 by Michael G Schwern Eschwern@pobox.comE. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F =cut 1; Perl58Compat.pm000664001750001750 67515111656240 20556 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Devel/TypeTiny# INTERNAL MODULE: Perl 5.8 compatibility for Type::Tiny. package Devel::TypeTiny::Perl58Compat; use 5.008; use strict; use warnings; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.008006'; $VERSION =~ tr/_//d; #### re doesn't provide is_regexp in Perl < 5.10 eval 'require re'; unless ( exists &re::is_regexp ) { require B; *re::is_regexp = sub { eval { B::svref_2object( $_[0] )->MAGIC->TYPE eq 'r' }; }; } #### Done! 5.8; Assertion.pm000664001750001750 1171415111656240 20370 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Error/TypeTinypackage Error::TypeTiny::Assertion; use 5.008001; use strict; use warnings; BEGIN { $Error::TypeTiny::Assertion::AUTHORITY = 'cpan:TOBYINK'; $Error::TypeTiny::Assertion::VERSION = '2.008006'; } $Error::TypeTiny::Assertion::VERSION =~ tr/_//d; require Error::TypeTiny; our @ISA = 'Error::TypeTiny'; sub type { $_[0]{type} } sub value { $_[0]{value} } sub varname { $_[0]{varname} ||= '$_' } sub attribute_step { $_[0]{attribute_step} } sub attribute_name { $_[0]{attribute_name} } sub has_type { defined $_[0]{type} }; # sic sub has_attribute_step { exists $_[0]{attribute_step} } sub has_attribute_name { exists $_[0]{attribute_name} } sub new { my $class = shift; my $self = $class->SUPER::new( @_ ); # Supported but undocumented parameter is `mgaca`. # This indicates whether Error::TypeTiny::Assertion # should attempt to figure out which attribute caused # the error from Method::Generate::Accessor's info. # Can be set to true/false or not set. If not set, # the current behaviour is true, but this may change # in the future. If set to false, will ignore the # $Method::Generate::Accessor::CurrentAttribute hashref. # if ( ref $Method::Generate::Accessor::CurrentAttribute and $self->{mgaca} || !exists $self->{mgaca} ) { require B; my %d = %{$Method::Generate::Accessor::CurrentAttribute}; $self->{attribute_name} = $d{name} if defined $d{name}; $self->{attribute_step} = $d{step} if defined $d{step}; if ( defined $d{init_arg} ) { $self->{varname} = sprintf( '$args->{%s}', B::perlstring( $d{init_arg} ) ); } elsif ( defined $d{name} ) { $self->{varname} = sprintf( '$self->{%s}', B::perlstring( $d{name} ) ); } } #/ if ( ref $Method::Generate::Accessor::CurrentAttribute...) return $self; } #/ sub new sub message { my $e = shift; $e->varname eq '$_' ? $e->SUPER::message : sprintf( '%s (in %s)', $e->SUPER::message, $e->varname ); } sub _build_message { my $e = shift; $e->has_type ? sprintf( '%s did not pass type constraint "%s"', Type::Tiny::_dd( $e->value ), $e->type ) : sprintf( '%s did not pass type constraint', Type::Tiny::_dd( $e->value ) ); } #/ sub _build_message *to_string = sub { my $e = shift; my $msg = $e->message; my $c = $e->context; $msg .= sprintf( " at %s line %s", $c->{file} || 'file?', $c->{line} || 'NaN' ) if $c; my $explain = $e->explain; return "$msg\n" unless @{ $explain || [] }; $msg .= "\n"; for my $line ( @$explain ) { $msg .= " $line\n"; } return $msg; } if $] >= 5.008; sub explain { my $e = shift; return undef unless $e->has_type; $e->type->validate_explain( $e->value, $e->varname ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Error::TypeTiny::Assertion - exception when a value fails a type constraint =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This exception is thrown when a value fails a type constraint assertion. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The type constraint that was checked against. Weakened links are involved, so this may end up being C. =item C The value that was tested. =item C The name of the variable that was checked, if known. Defaults to C<< '$_' >>. =item C If this exception was thrown as the result of an isa check or a failed coercion for a Moo attribute, then this will tell you which attribute (if your Moo is new enough). (Hopefully one day this will support other OO frameworks.) =item C If this exception was thrown as the result of an isa check or a failed coercion for a Moo attribute, then this will contain either C<< "isa check" >> or C<< "coercion" >> to indicate which went wrong (if your Moo is new enough). (Hopefully one day this will support other OO frameworks.) =back =head2 Methods =over =item C, C, C Predicate methods. =item C Overridden to add C to the message if defined. =item C Attempts to explain why the value did not pass the type constraint. Returns an arrayref of strings providing step-by-step reasoning; or returns undef if no explanation is possible. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Compilation.pm000664001750001750 357415111656240 20664 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Error/TypeTinypackage Error::TypeTiny::Compilation; use 5.008001; use strict; use warnings; BEGIN { $Error::TypeTiny::Compilation::AUTHORITY = 'cpan:TOBYINK'; $Error::TypeTiny::Compilation::VERSION = '2.008006'; } $Error::TypeTiny::Compilation::VERSION =~ tr/_//d; require Error::TypeTiny; our @ISA = 'Error::TypeTiny'; sub code { $_[0]{code} } sub environment { $_[0]{environment} ||= {} } sub errstr { $_[0]{errstr} } sub _build_message { my $self = shift; sprintf( "Failed to compile source because: %s", $self->errstr ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Error::TypeTiny::Compilation - exception for Eval::TypeTiny =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Thrown when compiling a closure fails. Common causes are problems with inlined type constraints, and syntax errors when coercions are given as strings of Perl code. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The Perl source code being compiled. =item C Hashref of variables being closed over. =item C Error message from Perl compiler. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. WrongNumberOfParameters.pm000664001750001750 621215111656240 23154 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Error/TypeTinypackage Error::TypeTiny::WrongNumberOfParameters; use 5.008001; use strict; use warnings; BEGIN { $Error::TypeTiny::WrongNumberOfParameters::AUTHORITY = 'cpan:TOBYINK'; $Error::TypeTiny::WrongNumberOfParameters::VERSION = '2.008006'; } $Error::TypeTiny::WrongNumberOfParameters::VERSION =~ tr/_//d; require Error::TypeTiny; our @ISA = 'Error::TypeTiny'; sub minimum { $_[0]{minimum} } sub maximum { $_[0]{maximum} } sub got { $_[0]{got} } sub target { $_[0]{target} } sub has_minimum { exists $_[0]{minimum} } sub has_maximum { exists $_[0]{maximum} } sub has_target { exists $_[0]{target} } sub _build_message { my $e = shift; my $base = 'Wrong number of parameters'; if ( $e->has_target ) { $base .= sprintf( ' to %s', $e->target ); } if ( $e->has_minimum and $e->has_maximum and $e->minimum == $e->maximum ) { return sprintf( "%s; got %d; expected %d", $base, $e->got, $e->minimum, ); } elsif ( $e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum ) { return sprintf( "%s; got %d; expected %d to %d", $base, $e->got, $e->minimum, $e->maximum, ); } elsif ( $e->has_minimum ) { return sprintf( "%s; got %d; expected at least %d", $base, $e->got, $e->minimum, ); } elsif ( $e->has_maximum ) { return sprintf( "%s; got %d; expected at most %d", $base, $e->got, $e->maximum, ); } else { return sprintf( "%s; got %d", $base, $e->got, ); } } #/ sub _build_message 1; __END__ =pod =encoding utf-8 =head1 NAME Error::TypeTiny::WrongNumberOfParameters - exception for Type::Params =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Thrown when a Type::Params compiled check is called with the wrong number of parameters. Also thrown by various parameterizable type constraints under similar circumstances. For example, the C<< HashRef[Int] >> makes sense, but C<< HashRef[Int, {}] >> does not. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The minimum expected number of parameters. =item C The maximum expected number of parameters. =item C The number of parameters actually passed to the compiled check. =item C A short string describing what there was the wrong number of parameters for. =back =head2 Methods =over =item C, C, C Predicate methods. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. CodeAccumulator.pm000664001750001750 1366615111656240 21301 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Eval/TypeTinypackage Eval::TypeTiny::CodeAccumulator; use 5.008001; use strict; use warnings; BEGIN { if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Eval::TypeTiny::CodeAccumulator::AUTHORITY = 'cpan:TOBYINK'; $Eval::TypeTiny::CodeAccumulator::VERSION = '2.008006'; } $Eval::TypeTiny::CodeAccumulator::VERSION =~ tr/_//d; sub new { my $class = shift; my %self = @_ == 1 ? %{$_[0]} : @_; $self{env} ||= {}; $self{code} ||= []; $self{placeholders} ||= {}; $self{indent} ||= ''; bless \%self, $class; } sub code { join( "\n", @{ $_[0]{code} } ) } sub description { $_[0]{description} } sub env { $_[0]{env} } sub add_line { my $self = shift; my $indent = $self->{indent}; push @{ $self->{code} }, map { $indent . $_ } map { split /\n/ } @_; $self; } sub addf { my $self = shift; my $fmt = shift; $self->add_line( sprintf $fmt, @_ ); } sub increase_indent { $_[0]{indent} .= "\t"; $_[0]; } sub decrease_indent { $_[0]{indent} =~ s/\t$//; $_[0]; } sub add_gap { push @{ $_[0]{code} }, ''; } sub add_placeholder { my ( $self, $for ) = ( shift, @_ ); my $indent = $self->{indent} || ''; $self->{placeholders}{$for} = [ scalar( @{ $self->{code} } ), $self->{indent}, ]; push @{ $self->{code} }, "$indent# placeholder [ $for ]"; if ( defined wantarray ) { return sub { $self->fill_placeholder( $for, @_ ) }; } } sub fill_placeholder { my ( $self, $for, @lines ) = ( shift, @_ ); my ( $line_number, $indent ) = @{ delete $self->{placeholders}{$for} or die }; my @indented_lines = map { $indent . $_ } map { split /\n/ } @lines; splice( @{ $self->{code} }, $line_number, 1, @indented_lines ); $self; } sub add_variable { my ( $self, $suggested_name, $reference ) = ( shift, @_ ); my $actual_name = $suggested_name; my $i = 1; while ( exists $self->{env}{$actual_name} ) { $actual_name = sprintf '%s_%d', $suggested_name, ++$i; } $self->{env}{$actual_name} = $reference; $actual_name; } sub finalize { my $self = shift; for my $p ( values %{ $self->{placeholders} } ) { splice( @{ $self->{code} }, $p->[0], 1 ); } $self; } sub compile { my ( $self, %opts ) = ( shift, @_ ); $self->{finalized}++ or $self->finalize(); require Eval::TypeTiny; return Eval::TypeTiny::eval_closure( description => $self->description, %opts, source => $self->code, environment => $self->env, ); } 1; __END__ =pod =encoding utf-8 =for stopwords pragmas coderefs =head1 NAME Eval::TypeTiny::CodeAccumulator - alternative API for Eval::TypeTiny =head1 SYNOPSIS my $make_adder = 'Eval::TypeTiny::CodeAccumulator'->new( description => 'adder', ); my $n = 40; my $varname = $make_adder->add_variable( '$addend' => \$n ); $make_adder->add_line( 'sub {' ); $make_adder->increase_indent; $make_adder->add_line( 'my $other_addend = shift;' ); $make_adder->add_gap; $make_adder->add_line( 'return ' . $varname . ' + $other_addend;' ); $make_adder->decrease_indent; $make_adder->add_line( '}' ); my $adder = $make_adder->compile; say $adder->( 2 ); ## ==> 42 =head1 STATUS This module is covered by the L. =head1 DESCRIPTION =head2 Constructor =over =item C<< new( %attrs ) >> The only currently supported attribute is C. =back =head2 Methods =over =item C<< env() >> Returns the current compilation environment, a hashref of variables to close over. =item C<< code() >> Returns the source code so far. =item C<< description() >> Returns the same description given to the constructor, if any. =item C<< add_line( @lines_of_code ) >> Adds the next line of code. =item C<< addf( $fmt, @args ) >> Shortcut for C<< add_line( sprintf $fmt, @args ) >>. =item C<< add_gap() >> Adds a blank line of code. =item C<< increase_indent() >> Increases the indentation level for subsequent lines of code. =item C<< decrease_indent() >> Decreases the indentation level for subsequent lines of code. =item C<< add_variable( $varname, $reference_to_value ) >> Adds a variable to the compilation environment so that the coderef being generated can close over it. If a variable already exists in the environment with that name, will instead add a variable with a different name and return that name. You should always continue to refer to the variable with that returned name, just in case. =item C<< add_placeholder( $placeholder_name ) >> Adds a line of code which is just a comment, but remembers its line number. =item C<< fill_placeholder( $placeholder_name, @lines_of_code ) >> Goes back to a previously inserted placeholder and replaces it with code. As an alternative, C returns a coderef, which you can call like C<< $callback->( @lines_of_code ) >>. =item C<< compile( %opts ) >> Compiles the code and returns it as a coderef. Options are passed on to C<< eval_closure >> from L, but cannot include C or C. C<< alias => 1 >> is probably the option most likely to be useful, but in general you won't need to provide any options. =item C<< finalize() >> This method is called by C just before compiling the code. All it does is remove unfilled placeholder comments. It is not intended for end users to call, but is documented as it may be a useful hook if you are subclassing this class. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. TypeTiny.pm000664001750001750 406715111656240 17644 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Reply/Pluginpackage Reply::Plugin::TypeTiny; use strict; use warnings; BEGIN { $Reply::Plugin::TypeTiny::AUTHORITY = 'cpan:TOBYINK'; $Reply::Plugin::TypeTiny::VERSION = '2.008006'; } $Reply::Plugin::TypeTiny::VERSION =~ tr/_//d; require Reply::Plugin; our @ISA = 'Reply::Plugin'; use Scalar::Util qw(blessed); use Term::ANSIColor; sub mangle_error { my $self = shift; my ( $err ) = @_; if ( blessed $err and $err->isa( "Error::TypeTiny::Assertion" ) ) { my $explain = $err->explain; if ( $explain ) { print color( "cyan" ); print "Error::TypeTiny::Assertion explain:\n"; $self->_explanation( $explain, "" ); local $| = 1; print "\n"; print color( "reset" ); } } #/ if ( blessed $err and ...) return @_; } #/ sub mangle_error sub _explanation { my $self = shift; my ( $ex, $indent ) = @_; for my $line ( @$ex ) { if ( ref( $line ) eq q(ARRAY) ) { print "$indent * Explain:\n"; $self->_explanation( $line, "$indent " ); } else { print "$indent * $line\n"; } } } #/ sub _explanation 1; __END__ =pod =encoding utf-8 =head1 NAME Reply::Plugin::TypeTiny - improved type constraint exceptions in Reply =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is a small plugin to improve error messages in L. Not massively tested. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =begin trustme =item mangle_error =end trustme FromMoose.pm000664001750001750 530015111656240 20105 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Coercionpackage Type::Coercion::FromMoose; use 5.008001; use strict; use warnings; BEGIN { $Type::Coercion::FromMoose::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::FromMoose::VERSION = '2.008006'; } $Type::Coercion::FromMoose::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } require Type::Coercion; our @ISA = 'Type::Coercion'; sub type_coercion_map { my $self = shift; my @from; if ( $self->type_constraint ) { my $moose = $self->type_constraint->{moose_type}; @from = @{ $moose->coercion->type_coercion_map } if $moose && $moose->has_coercion; } else { _croak "The type constraint attached to this coercion has been garbage collected... PANIC"; } my @return; while ( @from ) { my ( $type, $code ) = splice( @from, 0, 2 ); $type = Moose::Util::TypeConstraints::find_type_constraint( $type ) unless ref $type; push @return, Types::TypeTiny::to_TypeTiny( $type ), $code; } return \@return; } #/ sub type_coercion_map sub add_type_coercions { my $self = shift; _croak "Adding coercions to Type::Coercion::FromMoose not currently supported" if @_; } sub _build_moose_coercion { my $self = shift; if ( $self->type_constraint ) { my $moose = $self->type_constraint->{moose_type}; return $moose->coercion if $moose && $moose->has_coercion; } $self->SUPER::_build_moose_coercion( @_ ); } #/ sub _build_moose_coercion sub can_be_inlined { 0; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Coercion::FromMoose - a set of coercions borrowed from Moose =head1 STATUS This module is considered part of Type-Tiny's internals. It is not covered by the L. =head1 DESCRIPTION This package inherits from L; see that for most documentation. The major differences are that C always throws an exception, and the C is automatically populated from Moose. This is mostly for internal purposes. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Union.pm000664001750001750 603115111656240 17271 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Coercionpackage Type::Coercion::Union; use 5.008001; use strict; use warnings; BEGIN { $Type::Coercion::Union::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::Union::VERSION = '2.008006'; } $Type::Coercion::Union::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } require Type::Coercion; our @ISA = 'Type::Coercion'; sub _preserve_type_constraint { my $self = shift; $self->{_union_of} = $self->{type_constraint}->type_constraints if $self->{type_constraint}; } sub _maybe_restore_type_constraint { my $self = shift; if ( my $union = $self->{_union_of} ) { return Type::Tiny::Union->new( type_constraints => $union ); } return; # uncoverable statement } sub type_coercion_map { my $self = shift; Types::TypeTiny::assert_TypeTiny( my $type = $self->type_constraint ); $type->isa( 'Type::Tiny::Union' ) or _croak "Type::Coercion::Union must be used in conjunction with Type::Tiny::Union"; my @c; for my $tc ( @$type ) { next unless $tc->has_coercion; push @c, @{ $tc->coercion->type_coercion_map }; } return \@c; } #/ sub type_coercion_map sub add_type_coercions { my $self = shift; _croak "Adding coercions to Type::Coercion::Union not currently supported" if @_; } sub _build_moose_coercion { my $self = shift; my %options = (); $options{type_constraint} = $self->type_constraint if $self->has_type_constraint; require Moose::Meta::TypeCoercion::Union; my $r = "Moose::Meta::TypeCoercion::Union"->new( %options ); return $r; } #/ sub _build_moose_coercion sub can_be_inlined { my $self = shift; Types::TypeTiny::assert_TypeTiny( my $type = $self->type_constraint ); for my $tc ( @$type ) { next unless $tc->has_coercion; return !!0 unless $tc->coercion->can_be_inlined; } !!1; } #/ sub can_be_inlined 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Coercion::Union - a set of coercions to a union type constraint =head1 STATUS This module is covered by the L. =head1 DESCRIPTION This package inherits from L; see that for most documentation. The major differences are that C always throws an exception, and the C is automatically populated from the child constraints of the union type constraint. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Alternatives.pm000664001750001750 1676015111656240 20356 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Paramspackage Type::Params::Alternatives; use 5.008001; use strict; use warnings; BEGIN { if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Type::Params::Alternatives::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::Alternatives::VERSION = '2.008006'; } $Type::Params::Alternatives::VERSION =~ tr/_//d; use B (); use Eval::TypeTiny::CodeAccumulator; use Types::Standard qw( -is -types -assert ); use Types::TypeTiny qw( -is -types to_TypeTiny ); my $Attrs = Enum[ qw/ caller_level package subname description _is_signature_for ID method head tail parameters slurpy message on_die next fallback strictness is_named allow_dash method_invocant bless class constructor named_to_list list_to_named oo_trace class_prefix class_attributes returns_scalar returns_list want_details want_object want_source can_shortcut coderef sig_class base_options alternatives meta_alternatives quux mite_signature is_wrapper / ]; # quux for reasons require Type::Params::Signature; our @ISA = 'Type::Params::Signature'; sub new { my $class = shift; my %self = @_ == 1 ? %{$_[0]} : @_; my $self = bless \%self, $class; $self->{next} ||= delete $self->{goto_next} if exists $self->{goto_next}; exists( $self->{$_} ) || ( $self->{$_} = $self->{base_options}{$_} ) for keys %{ $self->{base_options} }; $self->{sig_class} ||= 'Type::Params::Signature'; $self->{message} ||= 'Parameter validation failed'; delete $self->{base_options}{$_} for qw/ returns returns_list returns_scalar /; $self->_rationalize_returns; $Attrs->all( sort keys %$self ) or do { require Carp; require Type::Utils; my @bad = ( ~ $Attrs )->grep( sort keys %$self ); Carp::carp( sprintf( "Warning: unrecognized signature %s: %s, continuing anyway", @bad == 1 ? 'option' : 'options', Type::Utils::english_list( @bad ), ) ); }; return $self; } sub base_options { $_[0]{base_options} ||= {} } sub alternatives { $_[0]{alternatives} ||= [] } sub sig_class { $_[0]{sig_class} } sub meta_alternatives { $_[0]{meta_alternatives} ||= $_[0]->_build_meta_alternatives } sub parameters { [] } sub next { $_[0]{base_options}{next} } sub goto_next { $_[0]{base_options}{next} } sub package { $_[0]{base_options}{package} } sub subname { $_[0]{base_options}{subname} } sub _build_meta_alternatives { my $self = shift; my $index = 0; return [ map { $self->_build_meta_alternative( $_, $index++ ) } @{ $self->alternatives } ]; } sub _build_meta_alternative { my ( $self, $alt, $index ) = @_; my $meta; if ( is_CodeRef $alt ) { $meta = { closure => $alt }; } elsif ( is_HashRef $alt and exists $alt->{closure} ) { $meta = { %$alt }; } elsif ( is_HashRef $alt ) { my %opts = ( %{ $self->base_options }, next => !!0, # don't propagate these next few returns => undef, returns_scalar => undef, returns_list => undef, %$alt, want_source => !!0, want_object => !!0, want_details => !!1, ); $meta = $self->sig_class->new_from_v2api( \%opts )->return_wanted; $meta->{ID} = $alt->{ID} if exists $alt->{ID}; } elsif ( is_ArrayRef $alt ) { my %opts = ( %{ $self->base_options }, next => !!0, # don't propagate these next few returns => undef, returns_scalar => undef, returns_list => undef, positional => $alt, want_source => !!0, want_object => !!0, want_details => !!1, ); $meta = $self->sig_class->new_from_v2api( \%opts )->return_wanted; } else { $self->_croak( 'Alternative signatures must be CODE, HASH, or ARRAY refs' ); } $meta->{_index} = $index; return $meta; } sub _coderef_start_extra { my ( $self, $coderef ) = ( shift, @_ ); $coderef->add_line( 'my $r;' ); $coderef->add_line( 'undef ${^_TYPE_PARAMS_MULTISIG};' ); $coderef->add_gap; for my $meta ( @{ $self->meta_alternatives } ) { $self->_coderef_meta_alternative( $coderef, $meta ); } $self; } sub _coderef_meta_alternative { my ( $self, $coderef, $meta ) = ( shift, @_ ); my @cond = '! $r'; push @cond, sprintf( '@_ >= %s', $meta->{min_args} ) if defined $meta->{min_args}; push @cond, sprintf( '@_ <= %s', $meta->{max_args} ) if defined $meta->{max_args}; if ( defined $meta->{max_args} and defined $meta->{min_args} ) { splice @cond, -2, 2, sprintf( '@_ == %s', $meta->{min_args} ) if $meta->{max_args} == $meta->{min_args}; } # It is sometimes possible to inline $meta->{source} here if ( $meta->{source} and $meta->{source} !~ /return/ and ! keys %{ $meta->{environment} } ) { my $alt_code = $meta->{source}; $alt_code =~ s/^sub [{]/do {/; $coderef->add_line( sprintf( 'eval { local @_ = @_; $r = [ %s ]; ${^_TYPE_PARAMS_MULTISIG} = %s }%sif ( %s );', $alt_code, defined( $meta->{ID} ) ? B::perlstring( $meta->{ID} ) : ( 0 + $meta->{_index} ), "\n\t", join( ' and ', @cond ), ) ); $coderef->add_gap; } else { my $callback_var = $coderef->add_variable( '$signature', \$meta->{closure} ); $coderef->add_line( sprintf( 'eval { $r = [ %s->(@_) ]; ${^_TYPE_PARAMS_MULTISIG} = %s }%sif ( %s );', $callback_var, defined( $meta->{ID} ) ? B::perlstring( $meta->{ID} ) : ( 0 + $meta->{_index} ), "\n\t", join( ' and ', @cond ), ) ); $coderef->add_gap; } return $self; } sub _coderef_end_extra { my ( $self, $coderef ) = ( shift, @_ ); $coderef->add_line( sprintf( '%s unless $r;', $self->_make_general_fail( message => B::perlstring( $self->{message} ) ), ) ); $coderef->add_gap; return $self; } sub _coderef_check_count { shift; } sub _make_return_list { '@$r'; } sub make_class_pp_code { my $self = shift; return join( qq{\n}, grep { length $_ } map { $_->{class_definition} || '' } @{ $self->meta_alternatives } ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Params::Alternatives - subclass of Type::Params::Signature for C signatures =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can be used to provide basic introspection for signatures. This module is a subclass of L, so inherits attributes and methods from that. =head2 Constructor =over =item C<< new(%attributes) >> =back =head2 Attributes All attributes are read-only. =over =item C<< base_options >> B =item C<< alternatives >> B<< ArrayRef[HashRef|ArrayRef|CodeRef] >> =item C<< sig_class >> B =item C<< meta_alternatives >> B Automatically built from C; do not set this yourself. =item C<< parameters >> B Overridden from parent class to always return the empty arrayref. =item C<< message >> B Error message to be thrown when none of the alternatives match. This is a bare attribute with no accessor method. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Parameter.pm000664001750001750 3435315111656240 17633 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Paramspackage Type::Params::Parameter; use 5.008001; use strict; use warnings; BEGIN { if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Type::Params::Parameter::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::Parameter::VERSION = '2.008006'; } $Type::Params::Parameter::VERSION =~ tr/_//d; use Types::Standard qw( -is -types ); my $RE_WORDLIKE = qr/\A[^\W0-9]\w*\z/; my $Attrs = Enum[ qw/ name type slurpy default alias strictness coerce clone in_list optional getter predicate allow_dash vartail default_on_undef quux / ]; sub _croak { require Carp; Carp::croak( pop ); } sub new { my $class = shift; my %self = @_ == 1 ? %{$_[0]} : @_; $self{alias} ||= []; if ( defined $self{alias} and not ref $self{alias} ) { $self{alias} = [ $self{alias} ]; } my $self = bless \%self, $class; $Attrs->all( sort keys %$self ) or do { require Carp; require Type::Utils; my @bad = ( ~ $Attrs )->grep( sort keys %$self ); Carp::carp( sprintf( "Warning: unrecognized parameter %s: %s, continuing anyway", @bad == 1 ? 'option' : 'options', Type::Utils::english_list( @bad ), ) ); }; return $self; } sub name { $_[0]{name} } sub has_name { exists $_[0]{name} } sub type { $_[0]{type} } sub has_type { exists $_[0]{type} } sub default { $_[0]{default} } sub has_default { exists $_[0]{default} } sub alias { $_[0]{alias} } sub has_alias { @{ $_[0]{alias} } } sub strictness { $_[0]{strictness} } sub has_strictness { exists $_[0]{strictness} } sub should_clone { $_[0]{clone} } sub default_on_undef { $_[0]{default_on_undef} } sub in_list { return $_[0]{in_list} if exists $_[0]{in_list}; $_[0]{in_list} = !$_[0]->optional; } sub coerce { exists( $_[0]{coerce} ) ? $_[0]{coerce} : ( $_[0]{coerce} = $_[0]->type->has_coercion ) } sub optional { exists( $_[0]{optional} ) ? $_[0]{optional} : do { $_[0]{optional} = $_[0]->has_default || grep( $_->{uniq} == Optional->{uniq}, $_[0]->type, $_[0]->type->parents, ); } } sub getter { exists( $_[0]{getter} ) ? $_[0]{getter} : ( $_[0]{getter} = $_[0]{name} ) } sub predicate { exists( $_[0]{predicate} ) ? $_[0]{predicate} : ( $_[0]{predicate} = ( $_[0]->optional ? 'has_' . $_[0]{name} : undef ) ) } sub might_supply_new_value { $_[0]->has_default or $_[0]->coerce or $_[0]->should_clone; } sub _all_aliases { my ( $self, $signature ) = @_; my $allow_dash = $self->{allow_dash}; $allow_dash = $signature->allow_dash if !defined $allow_dash; my @aliases; if ( $allow_dash and $self->name =~ $RE_WORDLIKE ) { push @aliases, sprintf( '-%s', $self->name ); } for my $name ( @{ $self->alias } ) { push @aliases, $name; if ( $allow_dash and $name =~ $RE_WORDLIKE ) { push @aliases, sprintf( '-%s', $name ); } } return @aliases; } sub _code_for_default { my ( $self, $signature, $coderef ) = @_; my $default = $self->default; if ( is_CodeRef $default ) { my $default_varname = $coderef->add_variable( '$default_for_' . $self->{vartail}, \$default, ); return sprintf( '%s->( %s )', $default_varname, $signature->method_invocant ); } if ( is_Undef $default ) { return 'undef'; } if ( is_Str $default ) { return B::perlstring( $default ); } if ( is_HashRef $default ) { return '{}'; } if ( is_ArrayRef $default ) { return '[]'; } if ( is_ScalarRef $default ) { return $$default; } $self->_croak( 'Default expected to be undef, string, coderef, or empty arrayref/hashref' ); } sub _maybe_clone { my ( $self, $varname ) = @_; if ( $self->should_clone ) { return sprintf( 'Storable::dclone( %s )', $varname ); } return $varname; } sub _make_code { my ( $self, %args ) = ( shift, @_ ); my $type = $args{type} || 'arg'; my $signature = $args{signature}; my $coderef = $args{coderef}; my $varname = $args{input_slot}; my $index = $args{index}; my $constraint = $self->type; my $is_optional = $self->optional; my $really_optional = $is_optional && $constraint->parent && $constraint->parent->{uniq} eq Optional->{uniq} && $constraint->type_parameter; # Allow Optional itself, without any parameter. $really_optional = Types::Standard::Any if $constraint && $constraint->{uniq} eq Optional->{uniq}; my $strictness; if ( $self->has_strictness ) { $strictness = \ $self->strictness; } elsif ( $signature->has_strictness ) { $strictness = \ $signature->strictness; } my ( $vartail, $exists_check ); if ( $args{is_named} ) { my $bit = $args{key}; $bit =~ s/([_\W])/$1 eq '_' ? '__' : sprintf('_%x', ord($1))/ge; $vartail = $type . '_' . $bit; $exists_check = sprintf 'exists( %s )', $args{input_slot}; } else { ( my $input_count_varname = $args{input_var} || '' ) =~ s/\@/\$\#/; $vartail = $type . '_' . $index; $exists_check = sprintf '%s >= %d', $input_count_varname, $index; } my $block_needs_ending = 0; my $needs_clone = $self->should_clone; my $in_big_optional_block = 0; if ( $needs_clone and not $signature->{loaded_Storable} ) { $coderef->add_line( 'use Storable ();' ); $coderef->add_gap; $signature->{loaded_Storable} = 1; } $coderef->add_line( sprintf( '# Parameter %s (type: %s)', $self->name || $args{input_slot}, $constraint->display_name, ) ); if ( $args{is_named} and my @aliases = $self->_all_aliases($signature) ) { $coderef->add_line( sprintf( 'for my $alias ( %s ) {', join( q{, }, map B::perlstring($_), @aliases ), ) ); $coderef->increase_indent; $coderef->add_line( 'exists $in{$alias} or next;' ); $coderef->add_line( sprintf( 'if ( %s ) {', $exists_check, ) ); $coderef->increase_indent; $coderef->add_line( sprintf( '%s;', $signature->_make_general_fail( coderef => $coderef, message => q{sprintf( 'Superfluous alias "%s" for argument "%s"', $alias, } . B::perlstring( $self->name || $args{input_slot} ) . q{ )}, ), ) ); $coderef->decrease_indent; $coderef->add_line( '}' ); $coderef->add_line( 'else {' ); $coderef->increase_indent; $coderef->add_line( sprintf( '%s = delete( $in{$alias} );', $varname, ) ); $coderef->decrease_indent; $coderef->add_line( '}' ); $coderef->decrease_indent; $coderef->add_line( '}' ); } if ( $args{is_named} and $signature->list_to_named and $self->in_list ) { $coderef->addf( 'if ( not exists %s ) {', $varname ); $coderef->increase_indent; $coderef->addf( 'for my $ix ( 0 .. $#positional ) {' ); $coderef->increase_indent; $coderef->addf( '%s or next;', ( $really_optional or $constraint )->coercibles->inline_check( '$positional[$ix]' ) ); $coderef->addf( '( %s ) = splice( @positional, $ix, 1 );', $varname ); $coderef->addf( 'last;' ); $coderef->decrease_indent; $coderef->addf( '}' ); $coderef->decrease_indent; $coderef->addf( '}' ); } if ( $self->has_default ) { my $check = $exists_check; if ( $self->default_on_undef ) { $check = "( $check and defined $varname )"; } $self->{vartail} = $vartail; # hack $coderef->add_line( sprintf( '$dtmp = %s ? %s : %s;', $check, $self->_maybe_clone( $varname ), $self->_code_for_default( $signature, $coderef ), ) ); $varname = '$dtmp'; $needs_clone = 0; } elsif ( $self->optional ) { if ( $args{is_named} ) { $coderef->add_line( sprintf( 'if ( %s ) {', $exists_check, ) ); $coderef->{indent} .= "\t"; ++$block_needs_ending; ++$in_big_optional_block; } else { $coderef->add_line( sprintf( "%s\n\tor %s;", $exists_check, $signature->_make_return_expression( is_early => 1 ), ) ); } } elsif ( $args{is_named} ) { $coderef->add_line( sprintf( "%s\n\tor %s;", $exists_check, $signature->_make_general_fail( coderef => $coderef, message => "'Missing required parameter: $args{key}'", ), ) ); } if ( $needs_clone ) { $coderef->add_line( sprintf( '$dtmp = %s;', $self->_maybe_clone( $varname ), ) ); $varname = '$dtmp'; $needs_clone = 0; } if ( $constraint->has_coercion and $constraint->coercion->can_be_inlined ) { $coderef->add_line( sprintf( '$tmp%s = %s;', ( $is_optional ? '{x}' : '' ), $constraint->coercion->inline_coercion( $varname ) ) ); $varname = '$tmp' . ( $is_optional ? '{x}' : '' ); } elsif ( $constraint->has_coercion ) { my $coercion_varname = $coderef->add_variable( '$coercion_for_' . $vartail, \ $constraint->coercion->compiled_coercion, ); $coderef->add_line( sprintf( '$tmp%s = &%s( %s );', ( $is_optional ? '{x}' : '' ), $coercion_varname, $varname, ) ); $varname = '$tmp' . ( $is_optional ? '{x}' : '' ); } undef $Type::Tiny::ALL_TYPES{ $constraint->{uniq} }; $Type::Tiny::ALL_TYPES{ $constraint->{uniq} } = $constraint; my $strictness_test = ''; if ( $strictness and $$strictness eq 1 ) { $strictness_test = ''; } elsif ( $strictness and $$strictness ) { $strictness_test = sprintf "( not %s )\n\tor ", $$strictness; } if ( $strictness and not $$strictness ) { $coderef->add_line( '1; # ... nothing to do' ); } elsif ( $constraint->{uniq} == Any->{uniq} ) { $coderef->add_line( '1; # ... nothing to do' ); } elsif ( $args{is_slurpy} and $self->_dont_validate_slurpy ) { $coderef->add_line( '1; # ... nothing to do' ); } elsif ( $constraint->can_be_inlined ) { $coderef->add_line( $strictness_test . sprintf( "%s\n\tor %s;", ( $really_optional or $constraint )->inline_check( $varname ), $signature->_make_constraint_fail( coderef => $coderef, parameter => $self, constraint => $constraint, varname => $varname, display_var => $args{display_var}, ), ) ); } else { my $compiled_check_varname = $coderef->add_variable( '$check_for_' . $vartail, \ ( ( $really_optional or $constraint )->compiled_check ), ); $coderef->add_line( $strictness_test . sprintf( "&%s( %s )\n\tor %s;", $compiled_check_varname, $varname, $signature->_make_constraint_fail( coderef => $coderef, parameter => $self, constraint => $constraint, varname => $varname, display_var => $args{display_var}, ), ) ); } if ( $args{output_var} ) { $coderef->add_line( sprintf( 'push( %s, %s );', $args{output_var}, $varname, ) ); } elsif ( $args{output_slot} and $args{output_slot} ne $varname ) { if ( !$in_big_optional_block and $varname =~ /\{/ ) { $coderef->add_line( sprintf( '%s = %s if exists( %s );', $args{output_slot}, $varname, $varname, ) ); } else { $coderef->add_line( sprintf( '%s = %s;', $args{output_slot}, $varname, ) ); } } if ( $args{is_named} ) { $coderef->add_line( sprintf( 'delete( %s );', $args{input_slot}, ) ); } if ( $block_needs_ending ) { $coderef->{indent} =~ s/\s$//; $coderef->add_line( '}' ); } $coderef->add_gap; $self; } # This list can be reused safely. my @uniqs; # If $SLURPY is one of a handful of very loose type constraints, there is # no need to validate it because we built it as a hashref or arrayref ourself, # so there's no way it couldn't be a hashref or arrayref. sub _dont_validate_slurpy { my $self = shift; my $type = $self->type or return 1; if ( not @uniqs ) { @uniqs = map { $_->{uniq} } Slurpy, Slurpy[Any], Any, Slurpy[Item], Item, Slurpy[Ref], Ref, Slurpy[HashRef], HashRef, Slurpy[ArrayRef], ArrayRef; } ( $_ == $type->{uniq} and return 1 ) for @uniqs; return 0; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Params::Parameter - internal representation of a parameter in a function signature =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can be used to provide basic introspection for signatures. =head2 Constructor =over =item C<< new(%attributes) >> =back =head2 Attributes All attributes are read-only. =over =item C<< type >> B Type constraint for the parameter. =item C<< default >> B<< CodeRef|ScalarRef|Ref|Str|Undef >> A default for the parameter: either a coderef to generate a value, a reference to a string of Perl code to generate the value, an a reference to an empty array or empty hash, a literal string to use as a default, or a literal undef to use as a default. =item C<< strictness >> B<< Bool|ScalarRef >> A boolean indicating whether to be stricter with type checks, or a reference to a string of Perl code naming a Perl variable or constant which controls strict behaviour. =item C<< clone >> B<< Bool >> The method for accessing this is called C for no particular reason. =item C<< coerce >> B<< Bool >> Defaults to true if C has a coercion. =item C<< optional >> B<< Bool >> Defaults to true if there is a C or if C is a subtype of B. =item C<< in_list >> B<< Bool >> Boolean that is only used when the signature has the C feature enabled. =item C<< default_on_undef >> B<< Bool >> Should the default be triggered if the caller passes an explicit undef? =back =head3 Attributes related to named parameters =over =item C<< name >> B =item C<< alias >> B<< ArrayRef[Str] >> =item C<< getter >> B =item C<< predicate >> B<< Str >> =back =head2 Methods =head3 Predicates Predicate methods return true/false to indicate the presence or absence of attributes. =over =item C<< has_type >> =item C<< has_default >> =item C<< has_strictness >> =item C<< has_name >> =item C<< has_alias >> =back =head3 Other methods =over =item C<< might_supply_new_value >> Indicates that the parameter can't simply be referenced within C<< @_ >> because a default value might be used, the given value might be coerced, or the given value might be cloned using L. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Signature.pm000664001750001750 10713515111656240 17673 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Paramspackage Type::Params::Signature; use 5.008001; use strict; use warnings; BEGIN { if ( $] < 5.010 ) { require Devel::TypeTiny::Perl58Compat } } BEGIN { $Type::Params::Signature::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::Signature::VERSION = '2.008006'; } $Type::Params::Signature::VERSION =~ tr/_//d; use B (); use Eval::TypeTiny::CodeAccumulator; use Types::Standard qw( -is -types -assert ); use Types::TypeTiny qw( -is -types to_TypeTiny ); use Type::Params::Parameter; my $Attrs = Enum[ qw/ caller_level package subname description _is_signature_for ID method head tail parameters slurpy message on_die next fallback strictness is_named allow_dash method_invocant bless class constructor named_to_list list_to_named oo_trace class_prefix class_attributes returns_scalar returns_list want_details want_object want_source can_shortcut coderef quux mite_signature is_wrapper / ]; # quux for reasons sub _croak { require Error::TypeTiny; return Error::TypeTiny::croak( pop ); } sub _new_parameter { shift; 'Type::Params::Parameter'->new( @_ ); } sub _new_code_accumulator { shift; 'Eval::TypeTiny::CodeAccumulator'->new( @_ ); } sub new { my $class = shift; my %self = @_ == 1 ? %{$_[0]} : @_; my $self = bless \%self, $class; $self->{parameters} ||= []; $self->{class_prefix} ||= 'Type::Params::OO::Klass'; $self->{next} ||= delete $self->{goto_next} if exists $self->{goto_next}; $self->BUILD; $Attrs->all( sort keys %$self ) or do { require Carp; require Type::Utils; my @bad = ( ~ $Attrs )->grep( sort keys %$self ); Carp::carp( sprintf( "Warning: unrecognized signature %s: %s, continuing anyway", @bad == 1 ? 'option' : 'options', Type::Utils::english_list( @bad ), ) ); }; return $self; } { my $klass_id; my %klass_cache; sub BUILD { my $self = shift; if ( $self->{named_to_list} and not is_ArrayRef $self->{named_to_list} ) { $self->{named_to_list} = [ map $_->name, @{ $self->{parameters} } ]; } if ( delete $self->{rationalize_slurpies} ) { $self->_rationalize_slurpies; } if ( $self->{method} ) { my $type = $self->{method}; $type = is_Int($type) ? Defined : is_Str($type) ? do { require Type::Utils; Type::Utils::dwim_type( $type, $self->{package} ? ( for => $self->{package} ) : () ) } : to_TypeTiny( $type ); unshift @{ $self->{head} ||= [] }, $self->_new_parameter( name => 'invocant', type => $type, ); } $self->_rationalize_returns; if ( defined $self->{bless} and is_BoolLike $self->{bless} and $self->{bless} and not $self->{named_to_list} ) { my $klass_key = $self->_klass_key; $self->{bless} = ( $klass_cache{$klass_key} ||= sprintf( '%s%d', $self->{class_prefix}, ++$klass_id ) ); $self->{oo_trace} = 1 unless exists $self->{oo_trace}; $self->make_class; } if ( is_ArrayRef $self->{class} ) { $self->{constructor} = $self->{class}->[1]; $self->{class} = $self->{class}->[0]; } } } sub _klass_key { my $self = shift; my @parameters = @{ $self->parameters }; if ( $self->has_slurpy ) { push @parameters, $self->slurpy; } no warnings 'uninitialized'; join( '|', map sprintf( '%s*%s*%s', $_->name, $_->getter, $_->predicate ), sort { $a->{name} cmp $b->{name} } @parameters ); } sub _rationalize_slurpies { my $self = shift; my $parameters = $self->parameters; if ( $self->is_named ) { my ( @slurpy, @rest ); for my $parameter ( @$parameters ) { if ( $parameter->type->is_strictly_a_type_of( Slurpy ) ) { push @slurpy, $parameter; } elsif ( $parameter->{slurpy} ) { $parameter->{type} = Slurpy[ $parameter->type ]; push @slurpy, $parameter; } else { push @rest, $parameter; } } if ( @slurpy == 1 ) { my $constraint = $slurpy[0]->type; if ( $constraint->type_parameter && $constraint->type_parameter->{uniq} == Any->{uniq} or $constraint->my_slurp_into eq 'HASH' ) { $self->{slurpy} = $slurpy[0]; @$parameters = @rest; } else { $self->_croak( 'Signatures with named parameters can only have slurpy parameters which are a subtype of HashRef' ); } } elsif ( @slurpy ) { $self->_croak( 'Found multiple slurpy parameters! There can be only one' ); } } elsif ( @$parameters ) { if ( $parameters->[-1]->type->is_strictly_a_type_of( Slurpy ) ) { $self->{slurpy} = pop @$parameters; } elsif ( $parameters->[-1]{slurpy} ) { $self->{slurpy} = pop @$parameters; $self->{slurpy}{type} = Slurpy[ $self->{slurpy}{type} ]; } for my $parameter ( @$parameters ) { if ( $parameter->type->is_strictly_a_type_of( Slurpy ) or $parameter->{slurpy} ) { $self->_croak( 'Parameter following slurpy parameter' ); } } } if ( $self->{slurpy} and $self->{slurpy}->has_default ) { require Carp; our @CARP_NOT = ( __PACKAGE__, 'Type::Params' ); Carp::carp( "Warning: the default for the slurpy parameter will be ignored, continuing anyway" ); delete $self->{slurpy}{default}; } if ( $self->{slurpy} and $self->{slurpy}->optional ) { require Carp; our @CARP_NOT = ( __PACKAGE__, 'Type::Params' ); Carp::carp( "Warning: the optional for the slurpy parameter will be ignored, continuing anyway" ); delete $self->{slurpy}{optional}; } } sub _rationalize_returns { my $self = shift; my $typify = sub { my $ref = shift; if ( is_Str $$ref ) { require Type::Utils; $$ref = Type::Utils::dwim_type( $$ref, $self->{package} ? ( for => $self->{package} ) : () ); } else { $$ref = to_TypeTiny( $$ref ); } }; if ( my $r = delete $self->{returns} ) { $typify->( \ $r ); $self->{returns_scalar} ||= $r; $self->{returns_list} ||= ArrayRef->of( $r ); } exists $self->{$_} && $typify->( \ $self->{$_} ) for qw/ returns_scalar returns_list /; return $self; } sub _parameters_from_list { my ( $class, $style, $list, %opts ) = @_; my @return; my $is_named = ( $style eq 'named' ); while ( @$list ) { my ( $type, %param_opts ); if ( $is_named ) { $param_opts{name} = assert_Str( shift( @$list ) ); } if ( is_HashRef $list->[0] and exists $list->[0]{slurpy} and not is_Bool $list->[0]{slurpy} ) { my %new_opts = %{ shift( @$list ) }; $type = delete $new_opts{slurpy}; %param_opts = ( %param_opts, %new_opts, slurpy => 1 ); } else { $type = shift( @$list ); } if ( is_HashRef( $list->[0] ) ) { unless ( exists $list->[0]{slurpy} and not is_Bool $list->[0]{slurpy} ) { %param_opts = ( %param_opts, %{ +shift( @$list ) } ); } } $param_opts{type} = is_Int($type) ? ( $type ? Any : do { $param_opts{optional} = !!1; Any; } ) : is_Str($type) ? do { require Type::Utils; Type::Utils::dwim_type( $type, $opts{package} ? ( for => $opts{package} ) : () ) } : to_TypeTiny( $type ); my $parameter = $class->_new_parameter( %param_opts ); push @return, $parameter; } return \@return; } sub new_from_compile { my $class = shift; my $style = shift; my $is_named = ( $style eq 'named' ); my %opts = (); while ( is_HashRef $_[0] and not exists $_[0]{slurpy} ) { %opts = ( %opts, %{ +shift } ); } for my $pos ( qw/ head tail / ) { next unless defined $opts{$pos}; if ( is_Int( $opts{$pos} ) ) { $opts{$pos} = [ ( Any ) x $opts{$pos} ]; } $opts{$pos} = $class->_parameters_from_list( positional => $opts{$pos}, %opts ); } my $list = [ @_ ]; $opts{is_named} = $is_named; $opts{parameters} = $class->_parameters_from_list( $style => $list, %opts ); my $self = $class->new( %opts, rationalize_slurpies => 1 ); return $self; } sub new_from_v2api { my ( $class, $opts ) = @_; my $positional = delete( $opts->{positional} ) || delete( $opts->{pos} ); my $named = delete( $opts->{named} ); my $multiple = delete( $opts->{multiple} ) || delete( $opts->{multi} ); $class->_croak( "Signature must be positional, named, or multiple" ) unless $positional || $named || $multiple; if ( $multiple ) { if ( is_HashRef $multiple ) { my @tmp; while ( my ( $name, $alt ) = each %$multiple ) { push @tmp, is_HashRef($alt) ? { ID => $name, %$alt } : is_ArrayRef($alt) ? { ID => $name, pos => $alt } : is_CodeRef($alt) ? { ID => $name, closure => $alt } : $class->_croak( "Bad alternative in multiple signature" ); } $multiple = \@tmp; } elsif ( not is_ArrayRef $multiple ) { $multiple = []; } unshift @$multiple, { positional => $positional } if $positional; unshift @$multiple, { named => $named } if $named; require Type::Params::Alternatives; return 'Type::Params::Alternatives'->new( base_options => $opts, alternatives => $multiple, sig_class => $class, ); } my ( $sig_kind, $args ) = ( pos => $positional ); if ( $named ) { $opts->{bless} = 1 unless exists $opts->{bless}; ( $sig_kind, $args ) = ( named => $named ); $class->_croak( "Signature cannot have both positional and named arguments" ) if $positional; } return $class->new_from_compile( $sig_kind, $opts, @$args ); } sub package { $_[0]{package} } sub subname { $_[0]{subname} } sub description { $_[0]{description} } sub has_description { exists $_[0]{description} } sub method { $_[0]{method} } sub head { $_[0]{head} } sub has_head { exists $_[0]{head} } sub tail { $_[0]{tail} } sub has_tail { exists $_[0]{tail} } sub parameters { $_[0]{parameters} } sub has_parameters { exists $_[0]{parameters} } sub slurpy { $_[0]{slurpy} } sub has_slurpy { exists $_[0]{slurpy} } sub on_die { $_[0]{on_die} } sub has_on_die { exists $_[0]{on_die} } sub strictness { $_[0]{strictness} } sub has_strictness { exists $_[0]{strictness} } sub next { $_[0]{next} } sub goto_next { $_[0]{next} } sub is_named { $_[0]{is_named} } sub allow_dash { $_[0]{allow_dash} } sub bless { $_[0]{bless} } sub class { $_[0]{class} } sub constructor { $_[0]{constructor} } sub named_to_list { $_[0]{named_to_list} } sub list_to_named { $_[0]{list_to_named} } sub oo_trace { $_[0]{oo_trace} } sub returns_scalar{ $_[0]{returns_scalar} } sub has_returns_scalar{ defined $_[0]{returns_scalar} } sub returns_list { $_[0]{returns_list} } sub has_returns_list { defined $_[0]{returns_list} } sub method_invocant { $_[0]{method_invocant} = defined( $_[0]{method_invocant} ) ? $_[0]{method_invocant} : 'undef' } sub can_shortcut { return $_[0]{can_shortcut} if exists $_[0]{can_shortcut}; $_[0]{can_shortcut} = !( $_[0]->slurpy or grep $_->might_supply_new_value, @{ $_[0]->parameters } ); } sub coderef { $_[0]{coderef} ||= $_[0]->_build_coderef; } sub _build_coderef { my $self = shift; my $coderef = $self->_new_code_accumulator( description => $self->description || sprintf( q{parameter validation for '%s::%s'}, $self->package || '', $self->subname || '__ANON__' ) ); $self->_coderef_start( $coderef ); $self->_coderef_head( $coderef ) if $self->has_head; $self->_coderef_tail( $coderef ) if $self->has_tail; $self->_coderef_parameters( $coderef ); if ( $self->has_slurpy ) { $self->_coderef_slurpy( $coderef ); } elsif ( $self->is_named ) { $self->_coderef_extra_names( $coderef ); } $self->_coderef_end( $coderef ); return $coderef; } sub _coderef_start { my ( $self, $coderef ) = ( shift, @_ ); $coderef->add_line( 'sub {' ); $coderef->{indent} .= "\t"; if ( my $next = $self->next ) { if ( is_CodeLike $next ) { $coderef->add_variable( '$__NEXT__', \$next ); } else { $coderef->add_line( 'my $__NEXT__ = shift;' ); $coderef->add_gap; } } if ( $self->method ) { # Passed to parameter defaults $self->{method_invocant} = '$__INVOCANT__'; $coderef->add_line( sprintf 'my %s = $_[0];', $self->method_invocant ); $coderef->add_gap; } $self->_coderef_start_extra( $coderef ); my $extravars = ''; if ( $self->has_head ) { $extravars .= ', @head'; } if ( $self->has_tail ) { $extravars .= ', @tail'; } if ( $self->is_named ) { $coderef->add_line( "my ( \%out, \%in, \%tmp, \$tmp, \$dtmp$extravars );" ); } elsif ( $self->can_shortcut ) { $coderef->add_line( "my ( \%tmp, \$tmp$extravars );" ); } else { $coderef->add_line( "my ( \@out, \%tmp, \$tmp, \$dtmp$extravars );" ); } if ( $self->has_on_die ) { $coderef->add_variable( '$__ON_DIE__', \ $self->on_die ); } $coderef->add_gap; $self->_coderef_check_count( $coderef ); $coderef->add_gap; $self; } sub _coderef_start_extra {} sub _coderef_check_count { my ( $self, $coderef ) = ( shift, @_ ); my $strictness_test = ''; if ( defined $self->strictness and $self->strictness eq 1 ) { $strictness_test = ''; } elsif ( $self->strictness ) { $strictness_test = sprintf '( not %s ) or ', $self->strictness; } elsif ( $self->has_strictness ) { return $self; } my $headtail = 0; $headtail += @{ $self->head } if $self->has_head; $headtail += @{ $self->tail } if $self->has_tail; my $is_named = $self->is_named; my $min_args = 0; my $max_args = 0; my $seen_optional = 0; for my $parameter ( @{ $self->parameters } ) { if ( $parameter->optional ) { ++$seen_optional; ++$max_args; } else { $seen_optional and !$is_named and $self->_croak( 'Non-Optional parameter following Optional parameter', ); ++$max_args; ++$min_args; } } undef $max_args if $self->has_slurpy; # Note: code related to $max_args_if_hash is currently commented out # because it handles this badly: # # my %opts = ( x => 1, y => 1 ); # your_func( %opts, y => 2 ); # override y # if ( $is_named and $self->list_to_named ) { require List::Util; my $args_if_hashref = $headtail + 1; my $min_args_if_list = $headtail + List::Util::sum( 0, map { $_->optional ? 0 : $_->in_list ? 1 : 2 } @{ $self->parameters } ); $self->{min_args} = List::Util::min( $args_if_hashref, $min_args_if_list ); $coderef->add_line( $strictness_test . sprintf( "\@_ >= %d\n\tor %s;", $self->{min_args}, $self->_make_count_fail( coderef => $coderef, got => 'scalar( @_ )', ), ) ); } elsif ( $is_named ) { my $args_if_hashref = $headtail + 1; my $hashref_index = @{ $self->head || [] }; my $arity_if_hash = $headtail % 2; my $min_args_if_hash = $headtail + ( 2 * $min_args ); #my $max_args_if_hash = defined( $max_args ) # ? ( $headtail + ( 2 * $max_args ) ) # : undef; require List::Util; $self->{min_args} = List::Util::min( $args_if_hashref, $min_args_if_hash ); #if ( defined $max_args_if_hash ) { # $self->{max_args} = List::Util::max( $args_if_hashref, $max_args_if_hash ); #} my $extra_conditions = ''; #if ( defined $max_args_if_hash and $min_args_if_hash==$max_args_if_hash ) { # $extra_conditions .= " && \@_ == $min_args_if_hash" #} #else { $extra_conditions .= " && \@_ >= $min_args_if_hash" if $min_args_if_hash; # $extra_conditions .= " && \@_ <= $max_args_if_hash" # if defined $max_args_if_hash; #} $coderef->add_line( $strictness_test . sprintf( "\@_ == %d && %s\n\tor \@_ %% 2 == %d%s\n\tor %s;", $args_if_hashref, HashRef->inline_check( sprintf '$_[%d]', $hashref_index ), $arity_if_hash, $extra_conditions, $self->_make_count_fail( coderef => $coderef, got => 'scalar( @_ )', ), ) ); } else { $min_args += $headtail; $max_args += $headtail if defined $max_args; $self->{min_args} = $min_args; $self->{max_args} = $max_args; if ( defined $max_args and $min_args == $max_args ) { $coderef->add_line( $strictness_test . sprintf( "\@_ == %d\n\tor %s;", $min_args, $self->_make_count_fail( coderef => $coderef, minimum => $min_args, maximum => $max_args, got => 'scalar( @_ )', ), ) ); } elsif ( $min_args and defined $max_args ) { $coderef->add_line( $strictness_test . sprintf( "\@_ >= %d && \@_ <= %d\n\tor %s;", $min_args, $max_args, $self->_make_count_fail( coderef => $coderef, minimum => $min_args, maximum => $max_args, got => 'scalar( @_ )', ), ) ); } else { $coderef->add_line( $strictness_test . sprintf( "\@_ >= %d\n\tor %s;", $min_args || 0, $self->_make_count_fail( coderef => $coderef, minimum => $min_args || 0, got => 'scalar( @_ )', ), ) ); } } } sub _coderef_head { my ( $self, $coderef ) = ( shift, @_ ); $self->has_head or return; my $size = @{ $self->head }; $coderef->add_line( sprintf( '@head = splice( @_, 0, %d );', $size, ) ); $coderef->add_gap; my $i = 0; for my $parameter ( @{ $self->head } ) { $parameter->_make_code( signature => $self, coderef => $coderef, input_slot => sprintf( '$head[%d]', $i ), input_var => '@head', output_slot => sprintf( '$head[%d]', $i ), output_var => undef, index => $i, type => 'head', display_var => sprintf( '$_[%d]', $i ), ); ++$i; } $self; } sub _coderef_tail { my ( $self, $coderef ) = ( shift, @_ ); $self->has_tail or return; my $size = @{ $self->tail }; $coderef->add_line( sprintf( '@tail = splice( @_, -%d );', $size, ) ); $coderef->add_gap; my $i = 0; my $n = @{ $self->tail }; for my $parameter ( @{ $self->tail } ) { $parameter->_make_code( signature => $self, coderef => $coderef, input_slot => sprintf( '$tail[%d]', $i ), input_var => '@tail', output_slot => sprintf( '$tail[%d]', $i ), output_var => undef, index => $i, type => 'tail', display_var => sprintf( '$_[-%d]', $n - $i ), ); ++$i; } $self; } sub _coderef_parameters { my ( $self, $coderef ) = ( shift, @_ ); if ( $self->is_named ) { if ( $self->list_to_named ) { require Type::Tiny::Enum; my $Keys = Type::Tiny::Enum->new( values => [ map { $_->name, $_->_all_aliases($self) } @{ $self->parameters } ] ); $coderef->addf( 'my @positional;' ); $coderef->addf( '{' ); $coderef->increase_indent; $coderef->addf( 'last if ( @_ == 0 );' ); $coderef->addf( 'last if ( @_ == 1 and %s );', HashRef->inline_check( '$_[0]' ) ); $coderef->addf( 'last if ( @_ %% 2 == 0 and %s );', $Keys->inline_check( '$_[0]' ) ); $coderef->addf( 'push @positional, shift @_;' ); $coderef->addf( 'redo;' ); $coderef->decrease_indent; $coderef->addf( '}' ); $coderef->add_gap; } $coderef->add_line( sprintf( '%%in = ( @_ == 1 and %s ) ? %%{ $_[0] } : @_;', HashRef->inline_check( '$_[0]' ), ) ); $coderef->add_gap; for my $parameter ( @{ $self->parameters } ) { my $qname = B::perlstring( $parameter->name ); $parameter->_make_code( signature => $self, coderef => $coderef, is_named => 1, input_slot => sprintf( '$in{%s}', $qname ), output_slot => sprintf( '$out{%s}', $qname ), display_var => sprintf( '$_{%s}', $qname ), key => $parameter->name, type => 'named_arg', ); } if ( $self->list_to_named ) { $coderef->add_line( sprintf( '@positional and %s;', $self->_make_general_fail( coderef => $coderef, message => q{'Superfluous positional arguments'}, ), ) ); } } else { my $can_shortcut = $self->can_shortcut; my $head_size = $self->has_head ? @{ $self->head } : 0; my $i = 0; for my $parameter ( @{ $self->parameters } ) { $parameter->_make_code( signature => $self, coderef => $coderef, is_named => 0, input_slot => sprintf( '$_[%d]', $i ), input_var => '@_', output_slot => ( $can_shortcut ? undef : sprintf( '$_[%d]', $i ) ), output_var => ( $can_shortcut ? undef : '@out' ), index => $i, display_var => sprintf( '$_[%d]', $i + $head_size ), ); ++$i; } } } sub _coderef_slurpy { my ( $self, $coderef ) = ( shift, @_ ); return unless $self->has_slurpy; my $parameter = $self->slurpy; my $constraint = $parameter->type; my $slurp_into = $constraint->my_slurp_into; my $real_type = $constraint->my_unslurpy; if ( $self->is_named ) { $coderef->add_line( 'my $SLURPY = \\%in;' ); } elsif ( $real_type and $real_type->{uniq} == Any->{uniq} ) { $coderef->add_line( sprintf( 'my $SLURPY = [ @_[ %d .. $#_ ] ];', scalar( @{ $self->parameters } ), ) ); } elsif ( $slurp_into eq 'HASH' ) { my $index = scalar( @{ $self->parameters } ); $coderef->add_line( sprintf( 'my $SLURPY = ( $#_ == %d and ( %s ) ) ? { %%{ $_[%d] } } : ( ( $#_ - %d ) %% 2 ) ? { @_[ %d .. $#_ ] } : %s;', $index, HashRef->inline_check("\$_[$index]"), $index, $index, $index, $self->_make_general_fail( coderef => $coderef, message => sprintf( qq{sprintf( "Odd number of elements in %%s", %s )}, B::perlstring( ( $real_type or $constraint )->display_name ), ), ), ) ); } else { $coderef->add_line( sprintf( 'my $SLURPY = [ @_[ %d .. $#_ ] ];', scalar( @{ $self->parameters } ), ) ); } $coderef->add_gap; $parameter->_make_code( signature => $self, coderef => $coderef, input_slot => '$SLURPY', display_var => '$SLURPY', index => 0, is_slurpy => 1, $self->is_named ? ( output_slot => sprintf( '$out{%s}', B::perlstring( $parameter->name ) ) ) : ( output_var => '@out' ) ); } sub _coderef_extra_names { my ( $self, $coderef ) = ( shift, @_ ); return $self if $self->has_strictness && ! $self->strictness; require Type::Utils; my $english_list = 'Type::Utils::english_list'; if ( $Type::Tiny::AvoidCallbacks ) { $english_list = 'join q{, } => '; } $coderef->add_line( '# Unrecognized parameters' ); $coderef->add_line( sprintf( '%s if %skeys %%in;', $self->_make_general_fail( coderef => $coderef, message => "sprintf( q{Unrecognized parameter%s: %s}, keys( %in ) > 1 ? q{s} : q{}, $english_list( sort keys %in ) )", ), defined( $self->strictness ) && $self->strictness ne 1 ? sprintf( '%s && ', $self->strictness ) : '' ) ); $coderef->add_gap; } sub _coderef_end { my ( $self, $coderef ) = ( shift, @_ ); if ( $self->{_is_signature_for} and $self->next ) { $coderef->add_variable( '$return_check_for_scalar', \ $self->returns_scalar->compiled_check ) if $self->has_returns_scalar; $coderef->add_variable( '$return_check_for_list', \ $self->returns_list->compiled_check ) if $self->has_returns_list; } if ( $self->bless and $self->oo_trace ) { my $package = $self->package; my $subname = $self->subname; if ( defined $package and defined $subname ) { $coderef->add_line( sprintf( '$out{"~~caller"} = %s;', B::perlstring( "$package\::$subname" ), ) ); $coderef->add_gap; } } $self->_coderef_end_extra( $coderef ); $coderef->add_line( $self->_make_return_expression( is_early => 0, allow_full_statements => 1 ) . ';' ); $coderef->{indent} =~ s/\t$//; $coderef->add_line( '}' ); $self; } sub _coderef_end_extra {} sub _make_return_list { my $self = shift; my @return_list; if ( $self->has_head ) { push @return_list, '@head'; } if ( not $self->is_named ) { push @return_list, $self->can_shortcut ? '@_' : '@out'; } elsif ( $self->named_to_list ) { push @return_list, map( sprintf( '$out{%s}', B::perlstring( $_ ) ), @{ $self->named_to_list }, ); } elsif ( $self->class ) { push @return_list, sprintf( '%s->%s( \%%out )', B::perlstring( $self->class ), $self->constructor || 'new', ); } elsif ( $self->bless ) { push @return_list, sprintf( 'bless( \%%out, %s )', B::perlstring( $self->bless ), ); } else { push @return_list, '\%out'; } if ( $self->has_tail ) { push @return_list, '@tail'; } return @return_list; } sub _make_return_expression { my ( $self, %args ) = @_; my $list = join q{, }, $self->_make_return_list; if ( $self->next ) { if ( $self->{_is_signature_for} and ( $self->has_returns_list or $self->has_returns_scalar ) ) { my $call = sprintf '$__NEXT__->( %s )', $list; return $self->_make_typed_return_expression( $call ); } elsif ( $list eq '@_' ) { return sprintf 'goto( $__NEXT__ )'; } elsif ( $args{allow_full_statements} and not ( $args{is_early} or not exists $args{is_early} ) ) { # We are allowed to return full statements, not # forced to use do {...} to make an expression. return sprintf '@_ = ( %s ); goto $__NEXT__', $list; } else { return sprintf 'do { @_ = ( %s ); goto $__NEXT__ }', $list; } } elsif ( $args{is_early} or not exists $args{is_early} ) { return sprintf 'return( %s )', $list; } else { return sprintf '( %s )', $list; } } sub _make_typed_return_expression { my ( $self, $expr ) = @_; return sprintf 'wantarray ? %s : defined( wantarray ) ? %s : do { %s; undef; }', $self->has_returns_list ? $self->_make_typed_list_return_expression( $expr, $self->returns_list ) : $expr, $self->has_returns_scalar ? $self->_make_typed_scalar_return_expression( $expr, $self->returns_scalar ) : $expr, $expr; } sub _make_typed_scalar_return_expression { my ( $self, $expr, $constraint ) = @_; if ( $constraint->{uniq} == Any->{uniq} ) { return $expr; } elsif ( $constraint->can_be_inlined ) { return sprintf 'do { my $__RETURN__ = %s; ( %s ) ? $__RETURN__ : %s }', $expr, $constraint->inline_check( '$__RETURN__' ), $self->_make_constraint_fail( constraint => $constraint, varname => '$__RETURN__' ); } else { return sprintf 'do { my $__RETURN__ = %s; $return_check_for_scalar->( $__RETURN__ ) ? $__RETURN__ : %s }', $expr, $self->_make_constraint_fail( constraint => $constraint, varname => '$__RETURN__' ); } } sub _make_typed_list_return_expression { my ( $self, $expr, $constraint ) = @_; my $slurp_into = Slurpy->of( $constraint )->my_slurp_into; my $varname = $slurp_into eq 'HASH' ? '%__RETURN__' : '@__RETURN__'; if ( $constraint->{uniq} == Any->{uniq} ) { return $expr; } elsif ( $constraint->can_be_inlined ) { return sprintf 'do { my %s = %s; my $__RETURN__ = \ %s; ( %s ) ? %s : %s }', $varname, $expr, $varname, $constraint->inline_check( '$__RETURN__' ), $varname, $self->_make_constraint_fail( constraint => $constraint, varname => '$__RETURN__', display_var => "\\$varname" ); } else { return sprintf 'do { my %s = %s; my $__RETURN__ = \ %s; $return_check_for_list->( $__RETURN__ ) ? %s : %s }', $varname, $expr, $varname, $varname, $self->_make_constraint_fail( constraint => $constraint, varname => '$__RETURN__', display_var => "\\$varname" ); } } sub _make_general_fail { my ( $self, %args ) = ( shift, @_ ); return sprintf( $self->has_on_die ? q{return( "Error::TypeTiny"->throw_cb( $__ON_DIE__, message => %s ) )} : q{"Error::TypeTiny"->throw( message => %s )}, $args{message}, ); } sub _make_constraint_fail { my ( $self, %args ) = ( shift, @_ ); return sprintf( $self->has_on_die ? q{return( Type::Tiny::_failed_check( %d, %s, %s, varname => %s, on_die => $__ON_DIE__ ) )} : q{Type::Tiny::_failed_check( %d, %s, %s, varname => %s )}, $args{constraint}{uniq}, B::perlstring( $args{constraint}->display_name ), $args{varname}, B::perlstring( $args{display_var} || $args{varname} ), ); } sub _make_count_fail { my ( $self, %args ) = ( shift, @_ ); my @counts; if ( $args{got} ) { push @counts, sprintf( 'got => %s', $args{got}, ); } for my $c ( qw/ minimum maximum / ) { is_Int( $args{$c} ) or next; push @counts, sprintf( '%s => %s', $c, $args{$c}, ); } if ( my $package = $self->package and my $subname = $self->subname ) { push @counts, sprintf( 'target => %s', B::perlstring( "$package\::$subname" ), ) if $package ne '__ANON__' && $subname ne '__ANON__'; } return sprintf( $self->has_on_die ? q{return( "Error::TypeTiny::WrongNumberOfParameters"->throw_cb( $__ON_DIE__, %s ) )} : q{"Error::TypeTiny::WrongNumberOfParameters"->throw( %s )}, join( q{, }, @counts ), ); } sub class_attributes { my $self = shift; $self->{class_attributes} ||= $self->_build_class_attributes; } sub _build_class_attributes { my $self = shift; my %predicates; my %getters; my @parameters = @{ $self->parameters }; if ( $self->has_slurpy ) { push @parameters, $self->slurpy; } for my $parameter ( @parameters ) { my $name = $parameter->name; if ( my $predicate = $parameter->predicate ) { $predicate =~ /^[^0-9\W]\w*$/ or $self->_croak( "Bad accessor name: \"$predicate\"" ); $predicates{$predicate} = $name; } if ( my $getter = $parameter->getter ) { $getter =~ /^[^0-9\W]\w*$/ or $self->_croak( "Bad accessor name: \"$getter\"" ); $getters{$getter} = $name; } } return { exists_predicates => \%predicates, getters => \%getters, }; } sub make_class { my $self = shift; my $env = uc( $ENV{PERL_TYPE_PARAMS_XS} || 'XS' ); if ( $env eq 'PP' or $ENV{PERL_ONLY} ) { $self->make_class_pp; } $self->make_class_xs; } sub make_class_xs { my $self = shift; eval { require Class::XSAccessor; 'Class::XSAccessor'->VERSION( '1.17' ); 1; } or return $self->make_class_pp; my $attr = $self->class_attributes; 'Class::XSAccessor'->import( class => $self->bless, replace => 1, %$attr, ); } sub make_class_pp { my $self = shift; my $code = $self->make_class_pp_code; do { local $@; eval( $code ) or die( $@ ); }; } sub make_class_pp_code { my $self = shift; return '' unless $self->is_named && $self->bless && !$self->named_to_list; my $coderef = $self->_new_code_accumulator; my $attr = $self->class_attributes; $coderef->add_line( '{' ); $coderef->{indent} = "\t"; $coderef->add_line( sprintf( 'package %s;', $self->bless ) ); $coderef->add_line( 'use strict;' ); $coderef->add_line( 'no warnings;' ); for my $function ( sort keys %{ $attr->{getters} } ) { my $slot = $attr->{getters}{$function}; $coderef->add_line( sprintf( 'sub %s { $_[0]{%s} }', $function, B::perlstring( $slot ), ) ); } for my $function ( sort keys %{ $attr->{exists_predicates} } ) { my $slot = $attr->{exists_predicates}{$function}; $coderef->add_line( sprintf( 'sub %s { exists $_[0]{%s} }', $function, B::perlstring( $slot ), ) ); } $coderef->add_line( '1;' ); $coderef->{indent} = ""; $coderef->add_line( '}' ); return $coderef->code; } sub return_wanted { my $self = shift; my $coderef = $self->coderef; if ( $self->{want_source} ) { return $coderef->code; } elsif ( $self->{want_object} ) { # undocumented for now return $self; } elsif ( $self->{want_details} ) { return { min_args => $self->{min_args}, max_args => $self->{max_args}, environment => $coderef->{env}, source => $coderef->code, closure => $coderef->compile, named => $self->is_named, class_definition => $self->make_class_pp_code, }; } return $coderef->compile; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Params::Signature - internal representation of a function signature =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can be used to provide basic introspection for signatures. =head2 Constructors =over =item C<< new(%attributes) >> =item C<< new_from_compile($style, %attributes) >> =item C<< new_from_v2api(\%attributes) >> =back =head2 Attributes All attributes are read-only. =over =item C<< package >> B The package we're providing a signature for. Will be used to look up any stringy type names. =item C<< subname >> B The sub we're providing a signature for. =item C<< description >> B =item C<< method >> B<< ArrayRef[InstanceOf['Type::Params::Parameter']] >> =item C<< head >> B<< ArrayRef[InstanceOf['Type::Params::Parameter']] >> =item C<< tail >> B<< ArrayRef[InstanceOf['Type::Params::Parameter']] >> =item C<< parameters >> B<< ArrayRef[InstanceOf['Type::Params::Parameter']] >> =item C<< slurpy >> B<< InstanceOf['Type::Params::Parameter'] >> =item C<< on_die >> B =item C<< strictness >> B<< Bool|ScalarRef >> =item C<< next >> B =item C<< goto_next >> B Alias for C. =item C<< can_shortcut >> B Indicates whether the signature has no potential to alter C<< @_ >> allowing it to be returned without being copied if type checks pass. Generally speaking, you should not provide this to the constructor and rely on Type::Params::Signature to figure it out. =item C<< coderef >> B<< InstanceOf['Eval::TypeTiny::CodeAccumulator'] >> You probably don't want to provide this to the constructor. The whole point of this module is to build it for you! =back =head3 Attributes related to named parameters =over =item C<< is_named >> B =item C<< allow_dash >> B =item C<< bless >> B =item C<< class >> B =item C<< constructor >> B =item C<< class_attributes >> B HashRef suitable for passing to the C method of L. A default will be generated based on C =item C<< named_to_list >> B<< ArrayRef >> Can be coerced from a bool based on C. =item C<< list_to_named >> B<< Bool >> =item C<< oo_trace >> B Defaults to true. Indicates whether blessed C<< $arg >> hashrefs created by the signature will include a C<< '~~caller' >> key. =back =head3 Bare attributes These attributes may be passed to the constructors and may do something, but no methods are provided to access the values later. =over =item C<< positional >> or C<< pos >> B =item C<< named >> B =item C<< multiple >> or C<< multi >> B =item C<< returns >> B Shortcut for setting C and C simultaneously. =item C<< want_source >> B =item C<< want_details >> B =item C<< want_object >> B =item C<< rationalize_slurpies >> B =back =head2 Methods =head3 Predicates Predicate methods return true/false to indicate the presence or absence of attributes. =over =item C<< has_description >> =item C<< has_head >> =item C<< has_tail >> =item C<< has_parameters >> =item C<< has_slurpy >> =item C<< has_on_die >> =item C<< has_strictness >> =item C<< has_returns_scalar >> =item C<< has_returns_list >> =back =head3 Class making methods These methods will be called automatically during object construction and should not typically be called. They are public methods in case it is desired to subclass Type::Params::Signature. =over =item C<< make_class_pp >> Builds the class specified in C by evaluating Perl code. =item C<< make_class_xs >> Builds the class specified in C using L. =item C<< make_class >> Calls either C or C. =item C<< make_class_pp_code >> Generates the code for C. =back =head3 Other methods =over =item C<< BUILD >> Called by the constructors. You should not call this. =item C<< return_wanted >> Normally returns the signature coderef, unless C, C, or C were provided to the constructor, in which case it will return the source code for the coderef, a hashref of details, or C<< $self >>. =back =head1 ENVIRONMENT =over =item C Affects the building of accessors for C<< $arg >> objects. If set to true, will use L. If set to false, will use pure Perl. If this environment variable does not exist, will use Class::XSAccessor. If Class::XSAccessor is not installed or is too old, pure Perl will always be used as a fallback. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Bitfield.pm000664001750001750 2630515111656240 17133 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Bitfield; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Bitfield::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Bitfield::VERSION = '2.008006'; } $Type::Tiny::Bitfield::VERSION =~ tr/_//d; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); use Type::Tiny (); use Types::Common::Numeric qw( +PositiveOrZeroInt ); use Eval::TypeTiny qw( eval_closure ); our @ISA = qw( Type::Tiny Exporter::Tiny ); __PACKAGE__->_install_overloads( q[+] => 'new_combined', ); sub _is_power_of_two { not $_[0] & $_[0]-1 } sub _exporter_fail { my ( $class, $type_name, $args, $globals ) = @_; my $caller = $globals->{into}; my %values = %$args; /^[-]/ && delete( $values{$_} ) for keys %values; my $type = $class->new( name => $type_name, values => \%values, coercion => 1, ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Bitfield type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Bitfield type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Bitfield type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply hashref of values" unless exists $opts{values}; $opts{parent} = PositiveOrZeroInt; for my $key ( keys %{ $opts{values} } ) { _croak "Not an all-caps name in a bitfield: $key" unless $key =~ /^[A-Z][A-Z0-9]*(_[A-Z0-9]+)*/ } my $ALL = 0; my %already = (); for my $value ( values %{ $opts{values} } ) { _croak "Not a positive power of 2 in a bitfield: $value" unless is_PositiveOrZeroInt( $value ) && _is_power_of_two( $value ); _croak "Duplicate value in a bitfield: $value" if $already{$value}++; $ALL |= ( 0 + $value ); } $opts{ALL} = $ALL; $opts{constraint} = sub { not shift() & ~$ALL; }; if ( defined $opts{coercion} and !ref $opts{coercion} and 1 eq $opts{coercion} ) { delete $opts{coercion}; $opts{_build_coercion} = sub { require Types::Standard; my $c = shift; my $t = $c->type_constraint; $c->add_type_coercions( Types::Standard::Str(), $t->_stringy_coercion, ); }; } #/ if ( defined $opts{coercion...}) return $proto->SUPER::new( %opts ); } #/ sub new sub new_combined { my ( $self, $other, $swap ) = @_; Scalar::Util::blessed( $self ) && $self->isa( __PACKAGE__ ) && Scalar::Util::blessed( $other ) && $other->isa( __PACKAGE__ ) or _croak( "Bad overloaded operation" ); ( $other, $self ) = ( $self, $other ) if $swap; for my $k ( keys %{ $self->values } ) { _croak "Conflicting value: $k" if exists $other->values->{$k}; } my %all_values = ( %{ $self->values }, %{ $other->values } ); return ref( $self )->new( display_name => sprintf( '%s+%s', "$self", "$other" ), values => \%all_values, ( $self->has_coercion || $other->has_coercion ) ? ( coercion => 1 ) : (), ); } sub values { $_[0]{values}; } sub _lockdown { my ( $self, $callback ) = @_; $callback->( $self->{values} ); } sub exportables { my ( $self, $base_name ) = @_; if ( not $self->is_anon ) { $base_name ||= $self->name; } my $exportables = $self->SUPER::exportables( $base_name ); require Eval::TypeTiny; require B; for my $key ( keys %{ $self->values } ) { my $value = $self->values->{$key}; push @$exportables, { name => uc( sprintf '%s_%s', $base_name, $key ), tags => [ 'constants' ], code => Eval::TypeTiny::eval_closure( source => sprintf( 'sub () { %d }', $value ), environment => {}, ), }; } my $weak = $self; require Scalar::Util; Scalar::Util::weaken( $weak ); push @$exportables, { name => sprintf( '%s_to_Str', $base_name ), tags => [ 'from' ], code => sub { $weak->to_string( @_ ) }, }; return $exportables; } sub constant_names { my $self = shift; return map { $_->{name} } grep { my $tags = $_->{tags}; grep $_ eq 'constants', @$tags; } @{ $self->exportables || [] }; } sub can_be_inlined { !!1; } sub inline_check { my ( $self, $var ) = @_; return sprintf( '( %s and not %s & ~%d )', PositiveOrZeroInt->inline_check( $var ), $var, $self->{ALL}, ); } sub _stringy_coercion { my ( $self, $varname ) = @_; $varname ||= '$_'; my %vals = %{ $self->values }; my $pfx = uc( "$self" ); my $pfxl = length $pfx; my $hash = sprintf( '( %s )', join( q{, }, map sprintf( '%s => %d', B::perlstring($_), $vals{$_} ), sort keys %vals, ), ); return qq{do { my \$bits = 0; my \%lookup = $hash; for my \$tok ( grep /\\w/, split /[\\s|+]+/, uc( $varname ) ) { if ( substr( \$tok, 0, $pfxl) eq "$pfx" ) { \$tok = substr( \$tok, $pfxl ); \$tok =~ s/^_//; } if ( exists \$lookup{\$tok} ) { \$bits |= \$lookup{\$tok}; next; } require Carp; Carp::carp("Unknown token: \$tok"); } \$bits; }}; } sub from_string { my ( $self, $str ) = @_; $self->{from_string} ||= eval_closure( environment => {}, source => sprintf( 'sub { my $STR = shift; %s }', $self->_stringy_coercion( '$STR' ) ), ); $self->{from_string}->( $str ); } sub to_string { my ( $self, $int ) = @_; $self->check( $int ) or return undef; my %values = %{ $self->values }; $self->{all_names} ||= [ sort { $values{$a} <=> $values{$b} } keys %values ]; $int += 0; my @names; for my $n ( @{ $self->{all_names} } ) { push @names, $n if $int & $values{$n}; } return join q{|}, @names; } sub AUTOLOAD { our $AUTOLOAD; my $self = shift; my ( $m ) = ( $AUTOLOAD =~ /::(\w+)$/ ); return if $m eq 'DESTROY'; if ( ref $self and exists $self->{values}{$m} ) { return 0 + $self->{values}{$m}; } local $Type::Tiny::AUTOLOAD = $AUTOLOAD; return $self->SUPER::AUTOLOAD( @_ ); } sub can { my ( $self, $m ) = ( shift, @_ ); if ( ref $self and exists $self->{values}{$m} ) { return sub () { 0 + $self->{values}{$m} }; } return $self->SUPER::can( @_ ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Bitfield - bitfield/bitflag type constraints =head1 SYNOPSIS Using Type::Tiny::Bitfield's export feature: package LightSource { use Moo; use Type::Tiny::Bitfield LedSet => { RED => 1, GREEN => 2, BLUE => 4, }; has leds => ( is => 'ro', isa => LedSet, default => 0, coerce => 1 ); sub new_red { my $class = shift; return $class->new( leds => LEDSET_RED ); } sub new_green { my $class = shift; return $class->new( leds => LEDSET_GREEN ); } sub new_yellow { my $class = shift; return $class->new( leds => LEDSET_RED | LEDSET_GREEN ); } } Using Type::Tiny::Bitfield's object-oriented interface: package LightSource { use Moo; use Type::Tiny::Bitfield; my $LedSet = Type::Tiny::Bitfield->new( name => 'LedSet', values => { RED => 1, GREEN => 2, BLUE => 4, }, coercion => 1, ); has leds => ( is => 'ro', isa => $LedSet, default => 0, coerce => 1 ); sub new_red { my $class = shift; return $class->new( leds => $LedSet->RED ); } sub new_green { my $class = shift; return $class->new( leds => $LedSet->GREEN ); } sub new_yellow { my $class = shift; return $class->new( leds => $LedSet->coerce('red|green') ); } } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Bitfield type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C Hashref of bits allowed in the bitfield. Keys must be UPPER_SNAKE_CASE strings. Values must be positive integers which are powers of two. The same number cannot be used multiple times. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always B, and cannot be passed to the constructor. =item C If C<< coercion => 1 >> is passed to the constructor, the type will have an automatic coercion from B. Types built by the C method will always have C<< coercion => 1 >>. In the SYNOPSIS example, the coercion from B will accept strings like: "RED" "red" "Red Green" "Red+Blue" "blue | GREEN" "LEDSET_RED + LeDsEt_green" =back =head2 Methods This class uses C to allow the names of each bit in the bitfield to be used as methods. These method names will always be UPPER_SNAKE_CASE. For example, in the synopsis, C<< LedSet->GREEN >> would return 2. Other methods it provides: =over =item C<< from_string( $str ) >> Provides the standard coercion from a string, even if this type constraint doesn't have a coercion. =item C<< to_string( $int ) >> Does the reverse coercion. =item C<< constant_names() >> This is a convenience to allow for: use base 'Exporter::Tiny'; push our @EXPORT_OK, LineStyle->constant_names; =back =head2 Exports Type::Tiny::Bitfield can be used as an exporter. use Type::Tiny::Bitfield LedSet => { RED => 1, GREEN => 2, BLUE => 4, }; This will export the following functions into your namespace: =over =item C<< LedSet >> =item C<< is_LedSet( $value ) >> =item C<< assert_LedSet( $value ) >> =item C<< to_LedSet( $string ) >> =item C<< LedSet_to_Str( $value ) >> =item C<< LEDSET_RED >> =item C<< LEDSET_GREEN >> =item C<< LEDSET_BLUE >> =back Multiple bitfield types can be exported at once: use Type::Tiny::Enum ( LedSet => { RED => 1, GREEN => 2, BLUE => 4 }, LedPattern => { FLASHING => 1 }, ); =head2 Overloading It is possible to combine two Bitfield types using the C<< + >> operator. use Type::Tiny::Enum ( LedSet => { RED => 1, GREEN => 2, BLUE => 4 }, LedPattern => { FLASHING => 8 }, ); has leds => ( is => 'ro', isa => LedSet + LedPattern, default => 0, coerce => 1 ); This will allow values like "11" (LEDSET_RED|LEDSET_GREEN|LEDPATTERN_FLASHING). An exception will be thrown if any of the names in the two types being combined conflict. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Class.pm000664001750001750 2570315111656240 16457 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Class; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Class::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Class::VERSION = '2.008006'; } $Type::Tiny::Class::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); use Type::Tiny::ConstrainedObject (); our @ISA = qw( Type::Tiny::ConstrainedObject Exporter::Tiny ); sub _short_name { 'Class' } sub _exporter_fail { my ( $class, $name, $opts, $globals ) = @_; my $caller = $globals->{into}; $opts->{name} = $name unless exists $opts->{name}; $opts->{name} =~ s/:://g; $opts->{class} = $name unless exists $opts->{class}; my $type = $class->new($opts); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type ) : ( $Type::Registry::DELAYED{$caller}{$type->name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } sub new { my $proto = shift; return $proto->class->new( @_ ) if blessed $proto; # DWIM my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Need to supply class name" unless exists $opts{class}; if ( Type::Tiny::_USE_XS ) { my $xsub = Type::Tiny::XS::get_coderef_for( "InstanceOf[" . $opts{class} . "]" ); $opts{compiled_type_constraint} = $xsub if $xsub; } elsif ( Type::Tiny::_USE_MOUSE ) { require Mouse::Util::TypeConstraints; my $maker = "Mouse::Util::TypeConstraints"->can( "generate_isa_predicate_for" ); $opts{compiled_type_constraint} = $maker->( $opts{class} ) if $maker; } return $proto->SUPER::new( %opts ); } #/ sub new sub class { $_[0]{class} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _is_null_constraint { 0 } sub _build_constraint { my $self = shift; my $class = $self->class; return sub { blessed( $_ ) and $_->isa( $class ) }; } sub _build_inlined { my $self = shift; my $class = $self->class; my $xsub; $xsub = Type::Tiny::XS::get_subname_for( "InstanceOf[$class]" ) if Type::Tiny::_USE_XS; sub { my $var = $_[1]; return qq{do { use Scalar::Util (); Scalar::Util::blessed($var) and $var->isa(q[$class]) }} if $Type::Tiny::AvoidCallbacks; return "$xsub\($var\)" if $xsub; qq{Scalar::Util::blessed($var) and $var->isa(q[$class])}; }; } #/ sub _build_inlined sub _build_default_message { no warnings 'uninitialized'; my $self = shift; my $c = $self->class; return sub { sprintf '%s did not pass type constraint (not isa %s)', Type::Tiny::_dd( $_[0] ), $c; } if $self->is_anon; my $name = "$self"; return sub { sprintf '%s did not pass type constraint "%s" (not isa %s)', Type::Tiny::_dd( $_[0] ), $name, $c; }; } #/ sub _build_default_message sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::Class; return "Moose::Meta::TypeConstraint::Class" ->new( %opts, class => $self->class ); } #/ sub _instantiate_moose_type sub plus_constructors { my $self = shift; unless ( @_ ) { require Types::Standard; push @_, Types::Standard::HashRef(), "new"; } require B; require Types::TypeTiny; my $class = B::perlstring( $self->class ); my @r; while ( @_ ) { my $source = shift; Types::TypeTiny::is_TypeTiny( $source ) or _croak "Expected type constraint; got $source"; my $constructor = shift; Types::TypeTiny::is_StringLike( $constructor ) or _croak "Expected string; got $constructor"; push @r, $source, sprintf( '%s->%s($_)', $class, $constructor ); } #/ while ( @_ ) return $self->plus_coercions( \@r ); } #/ sub plus_constructors sub parent { $_[0]{parent} ||= $_[0]->_build_parent; } sub _build_parent { my $self = shift; my $class = $self->class; # Some classes (I'm looking at you, Math::BigFloat) include a class in # their @ISA to inherit methods, but then override isa() to return false, # so that they don't appear to be a subclass. # # In these cases, we don't want to list the parent class as a parent # type constraint. # my @isa = grep $class->isa( $_ ), do { no strict "refs"; no warnings; @{"$class\::ISA"} }; if ( @isa == 0 ) { require Types::Standard; return Types::Standard::Object(); } if ( @isa == 1 ) { return ref( $self )->new( class => $isa[0] ); } require Type::Tiny::Intersection; "Type::Tiny::Intersection"->new( type_constraints => [ map ref( $self )->new( class => $_ ), @isa ], ); } #/ sub _build_parent *__get_linear_isa_dfs = eval { require mro } ? \&mro::get_linear_isa : sub { no strict 'refs'; my $classname = shift; my @lin = ( $classname ); my %stored; foreach my $parent ( @{"$classname\::ISA"} ) { my $plin = __get_linear_isa_dfs( $parent ); foreach ( @$plin ) { next if exists $stored{$_}; push( @lin, $_ ); $stored{$_} = 1; } } return \@lin; }; sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); return ["Not a blessed reference"] unless blessed( $value ); my @isa = @{ __get_linear_isa_dfs( ref $value ) }; my $display_var = $varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ); require Type::Utils; return [ sprintf( '"%s" requires that the reference isa %s', $self, $self->class ), sprintf( 'The reference%s isa %s', $display_var, Type::Utils::english_list( @isa ) ), ]; } #/ sub validate_explain 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Class - type constraints based on the "isa" method =head1 SYNOPSIS Using via L: package Local::Horse { use Moo; use Types::Standard qw( Str InstanceOf ); has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => InstanceOf[ 'Local::Person' ], default => sub { Local::Person->new }, ); } Using Type::Tiny::Class's export feature: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Class 'Local::Person'; has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => LocalPerson, default => sub { LocalPerson->new }, ); } Using Type::Tiny::Class's object-oriented interface: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Class; my $Person = Type::Tiny::Class->new( class => 'Local::Person' ); has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => $Person, default => sub { $Person->new }, ); } Using Type::Utils's functional interface: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Utils; my $Person = class_type 'Local::Person'; has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => $Person, default => sub { $Person->new }, ); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Type constraints of the general form C<< { $_->isa("Some::Class") } >>. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructor =over =item C When the constructor is called on an I of Type::Tiny::Class, it passes the call through to the constructor of the class for the constraint. So for example: my $type = Type::Tiny::Class->new(class => "Foo::Bar"); my $obj = $type->new(hello => "World"); say ref($obj); # prints "Foo::Bar" This little bit of DWIM was borrowed from L, but Type::Tiny doesn't take the idea quite as far. =back =head2 Attributes =over =item C The class for the constraint. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is automatically calculated, and cannot be passed to the constructor. =back =head2 Methods =over =item C<< plus_constructors($source, $method_name) >> Much like C but adds coercions that go via a constructor. (In fact, this is implemented as a wrapper for C.) Example: package MyApp::Minion; use Moose; extends "MyApp::Person"; use Types::Standard qw( HashRef Str ); use Type::Utils qw( class_type ); my $Person = class_type({ class => "MyApp::Person" }); has boss => ( is => "ro", isa => $Person->plus_constructors( HashRef, "new", Str, "_new_from_name", ), coerce => 1, ); package main; MyApp::Minion->new( ..., boss => "Bob", ## via MyApp::Person->_new_from_name ); MyApp::Minion->new( ..., boss => { name => "Bob" }, ## via MyApp::Person->new ); Because coercing C via constructor is a common desire, if you call C with no arguments at all, this is the default. $classtype->plus_constructors(HashRef, "new") $classtype->plus_constructors() ## identical to above This is handy for Moose/Mouse/Moo-based classes. =item C<< stringifies_to($constraint) >> See L. =item C<< numifies_to($constraint) >> See L. =item C<< with_attribute_values($attr1 => $constraint1, ...) >> See L. =back =head2 Exports Type::Tiny::Class can be used as an exporter. use Type::Tiny::Class 'HTTP::Tiny'; This will export the following functions into your namespace: =over =item C<< HTTPTiny >> =item C<< is_HTTPTiny( $value ) >> =item C<< assert_HTTPTiny( $value ) >> =item C<< to_HTTPTiny( $value ) >> =back You will also be able to use C<< HTTPTiny->new(...) >> as a shortcut for C<< HTTP::Tiny->new(...) >>. Multiple types can be exported at once: use Type::Tiny::Class qw( HTTP::Tiny LWP::UserAgent ); =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. ConstrainedObject.pm000664001750001750 1416015111656240 21005 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::ConstrainedObject; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::ConstrainedObject::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::ConstrainedObject::VERSION = '2.008006'; } $Type::Tiny::ConstrainedObject::VERSION =~ tr/_//d; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Type::Tiny (); our @ISA = 'Type::Tiny'; my %errlabel = ( parent => 'a parent', constraint => 'a constraint coderef', inlined => 'an inlining coderef', ); sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; for my $key ( qw/ parent constraint inlined / ) { next unless exists $opts{$key}; _croak( '%s type constraints cannot have %s passed to the constructor', $proto->_short_name, $errlabel{$key}, ); } $proto->SUPER::new( %opts ); } #/ sub new sub has_parent { !!1; } sub parent { require Types::Standard; Types::Standard::Object(); } sub _short_name { die "subclasses must implement this"; # uncoverable statement } my $i = 0; my $_where_expressions = sub { my $self = shift; my $name = shift; $name ||= "where expression check"; my ( %env, @codes ); while ( @_ ) { my $expr = shift; my $constraint = shift; if ( !ref $constraint ) { push @codes, sprintf( 'do { local $_ = %s; %s }', $expr, $constraint ); } else { require Types::Standard; my $type = Types::Standard::is_RegexpRef( $constraint ) ? Types::Standard::StrMatch()->of( $constraint ) : Types::TypeTiny::to_TypeTiny( $constraint ); if ( $type->can_be_inlined ) { push @codes, sprintf( 'do { my $tmp = %s; %s }', $expr, $type->inline_check( '$tmp' ) ); } else { ++$i; $env{ '$chk' . $i } = do { my $chk = $type->compiled_check; \$chk }; push @codes, sprintf( '$chk%d->(%s)', $i, $expr ); } } #/ else [ if ( !ref $constraint )] } #/ while ( @_ ) if ( keys %env ) { # cannot inline my $sub = Eval::TypeTiny::eval_closure( source => sprintf( 'sub ($) { local $_ = shift; %s }', join( q( and ), @codes ) ), description => sprintf( '%s for %s', $name, $self->name ), environment => \%env, ); return $self->where( $sub ); } #/ if ( keys %env ) else { return $self->where( join( q( and ), @codes ) ); } }; sub stringifies_to { my $self = shift; my ( $constraint ) = @_; $self->$_where_expressions( "stringification check", q{"$_"}, $constraint ); } sub numifies_to { my $self = shift; my ( $constraint ) = @_; $self->$_where_expressions( "numification check", q{0+$_}, $constraint ); } sub with_attribute_values { my $self = shift; my %constraint = @_; $self->$_where_expressions( "attributes check", map { my $attr = $_; qq{\$_->$attr} => $constraint{$attr} } sort keys %constraint, ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::ConstrainedObject - shared behaviour for Type::Tiny::Class, etc =head1 STATUS This module is considered experiemental. =head1 DESCRIPTION =head2 Methods The following methods exist for L, L, L, and any type constraints that inherit from C or C in L. These methods will also work for L if at least one of the types in the intersection provides these methods. These methods will also work for L if all of the types in the union provide these methods. =over =item C<< stringifies_to($constraint) >> Generates a new child type constraint which checks the object's stringification against a constraint. For example: my $type = Type::Tiny::Class->new(class => 'URI'); my $child = $type->stringifies_to( StrMatch[qr/^http:/] ); $child->assert_valid( URI->new("http://example.com/") ); In the above example, C<< $child >> is a type constraint that checks objects are blessed into (or inherit from) the URI class, and when stringified (e.g. though overloading) the result matches the regular expression C<< qr/^http:/ >>. C<< $constraint >> may be a type constraint, something that can be coerced to a type constraint (such as a coderef returning a boolean), a string of Perl code operating on C<< $_ >>, or a reference to a regular expression. So the following would work: my $child = $type->stringifies_to( sub { qr/^http:/ } ); my $child = $type->stringifies_to( qr/^http:/ ); my $child = $type->stringifies_to( 'm/^http:/' ); my $child = $type->where('"$_" =~ /^http:/'); =item C<< numifies_to($constraint) >> The same as C but checks numification. The following might be useful: use Types::Standard qw(Int Overload); my $IntLike = Int | Overload->numifies_to(Int) =item C<< with_attribute_values($attr1 => $constraint1, ...) >> This is best explained with an example: use Types::Common qw( InstanceOf StrMatch IntRange ); my $person = InstanceOf['Local::Human']; my $woman = $person->with_attribute_values( gender => StrMatch[ qr/^F/i ], age => IntRange[ 18 => () ], ); $woman->assert_valid($alice); This assertion will firstly check that C<< $alice >> is a Local::Human, then check that C<< $alice->gender >> starts with an "F", and lastly check that C<< $alice->age >> is an integer at least 18. Again, constraints can be type constraints, coderefs, strings of Perl code, or regular expressions. Technically the "attributes" don't need to be Moo/Moose/Mouse attributes, but any methods which can be called with no parameters and return a scalar. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Duck.pm000664001750001750 2273415111656240 16301 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Duck; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Duck::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Duck::VERSION = '2.008006'; } $Type::Tiny::Duck::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); use Type::Tiny::ConstrainedObject (); our @ISA = qw( Type::Tiny::ConstrainedObject Exporter::Tiny ); sub _short_name { 'Duck' } sub _exporter_fail { my ( $class, $type_name, $methods, $globals ) = @_; my $caller = $globals->{into}; my $type = $class->new( name => $type_name, methods => [ @$methods ], ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Need to supply list of methods" unless exists $opts{methods}; $opts{methods} = [ $opts{methods} ] unless ref $opts{methods}; if ( Type::Tiny::_USE_XS ) { my $methods = join ",", sort( @{ $opts{methods} } ); my $xsub = Type::Tiny::XS::get_coderef_for( "HasMethods[$methods]" ); $opts{compiled_type_constraint} = $xsub if $xsub; } elsif ( Type::Tiny::_USE_MOUSE ) { require Mouse::Util::TypeConstraints; my $maker = "Mouse::Util::TypeConstraints"->can( "generate_can_predicate_for" ); $opts{compiled_type_constraint} = $maker->( $opts{methods} ) if $maker; } return $proto->SUPER::new( %opts ); } #/ sub new sub new_intersection { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; my @types = @{ delete $opts{type_constraints} }; my %values; ++$values{$_} for map @{$_->methods}, @types; my @values = sort keys %values; if ( $INC{'Types/Standard.pm'} and not keys %opts ) { return Types::Standard::HasMethods->of( @values ); } return $proto->new( %opts, methods => \@values ); } sub _lockdown { my ( $self, $callback ) = @_; $callback->( $self->{methods} ); } sub methods { $_[0]{methods} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _is_null_constraint { 0 } sub _build_constraint { my $self = shift; my @methods = @{ $self->methods }; return sub { blessed( $_[0] ) and not grep( !$_[0]->can( $_ ), @methods ); }; } sub _build_inlined { my $self = shift; my @methods = @{ $self->methods }; my $xsub; if ( Type::Tiny::_USE_XS ) { my $methods = join ",", sort( @{ $self->methods } ); $xsub = Type::Tiny::XS::get_subname_for( "HasMethods[$methods]" ); } sub { my $var = $_[1]; local $" = q{ }; # If $var is $_ or $_->{foo} or $foo{$_} or somesuch, then we # can't use it within the grep expression, so we need to save # it into a temporary variable ($tmp). my $code = ( $var =~ /\$_/ ) ? qq{ Scalar::Util::blessed($var) and not do { my \$tmp = $var; grep(!\$tmp->can(\$_), qw/@methods/) } } : qq{ Scalar::Util::blessed($var) and not grep(!$var->can(\$_), qw/@methods/) }; return qq{do { $Type::Tiny::SafePackage use Scalar::Util (); $code }} if $Type::Tiny::AvoidCallbacks; return "$xsub\($var\)" if $xsub; $code; }; } #/ sub _build_inlined sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::DuckType; return "Moose::Meta::TypeConstraint::DuckType" ->new( %opts, methods => $self->methods ); } #/ sub _instantiate_moose_type sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); return ["Not a blessed reference"] unless blessed( $value ); require Type::Utils; return [ sprintf( '"%s" requires that the reference can %s', $self, Type::Utils::english_list( map qq["$_"], @{ $self->methods } ), ), map sprintf( 'The reference cannot "%s"', $_ ), grep !$value->can( $_ ), @{ $self->methods } ]; } #/ sub validate_explain push @Type::Tiny::CMP, sub { my $A = shift->find_constraining_type; my $B = shift->find_constraining_type; return Type::Tiny::CMP_UNKNOWN unless $A->isa( __PACKAGE__ ) && $B->isa( __PACKAGE__ ); my %seen; for my $word ( @{ $A->methods } ) { $seen{$word} += 1; } for my $word ( @{ $B->methods } ) { $seen{$word} += 2; } my $values = join( '', CORE::values %seen ); if ( $values =~ /^3*$/ ) { return Type::Tiny::CMP_EQUIVALENT; } elsif ( $values !~ /2/ ) { return Type::Tiny::CMP_SUBTYPE; } elsif ( $values !~ /1/ ) { return Type::Tiny::CMP_SUPERTYPE; } return Type::Tiny::CMP_UNKNOWN; }; 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Duck - type constraints based on the "can" method =head1 SYNOPSIS Using via L: package Logger { use Moo; use Types::Standard qw( HasMethods Bool ); has debugging => ( is => 'rw', isa => Bool, default => 0 ); has output => ( is => 'ro', isa => HasMethods[ 'print' ] ); sub warn { my ( $self, $message ) = @_; $self->output->print( "[WARNING] $message\n" ); } sub debug { my ( $self, $message ) = @_; $self->output->print( "[DEBUG] $message\n" ) if $self->debugging; } } Using Type::Tiny::Duck's export feature: package Logger { use Moo; use Types::Standard qw( Bool ); use Type::Tiny::Duck Printable => [ 'print' ]; has debugging => ( is => 'rw', isa => Bool, default => 0 ); has output => ( is => 'ro', isa => Printable ); sub warn { my ( $self, $message ) = @_; $self->output->print( "[WARNING] $message\n" ); } sub debug { my ( $self, $message ) = @_; $self->output->print( "[DEBUG] $message\n" ) if $self->debugging; } } Using Type::Tiny::Duck's object-oriented interface: package Logger { use Moo; use Types::Standard qw( Bool ); use Type::Tiny::Duck; my $Printable = Type::Type::Duck->new( name => 'Printable', methods => [ 'print' ], ); has debugging => ( is => 'rw', isa => Bool, default => 0 ); has output => ( is => 'ro', isa => $Printable ); sub warn { my ( $self, $message ) = @_; $self->output->print( "[WARNING] $message\n" ); } sub debug { my ( $self, $message ) = @_; $self->output->print( "[DEBUG] $message\n" ) if $self->debugging; } } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Type constraints of the general form C<< { $_->can("method") } >>. The name refers to the saying, "If it looks like a duck, swims like a duck, and quacks like a duck, then it probably is a duck". Duck typing can be a more flexible way of testing objects than relying on C, as it allows people to easily substitute mock objects. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructors The C constructor from L still works, of course. But there is also: =over =item C<< new_intersection( type_constraints => \@ducklings, %opts ) >> Creates a new duck type constraint which is the intersection of existing duck type constraints. This allows the intersection of C<< HasMethods['read'] >> and C<< HasMethods['write'] >> to be simply C<< HasMethods['read', 'write'] >> instead of a complex union type constraint with two duck type constraints as its children. =back =head2 Attributes =over =item C An arrayref of method names. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always B, and cannot be passed to the constructor. =back =head2 Methods =over =item C<< stringifies_to($constraint) >> See L. =item C<< numifies_to($constraint) >> See L. =item C<< with_attribute_values($attr1 => $constraint1, ...) >> See L. =back =head2 Exports Type::Tiny::Duck can be used as an exporter. use Type::Tiny::Duck HttpClient => [ 'get', 'post' ]; This will export the following functions into your namespace: =over =item C<< HttpClient >> =item C<< is_HttpClient( $value ) >> =item C<< assert_HttpClient( $value ) >> =item C<< to_HttpClient( $value ) >> =back Multiple types can be exported at once: use Type::Tiny::Duck ( HttpClient => [ 'get', 'post' ], FtpClient => [ 'upload', 'download' ], ); =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Enum.pm000664001750001750 4356615111656240 16325 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Enum; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Enum::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Enum::VERSION = '2.008006'; } $Type::Tiny::Enum::VERSION =~ tr/_//d; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); use Type::Tiny (); our @ISA = qw( Type::Tiny Exporter::Tiny ); __PACKAGE__->_install_overloads( q[@{}] => sub { shift->values }, ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my $type = $class->new( name => $type_name, values => [ @$values ], coercion => 1, ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Enum type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Enum type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Enum type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of values" unless exists $opts{values}; no warnings 'uninitialized'; $opts{values} = [ map "$_", @{ ref $opts{values} eq 'ARRAY' ? $opts{values} : [ $opts{values} ] } ]; my %tmp; undef $tmp{$_} for @{ $opts{values} }; $opts{unique_values} = [ sort keys %tmp ]; my $xs_encoding = _xs_encoding( $opts{unique_values} ); if ( defined $xs_encoding ) { my $xsub = Type::Tiny::XS::get_coderef_for( $xs_encoding ); $opts{compiled_type_constraint} = $xsub if $xsub; } if ( defined $opts{coercion} and !ref $opts{coercion} and 1 eq $opts{coercion} ) { delete $opts{coercion}; $opts{_build_coercion} = sub { require Types::Standard; my $c = shift; my $t = $c->type_constraint; $c->add_type_coercions( Types::Standard::Str(), sub { $t->closest_match( @_ ? $_[0] : $_ ) } ); }; } #/ if ( defined $opts{coercion...}) return $proto->SUPER::new( %opts ); } #/ sub new sub _lockdown { my ( $self, $callback ) = @_; $callback->( $self->{values}, $self->{unique_values} ); } sub new_union { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; my @types = @{ delete $opts{type_constraints} }; my @values = map @$_, @types; $proto->new( %opts, values => \@values ); } sub new_intersection { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; my @types = @{ delete $opts{type_constraints} }; my %values; ++$values{$_} for map @$_, @types; my @values = sort grep $values{$_}==@types, keys %values; $proto->new( %opts, values => \@values ); } sub values { $_[0]{values} } sub unique_values { $_[0]{unique_values} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub use_eq { return $_[0]{use_eq} if exists $_[0]{use_eq}; $_[0]{use_eq} = $_[0]->_build_use_eq } sub _is_null_constraint { 0 } sub _build_display_name { my $self = shift; sprintf( "Enum[%s]", join q[,], @{ $self->unique_values } ); } sub _build_use_eq { my $self = shift; !Type::Tiny::_USE_XS and @{ $self->unique_values } <= 5; } sub is_word_safe { my $self = shift; return not grep /\W/, @{ $self->unique_values }; } sub exportables { my ( $self, $base_name ) = @_; if ( not $self->is_anon ) { $base_name ||= $self->name; } my $exportables = $self->SUPER::exportables( $base_name ); if ( $self->is_word_safe ) { require Eval::TypeTiny; require B; for my $value ( @{ $self->unique_values } ) { push @$exportables, { name => uc( sprintf '%s_%s', $base_name, $value ), tags => [ 'constants' ], code => Eval::TypeTiny::eval_closure( source => sprintf( 'sub () { %s }', B::perlstring($value) ), environment => {}, ), }; } } return $exportables; } { my $new_xs; # # Note the fallback code for older Type::Tiny::XS cannot be tested as # part of the coverage tests because they use the latest Type::Tiny::XS. # sub _xs_encoding { my $unique_values = shift; return undef unless Type::Tiny::_USE_XS; return undef if @$unique_values > 50; # RT 121957 $new_xs = eval { Type::Tiny::XS->VERSION( "0.020" ); 1 } ? 1 : 0 unless defined $new_xs; if ( $new_xs ) { require B; return sprintf( "Enum[%s]", join( ",", map B::perlstring( $_ ), @$unique_values ) ); } else { # uncoverable statement return undef if grep /\W/, @$unique_values; # uncoverable statement return sprintf( "Enum[%s]", join( ",", @$unique_values ) ); # uncoverable statement } # uncoverable statement } #/ sub _xs_encoding } { my %cached; sub _build_constraint { my $self = shift; my $regexp = $self->_regexp; return $cached{$regexp} if $cached{$regexp}; my $coderef = ( $cached{$regexp} = sub { defined and m{\A(?:$regexp)\z} } ); Scalar::Util::weaken( $cached{$regexp} ); return $coderef; } } { my %cached; sub _build_compiled_check { my $self = shift; my $regexp = $self->_regexp; return $cached{$regexp} if $cached{$regexp}; my $coderef = ( $cached{$regexp} = $self->SUPER::_build_compiled_check( @_ ) ); Scalar::Util::weaken( $cached{$regexp} ); return $coderef; } } sub _regexp { my $self = shift; $self->{_regexp} ||= 'Type::Tiny::Enum::_Trie'->handle( $self->unique_values ); } sub as_regexp { my $self = shift; my $flags = @_ ? $_[0] : ''; unless ( defined $flags and $flags =~ /^[i]*$/ ) { _croak( "Unknown regexp flags: '$flags'; only 'i' currently accepted; stopped" ); } my $regexp = $self->_regexp; $flags ? qr/\A(?:$regexp)\z/i : qr/\A(?:$regexp)\z/; } #/ sub as_regexp sub can_be_inlined { !!1; } sub inline_check { my $self = shift; if ( my $xs_encoding = _xs_encoding( $self->unique_values ) ) { my $xsub = Type::Tiny::XS::get_subname_for( $xs_encoding ); return "$xsub\($_[0]\)" if $xsub && !$Type::Tiny::AvoidCallbacks; } my $code; if ( $self->use_eq ) { use B (); my %seen; my @vals = grep { not $seen{$_}++ } @{ $self->values }; if ( @vals == 1 ) { $code = sprintf( '(defined %s and !ref %s and %s eq %s)', $_[0], $_[0], $_[0], B::perlstring($vals[0]) ); } else { $code = sprintf( '(defined %s and !ref %s and (%s))', $_[0], $_[0], join q{ or } => map { sprintf '(%s eq %s)', $_[0], B::perlstring($_) } @vals ); } } else { my $regexp = $self->_regexp; $code = $_[0] eq '$_' ? "(defined and !ref and m{\\A(?:$regexp)\\z})" : "(defined($_[0]) and !ref($_[0]) and $_[0] =~ m{\\A(?:$regexp)\\z})"; } return "do { $Type::Tiny::SafePackage $code }" if $Type::Tiny::AvoidCallbacks; return $code; } #/ sub inline_check sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; require Moose::Meta::TypeConstraint::Enum; return "Moose::Meta::TypeConstraint::Enum" ->new( %opts, values => $self->values ); } #/ sub _instantiate_moose_type sub has_parent { !!1; } sub parent { require Types::Standard; Types::Standard::Str(); } sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); require Type::Utils; !defined( $value ) ? [ sprintf( '"%s" requires that the value is defined', $self, ), ] : @$self < 13 ? [ sprintf( '"%s" requires that the value is equal to %s', $self, Type::Utils::english_list( \"or", map B::perlstring( $_ ), @$self ), ), ] : [ sprintf( '"%s" requires that the value is one of an enumerated list of strings', $self, ), ]; } #/ sub validate_explain sub has_sorter { !!1; } sub _enum_order_hash { my $self = shift; my %hash; my $i = 0; for my $value ( @{ $self->values } ) { next if exists $hash{$value}; $hash{$value} = $i++; } return %hash; } #/ sub _enum_order_hash sub sorter { my $self = shift; my %hash = $self->_enum_order_hash; return [ sub { $_[0] <=> $_[1] }, sub { exists( $hash{ $_[0] } ) ? $hash{ $_[0] } : 2_100_000_000 }, ]; } my $canon; sub closest_match { require Types::Standard; my ( $self, $given ) = ( shift, @_ ); return unless Types::Standard::is_Str $given; return $given if $self->check( $given ); $canon ||= eval( $] lt '5.016' ? q< sub { ( my $var = lc($_[0]) ) =~ s/(^\s+)|(\s+$)//g; $var } > : q< sub { CORE::fc($_[0]) =~ s/(^\s+)|(\s+$)//gr; } > ); $self->{_lookups} ||= do { my %lookups; for ( @{ $self->values } ) { my $key = $canon->( $_ ); next if exists $lookups{$key}; $lookups{$key} = $_; } \%lookups; }; my $cgiven = $canon->( $given ); return $self->{_lookups}{$cgiven} if $self->{_lookups}{$cgiven}; my $best; VALUE: for my $possible ( @{ $self->values } ) { my $stem = substr( $possible, 0, length $cgiven ); if ( $cgiven eq $canon->( $stem ) ) { if ( defined( $best ) and length( $best ) >= length( $possible ) ) { next VALUE; } $best = $possible; } } return $best if defined $best; return $self->values->[$given] if Types::Standard::is_Int $given; return $given; } #/ sub closest_match push @Type::Tiny::CMP, sub { my $A = shift->find_constraining_type; my $B = shift->find_constraining_type; return Type::Tiny::CMP_UNKNOWN unless $A->isa( __PACKAGE__ ) && $B->isa( __PACKAGE__ ); my %seen; for my $word ( @{ $A->unique_values } ) { $seen{$word} += 1; } for my $word ( @{ $B->unique_values } ) { $seen{$word} += 2; } my $values = join( '', CORE::values %seen ); if ( $values =~ /^3*$/ ) { return Type::Tiny::CMP_EQUIVALENT; } elsif ( $values !~ /2/ ) { return Type::Tiny::CMP_SUPERTYPE; } elsif ( $values !~ /1/ ) { return Type::Tiny::CMP_SUBTYPE; } return Type::Tiny::CMP_UNKNOWN; }; package # stolen from Regexp::Trie Type::Tiny::Enum::_Trie; sub new { bless {} => shift } sub add { my $self = shift; my $str = shift; my $ref = $self; for my $char ( split //, $str ) { $ref->{$char} ||= {}; $ref = $ref->{$char}; } $ref->{''} = 1; # { '' => 1 } as terminator $self; } #/ sub add sub _regexp { my $self = shift; return if $self->{''} and scalar keys %$self == 1; # terminator my ( @alt, @cc ); my $q = 0; for my $char ( sort keys %$self ) { my $qchar = quotemeta $char; if ( ref $self->{$char} ) { if ( defined( my $recurse = _regexp( $self->{$char} ) ) ) { push @alt, $qchar . $recurse; } else { push @cc, $qchar; } } else { $q = 1; } } #/ for my $char ( sort keys...) my $cconly = !@alt; @cc and push @alt, @cc == 1 ? $cc[0] : '[' . join( '', @cc ) . ']'; my $result = @alt == 1 ? $alt[0] : '(?:' . join( '|', @alt ) . ')'; $q and $result = $cconly ? "$result?" : "(?:$result)?"; return $result; } #/ sub _regexp sub handle { my $class = shift; my ( $vals ) = @_; return '(?!)' unless @$vals; my $self = $class->new; $self->add( $_ ) for @$vals; $self->_regexp; } 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Enum - string enum type constraints =head1 SYNOPSIS Using via L: package Horse { use Moo; use Types::Standard qw( Str Enum ); has name => ( is => 'ro', isa => Str ); has status => ( is => 'ro', isa => Enum[ 'alive', 'dead' ] ); sub neigh { my ( $self ) = @_; return if $self->status eq 'dead'; ...; } } Using Type::Tiny::Enum's export feature: package Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Enum Status => [ 'alive', 'dead' ]; has name => ( is => 'ro', isa => Str ); has status => ( is => 'ro', isa => Status, default => STATUS_ALIVE ); sub neigh { my ( $self ) = @_; return if $self->status eq STATUS_DEAD; ...; } } Using Type::Tiny::Enum's object-oriented interface: package Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Enum; my $Status = Type::Tiny::Enum->new( name => 'Status', values => [ 'alive', 'dead' ], ); has name => ( is => 'ro', isa => Str ); has status => ( is => 'ro', isa => $Status, default => $Status->[0] ); sub neigh { my ( $self ) = @_; return if $self->status eq $Status->[0]; ...; } } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Enum type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructors The C constructor from L still works, of course. But there is also: =over =item C<< new_union( type_constraints => \@enums, %opts ) >> Creates a new enum type constraint which is the union of existing enum type constraints. =item C<< new_intersection( type_constraints => \@enums, %opts ) >> Creates a new enum type constraint which is the intersection of existing enum type constraints. =back =head2 Attributes =over =item C Arrayref of allowable value strings. Non-string values (e.g. objects with overloading) will be stringified in the constructor. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always B, and cannot be passed to the constructor. =item C The list of C but sorted and with duplicates removed. This cannot be passed to the constructor. =item C If C<< coercion => 1 >> is passed to the constructor, the type will have a coercion using the C method. =item C When generating Perl type checking code, Type::Tiny::Enum will traditionally test incoming strings for being valid using a single regular expression, unless L is available and a faster XS check is possible. From version 2.008006 onwards, if L is unavailable, and the enum is "small" (five possible values or less), Type::Tiny::Enum will instead generate code like: ( $_ eq "foo" or $_ eq "bar" or $_ eq "baz" ) ... which benchmarks around 5% to 20% faster than C<< /(?:ba[rz]|foo)/ >>. However, it is possible to manually indicate whether you prefer it to generate code using C or regexps by setting C to a boolean value in the constructor. (If C is not passed to the constructor at all, Type::Tiny::Enum will try to guess the most efficient technique.) If you know that certain values in your enumeration are more common than others, you can "front load" your enumeration with the most common values so that C checks those I. This may allow you to speed up certain checks. has car_colour => ( is => 'rw', isa => Type::Tiny::Enum->new( use_eq => 1, values => [qw/ blue red grey white black green yellow orange purple pink /] ); ); =back =head2 Methods =over =item C Returns the enum as a regexp which strings can be checked against. If you're checking I<< a lot >> of strings, then using this regexp might be faster than checking each string against my $enum = Type::Tiny::Enum->new(...); my $check = $enum->compiled_check; my $re = $enum->as_regexp; # fast my @valid_tokens = grep $enum->check($_), @all_tokens; # faster my @valid_tokens = grep $check->($_), @all_tokens; # fastest my @valid_tokens = grep /$re/, @all_tokens; You can get a case-insensitive regexp using C<< $enum->as_regexp('i') >>. =item C Returns the closest match in the enum for a string. my $enum = Type::Tiny::Enum->new( values => [ qw( foo bar baz quux ) ], ); say $enum->closest_match("FO"); # ==> foo It will try to find an exact match first, fall back to a case-insensitive match, if it still can't find one, will try to find a head substring match, and finally, if given an integer, will use that as an index. my $enum = Type::Tiny::Enum->new( values => [ qw( foo bar baz quux ) ], ); say $enum->closest_match( 0 ); # ==> foo say $enum->closest_match( 1 ); # ==> bar say $enum->closest_match( 2 ); # ==> baz say $enum->closest_match( -1 ); # ==> quux =item C<< is_word_safe >> Returns true if none of the values in the enumeration contain a non-word character. Word characters include letters, numbers, and underscores, but not most punctuation or whitespace. =back =head2 Exports Type::Tiny::Enum can be used as an exporter. use Type::Tiny::Enum Status => [ 'dead', 'alive' ]; This will export the following functions into your namespace: =over =item C<< Status >> =item C<< is_Status( $value ) >> =item C<< assert_Status( $value ) >> =item C<< to_Status( $value ) >> =item C<< STATUS_DEAD >> =item C<< STATUS_ALIVE >> =back Multiple enumerations can be exported at once: use Type::Tiny::Enum ( Status => [ 'dead', 'alive' ], TaxStatus => [ 'paid', 'pending' ], ); =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Intersection.pm000664001750001750 2357615111656240 20066 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Intersection; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Intersection::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Intersection::VERSION = '2.008006'; } $Type::Tiny::Intersection::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Type::Tiny (); our @ISA = 'Type::Tiny'; __PACKAGE__->_install_overloads( q[@{}] => sub { $_[0]{type_constraints} ||= [] }, ); sub new_by_overload { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; my @types = @{ $opts{type_constraints} }; if ( my @makers = map scalar( blessed($_) && $_->can( 'new_intersection' ) ), @types ) { my $first_maker = shift @makers; if ( ref $first_maker ) { my $all_same = not grep $_ ne $first_maker, @makers; if ( $all_same ) { return ref( $types[0] )->$first_maker( %opts ); } } } return $proto->new( \%opts ); } sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Intersection type constraints cannot have a parent constraint" if exists $opts{parent}; _croak "Intersection type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Intersection type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of type constraints" unless exists $opts{type_constraints}; $opts{type_constraints} = [ map { $_->isa( __PACKAGE__ ) ? @$_ : $_ } map Types::TypeTiny::to_TypeTiny( $_ ), @{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [ $opts{type_constraints} ] } ]; if ( Type::Tiny::_USE_XS ) { my @constraints = @{ $opts{type_constraints} }; my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { my $xsub = Type::Tiny::XS::get_coderef_for( sprintf "AllOf[%s]", join( ',', @known ) ); $opts{compiled_type_constraint} = $xsub if $xsub; } } #/ if ( Type::Tiny::_USE_XS) return $proto->SUPER::new( %opts ); } #/ sub new sub _lockdown { my ( $self, $callback ) = @_; $callback->( $self->{type_constraints} ); } sub type_constraints { $_[0]{type_constraints} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub _is_null_constraint { 0 } sub _build_display_name { my $self = shift; join q[&], @$self; } sub _build_constraint { my @checks = map $_->compiled_check, @{ +shift }; return sub { my $val = $_; $_->( $val ) || return for @checks; return !!1; } } sub can_be_inlined { my $self = shift; not grep !$_->can_be_inlined, @$self; } sub inline_check { my $self = shift; if ( Type::Tiny::_USE_XS and !exists $self->{xs_sub} ) { $self->{xs_sub} = undef; my @constraints = @{ $self->type_constraints }; my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { $self->{xs_sub} = Type::Tiny::XS::get_subname_for( sprintf "AllOf[%s]", join( ',', @known ) ); } } #/ if ( Type::Tiny::_USE_XS...) my $code = sprintf '(%s)', join " and ", map $_->inline_check( $_[0] ), @$self; return "do { $Type::Tiny::SafePackage $code }" if $Type::Tiny::AvoidCallbacks; return "$self->{xs_sub}\($_[0]\)" if $self->{xs_sub}; return $code; } #/ sub inline_check sub has_parent { !!@{ $_[0]{type_constraints} }; } sub parent { $_[0]{type_constraints}[0]; } sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); require Type::Utils; for my $type ( @$self ) { my $deep = $type->validate_explain( $value, $varname ); return [ sprintf( '"%s" requires that the value pass %s', $self, Type::Utils::english_list( map qq["$_"], @$self ), ), @$deep, ] if $deep; } #/ for my $type ( @$self ) # This should never happen... return; # uncoverable statement } #/ sub validate_explain my $_delegate = sub { my ( $self, $method ) = ( shift, shift ); my @types = @{ $self->type_constraints }; my $found = 0; for my $i ( 0 .. $#types ) { my $type = $types[$i]; if ( $type->can( $method ) ) { $types[$i] = $type->$method( @_ ); ++$found; last; } } _croak( 'Could not apply method %s to any type within the intersection', $method ) unless $found; ref( $self )->new( type_constraints => \@types ); }; sub stringifies_to { my $self = shift; $self->$_delegate( stringifies_to => @_ ); } sub numifies_to { my $self = shift; $self->$_delegate( numifies_to => @_ ); } sub with_attribute_values { my $self = shift; $self->$_delegate( with_attribute_values => @_ ); } my $comparator; $comparator = sub { my $A = shift->find_constraining_type; my $B = shift->find_constraining_type; if ( $A->isa( __PACKAGE__ ) ) { my @A_constraints = map $_->find_constraining_type, @{ $A->type_constraints }; my @A_equal_to_B = grep $_->equals( $B ), @A_constraints; if ( @A_equal_to_B == @A_constraints ) { return Type::Tiny::CMP_EQUIVALENT(); } my @A_subs_of_B = grep $_->is_a_type_of( $B ), @A_constraints; if ( @A_subs_of_B ) { return Type::Tiny::CMP_SUBTYPE(); } } #/ if ( $A->isa( __PACKAGE__...)) elsif ( $B->isa( __PACKAGE__ ) ) { my $r = $comparator->( $B, $A ); return $r if $r eq Type::Tiny::CMP_EQUIVALENT(); return -$r if $r eq Type::Tiny::CMP_SUBTYPE(); } return Type::Tiny::CMP_UNKNOWN(); }; push @Type::Tiny::CMP, $comparator; 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Intersection - intersection type constraints =head1 SYNOPSIS Using via the C<< & >> operator overload: package Local::Stash { use Moo; use Types::Common qw( LowerCaseStr StrLength ); has identifier => ( is => 'ro', isa => (LowerCaseStr) & (StrLength[4, 8]), ); } my $x = Local::Stash->new( data => {} ); # not ok my $y = Local::Stash->new( data => [] ); # not ok Note that it is a good idea to enclose each type being intersected in parentheses to avoid Perl thinking the C<< & >> is the sigil for a coderef. Using Type::Tiny::Intersection's object-oriented interface: package Local::Stash { use Moo; use Types::Common qw( LowerCaseStr StrLength ); use Type::Tiny::Intersection; my $ShortLcStr = Type::Tiny::Intersection->new( name => 'AnyData', type_constraints => [ LowerCaseStr, StrLength[4, 8] ], ); has identifier => ( is => 'ro', isa => $ShortLcStr, ); } Using Type::Utils's functional interface: package Local::Stash { use Moo; use Types::Common qw( LowerCaseStr StrLength ); use Type::Utils; my $ShortLcStr = intersection ShortLcStr => [ LowerCaseStr, StrLength[4, 8] ]; has identifier => ( is => 'ro', isa => $ShortLcStr, ); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Intersection type constraints. Intersection type constraints are not often very useful. Consider the intersection of B and B. A value will only pass if it is both a hashref and an arrayref. Given that neither of those type constraints accept C or overloaded objects, there is no possible value that can pass both. Which is not to say that intersections are never useful, but it happens quite rarely. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructor The C constructor from L still works, of course. But there is also: =over =item C<< new_by_overload(%attributes) >> Like the C constructor, but will sometimes return another type constraint which is not strictly an instance of L, but still encapsulates the same meaning. This constructor is used by Type::Tiny's overloading of the C<< & >> operator. =back =head2 Attributes =over =item C Arrayref of type constraints. When passed to the constructor, if any of the type constraints in the intersection is itself an intersection type constraint, this is "exploded" into the new intersection. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. A parent will instead be automatically calculated. (Technically any of the types in the intersection could be treated as a parent type; we choose the first arbitrarily.) =back =head2 Methods =over =item C<< stringifies_to($constraint) >> See L. =item C<< numifies_to($constraint) >> See L. =item C<< with_attribute_values($attr1 => $constraint1, ...) >> See L. =back =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Manual.pod000664001750001750 1513315111656240 16771 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual - an overview of Type::Tiny =head1 SYNOPSIS L is a small L class for writing type constraints, inspired by L's type constraint API and L. It has only one non-core dependency (and even that is simply a module that was previously distributed as part of Type::Tiny but has since been spun off), and can be used with L, L, or L (or none of the above). Type::Tiny is used by over 1000 Perl distributions on the CPAN (Comprehensive Perl Archive Network) and can be considered a stable and mature framework for efficiently and reliably enforcing data types. Type::Tiny is bundled with L a framework for organizing type constraints into collections. Also bundled is L, a Moose-inspired library of useful type constraints. L is also provided, to allow very fast checking and coercion of function and method parameters. The following example gives you an idea of some of the features of these modules. If you don't understand it all, that's fine; that's what the rest of the manual is for. Although the example uses Moo, the C could be changed to C or C and it would still work. use v5.36; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef InstanceOf ); use Type::Params qw( signature_for ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, required => 1, ); has gender => ( is => 'ro', isa => Enum[qw( f m )], ); has age => ( is => 'rw', isa => Int->where( '$_ >= 0' ), ); has children => ( is => 'ro', isa => ArrayRef[ InstanceOf['Horse'] ], default => sub { return [] }, ); signature_for add_child => ( method => Object, positional => [ InstanceOf['Horse'] ], ); sub add_child ( $self, $child ) { push $self->children->@*, $child; return $self; } } package main; my $boldruler = Horse->new( name => "Bold Ruler", gender => 'm', age => 16, ); my $secretariat = Horse->new( name => "Secretariat", gender => 'm', age => 0, ); $boldruler->add_child( $secretariat ); use Types::Standard qw( is_Object assert_Object ); # is_Object will return a boolean # if ( is_Object $boldruler ) { say $boldruler->name; } # assert_Object will return $secretariat or die # say assert_Object( $secretariat )->name; =head1 MANUAL Even if you are using Type::Tiny with other object-oriented programming toolkits (such as Moose or Mouse), you should start with the Moo sections of the manual. Most of the information is directly transferrable and the Moose and Mouse sections of the manual list the minor differences between using Type::Tiny with Moo and with them. In general, this manual assumes you use Perl 5.36 or above and may use examples that do not work on older versions of Perl. Type::Tiny does work on earlier versions of Perl, but not all the examples and features in the manual will run without adjustment. (For instance, you may need to replace C variables with lexical variables, avoid the C<< package NAME { BLOCK } >> syntax, unpack C<< @_ >> instead of using subroutine signatures, etc.) =over =item * L How to install Type::Tiny. If Type::Tiny is already installed, you can skip this. =item * L Basic use of Type::Tiny with Moo, including attribute type constraints, parameterized type constraints, coercions, and method parameter checking. =item * L Advanced use of Type::Tiny with Moo, including unions and intersections, C, C, C, and C. =item * L There's more than one way to do it! Alternative ways of using Type::Tiny, including type registries, exported functions, and C. =item * L Defining your own type libraries, including extending existing libraries, defining new types, adding coercions, defining parameterizable types, and the declarative style. =item * L How to use Type::Tiny with Moose, including the advantages of Type::Tiny over built-in type constraints, and Moose-specific features. =item * L How to use Type::Tiny with Mouse, including the advantages of Type::Tiny over built-in type constraints, and Mouse-specific features. =item * L How to use Type::Tiny with Mite, including how to write an entire Perl project using clean Moose-like code and no non-core dependencies. (Not even dependencies on Mite or Type::Tiny!) =item * L Including how to Type::Tiny in your object's C method, and third-party shims between Type::Tiny and Class::Tiny. =item * L Using Type::Tiny with Class::InsideOut, Params::Check, and Object::Accessor. =item * L Type::Tiny for test suites. =item * L Advanced information on Type::Params, and using Type::Tiny with other signature modules like Function::Parameters and Kavorka. =item * L Type::Tiny in non-object-oriented code. =item * L Squeeze the most out of your CPU. =item * L Advanced information on coercions. =item * L An alphabetical list of all type constraints bundled with Type::Tiny. =item * L Policies related to Type::Tiny development. =item * L Contributing to Type::Tiny development. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Role.pm000664001750001750 1570715111656240 16316 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Role; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Role::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Role::VERSION = '2.008006'; } $Type::Tiny::Role::VERSION =~ tr/_//d; use Scalar::Util qw< blessed weaken >; sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); use Type::Tiny::ConstrainedObject (); our @ISA = qw( Type::Tiny::ConstrainedObject Exporter::Tiny ); sub _short_name { 'Role' } sub _exporter_fail { my ( $class, $name, $opts, $globals ) = @_; my $caller = $globals->{into}; $opts->{name} = $name unless exists $opts->{name}; $opts->{name} =~ s/:://g; $opts->{role} = $name unless exists $opts->{role}; my $type = $class->new($opts); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type ) : ( $Type::Registry::DELAYED{$caller}{$type->name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } my %cache; sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Need to supply role name" unless exists $opts{role}; return $proto->SUPER::new( %opts ); } sub role { $_[0]{role} } sub inlined { $_[0]{inlined} ||= $_[0]->_build_inlined } sub has_inlined { !!1 } sub _is_null_constraint { 0 } sub _build_constraint { my $self = shift; my $role = $self->role; return sub { blessed( $_ ) and do { my $method = $_->can( 'DOES' ) || $_->can( 'isa' ); $_->$method( $role ); } }; } #/ sub _build_constraint sub _build_inlined { my $self = shift; my $role = $self->role; sub { my $var = $_[1]; my $code = qq{Scalar::Util::blessed($var) and do { my \$method = $var->can('DOES')||$var->can('isa'); $var->\$method(q[$role]) }}; return qq{do { use Scalar::Util (); $code }} if $Type::Tiny::AvoidCallbacks; $code; }; } #/ sub _build_inlined sub _build_default_message { my $self = shift; my $c = $self->role; return sub { sprintf '%s did not pass type constraint (not DOES %s)', Type::Tiny::_dd( $_[0] ), $c; } if $self->is_anon; my $name = "$self"; return sub { sprintf '%s did not pass type constraint "%s" (not DOES %s)', Type::Tiny::_dd( $_[0] ), $name, $c; }; } #/ sub _build_default_message sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); return ["Not a blessed reference"] unless blessed( $value ); return ["Reference provides no DOES method to check roles"] unless $value->can( 'DOES' ); my $display_var = $varname eq q{$_} ? '' : sprintf( ' (in %s)', $varname ); return [ sprintf( '"%s" requires that the reference does %s', $self, $self->role ), sprintf( "The reference%s doesn't %s", $display_var, $self->role ), ]; } #/ sub validate_explain 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Role - type constraints based on the "DOES" method =head1 SYNOPSIS Using via L: package Local::Horse { use Moo; use Types::Standard qw( Str ConsumerOf ); has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => ConsumerOf[ 'Local::Traits::DoesOwnership' ], default => sub { Local::Person->new }, ); } Using Type::Tiny::Class's export feature: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Role ( Owner => { role => 'Local::Traits::DoesOwnership' }, ); has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => Owner, default => sub { Local::Person->new }, ); } Using Type::Tiny::Role's object-oriented interface: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Tiny::Class; my $Owner = Type::Tiny::Role->new( role => 'Local::Traits::DoesOwnership', ); has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => $Owner, default => sub { Local::Person->new }, ); } Using Type::Utils's functional interface: package Local::Horse { use Moo; use Types::Standard qw( Str ); use Type::Utils; my $Owner = role_type 'Local::Traits::DoesOwnership'; has name => ( is => 'ro', isa => Str, ); has owner => ( is => 'ro', isa => $Owner, default => sub { Local::Person->new }, ); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Type constraints of the general form C<< { $_->DOES("Some::Role") } >>. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Attributes =over =item C The role for the constraint. Note that this package doesn't subscribe to any particular flavour of roles (L, L, L, L, etc). It simply trusts the object's C method (see L). =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Parent is always B, and cannot be passed to the constructor. =back =head2 Methods =over =item C<< stringifies_to($constraint) >> See L. =item C<< numifies_to($constraint) >> See L. =item C<< with_attribute_values($attr1 => $constraint1, ...) >> See L. =back =head2 Exports Type::Tiny::Role can be used as an exporter. use Type::Tiny::Role 'MyApp::Printable'; This will export the following functions into your namespace: =over =item C<< MyAppPrintable >> =item C<< is_MyAppPrintable( $value ) >> =item C<< assert_MyAppPrintable( $value ) >> =item C<< to_MyAppPrintable( $value ) >> =back Multiple types can be exported at once: use Type::Tiny::Role qw( MyApp::Printable MyApp::Sendable ); =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Union.pm000664001750001750 3151215111656240 16475 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::Union; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::Union::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::Union::VERSION = '2.008006'; } $Type::Tiny::Union::VERSION =~ tr/_//d; use Scalar::Util qw< blessed >; use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Type::Tiny (); our @ISA = 'Type::Tiny'; __PACKAGE__->_install_overloads( q[@{}] => sub { $_[0]{type_constraints} ||= [] } ); sub new_by_overload { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; my @types = @{ $opts{type_constraints} }; if ( my @makers = map scalar( blessed($_) && $_->can( 'new_union' ) ), @types ) { my $first_maker = shift @makers; if ( ref $first_maker ) { my $all_same = not grep +( !defined $_ or $_ ne $first_maker ), @makers; if ( $all_same ) { return ref( $types[0] )->$first_maker( %opts ); } } } return $proto->new( \%opts ); } sub new { my $proto = shift; my %opts = ( @_ == 1 ) ? %{ $_[0] } : @_; _croak "Union type constraints cannot have a parent constraint passed to the constructor" if exists $opts{parent}; _croak "Union type constraints cannot have a constraint coderef passed to the constructor" if exists $opts{constraint}; _croak "Union type constraints cannot have a inlining coderef passed to the constructor" if exists $opts{inlined}; _croak "Need to supply list of type constraints" unless exists $opts{type_constraints}; $opts{type_constraints} = [ map { $_->isa( __PACKAGE__ ) ? @$_ : $_ } map Types::TypeTiny::to_TypeTiny( $_ ), @{ ref $opts{type_constraints} eq "ARRAY" ? $opts{type_constraints} : [ $opts{type_constraints} ] } ]; if ( Type::Tiny::_USE_XS ) { my @constraints = @{ $opts{type_constraints} }; my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { my $xsub = Type::Tiny::XS::get_coderef_for( sprintf "AnyOf[%s]", join( ',', @known ) ); $opts{compiled_type_constraint} = $xsub if $xsub; } } #/ if ( Type::Tiny::_USE_XS) my $self = $proto->SUPER::new( %opts ); $self->coercion if grep $_->has_coercion, @$self; return $self; } #/ sub new sub _lockdown { my ( $self, $callback ) = @_; $callback->( $self->{type_constraints} ); } sub type_constraints { $_[0]{type_constraints} } sub constraint { $_[0]{constraint} ||= $_[0]->_build_constraint } sub _is_null_constraint { 0 } sub _build_display_name { my $self = shift; join q[|], @$self; } sub _build_coercion { require Type::Coercion::Union; my $self = shift; return "Type::Coercion::Union"->new( type_constraint => $self ); } sub _build_constraint { my @checks = map $_->compiled_check, @{ +shift }; return sub { my $val = $_; $_->( $val ) && return !!1 for @checks; return; } } sub can_be_inlined { my $self = shift; not grep !$_->can_be_inlined, @$self; } sub inline_check { my $self = shift; if ( Type::Tiny::_USE_XS and !exists $self->{xs_sub} ) { $self->{xs_sub} = undef; my @constraints = @{ $self->type_constraints }; my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { $self->{xs_sub} = Type::Tiny::XS::get_subname_for( sprintf "AnyOf[%s]", join( ',', @known ) ); } } #/ if ( Type::Tiny::_USE_XS...) my $code = sprintf '(%s)', join " or ", map $_->inline_check( $_[0] ), @$self; return "do { $Type::Tiny::SafePackage $code }" if $Type::Tiny::AvoidCallbacks; return "$self->{xs_sub}\($_[0]\)" if $self->{xs_sub}; return $code; } #/ sub inline_check sub _instantiate_moose_type { my $self = shift; my %opts = @_; delete $opts{parent}; delete $opts{constraint}; delete $opts{inlined}; my @tc = map $_->moose_type, @{ $self->type_constraints }; require Moose::Meta::TypeConstraint::Union; return "Moose::Meta::TypeConstraint::Union" ->new( %opts, type_constraints => \@tc ); } #/ sub _instantiate_moose_type sub has_parent { defined( shift->parent ); } sub parent { $_[0]{parent} ||= $_[0]->_build_parent; } sub _build_parent { my $self = shift; my ( $first, @rest ) = @$self; for my $parent ( $first, $first->parents ) { return $parent unless grep !$_->is_a_type_of( $parent ), @rest; } return; } #/ sub _build_parent sub find_type_for { my @types = @{ +shift }; for my $type ( @types ) { return $type if $type->check( @_ ); } return; } sub validate_explain { my $self = shift; my ( $value, $varname ) = @_; $varname = '$_' unless defined $varname; return undef if $self->check( $value ); require Type::Utils; return [ sprintf( '"%s" requires that the value pass %s', $self, Type::Utils::english_list( \"or", map qq["$_"], @$self ), ), map { $_->get_message( $value ), map( " $_", @{ $_->validate_explain( $value ) || [] } ), } @$self ]; } #/ sub validate_explain my $_delegate = sub { my ( $self, $method ) = ( shift, shift ); my @types = @{ $self->type_constraints }; my @unsupported = grep !$_->can( $method ), @types; _croak( 'Could not apply method %s to all types within the union', $method ) if @unsupported; ref( $self )->new( type_constraints => [ map $_->$method( @_ ), @types ] ); }; sub stringifies_to { my $self = shift; $self->$_delegate( stringifies_to => @_ ); } sub numifies_to { my $self = shift; $self->$_delegate( numifies_to => @_ ); } sub with_attribute_values { my $self = shift; $self->$_delegate( with_attribute_values => @_ ); } push @Type::Tiny::CMP, sub { my $A = shift->find_constraining_type; my $B = shift->find_constraining_type; if ( $A->isa( __PACKAGE__ ) and $B->isa( __PACKAGE__ ) ) { my @A_constraints = @{ $A->type_constraints }; my @B_constraints = @{ $B->type_constraints }; # If everything in @A_constraints is equal to something in @B_constraints and vice versa, then $A equiv to $B EQUALITY: { my $everything_in_a_is_equal = 1; OUTER: for my $A_child ( @A_constraints ) { INNER: for my $B_child ( @B_constraints ) { if ( $A_child->equals( $B_child ) ) { next OUTER; } } $everything_in_a_is_equal = 0; last OUTER; } my $everything_in_b_is_equal = 1; OUTER: for my $B_child ( @B_constraints ) { INNER: for my $A_child ( @A_constraints ) { if ( $B_child->equals( $A_child ) ) { next OUTER; } } $everything_in_b_is_equal = 0; last OUTER; } return Type::Tiny::CMP_EQUIVALENT if $everything_in_a_is_equal && $everything_in_b_is_equal; } #/ EQUALITY: # If everything in @A_constraints is a subtype of something in @B_constraints, then $A is subtype of $B SUBTYPE: { OUTER: for my $A_child ( @A_constraints ) { my $a_child_is_subtype_of_something = 0; INNER: for my $B_child ( @B_constraints ) { if ( $A_child->is_a_type_of( $B_child ) ) { ++$a_child_is_subtype_of_something; last INNER; } } if ( not $a_child_is_subtype_of_something ) { last SUBTYPE; } } #/ OUTER: for my $A_child ( @A_constraints) return Type::Tiny::CMP_SUBTYPE; } #/ SUBTYPE: # If everything in @B_constraints is a subtype of something in @A_constraints, then $A is supertype of $B SUPERTYPE: { OUTER: for my $B_child ( @B_constraints ) { my $b_child_is_subtype_of_something = 0; INNER: for my $A_child ( @A_constraints ) { if ( $B_child->is_a_type_of( $A_child ) ) { ++$b_child_is_subtype_of_something; last INNER; } } if ( not $b_child_is_subtype_of_something ) { last SUPERTYPE; } } #/ OUTER: for my $B_child ( @B_constraints) return Type::Tiny::CMP_SUPERTYPE; } #/ SUPERTYPE: } #/ if ( $A->isa( __PACKAGE__...)) # I think it might be possible to merge this into the first bit by treating $B as union[$B]. # Test cases first though. if ( $A->isa( __PACKAGE__ ) ) { my @A_constraints = @{ $A->type_constraints }; if ( @A_constraints == 1 ) { my $result = Type::Tiny::cmp( $A_constraints[0], $B ); return $result unless $result eq Type::Tiny::CMP_UNKNOWN; } my $subtype = 1; for my $child ( @A_constraints ) { if ( $B->is_a_type_of( $child ) ) { return Type::Tiny::CMP_SUPERTYPE; } if ( $subtype and not $B->is_supertype_of( $child ) ) { $subtype = 0; } } if ( $subtype ) { return Type::Tiny::CMP_SUBTYPE; } } #/ if ( $A->isa( __PACKAGE__...)) # I think it might be possible to merge this into the first bit by treating $A as union[$A]. # Test cases first though. if ( $B->isa( __PACKAGE__ ) ) { my @B_constraints = @{ $B->type_constraints }; if ( @B_constraints == 1 ) { my $result = Type::Tiny::cmp( $A, $B_constraints[0] ); return $result unless $result eq Type::Tiny::CMP_UNKNOWN; } my $supertype = 1; for my $child ( @B_constraints ) { if ( $A->is_a_type_of( $child ) ) { return Type::Tiny::CMP_SUBTYPE; } if ( $supertype and not $A->is_supertype_of( $child ) ) { $supertype = 0; } } if ( $supertype ) { return Type::Tiny::CMP_SUPERTYPE; } } #/ if ( $B->isa( __PACKAGE__...)) return Type::Tiny::CMP_UNKNOWN; }; 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::Union - union type constraints =head1 SYNOPSIS Using via the C<< | >> operator overload: package Local::Stash { use Moo; use Types::Common qw( ArrayRef HashRef ); has data => ( is => 'ro', isa => HashRef | ArrayRef, ); } my $x = Local::Stash->new( data => {} ); # ok my $y = Local::Stash->new( data => [] ); # ok Using Type::Tiny::Union's object-oriented interface: package Local::Stash { use Moo; use Types::Common qw( ArrayRef HashRef ); use Type::Tiny::Union; my $AnyData = Type::Tiny::Union->new( name => 'AnyData', type_constraints => [ HashRef, ArrayRef ], ); has data => ( is => 'ro', isa => $AnyData, ); } Using Type::Utils's functional interface: package Local::Stash { use Moo; use Types::Common qw( ArrayRef HashRef ); use Type::Utils; my $AnyData = union AnyData => [ HashRef, ArrayRef ]; has data => ( is => 'ro', isa => $AnyData, ); } =head1 STATUS This module is covered by the L. =head1 DESCRIPTION Union type constraints. This package inherits from L; see that for most documentation. Major differences are listed below: =head2 Constructor The C constructor from L still works, of course. But there is also: =over =item C<< new_by_overload(%attributes) >> Like the C constructor, but will sometimes return another type constraint which is not strictly an instance of L, but still encapsulates the same meaning. This constructor is used by Type::Tiny's overloading of the C<< | >> operator. =back =head2 Attributes =over =item C Arrayref of type constraints. When passed to the constructor, if any of the type constraints in the union is itself a union type constraint, this is "exploded" into the new union. =item C Unlike Type::Tiny, you I pass a constraint coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. Instead rely on the default. =item C Unlike Type::Tiny, you I pass an inlining coderef to the constructor. A parent will instead be automatically calculated. =item C You probably do not pass this to the constructor. (It's not currently disallowed, as there may be a use for it that I haven't thought of.) The auto-generated default will be a L object. =back =head2 Methods =over =item C<< find_type_for($value) >> Returns the first individual type constraint in the union which C<< $value >> passes. =item C<< stringifies_to($constraint) >> See L. =item C<< numifies_to($constraint) >> See L. =item C<< with_attribute_values($attr1 => $constraint1, ...) >> See L. =back =head2 Overloading =over =item * Arrayrefification calls C. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. _DeclaredType.pm000664001750001750 407215111656240 20072 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::_DeclaredType; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::_DeclaredType::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::_DeclaredType::VERSION = '2.008006'; } $Type::Tiny::_DeclaredType::VERSION =~ tr/_//d; use Type::Tiny (); our @ISA = qw( Type::Tiny ); sub new { my $class = shift; my %opts = @_ == 1 ? %{ +shift } : @_; my $library = delete $opts{library}; my $name = delete $opts{name}; $library->can( 'get_type' ) or Type::Tiny::_croak( "Expected $library to be a type library, but it doesn't seem to be" ); $opts{display_name} = $name; $opts{constraint} = sub { my $val = @_ ? pop : $_; $library->get_type( $name )->check( $val ); }; $opts{inlined} = sub { my $val = @_ ? pop : $_; sprintf( '%s::is_%s(%s)', $library, $name, $val ); }; $opts{_build_coercion} = sub { my $realtype = $library->get_type( $name ); $_[0] = $realtype->coercion if $realtype; }; $class->SUPER::new( %opts ); } #/ sub new 1; __END__ =pod =encoding utf-8 =head1 NAME Type::Tiny::_DeclaredType - half-defined type constraint =head1 STATUS This module is considered part of Type-Tiny's internals. It is not covered by the L. =head1 DESCRIPTION This is not considered part of Type::Tiny's public API. It is a class representing a declared-but-not-defined type constraint. It inherits from L. =head2 Constructor =over =item C<< new(%options) >> =back =head1 BUGS Please report any bugs to L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. _HalfOp.pm000664001750001750 336715111656240 16704 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tinypackage Type::Tiny::_HalfOp; use 5.008001; use strict; use warnings; BEGIN { $Type::Tiny::_HalfOp::AUTHORITY = 'cpan:TOBYINK'; $Type::Tiny::_HalfOp::VERSION = '2.008006'; } $Type::Tiny::_HalfOp::VERSION =~ tr/_//d; sub new { my ( $class, $op, $param, $type ) = @_; bless { op => $op, param => $param, type => $type, }, $class; } sub complete { require overload; my ( $self, $type ) = @_; my $complete_type = $type->parameterize( @{ $self->{param} } ); my $method = overload::Method( $complete_type, $self->{op} ); $complete_type->$method( $self->{type}, undef ); } 1; __END__ =pod =encoding utf-8 =for stopwords pragmas =head1 NAME Type::Tiny::_HalfOp - half-completed overloaded operation =head1 STATUS This module is considered part of Type-Tiny's internals. It is not covered by the L. =head1 DESCRIPTION This is not considered part of Type::Tiny's public API. It is a class representing a half-completed overloaded operation. =head2 Constructor =over =item C<< new($operation, $param, $type) >> =back =head2 Method =over =item C<< complete($type) >> =back =head1 BUGS Please report any bugs to L. =head1 AUTHOR Graham Knop Ehaarg@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Graham Knop. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Numeric.pm000664001750001750 2030515111656240 17475 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Commonpackage Types::Common::Numeric; use 5.008001; use strict; use warnings; BEGIN { $Types::Common::Numeric::AUTHORITY = 'cpan:TOBYINK'; $Types::Common::Numeric::VERSION = '2.008006'; } $Types::Common::Numeric::VERSION =~ tr/_//d; use Type::Library -base, -declare => qw( PositiveNum PositiveOrZeroNum PositiveInt PositiveOrZeroInt NegativeNum NegativeOrZeroNum NegativeInt NegativeOrZeroInt SingleDigit NumRange IntRange ); use Type::Tiny (); use Types::Standard qw( Num Int ); use Types::TypeTiny qw( BoolLike ); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } my $meta = __PACKAGE__->meta; $meta->add_type( name => 'PositiveNum', parent => Num, constraint => sub { $_ > 0 }, inlined => sub { undef, qq($_ > 0) }, message => sub { "Must be a positive number" }, ); $meta->add_type( name => 'PositiveOrZeroNum', parent => Num, constraint => sub { $_ >= 0 }, inlined => sub { undef, qq($_ >= 0) }, message => sub { "Must be a number greater than or equal to zero" }, type_default => sub { return 0; }, ); my ( $pos_int, $posz_int ); if ( Type::Tiny::_USE_XS ) { $pos_int = Type::Tiny::XS::get_coderef_for( 'PositiveInt' ) if Type::Tiny::XS->VERSION >= 0.013; # fixed bug with "00" $posz_int = Type::Tiny::XS::get_coderef_for( 'PositiveOrZeroInt' ); } $meta->add_type( name => 'PositiveInt', parent => Int, constraint => sub { $_ > 0 }, inlined => sub { if ( $pos_int ) { my $xsub = Type::Tiny::XS::get_subname_for( $_[0]->name ); return "$xsub($_[1])" if $xsub && !$Type::Tiny::AvoidCallbacks; } undef, qq($_ > 0); }, message => sub { "Must be a positive integer" }, $pos_int ? ( compiled_type_constraint => $pos_int ) : (), ); $meta->add_type( name => 'PositiveOrZeroInt', parent => Int, constraint => sub { $_ >= 0 }, inlined => sub { if ( $posz_int ) { my $xsub = Type::Tiny::XS::get_subname_for( $_[0]->name ); return "$xsub($_[1])" if $xsub && !$Type::Tiny::AvoidCallbacks; } undef, qq($_ >= 0); }, message => sub { "Must be an integer greater than or equal to zero" }, $posz_int ? ( compiled_type_constraint => $posz_int ) : (), type_default => sub { return 0; }, ); $meta->add_type( name => 'NegativeNum', parent => Num, constraint => sub { $_ < 0 }, inlined => sub { undef, qq($_ < 0) }, message => sub { "Must be a negative number" }, ); $meta->add_type( name => 'NegativeOrZeroNum', parent => Num, constraint => sub { $_ <= 0 }, inlined => sub { undef, qq($_ <= 0) }, message => sub { "Must be a number less than or equal to zero" }, type_default => sub { return 0; }, ); $meta->add_type( name => 'NegativeInt', parent => Int, constraint => sub { $_ < 0 }, inlined => sub { undef, qq($_ < 0) }, message => sub { "Must be a negative integer" }, ); $meta->add_type( name => 'NegativeOrZeroInt', parent => Int, constraint => sub { $_ <= 0 }, inlined => sub { undef, qq($_ <= 0) }, message => sub { "Must be an integer less than or equal to zero" }, type_default => sub { return 0; }, ); $meta->add_type( name => 'SingleDigit', parent => Int, constraint => sub { $_ >= -9 and $_ <= 9 }, inlined => sub { undef, qq($_ >= -9), qq($_ <= 9) }, message => sub { "Must be a single digit" }, type_default => sub { return 0; }, ); for my $base ( qw/Num Int/ ) { $meta->add_type( name => "${base}Range", parent => Types::Standard->get_type( $base ), constraint_generator => sub { return $meta->get_type( "${base}Range" ) unless @_; my $base_obj = Types::Standard->get_type( $base ); Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Common::Numeric', "${base}Range", \@_, 4 ); my ( $min, $max, $min_excl, $max_excl ) = @_; !defined( $min ) or $base_obj->check( $min ) or _croak( "${base}Range min must be a %s; got %s", lc( $base ), $min ); !defined( $max ) or $base_obj->check( $max ) or _croak( "${base}Range max must be a %s; got %s", lc( $base ), $max ); !defined( $min_excl ) or BoolLike->check( $min_excl ) or _croak( "${base}Range minexcl must be a boolean; got $min_excl" ); !defined( $max_excl ) or BoolLike->check( $max_excl ) or _croak( "${base}Range maxexcl must be a boolean; got $max_excl" ); # this is complicated so defer to the inline generator eval sprintf( 'sub { %s }', join ' and ', grep defined, $meta->get_type( "${base}Range" )->inline_generator->( @_ )->( undef, '$_[0]' ), ); }, inline_generator => sub { my ( $min, $max, $min_excl, $max_excl ) = @_; my $gt = $min_excl ? '>' : '>='; my $lt = $max_excl ? '<' : '<='; return sub { my $v = $_[1]; my @code = ( undef ); # parent constraint push @code, "$v $gt $min"; push @code, "$v $lt $max" if defined $max; return @code; }; }, deep_explanation => sub { my ( $type, $value, $varname ) = @_; my ( $min, $max, $min_excl, $max_excl ) = @{ $type->parameters || [] }; my @whines; if ( defined $max ) { push @whines, sprintf( '"%s" expects %s to be %s %d and %s %d', $type, $varname, $min_excl ? 'greater than' : 'at least', $min, $max_excl ? 'less than' : 'at most', $max, ); } #/ if ( defined $max ) else { push @whines, sprintf( '"%s" expects %s to be %s %d', $type, $varname, $min_excl ? 'greater than' : 'at least', $min, ); } push @whines, sprintf( "%s is %s", $varname, $value, ); return \@whines; }, ); } #/ for my $base ( qw/Num Int/) __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Common::Numeric - drop-in replacement for MooseX::Types::Common::Numeric =head1 STATUS This module is covered by the L. =head1 DESCRIPTION A drop-in replacement for L. =head2 Types The following types are similar to those described in L. =over =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B C interestingly accepts the numbers -9 to -1; not just 0 to 9. =back This module also defines an extra pair of type constraints not found in L. =over =item * B<< IntRange[`min, `max] >> Type constraint for an integer between min and max. For example: IntRange[1, 10] The maximum can be omitted. IntRange[10] # at least 10 The minimum and maximum are inclusive. =item * B<< NumRange[`min, `max] >> Type constraint for a number between min and max. For example: NumRange[0.1, 10.0] As with IntRange, the maximum can be omitted, and the minimum and maximum are inclusive. Exclusive ranges can be useful for non-integer values, so additional parameters can be given to make the minimum and maximum exclusive. NumRange[0.1, 10.0, 0, 0] # both inclusive NumRange[0.1, 10.0, 0, 1] # exclusive maximum, so 10.0 is invalid NumRange[0.1, 10.0, 1, 0] # exclusive minimum, so 0.1 is invalid NumRange[0.1, 10.0, 1, 1] # both exclusive Making one of the limits exclusive means that a C<< < >> or C<< > >> operator will be used instead of the usual C<< <= >> or C<< >= >> operators. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. String.pm000664001750001750 2476315111656240 17355 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Commonpackage Types::Common::String; use 5.008001; use strict; use warnings; use utf8; BEGIN { $Types::Common::String::AUTHORITY = 'cpan:TOBYINK'; $Types::Common::String::VERSION = '2.008006'; } $Types::Common::String::VERSION =~ tr/_//d; use Type::Library -base, -declare => qw( SimpleStr NonEmptySimpleStr NumericCode LowerCaseSimpleStr UpperCaseSimpleStr Password StrongPassword NonEmptyStr LowerCaseStr UpperCaseStr StrLength DelimitedStr ); use Type::Tiny (); use Types::TypeTiny (); use Types::Standard qw( Str ); my $meta = __PACKAGE__->meta; $meta->add_type( name => SimpleStr, parent => Str, constraint => sub { length( $_ ) <= 255 and not /\n/ }, inlined => sub { undef, qq(length($_) <= 255), qq($_ !~ /\\n/) }, message => sub { "Must be a single line of no more than 255 chars" }, type_default => sub { return ''; }, ); $meta->add_type( name => NonEmptySimpleStr, parent => SimpleStr, constraint => sub { length( $_ ) > 0 }, inlined => sub { undef, qq(length($_) > 0) }, message => sub { "Must be a non-empty single line of no more than 255 chars" }, ); $meta->add_type( name => NumericCode, parent => NonEmptySimpleStr, constraint => sub { /^[0-9]+$/ }, inlined => sub { SimpleStr->inline_check( $_ ), qq($_ =~ m/^[0-9]+\$/) }, message => sub { 'Must be a non-empty single line of no more than 255 chars that consists ' . 'of numeric characters only'; }, ); NumericCode->coercion->add_type_coercions( NonEmptySimpleStr, q[ do { (my $code = $_) =~ s/[[:punct:][:space:]]//g; $code } ], ); $meta->add_type( name => Password, parent => NonEmptySimpleStr, constraint => sub { length( $_ ) > 3 }, inlined => sub { SimpleStr->inline_check( $_ ), qq(length($_) > 3) }, message => sub { "Must be between 4 and 255 chars" }, ); $meta->add_type( name => StrongPassword, parent => Password, constraint => sub { length( $_ ) > 7 and /[^a-zA-Z]/ }, inlined => sub { SimpleStr()->inline_check( $_ ), qq(length($_) > 7), qq($_ =~ /[^a-zA-Z]/); }, message => sub { "Must be between 8 and 255 chars, and contain a non-alpha char"; }, ); my ( $nestr ); if ( Type::Tiny::_USE_XS ) { $nestr = Type::Tiny::XS::get_coderef_for( 'NonEmptyStr' ); } $meta->add_type( name => NonEmptyStr, parent => Str, constraint => sub { length( $_ ) > 0 }, inlined => sub { if ( $nestr ) { my $xsub = Type::Tiny::XS::get_subname_for( $_[0]->name ); return "$xsub($_[1])" if $xsub && !$Type::Tiny::AvoidCallbacks; } undef, qq(length($_) > 0); }, message => sub { "Must not be empty" }, $nestr ? ( compiled_type_constraint => $nestr ) : (), ); $meta->add_type( name => LowerCaseStr, parent => NonEmptyStr, constraint => sub { !/\p{Upper}/ms }, inlined => sub { undef, qq($_ !~ /\\p{Upper}/ms) }, message => sub { "Must not contain upper case letters" }, ); LowerCaseStr->coercion->add_type_coercions( NonEmptyStr, q[ lc($_) ], ); $meta->add_type( name => UpperCaseStr, parent => NonEmptyStr, constraint => sub { !/\p{Lower}/ms }, inlined => sub { undef, qq($_ !~ /\\p{Lower}/ms) }, message => sub { "Must not contain lower case letters" }, ); UpperCaseStr->coercion->add_type_coercions( NonEmptyStr, q[ uc($_) ], ); $meta->add_type( name => LowerCaseSimpleStr, parent => NonEmptySimpleStr, constraint => sub { !/\p{Upper}/ms }, inlined => sub { undef, qq($_ !~ /\\p{Upper}/ms) }, message => sub { "Must not contain upper case letters" }, ); LowerCaseSimpleStr->coercion->add_type_coercions( NonEmptySimpleStr, q[ lc($_) ], ); $meta->add_type( name => UpperCaseSimpleStr, parent => NonEmptySimpleStr, constraint => sub { !/\p{Lower}/ms }, inlined => sub { undef, qq($_ !~ /\\p{Lower}/ms) }, message => sub { "Must not contain lower case letters" }, ); UpperCaseSimpleStr->coercion->add_type_coercions( NonEmptySimpleStr, q[ uc($_) ], ); $meta->add_type( name => StrLength, parent => Str, constraint_generator => sub { return $meta->get_type( 'StrLength' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Common::String', "StrLength", \@_, 2 ); my ( $min, $max ) = @_; Types::Standard::is_Int( $_ ) || Types::Standard::_croak( "Parameters for StrLength[`min, `max] expected to be integers; got $_" ) for @_; if ( defined $max ) { return sub { length( $_[0] ) >= $min and length( $_[0] ) <= $max }; } else { return sub { length( $_[0] ) >= $min }; } }, inline_generator => sub { my ( $min, $max ) = @_; return sub { my $v = $_[1]; my @code = ( undef ); # parent constraint push @code, "length($v) >= $min"; push @code, "length($v) <= $max" if defined $max; return @code; }; }, deep_explanation => sub { my ( $type, $value, $varname ) = @_; my ( $min, $max ) = @{ $type->parameters || [] }; my @whines; if ( defined $max ) { push @whines, sprintf( '"%s" expects length(%s) to be between %d and %d', $type, $varname, $min, $max, ); } else { push @whines, sprintf( '"%s" expects length(%s) to be at least %d', $type, $varname, $min, ); } push @whines, sprintf( "length(%s) is %d", $varname, length( $value ), ); return \@whines; }, ); $meta->add_type( name => DelimitedStr, parent => Str, type_default => undef, constraint_generator => sub { return $meta->get_type( 'DelimitedStr' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Common::String', "DelimitedStr", \@_, 5 ); my ( $delimiter, $part_constraint, $min_parts, $max_parts, $ws ) = @_; Types::Standard::assert_Str( $delimiter ); Types::TypeTiny::assert_TypeTiny( $part_constraint ) if defined $part_constraint; $min_parts ||= 0; my $q_delimiter = $ws ? sprintf( '\s*%s\s*', quotemeta( $delimiter ) ) : quotemeta( $delimiter ); return sub { my @split = $ws ? split( $q_delimiter, do { ( my $trimmed = $_[0] ) =~ s{\A\s+|\s+\z}{}g; $trimmed } ) : split( $q_delimiter, $_[0] ); return if @split < $min_parts; return if defined($max_parts) && ( @split > $max_parts ); !$part_constraint or $part_constraint->all( @split ); }; }, inline_generator => sub { my ( $delimiter, $part_constraint, $min_parts, $max_parts, $ws ) = @_; $min_parts ||= 0; my $q_delimiter = $ws ? sprintf( '\s*%s\s*', quotemeta( $delimiter ) ) : quotemeta( $delimiter ); return sub { my $v = $_[1]; my @cond; push @cond, "\@\$split >= $min_parts" if $min_parts > 0; push @cond, "\@\$split <= $max_parts" if defined $max_parts; push @cond, Types::Standard::ArrayRef->of( $part_constraint )->inline_check( '$split' ) if $part_constraint && $part_constraint->{uniq} != Types::Standard::Any->{uniq}; return ( undef ) if ! @cond; return ( undef, sprintf( 'do { my $split = [ split %s, %s ]; %s }', B::perlstring( $q_delimiter ), $ws ? sprintf( 'do { ( my $trimmed = %s ) =~ s{\A\s+|\s+\z}{}g; $trimmed }', $v ) : $v, join( q{ and }, @cond ), ), ); }; }, coercion_generator => sub { my ( $parent, $self, $delimiter, $part_constraint, $min_parts, $max_parts ) = @_; return unless $delimiter; $part_constraint ||= Types::Standard::Str; $min_parts ||= 0; require Type::Coercion; my $c = 'Type::Coercion'->new( type_constraint => $self ); $c->add_type_coercions( Types::Standard::ArrayRef->of( $part_constraint, $min_parts, defined $max_parts ? $max_parts : (), ), sprintf( 'join( %s, @$_ )', B::perlstring( $delimiter ) ), ); return $c; }, ); DelimitedStr->coercion->add_type_coercions( Types::Standard::ArrayRef->of( Types::Standard::Str ), 'join( $", @$_ )', ); __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Common::String - drop-in replacement for MooseX::Types::Common::String =head1 STATUS This module is covered by the L. =head1 DESCRIPTION A drop-in replacement for L. =head2 Types The following types are similar to those described in L. =over =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =back This module also defines some extra type constraints not found in L. =over =item * B<< StrLength[`min, `max] >> Type constraint for a string between min and max characters long. For example: StrLength[4, 20] It is sometimes useful to combine this with another type constraint in an intersection. (LowerCaseStr) & (StrLength[4, 20]) The max length can be omitted. StrLength[10] # at least 10 characters Lengths are inclusive. =item * B<< DelimitedStr[`delimiter, `type, `min, `max, `ws] >> Parameterized constraint for delimited strings, such as comma-delimited. B<< DelimitedStr[",", Int, 1, 3] >> will allow between 1 and 3 integers, separated by commas. So C<< "1,42,-999" >> will pass the type constraint, but C<< "Hello,45" >> will fail. The ws parameter allows optional whitespace surrounding the delimiters, as well as optional leading and trailing whitespace. The type, min, max, and ws parameters are optional. Parameterized B type constraints will automatically have a coercion from B<< ArrayRef[`type] >> which uses C<< join >> to join by the delimiter. The plain unparameterized type constraint B has a coercion from B<< ArrayRef[Str] >> which joins the strings using the list separator C<< $" >> (which is a space by default). =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. ArrayRef.pm000664001750001750 2046615111656240 20126 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for ArrayRef type from Types::Standard. package Types::Standard::ArrayRef; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::ArrayRef::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::ArrayRef::VERSION = '2.008006'; } $Types::Standard::ArrayRef::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my $of = exists( $values->{of} ) ? $values->{of} : $values->{type}; defined $of or _croak( qq{Expected option "of" for type "$type_name"} ); if ( not Types::TypeTiny::is_TypeTiny($of) ) { require Type::Utils; $of = Type::Utils::dwim_type( $of, for => $caller ); } my $type = Types::Standard::ArrayRef->of( $of ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; sub __constraint_generator { return Types::Standard::ArrayRef unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'ArrayRef', \@_, 3 ); my $param = shift; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to ArrayRef[`a] expected to be a type constraint; got $param" ); my ( $min, $max ) = ( 0, -1 ); $min = Types::Standard::assert_Int( shift ) if @_; $max = Types::Standard::assert_Int( shift ) if @_; my $param_compiled_check = $param->compiled_check; my $xsub; if ( Type::Tiny::_USE_XS and $min == 0 and $max == -1 ) { my $paramname = Type::Tiny::XS::is_known( $param_compiled_check ); $xsub = Type::Tiny::XS::get_coderef_for( "ArrayRef[$paramname]" ) if $paramname; } elsif ( Type::Tiny::_USE_MOUSE and $param->_has_xsub and $min == 0 and $max == -1 ) { require Mouse::Util::TypeConstraints; my $maker = "Mouse::Util::TypeConstraints"->can( "_parameterize_ArrayRef_for" ); $xsub = $maker->( $param ) if $maker; } return ( sub { my $array = shift; $param->check( $_ ) || return for @$array; return !!1; }, $xsub, ) if $min == 0 and $max == -1; return sub { my $array = shift; return if @$array < $min; $param->check( $_ ) || return for @$array; return !!1; } if $max == -1; return sub { my $array = shift; return if @$array > $max; $param->check( $_ ) || return for @$array; return !!1; } if $min == 0; return sub { my $array = shift; return if @$array < $min; return if @$array > $max; $param->check( $_ ) || return for @$array; return !!1; }; } #/ sub __constraint_generator sub __inline_generator { my $param = shift; my ( $min, $max ) = ( 0, -1 ); $min = shift if @_; $max = shift if @_; my $param_compiled_check = $param->compiled_check; my $xsubname; if ( Type::Tiny::_USE_XS and $min == 0 and $max == -1 ) { my $paramname = Type::Tiny::XS::is_known( $param_compiled_check ); $xsubname = Type::Tiny::XS::get_subname_for( "ArrayRef[$paramname]" ); } return unless $param->can_be_inlined; return sub { my $v = $_[1]; return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $p = Types::Standard::ArrayRef->inline_check( $v ); if ( $min != 0 ) { $p .= sprintf( ' and @{%s} >= %d', $v, $min ); } if ( $max > 0 ) { $p .= sprintf( ' and @{%s} <= %d', $v, $max ); } my $param_check = $param->inline_check( '$i' ); return $p if $param->{uniq} eq Types::Standard::Any->{uniq}; "$p and do { " . "my \$ok = 1; " . "for my \$i (\@{$v}) { " . "(\$ok = 0, last) unless $param_check " . "}; " . "\$ok " . "}"; }; } #/ sub __inline_generator sub __deep_explanation { my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; my ( $min, $max ) = ( 0, -1 ); $min = $type->parameters->[1] if @{ $type->parameters } > 1; $max = $type->parameters->[2] if @{ $type->parameters } > 2; if ( $min != 0 and @$value < $min ) { return [ sprintf( '"%s" constrains array length at least %s', $type, $min ), sprintf( '@{%s} is %d', $varname, scalar @$value ), ]; } if ( $max > 0 and @$value > $max ) { return [ sprintf( '"%s" constrains array length at most %d', $type, $max ), sprintf( '@{%s} is %d', $varname, scalar @$value ), ]; } for my $i ( 0 .. $#$value ) { my $item = $value->[$i]; next if $param->check( $item ); return [ sprintf( '"%s" constrains each value in the array with "%s"', $type, $param ), @{ $param->validate_explain( $item, sprintf( '%s->[%d]', $varname, $i ) ) }, ]; } # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation # XXX: min and max need to be handled by coercion? sub __coercion_generator { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new( type_constraint => $child ); if ( $param->coercion->can_be_inlined and $coercable_item->can_be_inlined ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my @code; push @code, 'do { my ($orig, $return_orig, @new) = ($_, 0);'; push @code, 'for (@$orig) {'; push @code, sprintf( '++$return_orig && last unless (%s);', $coercable_item->inline_check( '$_' ) ); push @code, sprintf( 'push @new, (%s);', $param->coercion->inline_coercion( '$_' ) ); push @code, '}'; push @code, '$return_orig ? $orig : \\@new'; push @code, '}'; "@code"; } ); } #/ if ( $param->coercion->...) else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my @new; for my $item ( @$value ) { return $value unless $coercable_item->check( $item ); push @new, $param->coerce( $item ); } return \@new; }, ); } #/ else [ if ( $param->coercion->...)] return $C; } #/ sub __coercion_generator 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::ArrayRef - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate an arrayref of integers. # ArrayRef->of( Int )->assert_valid( [ 1, 2, 3 ] ); use Types::Standard::ArrayRef Ints => { of => Int }, # Exported shortcut # assert_Ints [ 1, 2, 3 ]; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::ArrayRef can be used experimentally as an exporter. use Types::Standard 'Int'; use Types::Standard::ArrayRef Ints => { of => Int }; This will export the following functions into your namespace: =over =item C<< Ints >> =item C<< is_Ints( $value ) >> =item C<< assert_Ints( $value ) >> =item C<< to_Ints( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::ArrayRef ( Ints => { of => Int }, Nums => { of => Num }, Strs => { of => Str }, ); assert_Ints [ 1, 2, 3 ]; # should not die It's possible to further constrain the arrayref using C: use Types::Standard::ArrayRef Ints => { of => Int, where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. CycleTuple.pm000664001750001750 2130715111656240 20457 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for CycleTuple type from Types::Standard. package Types::Standard::CycleTuple; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::CycleTuple::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::CycleTuple::VERSION = '2.008006'; } $Types::Standard::CycleTuple::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } my $_Optional = Types::Standard::Optional; my $_arr = Types::Standard::ArrayRef; my $_Slurpy = Types::Standard::Slurpy; use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my @final; { my $to_type = sub { return $_[0] if Types::TypeTiny::is_TypeTiny($_[0]); require Type::Utils; Type::Utils::dwim_type( $_[0], for => 'caller' ); }; my $of = $values->{of}; Types::TypeTiny::is_ArrayLike($of) or _croak( qq{Expected arrayref option "of" for type "$type_name"} ); @final = map { $to_type->($_) } @$of; } my $type = Types::Standard::CycleTuple->of( @final ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; my $cycleuniq = 0; sub __constraint_generator { my @params = map { my $param = $_; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameters to CycleTuple[...] expected to be type constraints; got $param" ); $param; } @_; my $count = @params; my $tuple = Types::Standard::Tuple()->of( @params ); _croak( "Parameters to CycleTuple[...] cannot be optional" ) if grep !!$_->is_strictly_a_type_of( $_Optional ), @params; _croak( "Parameters to CycleTuple[...] cannot be slurpy" ) if grep !!$_->is_strictly_a_type_of( $_Slurpy ), @params; sub { my $value = shift; return unless $_arr->check( $value ); return if @$value % $count; my $i = 0; while ( $i < $#$value ) { my $tmp = [ @$value[ $i .. $i + $count - 1 ] ]; return unless $tuple->check( $tmp ); $i += $count; } !!1; } } #/ sub __constraint_generator sub __inline_generator { my @params = map { my $param = $_; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to CycleTuple[`a] expected to be a type constraint; got $param" ); $param; } @_; my $count = @params; my $tuple = Types::Standard::Tuple()->of( @params ); return unless $tuple->can_be_inlined; sub { $cycleuniq++; my $v = $_[1]; my @checks = $_arr->inline_check( $v ); push @checks, sprintf( 'not(@%s %% %d)', ( $v =~ /\A\$[a-z0-9_]+\z/i ? $v : "{$v}" ), $count, ); push @checks, sprintf( 'do { my $cyclecount%d = 0; my $cycleok%d = 1; while ($cyclecount%d < $#{%s}) { my $cycletmp%d = [@{%s}[$cyclecount%d .. $cyclecount%d+%d]]; unless (%s) { $cycleok%d = 0; last; }; $cyclecount%d += %d; }; $cycleok%d; }', $cycleuniq, $cycleuniq, $cycleuniq, $v, $cycleuniq, $v, $cycleuniq, $cycleuniq, $count - 1, $tuple->inline_check( "\$cycletmp$cycleuniq" ), $cycleuniq, $cycleuniq, $count, $cycleuniq, ) if grep { $_->inline_check( '$xyz' ) ne '(!!1)' } @params; join( ' && ', @checks ); } } #/ sub __inline_generator sub __deep_explanation { my ( $type, $value, $varname ) = @_; my @constraints = map Types::TypeTiny::to_TypeTiny( $_ ), @{ $type->parameters }; if ( @$value % @constraints ) { return [ sprintf( '"%s" expects a multiple of %d values in the array', $type, scalar( @constraints ) ), sprintf( '%d values found', scalar( @$value ) ), ]; } for my $i ( 0 .. $#$value ) { my $constraint = $constraints[ $i % @constraints ]; next if $constraint->check( $value->[$i] ); return [ sprintf( '"%s" constrains value at index %d of array with "%s"', $type, $i, $constraint ), @{ $constraint->validate_explain( $value->[$i], sprintf( '%s->[%s]', $varname, $i ) ) }, ]; } #/ for my $i ( 0 .. $#$value) # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation my $label_counter = 0; sub __coercion_generator { my ( $parent, $child, @tuple ) = @_; my $child_coercions_exist = 0; my $all_inlinable = 1; for my $tc ( @tuple ) { $all_inlinable = 0 if !$tc->can_be_inlined; $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined; $child_coercions_exist++ if $tc->has_coercion; } return unless $child_coercions_exist; my $C = "Type::Coercion"->new( type_constraint => $child ); if ( $all_inlinable ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my $label = sprintf( "CTUPLELABEL%d", ++$label_counter ); my $label2 = sprintf( "CTUPLEINNER%d", $label_counter ); my @code; push @code, 'do { my ($orig, $return_orig, $tmp, @new) = ($_, 0);'; push @code, "$label: {"; push @code, sprintf( '(($return_orig = 1), last %s) if scalar(@$orig) %% %d != 0;', $label, scalar @tuple ); push @code, sprintf( 'my $%s = 0; while ($%s < @$orig) {', $label2, $label2 ); for my $i ( 0 .. $#tuple ) { my $ct = $tuple[$i]; my $ct_coerce = $ct->has_coercion; push @code, sprintf( 'do { $tmp = %s; (%s) ? ($new[$%s + %d]=$tmp) : (($return_orig=1), last %s) };', $ct_coerce ? $ct->coercion->inline_coercion( "\$orig->[\$$label2 + $i]" ) : "\$orig->[\$$label2 + $i]", $ct->inline_check( '$tmp' ), $label2, $i, $label, ); } #/ for my $i ( 0 .. $#tuple) push @code, sprintf( '$%s += %d;', $label2, scalar( @tuple ) ); push @code, '}'; push @code, '}'; push @code, '$return_orig ? $orig : \\@new'; push @code, '}'; "@code"; } ); } #/ if ( $all_inlinable ) else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; if ( scalar( @$value ) % scalar( @tuple ) != 0 ) { return $value; } my @new; for my $i ( 0 .. $#$value ) { my $ct = $tuple[ $i % @tuple ]; my $x = $ct->has_coercion ? $ct->coerce( $value->[$i] ) : $value->[$i]; return $value unless $ct->check( $x ); $new[$i] = $x; } return \@new; }, ); } #/ else [ if ( $all_inlinable ) ] return $C; } #/ sub __coercion_generator 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::CycleTuple - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate a list of pairs of integers. # CycleTuple->of( Int, Int )->assert_valid( [ 7, 49, 8, 64 ] ); use Types::Standard::CycleTuple IntPairs => { of => [ Int, Int ] }, # Exported shortcut # assert_IntPairs [ 7, 49, 8, 64 ]; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::CycleTuple can be used experimentally as an exporter. use Types::Standard 'Int'; use Types::Standard::CycleTuple IntPairs => { of => [ Int, Int ] }; This will export the following functions into your namespace: =over =item C<< IntPairs >> =item C<< is_IntPairs( $value ) >> =item C<< assert_IntPairs( $value ) >> =item C<< to_IntPairs( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::CycleTuple ( IntIntPairs => { of => [ Int, Int ] }, StrIntPairs => { of => [ Str, Int ] }, ); assert_StrIntPairs [ one => 1, two => 2 ]; # should not die It's possible to further constrain the cycletuple using C: use Types::Standard::CycleTuple MyThing => { of => [ ... ], where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Dict.pm000664001750001750 4371515111656240 17300 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for Dict type from Types::Standard. package Types::Standard::Dict; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::Dict::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::Dict::VERSION = '2.008006'; } $Types::Standard::Dict::VERSION =~ tr/_//d; use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Carp; goto \&Carp::confess; require Error::TypeTiny; goto \&Error::TypeTiny::croak; } my $_Slurpy = Types::Standard::Slurpy; my $_optional = Types::Standard::Optional; my $_hash = Types::Standard::HashRef; my $_map = Types::Standard::Map; my $_any = Types::Standard::Any; use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); our @EXPORT_OK = qw( combine ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my @final; { my $to_type = sub { return $_[0] if Types::TypeTiny::is_TypeTiny($_[0]); require Type::Utils; Type::Utils::dwim_type( $_[0], for => 'caller' ); }; my $of = $values->{of}; Types::TypeTiny::is_ArrayLike($of) or _croak( qq{Expected arrayref option "of" for type "$type_name"} ); my @of_copy = @$of; my $slurpy = @of_copy % 2 ? pop( @of_copy ) : undef; my $iter = pair_iterator( @of_copy ); while ( my ( $name, $type ) = $iter->() ) { push @final, $name, $to_type->( $type ); } push @final, $to_type->( $slurpy ) if defined $slurpy; } my $type = Types::Standard::Dict->of( @final ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; sub pair_iterator { _croak( "Expected even-sized list" ) if @_ % 2; my @array = @_; sub { return unless @array; splice( @array, 0, 2 ); }; } sub __constraint_generator { my $slurpy = @_ && Types::TypeTiny::is_TypeTiny( $_[-1] ) && $_[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop->my_unslurpy : undef; my $iterator = pair_iterator @_; my %constraints; my %is_optional; my @keys; while ( my ( $k, $v ) = $iterator->() ) { $constraints{$k} = $v; Types::TypeTiny::is_TypeTiny( $v ) or _croak( "Parameter for Dict[...] with key '$k' expected to be a type constraint; got $v" ); Types::TypeTiny::is_StringLike( $k ) or _croak( "Key for Dict[...] expected to be string; got $k" ); push @keys, $k; $is_optional{$k} = !!$constraints{$k}->is_strictly_a_type_of( $_optional ); } #/ while ( my ( $k, $v ) = $iterator...) return sub { my $value = $_[0]; if ( $slurpy ) { my %tmp = map +( exists( $constraints{$_} ) ? () : ( $_ => $value->{$_} ) ), keys %$value; return unless $slurpy->check( \%tmp ); } else { exists( $constraints{$_} ) || return for sort keys %$value; } for my $k ( @keys ) { exists( $value->{$k} ) or ( $is_optional{$k} ? next : return ); $constraints{$k}->check( $value->{$k} ) or return; } return !!1; }; } #/ sub __constraint_generator sub __inline_generator { # We can only inline a parameterized Dict if all the # constraints inside can be inlined. my $slurpy = @_ && Types::TypeTiny::is_TypeTiny( $_[-1] ) && $_[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop->my_unslurpy : undef; return if $slurpy && !$slurpy->can_be_inlined; # Is slurpy a very loose type constraint? # i.e. Any, Item, Defined, Ref, or HashRef my $slurpy_is_any = $slurpy && $_hash->is_a_type_of( $slurpy ); # Is slurpy a parameterized Map, or expressible as a parameterized Map? my $slurpy_is_map = $slurpy && $slurpy->is_parameterized && ( ( $slurpy->parent->strictly_equals( $_map ) && $slurpy->parameters ) || ( $slurpy->parent->strictly_equals( $_hash ) && [ $_any, $slurpy->parameters->[0] ] ) ); my $iterator = pair_iterator @_; my %constraints; my @keys; while ( my ( $k, $c ) = $iterator->() ) { return unless $c->can_be_inlined; $constraints{$k} = $c; push @keys, $k; } my $regexp = join "|", map quotemeta, @keys; return sub { require B; my $h = $_[1]; join " and ", Types::Standard::HashRef->inline_check( $h ), ( $slurpy_is_any ? () : $slurpy_is_map ? do { '(not grep {' . "my \$v = ($h)->{\$_};" . sprintf( 'not((/\\A(?:%s)\\z/) or ((%s) and (%s)))', $regexp, $slurpy_is_map->[0]->inline_check( '$_' ), $slurpy_is_map->[1]->inline_check( '$v' ), ) . "} keys \%{$h})"; } : $slurpy ? do { 'do {' . "my \$slurpy_tmp = +{ map /\\A(?:$regexp)\\z/ ? () : (\$_ => ($h)->{\$_}), keys \%{$h} };" . $slurpy->inline_check( '$slurpy_tmp' ) . '}'; } : "not(grep !/\\A(?:$regexp)\\z/, keys \%{$h})" ), ( map { my $k = B::perlstring( $_ ); $constraints{$_}->is_strictly_a_type_of( $_optional ) ? sprintf( '(!exists %s->{%s} or %s)', $h, $k, $constraints{$_}->inline_check( "$h\->{$k}" ) ) : ( "exists($h\->{$k})", $constraints{$_}->inline_check( "$h\->{$k}" ) ) } @keys ), ; } } #/ sub __inline_generator sub __deep_explanation { require B; my ( $type, $value, $varname ) = @_; my @params = @{ $type->parameters }; my $slurpy = @params && Types::TypeTiny::is_TypeTiny( $params[-1] ) && $params[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop( @params )->my_unslurpy : undef; my $iterator = pair_iterator @params; my %constraints; my @keys; while ( my ( $k, $c ) = $iterator->() ) { push @keys, $k; $constraints{$k} = $c; } for my $k ( @keys ) { next if $constraints{$k}->has_parent && ( $constraints{$k}->parent == Types::Standard::Optional ) && ( !exists $value->{$k} ); next if $constraints{$k}->check( $value->{$k} ); return [ sprintf( '"%s" requires key %s to appear in hash', $type, B::perlstring( $k ) ) ] unless exists $value->{$k}; return [ sprintf( '"%s" constrains value at key %s of hash with "%s"', $type, B::perlstring( $k ), $constraints{$k}, ), @{ $constraints{$k}->validate_explain( $value->{$k}, sprintf( '%s->{%s}', $varname, B::perlstring( $k ) ), ) }, ]; } #/ for my $k ( @keys ) if ( $slurpy ) { my %tmp = map { exists( $constraints{$_} ) ? () : ( $_ => $value->{$_} ) } keys %$value; my $explain = $slurpy->validate_explain( \%tmp, '$slurpy' ); return [ sprintf( '"%s" requires the hashref of additional key/value pairs to conform to "%s"', $type, $slurpy ), @$explain, ] if $explain; } #/ if ( $slurpy ) else { for my $k ( sort keys %$value ) { return [ sprintf( '"%s" does not allow key %s to appear in hash', $type, B::perlstring( $k ) ) ] unless exists $constraints{$k}; } } #/ else [ if ( $slurpy ) ] # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation my $label_counter = 0; our ( $keycheck_counter, @KEYCHECK ) = -1; sub __coercion_generator { my $slurpy = @_ && Types::TypeTiny::is_TypeTiny( $_[-1] ) && $_[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop->my_unslurpy : undef; my ( $parent, $child, %dict ) = @_; my $C = "Type::Coercion"->new( type_constraint => $child ); my $all_inlinable = 1; my $child_coercions_exist = 0; for my $tc ( values %dict ) { $all_inlinable = 0 if !$tc->can_be_inlined; $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined; $child_coercions_exist++ if $tc->has_coercion; } $all_inlinable = 0 if $slurpy && !$slurpy->can_be_inlined; $all_inlinable = 0 if $slurpy && $slurpy->has_coercion && !$slurpy->coercion->can_be_inlined; $child_coercions_exist++ if $slurpy && $slurpy->has_coercion; return unless $child_coercions_exist; if ( $all_inlinable ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { require B; my $keycheck = join "|", map quotemeta, sort { length( $b ) <=> length( $a ) or $a cmp $b } keys %dict; $keycheck = $KEYCHECK[ ++$keycheck_counter ] = qr{^($keycheck)$}ms; # regexp for legal keys my $label = sprintf( "DICTLABEL%d", ++$label_counter ); my @code; push @code, 'do { my ($orig, $return_orig, $tmp, %new) = ($_, 0);'; push @code, "$label: {"; if ( $slurpy ) { push @code, sprintf( 'my $slurped = +{ map +($_=~$%s::KEYCHECK[%d])?():($_=>$orig->{$_}), keys %%$orig };', __PACKAGE__, $keycheck_counter ); if ( $slurpy->has_coercion ) { push @code, sprintf( 'my $coerced = %s;', $slurpy->coercion->inline_coercion( '$slurped' ) ); push @code, sprintf( '((%s)&&(%s))?(%%new=%%$coerced):(($return_orig = 1), last %s);', $_hash->inline_check( '$coerced' ), $slurpy->inline_check( '$coerced' ), $label ); } #/ if ( $slurpy->has_coercion) else { push @code, sprintf( '(%s)?(%%new=%%$slurped):(($return_orig = 1), last %s);', $slurpy->inline_check( '$slurped' ), $label ); } } #/ if ( $slurpy ) else { push @code, sprintf( '($_ =~ $%s::KEYCHECK[%d])||(($return_orig = 1), last %s) for sort keys %%$orig;', __PACKAGE__, $keycheck_counter, $label ); } for my $k ( keys %dict ) { my $ct = $dict{$k}; my $ct_coerce = $ct->has_coercion; my $ct_optional = $ct->is_a_type_of( $_optional ); my $K = B::perlstring( $k ); push @code, sprintf( 'if (exists $orig->{%s}) { $tmp = %s; (%s) ? ($new{%s}=$tmp) : (($return_orig=1), last %s) }', $K, $ct_coerce ? $ct->coercion->inline_coercion( "\$orig->{$K}" ) : "\$orig->{$K}", $ct->inline_check( '$tmp' ), $K, $label, ); } #/ for my $k ( keys %dict ) push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; #warn "CODE:: @code"; "@code"; } ); } #/ if ( $all_inlinable ) else { my %is_optional = map { ; $_ => !!$dict{$_}->is_strictly_a_type_of( $_optional ) } sort keys %dict; $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; if ( $slurpy ) { my %slurped = map exists( $dict{$_} ) ? () : ( $_ => $value->{$_} ), keys %$value; if ( $slurpy->check( \%slurped ) ) { %new = %slurped; } elsif ( $slurpy->has_coercion ) { my $coerced = $slurpy->coerce( \%slurped ); $slurpy->check( $coerced ) ? ( %new = %$coerced ) : ( return $value ); } else { return $value; } } #/ if ( $slurpy ) else { for my $k ( keys %$value ) { return $value unless exists $dict{$k}; } } for my $k ( keys %dict ) { next if $is_optional{$k} and not exists $value->{$k}; my $ct = $dict{$k}; my $x = $ct->has_coercion ? $ct->coerce( $value->{$k} ) : $value->{$k}; return $value unless $ct->check( $x ); $new{$k} = $x; } #/ for my $k ( keys %dict ) return \%new; }, ); } #/ else [ if ( $all_inlinable ) ] return $C; } #/ sub __coercion_generator sub __dict_is_slurpy { my $self = shift; return !!0 if $self == Types::Standard::Dict(); my $dict = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::Dict() } ); my $slurpy = @{ $dict->parameters } && Types::TypeTiny::is_TypeTiny( $dict->parameters->[-1] ) && $dict->parameters->[-1]->is_strictly_a_type_of( $_Slurpy ) ? $dict->parameters->[-1] : undef; } #/ sub __dict_is_slurpy sub __hashref_allows_key { my $self = shift; my ( $key ) = @_; return Types::Standard::is_Str( $key ) if $self == Types::Standard::Dict(); my $dict = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::Dict() } ); my %params; my $slurpy = $dict->my_dict_is_slurpy; if ( $slurpy ) { my @args = @{ $dict->parameters }; pop @args; %params = @args; $slurpy = $slurpy->my_unslurpy; } else { %params = @{ $dict->parameters }; } return !!1 if exists( $params{$key} ); return !!0 if !$slurpy; return Types::Standard::is_Str( $key ) if $slurpy == Types::Standard::Any() || $slurpy == Types::Standard::Item() || $slurpy == Types::Standard::Defined() || $slurpy == Types::Standard::Ref(); return $slurpy->my_hashref_allows_key( $key ) if $slurpy->is_a_type_of( Types::Standard::HashRef() ); return !!0; } #/ sub __hashref_allows_key sub __hashref_allows_value { my $self = shift; my ( $key, $value ) = @_; return !!0 unless $self->my_hashref_allows_key( $key ); return !!1 if $self == Types::Standard::Dict(); my $dict = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::Dict() } ); my %params; my $slurpy = $dict->my_dict_is_slurpy; if ( $slurpy ) { my @args = @{ $dict->parameters }; pop @args; %params = @args; $slurpy = $slurpy->my_unslurpy; } else { %params = @{ $dict->parameters }; } return !!1 if exists( $params{$key} ) && $params{$key}->check( $value ); return !!0 if !$slurpy; return !!1 if $slurpy == Types::Standard::Any() || $slurpy == Types::Standard::Item() || $slurpy == Types::Standard::Defined() || $slurpy == Types::Standard::Ref(); return $slurpy->my_hashref_allows_value( $key, $value ) if $slurpy->is_a_type_of( Types::Standard::HashRef() ); return !!0; } #/ sub __hashref_allows_value sub combine { require Type::Tiny::Union; my @key_order; my %keys; my @slurpy; for my $dict ( @_ ) { Types::TypeTiny::is_TypeTiny( $dict ) && $dict->is_a_type_of( Types::Standard::Dict() ) or _croak "Unexpected non-Dict argument: $dict"; my @args; if ( my $s = $dict->my_dict_is_slurpy ) { @args = @{ $dict->parameters }; pop @args; push @slurpy, $s->my_unslurpy; } else { @args = @{ $dict->parameters }; } while ( @args ) { my ( $key, $type ) = splice @args, 0, 2; if ( not exists $keys{ $key } ) { push @key_order, $key; $keys{$key} = []; } push @{ $keys{$key} }, $type; } } my @args; for my $key ( @key_order ) { if ( @{ $keys{$key} } == 1 ) { push @args, $key => $keys{$key}[0]; } else { my %seen; my @uniq = grep { not $seen{$_->{uniq}}++ } @{ $keys{$key} }; my $union = 'Type::Tiny::Union'->new( type_constraints => \@uniq ); push @args, $key => $union; } } if ( @slurpy ) { my %seen; my @uniq = grep { not $seen{$_->{uniq}}++ } @slurpy; my $union = 'Type::Tiny::Union'->new( type_constraints => \@uniq ); push @args, Types::Standard::Slurpy->of( $union ); } return Types::Standard::Dict->of( @args ); } 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::Dict - exporter utility and utility functions for the B type constraint =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but has one public-facing function. =head2 Function =over =item C<< Types::Standard::Dict::combine(@dicts) >> Creates a combined type constraint, attempting to be permissive. The following two types should be equivalent: my $type1 = Types::Standard::Dict::combine( Dict[ name => Str ], Dict[ age => Int, Slurpy[HashRef[Int]] ], Dict[ id => Str, name => ArrayRef, Slurpy[ArrayRef] ], ); my $type2 = Dict[ name => Str|ArrayRef, age => Int, id => Str, Slurpy[ HashRef[Int] | ArrayRef ], ]; Note that a hashref satisfying the combined type wouldn't satisfy any of the individual B constraints, nor vice versa! This function can be exported: use Types::Standard -types; use Types::Standard::Dict combine => { -as => 'combine_dicts' }; my $type1 = combine_dicts( Dict[ name => Str ], Dict[ age => Int, Slurpy[HashRef[Int]] ], Dict[ id => Str, name => ArrayRef, Slurpy[ArrayRef] ], ); =back =head2 Exports Types::Standard::Dict can be used experimentally as an exporter. use Types::Standard 'Str'; use Types::Standard::Dict Credentials => { of => [ username => Str, password => Str, ] }; This will export the following functions into your namespace: =over =item C<< Credentials >> =item C<< is_Credentials( $value ) >> =item C<< assert_Credentials( $value ) >> =item C<< to_Credentials( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::Dict ( Credentials => { of => [ username => Str, password => Str, ] }, Headers => { of => [ 'Content-Type' => Optional[Str], 'Accept' => Optional[Str], 'User-Agent' => Optional[Str], ] }, ); # Exporting this separately so it can use the types defined by # the first export. use Types::Standard::Dict ( HttpRequestData => { of => [ credentials => Credentials, headers => Headers, url => Str, method => Enum[ qw( OPTIONS HEAD GET POST PUT DELETE PATCH ) ], ] }, ); assert_HttpRequestData( { credentials => { username => 'bob', password => 's3cr3t' }, headers => { 'Accept' => 'application/json' }, url => 'http://example.net/api/v1/stuff', method => 'GET', } ); It's possible to further constrain the hashref using C: use Types::Standard::Dict MyThing => { of => [ ... ], where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. HashRef.pm000664001750001750 1664415111656240 17736 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for HashRef type from Types::Standard. package Types::Standard::HashRef; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::HashRef::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::HashRef::VERSION = '2.008006'; } $Types::Standard::HashRef::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my $of = exists( $values->{of} ) ? $values->{of} : $values->{type}; defined $of or _croak( qq{Expected option "of" for type "$type_name"} ); if ( not Types::TypeTiny::is_TypeTiny($of) ) { require Type::Utils; $of = Type::Utils::dwim_type( $of, for => $caller ); } my $type = Types::Standard::HashRef->of( $of ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; sub __constraint_generator { return Types::Standard::HashRef unless @_; require Error::TypeTiny::WrongNumberOfParameters; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'HashRef', \@_, 1 ); my $param = shift; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to HashRef[`a] expected to be a type constraint; got $param" ); my $param_compiled_check = $param->compiled_check; my $xsub; if ( Type::Tiny::_USE_XS ) { my $paramname = Type::Tiny::XS::is_known( $param_compiled_check ); $xsub = Type::Tiny::XS::get_coderef_for( "HashRef[$paramname]" ) if $paramname; } elsif ( Type::Tiny::_USE_MOUSE and $param->_has_xsub ) { require Mouse::Util::TypeConstraints; my $maker = "Mouse::Util::TypeConstraints"->can( "_parameterize_HashRef_for" ); $xsub = $maker->( $param ) if $maker; } return ( sub { my $hash = shift; $param->check( $_ ) || return for values %$hash; return !!1; }, $xsub, ); } #/ sub __constraint_generator sub __inline_generator { my $param = shift; my $compiled = $param->compiled_check; my $xsubname; if ( Type::Tiny::_USE_XS and not $Type::Tiny::AvoidCallbacks ) { my $paramname = Type::Tiny::XS::is_known( $compiled ); $xsubname = Type::Tiny::XS::get_subname_for( "HashRef[$paramname]" ); } return unless $param->can_be_inlined; return sub { my $v = $_[1]; return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $p = Types::Standard::HashRef->inline_check( $v ); my $param_check = $param->inline_check( '$i' ); "$p and do { " . "my \$ok = 1; " . "for my \$i (values \%{$v}) { " . "(\$ok = 0, last) unless $param_check " . "}; " . "\$ok " . "}"; }; } #/ sub __inline_generator sub __deep_explanation { require B; my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; for my $k ( sort keys %$value ) { my $item = $value->{$k}; next if $param->check( $item ); return [ sprintf( '"%s" constrains each value in the hash with "%s"', $type, $param ), @{ $param->validate_explain( $item, sprintf( '%s->{%s}', $varname, B::perlstring( $k ) ) ) }, ]; } #/ for my $k ( sort keys %$value) # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation sub __coercion_generator { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new( type_constraint => $child ); if ( $param->coercion->can_be_inlined and $coercable_item->can_be_inlined ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my @code; push @code, 'do { my ($orig, $return_orig, %new) = ($_, 0);'; push @code, 'for (keys %$orig) {'; push @code, sprintf( '$return_orig++ && last unless (%s);', $coercable_item->inline_check( '$orig->{$_}' ) ); push @code, sprintf( '$new{$_} = (%s);', $param->coercion->inline_coercion( '$orig->{$_}' ) ); push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; "@code"; } ); } #/ if ( $param->coercion->...) else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; for my $k ( keys %$value ) { return $value unless $coercable_item->check( $value->{$k} ); $new{$k} = $param->coerce( $value->{$k} ); } return \%new; }, ); } #/ else [ if ( $param->coercion->...)] return $C; } #/ sub __coercion_generator sub __hashref_allows_key { my $self = shift; Types::Standard::is_Str( $_[0] ); } sub __hashref_allows_value { my $self = shift; my ( $key, $value ) = @_; return !!0 unless $self->my_hashref_allows_key( $key ); return !!1 if $self == Types::Standard::HashRef(); my $href = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::HashRef() } ); my $param = $href->type_parameter; Types::Standard::is_Str( $key ) and $param->check( $value ); } #/ sub __hashref_allows_value 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::HashRef - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate a hashref of integers. # HashRef->of( Int )->assert_valid( { one => 1 } ); use Types::Standard::HashRef IntHash => { of => Int }, # Exported shortcut # assert_IntHash { one => 1 }; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::HashRef can be used experimentally as an exporter. use Types::Standard 'Int'; use Types::Standard::HashRef IntHash => { of => Int }; This will export the following functions into your namespace: =over =item C<< IntHash >> =item C<< is_IntHash( $value ) >> =item C<< assert_IntHash( $value ) >> =item C<< to_IntHash( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::HashRef ( IntHash => { of => Int }, NumHash => { of => Num }, StrHash => { of => Str }, ); assert_IntHash { two => 2 }; # should not die It's possible to further constrain the hashref using C: use Types::Standard::HashRef MyThing => { of => Int, where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Map.pm000664001750001750 2265015111656240 17125 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for Map type from Types::Standard. package Types::Standard::Map; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::Map::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::Map::VERSION = '2.008006'; } $Types::Standard::Map::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my ( $keys, $vals ) = exists( $values->{of} ) ? @{ $values->{of} } : ( $values->{keys}, $values->{values} ); defined $keys or _croak( qq{Expected option "keys" for type "$type_name"} ); defined $vals or _croak( qq{Expected option "values" for type "$type_name"} ); if ( not Types::TypeTiny::is_TypeTiny($keys) ) { require Type::Utils; $keys = Type::Utils::dwim_type( $keys, for => $caller ); } if ( not Types::TypeTiny::is_TypeTiny($vals) ) { require Type::Utils; $vals = Type::Utils::dwim_type( $vals, for => $caller ); } my $type = Types::Standard::Map->of( $keys, $vals ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } my $meta = Types::Standard->meta; no warnings; sub __constraint_generator { return $meta->get_type( 'Map' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Map', \@_, 2, 2 ); my ( $keys, $values ) = @_; Types::TypeTiny::is_TypeTiny( $keys ) or _croak( "First parameter to Map[`k,`v] expected to be a type constraint; got $keys" ); Types::TypeTiny::is_TypeTiny( $values ) or _croak( "Second parameter to Map[`k,`v] expected to be a type constraint; got $values" ); my @xsub; if ( Type::Tiny::_USE_XS ) { my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } ( $keys, $values ); if ( @known == 2 ) { my $xsub = Type::Tiny::XS::get_coderef_for( sprintf "Map[%s,%s]", @known ); push @xsub, $xsub if $xsub; } } #/ if ( Type::Tiny::_USE_XS) sub { my $hash = shift; $keys->check( $_ ) || return for keys %$hash; $values->check( $_ ) || return for values %$hash; return !!1; }, @xsub; } #/ sub __constraint_generator sub __inline_generator { my ( $k, $v ) = @_; return unless $k->can_be_inlined && $v->can_be_inlined; my $xsubname; if ( Type::Tiny::_USE_XS ) { my @known = map { my $known = Type::Tiny::XS::is_known( $_->compiled_check ); defined( $known ) ? $known : (); } ( $k, $v ); if ( @known == 2 ) { $xsubname = Type::Tiny::XS::get_subname_for( sprintf "Map[%s,%s]", @known ); } } #/ if ( Type::Tiny::_USE_XS) return sub { my $h = $_[1]; return "$xsubname\($h\)" if $xsubname && !$Type::Tiny::AvoidCallbacks; my $p = Types::Standard::HashRef->inline_check( $h ); my $k_check = $k->inline_check( '$k' ); my $v_check = $v->inline_check( '$v' ); "$p and do { " . "my \$ok = 1; " . "for my \$v (values \%{$h}) { " . "(\$ok = 0, last) unless $v_check " . "}; " . "for my \$k (keys \%{$h}) { " . "(\$ok = 0, last) unless $k_check " . "}; " . "\$ok " . "}"; }; } #/ sub __inline_generator sub __deep_explanation { require B; my ( $type, $value, $varname ) = @_; my ( $kparam, $vparam ) = @{ $type->parameters }; for my $k ( sort keys %$value ) { unless ( $kparam->check( $k ) ) { return [ sprintf( '"%s" constrains each key in the hash with "%s"', $type, $kparam ), @{ $kparam->validate_explain( $k, sprintf( 'key %s->{%s}', $varname, B::perlstring( $k ) ) ) }, ]; } #/ unless ( $kparam->check( $k...)) unless ( $vparam->check( $value->{$k} ) ) { return [ sprintf( '"%s" constrains each value in the hash with "%s"', $type, $vparam ), @{ $vparam->validate_explain( $value->{$k}, sprintf( '%s->{%s}', $varname, B::perlstring( $k ) ) ) }, ]; } #/ unless ( $vparam->check( $value...)) } #/ for my $k ( sort keys %$value) # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation sub __coercion_generator { my ( $parent, $child, $kparam, $vparam ) = @_; return unless $kparam->has_coercion || $vparam->has_coercion; my $kcoercable_item = $kparam->has_coercion ? $kparam->coercion->_source_type_union : $kparam; my $vcoercable_item = $vparam->has_coercion ? $vparam->coercion->_source_type_union : $vparam; my $C = "Type::Coercion"->new( type_constraint => $child ); if ( ( !$kparam->has_coercion or $kparam->coercion->can_be_inlined ) and ( !$vparam->has_coercion or $vparam->coercion->can_be_inlined ) and $kcoercable_item->can_be_inlined and $vcoercable_item->can_be_inlined ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my @code; push @code, 'do { my ($orig, $return_orig, %new) = ($_, 0);'; push @code, 'for (keys %$orig) {'; push @code, sprintf( '++$return_orig && last unless (%s);', $kcoercable_item->inline_check( '$_' ) ); push @code, sprintf( '++$return_orig && last unless (%s);', $vcoercable_item->inline_check( '$orig->{$_}' ) ); push @code, sprintf( '$new{(%s)} = (%s);', $kparam->has_coercion ? $kparam->coercion->inline_coercion( '$_' ) : '$_', $vparam->has_coercion ? $vparam->coercion->inline_coercion( '$orig->{$_}' ) : '$orig->{$_}', ); push @code, '}'; push @code, '$return_orig ? $orig : \\%new'; push @code, '}'; "@code"; } ); } #/ if ( ( !$kparam->has_coercion...)) else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my %new; for my $k ( keys %$value ) { return $value unless $kcoercable_item->check( $k ) && $vcoercable_item->check( $value->{$k} ); $new{ $kparam->has_coercion ? $kparam->coerce( $k ) : $k } = $vparam->has_coercion ? $vparam->coerce( $value->{$k} ) : $value->{$k}; } return \%new; }, ); } #/ else [ if ( ( !$kparam->has_coercion...))] return $C; } #/ sub __coercion_generator sub __hashref_allows_key { my $self = shift; my ( $key ) = @_; return Types::Standard::is_Str( $key ) if $self == Types::Standard::Map(); my $map = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::Map() } ); my ( $kcheck, $vcheck ) = @{ $map->parameters }; ( $kcheck or Types::Standard::Any() )->check( $key ); } #/ sub __hashref_allows_key sub __hashref_allows_value { my $self = shift; my ( $key, $value ) = @_; return !!0 unless $self->my_hashref_allows_key( $key ); return !!1 if $self == Types::Standard::Map(); my $map = $self->find_parent( sub { $_->has_parent && $_->parent == Types::Standard::Map() } ); my ( $kcheck, $vcheck ) = @{ $map->parameters }; ( $kcheck or Types::Standard::Any() )->check( $key ) and ( $vcheck or Types::Standard::Any() )->check( $value ); } #/ sub __hashref_allows_value 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::Map - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate map. # Map->of( Int, Str )->assert_valid( { 1 => "one" } ); use Types::Standard::Map IntsToStrs => { keys => Int, values => Str }, # Exported shortcut # assert_IntsToStrs { 1 => "one" }; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::Map can be used experimentally as an exporter. use Types::Standard 'Int'; use Types::Standard::Map IntsToStrs => { keys => Int, values => Str }, This will export the following functions into your namespace: =over =item C<< IntsToStrs >> =item C<< is_IntsToStrs( $value ) >> =item C<< assert_IntsToStrs( $value ) >> =item C<< to_IntsToStrs( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::Map ( IntsToStrs => { keys => Int, values => Str }, StrsToInts => { keys => Str, values => Int }, ); assert_StrsToInts { two => 2 }; # should not die It's possible to further constrain the hashref using C: use Types::Standard::Dict MyThing => { keys => Str->where( sub { ... } ), values => Int->where( sub { ... } ), where => sub { ... }, }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. ScalarRef.pm000664001750001750 1327715111656240 20257 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for ScalarRef type from Types::Standard. package Types::Standard::ScalarRef; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::ScalarRef::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::ScalarRef::VERSION = '2.008006'; } $Types::Standard::ScalarRef::VERSION =~ tr/_//d; use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } no warnings; use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my $of = exists( $values->{of} ) ? $values->{of} : $values->{type}; defined $of or _croak( qq{Expected option "of" for type "$type_name"} ); if ( not Types::TypeTiny::is_TypeTiny($of) ) { require Type::Utils; $of = Type::Utils::dwim_type( $of, for => $caller ); } my $type = Types::Standard::ScalarRef->of( $of ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } sub __constraint_generator { return Types::Standard::ScalarRef unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'ScalarRef', \@_, 1 ); my $param = shift; Types::TypeTiny::is_TypeTiny( $param ) or _croak( "Parameter to ScalarRef[`a] expected to be a type constraint; got $param" ); return sub { my $ref = shift; $param->check( $$ref ) || return; return !!1; }; } #/ sub __constraint_generator sub __inline_generator { my $param = shift; return unless $param->can_be_inlined; return sub { my $v = $_[1]; my $param_check = $param->inline_check( "\${$v}" ); "(ref($v) eq 'SCALAR' or ref($v) eq 'REF') and $param_check"; }; } sub __deep_explanation { my ( $type, $value, $varname ) = @_; my $param = $type->parameters->[0]; for my $item ( $$value ) { next if $param->check( $item ); return [ sprintf( '"%s" constrains the referenced scalar value with "%s"', $type, $param ), @{ $param->validate_explain( $item, sprintf( '${%s}', $varname ) ) }, ]; } # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation sub __coercion_generator { my ( $parent, $child, $param ) = @_; return unless $param->has_coercion; my $coercable_item = $param->coercion->_source_type_union; my $C = "Type::Coercion"->new( type_constraint => $child ); if ( $param->coercion->can_be_inlined and $coercable_item->can_be_inlined ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my @code; push @code, 'do { my ($orig, $return_orig, $new) = ($_, 0);'; push @code, 'for ($$orig) {'; push @code, sprintf( '++$return_orig && last unless (%s);', $coercable_item->inline_check( '$_' ) ); push @code, sprintf( '$new = (%s);', $param->coercion->inline_coercion( '$_' ) ); push @code, '}'; push @code, '$return_orig ? $orig : \\$new'; push @code, '}'; "@code"; } ); } #/ if ( $param->coercion->...) else { $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; my $new; for my $item ( $$value ) { return $value unless $coercable_item->check( $item ); $new = $param->coerce( $item ); } return \$new; }, ); } #/ else [ if ( $param->coercion->...)] return $C; } #/ sub __coercion_generator 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::ScalarRef - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate a reference to a string. # ScalarRef->of( Str )->assert_valid( \ "foo" ); use Types::Standard::ScalarRef StrRef => { of => Str }, # Exported shortcut # assert_StrRef \ "foo"; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::ScalarRef can be used experimentally as an exporter. use Types::Standard 'Str'; use Types::Standard::ScalarRef StrRef => { of => Str }; This will export the following functions into your namespace: =over =item C<< StrRef >> =item C<< is_StrRef( $value ) >> =item C<< assert_StrRef( $value ) >> =item C<< to_StrRef( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::ScalarRef ( IntRef => { of => Int }, StrRef => { of => Str }, ); assert_IntRef \42; # should not die It's possible to further constrain the reference using C: use Types::Standard::ScalarRef MyThing => { of => Str, where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. StrMatch.pm000664001750001750 1414415111656240 20134 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for StrMatch type from Types::Standard. package Types::Standard::StrMatch; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::StrMatch::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::StrMatch::VERSION = '2.008006'; } $Types::Standard::StrMatch::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my $of = exists( $values->{of} ) ? $values->{of} : $values->{re}; Types::Standard::RegexpRef->assert_valid( $of ); my $type = Types::Standard::StrMatch->of( $of ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; our %expressions; my $has_regexp_util; my $serialize_regexp = sub { $has_regexp_util = eval { require Regexp::Util; Regexp::Util->VERSION( '0.003' ); 1; } || 0 unless defined $has_regexp_util; my $re = shift; my $serialized; if ( $has_regexp_util ) { $serialized = eval { Regexp::Util::serialize_regexp( $re ) }; } unless ( defined $serialized ) { my $key = sprintf( '%s|%s', ref( $re ), $re ); $expressions{$key} = $re; $serialized = sprintf( '$Types::Standard::StrMatch::expressions{%s}', B::perlstring( $key ) ); } return $serialized; }; sub __constraint_generator { return Types::Standard->meta->get_type( 'StrMatch' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'StrMatch', \@_, 2, 1 ); my ( $regexp, $checker ) = @_; Types::Standard::is_RegexpRef( $regexp ) or _croak( "First parameter to StrMatch[`a] expected to be a Regexp; got $regexp" ); if ( @_ > 1 ) { $checker = Types::TypeTiny::to_TypeTiny( $checker ); Types::TypeTiny::is_TypeTiny( $checker ) or _croak( "Second parameter to StrMatch[`a] expected to be a type constraint; got $checker" ); } $checker ? sub { my $value = shift; return if !defined ( $value ); return if ref( $value ); my @m = ( $value =~ $regexp ); $checker->check( \@m ); } : sub { my $value = shift; defined( $value ) and !ref( $value ) and !!( $value =~ $regexp ); }; } #/ sub __constraint_generator sub __inline_generator { require B; my ( $regexp, $checker ) = @_; my $serialized_re = $regexp->$serialize_regexp or return; if ( $checker ) { return unless $checker->can_be_inlined; return sub { my $v = $_[1]; if ( $Type::Tiny::AvoidCallbacks and $serialized_re =~ /Types::Standard::StrMatch::expressions/ ) { require Carp; Carp::carp( "Cannot serialize regexp without callbacks; serializing using callbacks" ); } sprintf "defined($v) and !ref($v) and do { my \$m = [$v =~ %s]; %s }", $serialized_re, $checker->inline_check( '$m' ), ; }; } #/ if ( $checker ) else { my $regexp_string = "$regexp"; if ( $regexp_string =~ /\A\(\?\^u?:\\A(\.+)\)\z/ ) { my $length = length $1; return sub { "defined($_) and !ref($_) and length($_)>=$length" }; } if ( $regexp_string =~ /\A\(\?\^u?:\\A(\.+)\\z\)\z/ ) { my $length = length $1; return sub { "defined($_) and !ref($_) and length($_)==$length" }; } return sub { my $v = $_[1]; if ( $Type::Tiny::AvoidCallbacks and $serialized_re =~ /Types::Standard::StrMatch::expressions/ ) { require Carp; Carp::carp( "Cannot serialize regexp without callbacks; serializing using callbacks" ); } "defined($v) and !ref($v) and !!( $v =~ $serialized_re )"; }; } #/ else [ if ( $checker ) ] } #/ sub __inline_generator 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::StrMatch - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate a string against a regular expression. # StrMatch->of( qr/.../ )->assert_valid( "foo" ); use Types::Standard::StrMatch Identifier => { re => qr/.../ }, # Exported shortcut # assert_Identifier "foo"; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::ScalarRef can be used experimentally as an exporter. use Types::Standard::StrMatch Identifier => { re => qr/.../ }; This will export the following functions into your namespace: =over =item C<< Identifier >> =item C<< is_Identifier( $value ) >> =item C<< assert_Identifier( $value ) >> =item C<< to_Identifier( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::StrMatch ( Identifier => { re => qr/.../ }, Url => { re => qr/.../ }, Email => { re => qr/.../ }, ); assert_Email 'tobyink@example.net'; # should not die It's possible to further constrain the string using C: use Types::Standard::StrMatch MyThing => { re => qr/.../, where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. Tied.pm000664001750001750 406115111656240 17251 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for Tied type from Types::Standard. package Types::Standard::Tied; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::Tied::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::Tied::VERSION = '2.008006'; } $Types::Standard::Tied::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } no warnings; sub __constraint_generator { return Types::Standard->meta->get_type( 'Tied' ) unless @_; Type::Tiny::check_parameter_count_for_parameterized_type( 'Types::Standard', 'Tied', \@_, 1 ); my $param = Types::TypeTiny::to_TypeTiny( shift ); unless ( Types::TypeTiny::is_TypeTiny( $param ) ) { Types::TypeTiny::is_StringLike( $param ) or _croak( "Parameter to Tied[`a] expected to be a class name; got $param" ); require Type::Tiny::Class; $param = "Type::Tiny::Class"->new( class => "$param" ); } my $check = $param->compiled_check; sub { $check->( tied( Scalar::Util::reftype( $_ ) eq 'HASH' ? %{$_} : Scalar::Util::reftype( $_ ) eq 'ARRAY' ? @{$_} : Scalar::Util::reftype( $_ ) =~ /^(SCALAR|REF)$/ ? ${$_} : undef ) ); }; } #/ sub __constraint_generator sub __inline_generator { my $param = Types::TypeTiny::to_TypeTiny( shift ); unless ( Types::TypeTiny::is_TypeTiny( $param ) ) { Types::TypeTiny::is_StringLike( $param ) or _croak( "Parameter to Tied[`a] expected to be a class name; got $param" ); require Type::Tiny::Class; $param = "Type::Tiny::Class"->new( class => "$param" ); } return unless $param->can_be_inlined; sub { require B; my $var = $_[1]; sprintf( "%s and do { my \$TIED = tied(Scalar::Util::reftype($var) eq 'HASH' ? \%{$var} : Scalar::Util::reftype($var) eq 'ARRAY' ? \@{$var} : Scalar::Util::reftype($var) =~ /^(SCALAR|REF)\$/ ? \${$var} : undef); %s }", Types::Standard::Ref()->inline_check( $var ), $param->inline_check( '$TIED' ) ); } } #/ sub __inline_generator 1; Tuple.pm000664001750001750 3125615111656240 17503 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Types/Standard# INTERNAL MODULE: guts for Tuple type from Types::Standard. package Types::Standard::Tuple; use 5.008001; use strict; use warnings; BEGIN { $Types::Standard::Tuple::AUTHORITY = 'cpan:TOBYINK'; $Types::Standard::Tuple::VERSION = '2.008006'; } $Types::Standard::Tuple::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } my $_Optional = Types::Standard::Optional; my $_Slurpy = Types::Standard::Slurpy; use Exporter::Tiny 1.004001 (); our @ISA = qw( Exporter::Tiny ); sub _exporter_fail { my ( $class, $type_name, $values, $globals ) = @_; my $caller = $globals->{into}; my @final; { my $to_type = sub { return $_[0] if Types::TypeTiny::is_TypeTiny($_[0]); require Type::Utils; Type::Utils::dwim_type( $_[0], for => 'caller' ); }; my $of = $values->{of}; Types::TypeTiny::is_ArrayLike($of) or _croak( qq{Expected arrayref option "of" for type "$type_name"} ); @final = map { $to_type->($_) } @$of; } my $type = Types::Standard::Tuple->of( @final ); $type = $type->create_child_type( name => $type_name, $type->has_coercion ? ( coercion => 1 ) : (), exists( $values->{where} ) ? ( constraint => $values->{where} ) : (), ); $INC{'Type/Registry.pm'} ? 'Type::Registry'->for_class( $caller )->add_type( $type, $type_name ) : ( $Type::Registry::DELAYED{$caller}{$type_name} = $type ) unless( ref($caller) or $caller eq '-lexical' or $globals->{'lexical'} ); return map +( $_->{name} => $_->{code} ), @{ $type->exportables }; } no warnings; sub __constraint_generator { my $slurpy = @_ && Types::TypeTiny::is_TypeTiny( $_[-1] ) && $_[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop : undef; my @constraints = @_; for ( @constraints ) { Types::TypeTiny::is_TypeTiny( $_ ) or _croak( "Parameters to Tuple[...] expected to be type constraints; got $_" ); } # By god, the Type::Tiny::XS API is currently horrible my @xsub; if ( Type::Tiny::_USE_XS and !$slurpy ) { my @known = map { my $known; $known = Type::Tiny::XS::is_known( $_->compiled_check ) unless $_->is_strictly_a_type_of( $_Optional ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { my $xsub = Type::Tiny::XS::get_coderef_for( sprintf( "Tuple[%s]", join( ',', @known ) ) ); push @xsub, $xsub if $xsub; } } #/ if ( Type::Tiny::_USE_XS...) my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @constraints; my $slurp_hash = $slurpy && $slurpy->my_slurp_into eq 'HASH'; my $slurp_any = $slurpy && $slurpy->my_unslurpy->equals( Types::Standard::Any ); my @sorted_is_optional = sort @is_optional; join( "|", @sorted_is_optional ) eq join( "|", @is_optional ) or _croak( "Optional parameters to Tuple[...] cannot precede required parameters" ); sub { my $value = $_[0]; if ( $#constraints < $#$value ) { return !!0 unless $slurpy; my $tmp; if ( $slurp_hash ) { ( $#$value - $#constraints + 1 ) % 2 or return; $tmp = +{ @$value[ $#constraints + 1 .. $#$value ] }; $slurpy->check( $tmp ) or return; } elsif ( not $slurp_any ) { $tmp = +[ @$value[ $#constraints + 1 .. $#$value ] ]; $slurpy->check( $tmp ) or return; } } #/ if ( $#constraints < $#$value) for my $i ( 0 .. $#constraints ) { ( $i > $#$value ) and return !!$is_optional[$i]; $constraints[$i]->check( $value->[$i] ) or return !!0; } return !!1; }, @xsub; } #/ sub __constraint_generator sub __inline_generator { my $slurpy = @_ && Types::TypeTiny::is_TypeTiny( $_[-1] ) && $_[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop : undef; my @constraints = @_; return if grep { not $_->can_be_inlined } @constraints; return if defined $slurpy && !$slurpy->can_be_inlined; my $xsubname; if ( Type::Tiny::_USE_XS and !$slurpy ) { my @known = map { my $known; $known = Type::Tiny::XS::is_known( $_->compiled_check ) unless $_->is_strictly_a_type_of( $_Optional ); defined( $known ) ? $known : (); } @constraints; if ( @known == @constraints ) { $xsubname = Type::Tiny::XS::get_subname_for( sprintf( "Tuple[%s]", join( ',', @known ) ) ); } } #/ if ( Type::Tiny::_USE_XS...) my $tmpl = "do { my \$tmp = +[\@{%s}[%d..\$#{%s}]]; %s }"; my $slurpy_any; if ( defined $slurpy ) { $tmpl = 'do { my ($orig, $from, $to) = (%s, %d, $#{%s});' . '(($to-$from) %% 2) and do { my $tmp = +{@{$orig}[$from..$to]}; %s }' . '}' if $slurpy->my_slurp_into eq 'HASH'; $slurpy_any = 1 if $slurpy->my_unslurpy->equals( Types::Standard::Any ); } my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @constraints; my $min = 0+ grep !$_, @is_optional; return sub { my $v = $_[1]; return "$xsubname\($v\)" if $xsubname && !$Type::Tiny::AvoidCallbacks; join " and ", Types::Standard::ArrayRef->inline_check( $v ), ( ( scalar @constraints == $min and not $slurpy ) ? "\@{$v} == $min" : sprintf( "(\@{$v} == $min or (\@{$v} > $min and \@{$v} <= ${\(1+$#constraints)}) or (\@{$v} > ${\(1+$#constraints)} and %s))", ( $slurpy_any ? '!!1' : ( $slurpy ? sprintf( $tmpl, $v, $#constraints + 1, $v, $slurpy->inline_check( '$tmp' ) ) : sprintf( "\@{$v} <= %d", scalar @constraints ) ) ), ) ), map { my $inline = $constraints[$_]->inline_check( "$v\->[$_]" ); $inline eq '(!!1)' ? () : ( $is_optional[$_] ? sprintf( '(@{%s} <= %d or %s)', $v, $_, $inline ) : $inline ); } 0 .. $#constraints; }; } #/ sub __inline_generator sub __deep_explanation { my ( $type, $value, $varname ) = @_; my @constraints = @{ $type->parameters }; my $slurpy = @constraints && Types::TypeTiny::is_TypeTiny( $constraints[-1] ) && $constraints[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop( @constraints ) : undef; @constraints = map Types::TypeTiny::to_TypeTiny( $_ ), @constraints; if ( @constraints < @$value and not $slurpy ) { return [ sprintf( '"%s" expects at most %d values in the array', $type, scalar( @constraints ) ), sprintf( '%d values found; too many', scalar( @$value ) ), ]; } for my $i ( 0 .. $#constraints ) { next if $constraints[$i] ->is_strictly_a_type_of( Types::Standard::Optional ) && $i > $#$value; next if $constraints[$i]->check( $value->[$i] ); return [ sprintf( '"%s" constrains value at index %d of array with "%s"', $type, $i, $constraints[$i] ), @{ $constraints[$i] ->validate_explain( $value->[$i], sprintf( '%s->[%s]', $varname, $i ) ) }, ]; } #/ for my $i ( 0 .. $#constraints) if ( defined( $slurpy ) ) { my $tmp = $slurpy->my_slurp_into eq 'HASH' ? +{ @$value[ $#constraints + 1 .. $#$value ] } : +[ @$value[ $#constraints + 1 .. $#$value ] ]; $slurpy->check( $tmp ) or return [ sprintf( 'Array elements from index %d are slurped into a %s which is constrained with "%s"', $#constraints + 1, ( $slurpy->my_slurp_into eq 'HASH' ) ? 'hashref' : 'arrayref', ( $slurpy->my_unslurpy || $slurpy ), ), @{ ( $slurpy->my_unslurpy || $slurpy )->validate_explain( $tmp, '$SLURPY' ) }, ]; } #/ if ( defined( $slurpy ...)) # This should never happen... return; # uncoverable statement } #/ sub __deep_explanation my $label_counter = 0; sub __coercion_generator { my ( $parent, $child, @tuple ) = @_; my $slurpy = @tuple && Types::TypeTiny::is_TypeTiny( $tuple[-1] ) && $tuple[-1]->is_strictly_a_type_of( $_Slurpy ) ? pop( @tuple ) : undef; my $child_coercions_exist = 0; my $all_inlinable = 1; for my $tc ( @tuple, ( $slurpy ? $slurpy : () ) ) { $all_inlinable = 0 if !$tc->can_be_inlined; $all_inlinable = 0 if $tc->has_coercion && !$tc->coercion->can_be_inlined; $child_coercions_exist++ if $tc->has_coercion; } return unless $child_coercions_exist; my $C = "Type::Coercion"->new( type_constraint => $child ); my $slurpy_is_hashref = $slurpy && $slurpy->my_slurp_into eq 'HASH'; if ( $all_inlinable ) { $C->add_type_coercions( $parent => Types::Standard::Stringable { my $label = sprintf( "TUPLELABEL%d", ++$label_counter ); my @code; push @code, 'do { my ($orig, $return_orig, $tmp, @new) = ($_, 0);'; push @code, "$label: {"; push @code, sprintf( '(($return_orig = 1), last %s) if @$orig > %d;', $label, scalar @tuple ) unless $slurpy; for my $i ( 0 .. $#tuple ) { my $ct = $tuple[$i]; my $ct_coerce = $ct->has_coercion; my $ct_optional = $ct->is_a_type_of( Types::Standard::Optional ); push @code, sprintf( 'if (@$orig > %d) { $tmp = %s; (%s) ? ($new[%d]=$tmp) : (($return_orig=1), last %s) }', $i, $ct_coerce ? $ct->coercion->inline_coercion( "\$orig->[$i]" ) : "\$orig->[$i]", $ct->inline_check( '$tmp' ), $i, $label, ); } #/ for my $i ( 0 .. $#tuple) if ( $slurpy ) { my $size = @tuple; push @code, sprintf( 'if (@$orig > %d) {', $size ); push @code, sprintf( ( $slurpy_is_hashref ? 'my $tail = do { no warnings; +{ @{$orig}[%d .. $#$orig]} };' : 'my $tail = [ @{$orig}[%d .. $#$orig] ];' ), $size, ); push @code, $slurpy->has_coercion ? sprintf( '$tail = %s;', $slurpy->coercion->inline_coercion( '$tail' ) ) : q(); push @code, sprintf( '(%s) ? push(@new, %s$tail) : ($return_orig++);', $slurpy->inline_check( '$tail' ), ( $slurpy_is_hashref ? '%' : '@' ), ); push @code, '}'; } #/ if ( $slurpy ) push @code, '}'; push @code, '$return_orig ? $orig : \\@new'; push @code, '}'; "@code"; } ); } #/ if ( $all_inlinable ) else { my @is_optional = map !!$_->is_strictly_a_type_of( $_Optional ), @tuple; $C->add_type_coercions( $parent => sub { my $value = @_ ? $_[0] : $_; if ( !$slurpy and @$value > @tuple ) { return $value; } my @new; for my $i ( 0 .. $#tuple ) { return \@new if $i > $#$value and $is_optional[$i]; my $ct = $tuple[$i]; my $x = $ct->has_coercion ? $ct->coerce( $value->[$i] ) : $value->[$i]; return $value unless $ct->check( $x ); $new[$i] = $x; } #/ for my $i ( 0 .. $#tuple) if ( $slurpy and @$value > @tuple ) { no warnings; my $tmp = $slurpy_is_hashref ? { @{$value}[ @tuple .. $#$value ] } : [ @{$value}[ @tuple .. $#$value ] ]; $tmp = $slurpy->coerce( $tmp ) if $slurpy->has_coercion; $slurpy->check( $tmp ) ? push( @new, $slurpy_is_hashref ? %$tmp : @$tmp ) : return ( $value ); } #/ if ( $slurpy and @$value...) return \@new; }, ); } #/ else [ if ( $all_inlinable ) ] return $C; } #/ sub __coercion_generator 1; __END__ =pod =encoding utf-8 =head1 NAME Types::Standard::Tuple - exporter utility for the B type constraint =head1 SYNOPSIS use Types::Standard -types; # Normal way to validate a pair of integers. # Tuple->of( Int, Int )->assert_valid( [ 7, 49 ] ); use Types::Standard::Tuple IntPair => { of => [ Int, Int ] }, # Exported shortcut # assert_IntPair [ 7, 49 ]; =head1 STATUS This module is not covered by the L. =head1 DESCRIPTION This is mostly internal code, but can also act as an exporter utility. =head2 Exports Types::Standard::Tuple can be used experimentally as an exporter. use Types::Standard 'Int'; use Types::Standard::Tuple IntPair => { of => [ Int, Int ] }; This will export the following functions into your namespace: =over =item C<< IntPair >> =item C<< is_IntPair( $value ) >> =item C<< assert_IntPair( $value ) >> =item C<< to_IntPair( $value ) >> =back Multiple types can be exported at once: use Types::Standard -types; use Types::Standard::HashRef ( IntPair => { of => [ Int, Int ] }, StrInt => { of => [ Str, Int ] }, ); assert_StrInt [ two => 2 ]; # should not die It's possible to further constrain the tuple using C: use Types::Standard::Tuple MyThing => { of => [ ... ], where => sub { ... } }; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. basic.t000664001750001750 120015111656240 23047 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Devel-TypeTiny-Perl58Compat=pod =encoding utf-8 =head1 PURPOSE Checks C<< re::is_regexp() >> works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Types::Standard; ok( +re::is_regexp(qr{foo}), 're::is_regexp(qr{foo})', ); ok( +re::is_regexp(bless qr{foo}, "Foo"), 're::is_regexp(bless qr{foo}, "Foo")', ); done_testing; basic.t000664001750001750 210615111656240 20666 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Error-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests for basic L functionality. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Error::TypeTiny; #line 31 "basic.t" my $e1 = exception { 'Error::TypeTiny'->throw() }; is($e1->message, 'An exception has occurred', '$e1->message (default)'); is($e1->context->{package}, 'main', '$e1->context->{main}'); is($e1->context->{line}, '31', '$e1->context->{line}'); is($e1->context->{file}, 'basic.t', '$e1->context->{file}'); my $e2 = exception { 'Error::TypeTiny'->throw(message => 'oh dear') }; is($e2->message, 'oh dear', '$e2->message'); my $e3 = exception { Error::TypeTiny::croak('oh %s', 'drat') }; is($e3->message, 'oh drat', '$e3->message (set by croak)'); done_testing; stacktrace.t000664001750001750 223315111656240 21732 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Error-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests that L is capable of providing stack traces. =head1 DEPENDENCIES Requires L; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Error::TypeTiny (); local $Error::TypeTiny::StackTrace; use Test::More; use Test::Fatal; use Test::Requires { "Devel::StackTrace" => 0 }; use Types::Standard (); { package Local::Guts; sub foo { local $Error::TypeTiny::StackTrace = 1; local $Error::TypeTiny::CarpInternal{'Local::Guts'} = 1; Types::Standard::Int->( @_ ); } } sub bar { Local::Guts::foo( @_ ); } sub baz { bar( @_ ); } my $e = exception { baz(undef) }; my $subs = [ map $e->stack_trace->frame( $_ )->subroutine, 0 .. 2 ]; is_deeply( $subs, [ 'Local::Guts::foo', 'main::bar', 'main::baz' ], ) or diag explain( $subs ); done_testing; basic.t000664001750001750 2650615111656240 22665 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Error-TypeTiny-Assertion=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); local $Error::TypeTiny::LastError; use Test::More; use Test::Fatal; use Scalar::Util qw(refaddr); use Types::Standard slurpy => -types; require Error::TypeTiny::Assertion; my $tmp = Error::TypeTiny::Assertion->new(value => 1.1, type => Int, varname => '$bob'); is($tmp->message, "Value \"1.1\" did not pass type constraint \"Int\" (in \$bob)", "autogeneration of \$e->message"); my $supernum = Types::Standard::STRICTNUM ? "StrictNum" : "LaxNum"; my $v = []; my $e = exception { Int->create_child_type->assert_valid($v) }; isa_ok($e, "Error::TypeTiny", '$e'); is(refaddr($e), refaddr($Error::TypeTiny::LastError), '$Error::TypeTiny::LastError'); is( $e->message, q{Reference [] did not pass type constraint}, '$e->message is as expected', ); isa_ok($e, "Error::TypeTiny::Assertion", '$e'); cmp_ok( $e->type, '==', Int, '$e->type is as expected', ); is( $e->value, $v, '$e->value is as expected', ); is_deeply( $e->explain, [ '"__ANON__" is a subtype of "Int"', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', 'Reference [] did not pass type constraint "Value"', '"Value" is defined as: (defined($_) and not ref($_))', ], '$e->explain is as expected', ); is_deeply( (exception { (ArrayRef[Int])->([1, 2, [3]]) })->explain, [ 'Reference [1,2,[3]] did not pass type constraint "ArrayRef[Int]"', '"ArrayRef[Int]" constrains each value in the array with "Int"', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', 'Reference [3] did not pass type constraint "Value" (in $_->[2])', '"Value" is defined as: (defined($_) and not ref($_))', ], 'ArrayRef[Int] deep explanation, given [1, 2, [3]]', ); is_deeply( [ @{ (exception { (ArrayRef[Int])->({}) })->explain }[0..1] ], [ '"ArrayRef[Int]" is a subtype of "ArrayRef"', 'Reference {} did not pass type constraint "ArrayRef"', # '"ArrayRef" is defined as: (ref($_) eq \'ARRAY\')', ], 'ArrayRef[Int] deep explanation, given {}', ); is_deeply( (exception { (Ref["ARRAY"])->({}) })->explain, [ 'Reference {} did not pass type constraint "Ref[ARRAY]"', '"Ref[ARRAY]" constrains reftype($_) to be equal to "ARRAY"', 'reftype($_) is "HASH"', ], 'Ref["ARRAY"] deep explanation, given {}', ); is_deeply( (exception { (HashRef[Maybe[Int]])->({a => undef, b => 42, c => []}) })->explain, [ 'Reference {"a" => undef,"b" => 42,"c" => []} did not pass type constraint "HashRef[Maybe[Int]]"', '"HashRef[Maybe[Int]]" constrains each value in the hash with "Maybe[Int]"', 'Reference [] did not pass type constraint "Maybe[Int]" (in $_->{"c"})', 'Reference [] is defined', '"Maybe[Int]" constrains the value with "Int" if it is defined', '"Int" is a subtype of "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', 'Reference [] did not pass type constraint "Value" (in $_->{"c"})', '"Value" is defined as: (defined($_) and not ref($_))', ], 'HashRef[Maybe[Int]] deep explanation, given {a => undef, b => 42, c => []}', ); my $dict = Dict[a => Int, b => Optional[ArrayRef[Str]]]; is_deeply( (exception { $dict->({a => 1, c => 1}) })->explain, [ 'Reference {"a" => 1,"c" => 1} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" does not allow key "c" to appear in hash', ], '$dict deep explanation, given {a => 1, c => 1}', ); is_deeply( (exception { $dict->({b => 1}) })->explain, [ 'Reference {"b" => 1} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" requires key "a" to appear in hash', ], '$dict deep explanation, given {b => 1}', ); is_deeply( (exception { $dict->({a => 1, b => 2}) })->explain, [ 'Reference {"a" => 1,"b" => 2} did not pass type constraint "Dict[a=>Int,b=>Optional[ArrayRef[Str]]]"', '"Dict[a=>Int,b=>Optional[ArrayRef[Str]]]" constrains value at key "b" of hash with "Optional[ArrayRef[Str]]"', 'Value "2" did not pass type constraint "Optional[ArrayRef[Str]]" (in $_->{"b"})', '$_->{"b"} exists', '"Optional[ArrayRef[Str]]" constrains $_->{"b"} with "ArrayRef[Str]" if it exists', '"ArrayRef[Str]" is a subtype of "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "2" did not pass type constraint "Ref" (in $_->{"b"})', '"Ref" is defined as: (!!ref($_))', ], '$dict deep explanation, given {a => 1, b => 2}', ); TODO: { no warnings 'numeric'; require Data::Dumper; local $TODO = (Data::Dumper->VERSION > 2.145) ? "Data::Dumper output changed after 2.145" : (Data::Dumper->VERSION < 2.121) ? "Data::Dumper too old" : undef; is_deeply( (exception { (Map[Int,Num])->({1=>1.1,2.2=>2.3,3.3=>3.4}) })->explain, [ 'Reference {1 => "1.1","2.2" => "2.3","3.3" => "3.4"} did not pass type constraint "Map[Int,Num]"', '"Map[Int,Num]" constrains each key in the hash with "Int"', 'Value "2.2" did not pass type constraint "Int" (in key $_->{"2.2"})', '"Int" is defined as: (do { my $tmp = $_; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ })', ], 'Map[Int,Num] deep explanation, given {1=>1.1,2.2=>2.3,3.3=>3.4}', ); } TODO: { no warnings 'numeric'; require Data::Dumper; local $TODO = (Data::Dumper->VERSION < 2.121) ? "Data::Dumper too old" : undef; my $Ext = (StrMatch[qr/^x_/])->create_child_type(name => 'Ext'); my $dict2 = Dict[foo => ArrayRef, slurpy Map[$Ext, Int]]; ok( $dict2->({ foo => [], x_bar => 1, x_baz => 2 }), "$dict2 works ok it seems", ); ### TODO # # my $e = exception { $dict2->({foo => [], x_bar => 1, x_baz => []}) }; # is_deeply( # $e->explain, # [ # 'Reference {"foo" => [],"x_bar" => 1,"x_baz" => []} did not pass type constraint "Dict[foo=>ArrayRef,Slurpy[Map[Ext,Int]]]"', # '"Dict[foo=>ArrayRef,Slurpy[Map[Ext,Int]]]" requires the hashref of additional key/value pairs to conform to "Map[Ext,Int]"', # 'Reference {"x_bar" => 1,"x_baz" => []} did not pass type constraint "Map[Ext,Int]" (in $slurpy)', # '"Map[Ext,Int]" constrains each value in the hash with "Int"', # '"Int" is a subtype of "Num"', # '"Num" is a subtype of "'.$supernum.'"', # '"'.$supernum.'" is a subtype of "Str"', # '"Str" is a subtype of "Value"', # 'Reference [] did not pass type constraint "Value" (in $slurpy->{"x_baz"})', # '"Value" is defined as: (defined($_) and not ref($_))' # ], # "$dict2 explanation, given {foo => [], x_bar => 1, x_baz => []}", # ) or diag explain($e->explain); } my $AlwaysFail = Any->create_child_type(constraint => sub { 0 }); is_deeply( (exception { $AlwaysFail->(1) })->explain, [ 'Value "1" did not pass type constraint', '"__ANON__" is defined as: sub { 0; }', ], '$AlwaysFail explanation, given 1', ); my $TupleOf1 = Tuple[ Int ]; is_deeply( (exception { $TupleOf1->([1,2]) })->explain, [ 'Reference [1,2] did not pass type constraint "Tuple[Int]"', '"Tuple[Int]" expects at most 1 values in the array', '2 values found; too many', ], '$TupleOf1 explanation, given [1,2]', ); my $CTuple = CycleTuple[ Int, ArrayRef ]; is_deeply( (exception { $CTuple->([1,"Foo"]) })->explain, [ 'Reference [1,"Foo"] did not pass type constraint "CycleTuple[Int,ArrayRef]"', '"CycleTuple[Int,ArrayRef]" constrains value at index 1 of array with "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "Foo" did not pass type constraint "Ref" (in $_->[1])', '"Ref" is defined as: (!!ref($_))', ], '$CTuple explanation, given [1,"Foo"]', ); TODO: { no warnings 'numeric'; require Data::Dumper; local $TODO = (Data::Dumper->VERSION < 2.121) ? "Data::Dumper too old" : undef; my $SlurpyThing = Tuple[ Num, slurpy Map[Str, ArrayRef] ]; is_deeply( (exception { $SlurpyThing->(1) })->explain, [ '"Tuple[Num,Slurpy[Map[Str,ArrayRef]]]" is a subtype of "Tuple"', '"Tuple" is a subtype of "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "1" did not pass type constraint "Ref"', '"Ref" is defined as: (!!ref($_))', ], '$SlurpyThing explanation, given 1', ); is_deeply( (exception { $SlurpyThing->([[]]) })->explain, [ 'Reference [[]] did not pass type constraint "Tuple[Num,Slurpy[Map[Str,ArrayRef]]]"', '"Tuple[Num,Slurpy[Map[Str,ArrayRef]]]" constrains value at index 0 of array with "Num"', '"Num" is a subtype of "'.$supernum.'"', '"'.$supernum.'" is a subtype of "Str"', '"Str" is a subtype of "Value"', 'Reference [] did not pass type constraint "Value" (in $_->[0])', '"Value" is defined as: (defined($_) and not ref($_))', ], '$SlurpyThing explanation, given [[]]', ); is_deeply( (exception { $SlurpyThing->([1.1, yeah => "Hello"]) })->explain, [ 'Reference ["1.1","yeah","Hello"] did not pass type constraint "Tuple[Num,Slurpy[Map[Str,ArrayRef]]]"', 'Array elements from index 1 are slurped into a hashref which is constrained with "Map[Str,ArrayRef]"', 'Reference {"yeah" => "Hello"} did not pass type constraint "Map[Str,ArrayRef]" (in $SLURPY)', '"Map[Str,ArrayRef]" constrains each value in the hash with "ArrayRef"', '"ArrayRef" is a subtype of "Ref"', 'Value "Hello" did not pass type constraint "Ref" (in $SLURPY->{"yeah"})', '"Ref" is defined as: (!!ref($_))', ], '$SlurpyThing explanation, given [1.1, yeah => "Hello"]', ); } my $UndefRef = ScalarRef[Undef]; is_deeply( (exception { $UndefRef->(do { my $x = "bar"; \$x }) })->explain, [ 'Reference \\"bar" did not pass type constraint "ScalarRef[Undef]"', '"ScalarRef[Undef]" constrains the referenced scalar value with "Undef"', 'Value "bar" did not pass type constraint "Undef" (in ${$_})', '"Undef" is defined as: (!defined($_))', ], '$UndefRef explanantion, given \"bar"', ); is_deeply( (exception { $UndefRef->([]) })->explain, [ '"ScalarRef[Undef]" is a subtype of "ScalarRef"', 'Reference [] did not pass type constraint "ScalarRef"', '"ScalarRef" is defined as: (ref($_) eq \'SCALAR\' or ref($_) eq \'REF\')', ], '$UndefRef explanantion, given []', ); my $e_where = exception { #line 1 "thisfile.plx" package Monkey::Nuts; "Error::TypeTiny"->throw(message => "Test"); }; #line 230 "exceptions.t" is_deeply( $e_where->context, { package => "Monkey::Nuts", file => "thisfile.plx", line => 2, }, '$e_where->context', ); is( "$e_where", "Test at thisfile.plx line 2.\n", '"$e_where"', ); BEGIN { package MyTypes; use Type::Library -base, -declare => qw(HttpMethod); use Type::Utils -all; use Types::Standard qw(Enum); declare HttpMethod, as Enum[qw/ HEAD GET POST PUT DELETE OPTIONS PATCH /], message { "$_ is not a HttpMethod" }; }; like( exception { MyTypes::HttpMethod->("FOOL") }, qr{^FOOL is not a HttpMethod}, "correct exception from type with null constraint", ); { local $Type::Tiny::DD = sub { substr("$_[0]", 0, 5) }; like( exception { Types::Standard::Str->([]) }, qr{^ARRAY did not pass type constraint}, "local \$Type::Tiny::DD", ); } done_testing; basic.t000664001750001750 304215111656240 23142 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Error-TypeTiny-Compilation=pod =encoding utf-8 =head1 PURPOSE Tests for L, mostly by triggering compilation errors using L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Eval::TypeTiny; my $e = exception { no warnings qw(void); 0; 1; 2; #line 38 "basic.t" eval_closure( source => 'sub { 1 ]', environment => { '$x' => do { my $x = 42; \$x } }, ); 3; 4; 5; 6; }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->message, qr{^Failed to compile source because: syntax error}, '$e->message', ); subtest '$e->context' => sub { my $ctx = $e->context; is($ctx->{package}, 'main', '$ctx->{package}'); is($ctx->{file}, 'basic.t', '$ctx->{file}'); ok($ctx->{line} >= 37, '$ctx->{line} >= 37') or diag('line is '.$ctx->{line}); ok($ctx->{line} <= 42, '$ctx->{line} <= 42') or diag('line is '.$ctx->{line}); }; like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); is_deeply( $e->environment, { '$x' => do { my $x = 42; \$x } }, '$e->environment', ); done_testing; basic.t000664001750001750 503515111656240 25446 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Error-TypeTiny-WrongNumberOfParameters=pod =encoding utf-8 =head1 PURPOSE Test L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard qw(Num Optional slurpy ArrayRef); my $check1; sub nth_root { $check1 ||= compile( Num, Num ); [ $check1->(@_) ]; } subtest "nth_root()" => sub { my $e = exception { nth_root() }; ok($e->has_minimum); is($e->minimum, 2); ok($e->has_maximum); is($e->maximum, 2); is($e->got, 0); like($e, qr{^Wrong number of parameters to main::nth_root; got 0; expected 2}); }; subtest "nth_root(1)" => sub { my $e = exception { nth_root(1) }; ok($e->has_minimum); is($e->minimum, 2); ok($e->has_maximum); is($e->maximum, 2); is($e->got, 1); like($e, qr{^Wrong number of parameters to main::nth_root; got 1; expected 2}); }; subtest "nth_root(1, 2, 3)" => sub { my $e = exception { nth_root(1, 2, 3) }; ok($e->has_minimum); is($e->minimum, 2); ok($e->has_maximum); is($e->maximum, 2); is($e->got, 3); like($e, qr{^Wrong number of parameters to main::nth_root; got 3; expected 2}); }; my $check2; sub nth_root_opt { $check2 ||= compile( Num, Optional[Num] ); [ $check2->(@_) ]; } subtest "nth_root_opt()" => sub { my $e = exception { nth_root_opt() }; ok($e->has_minimum); is($e->minimum, 1); ok($e->has_maximum); is($e->maximum, 2); is($e->got, 0); like($e, qr{^Wrong number of parameters to main::nth_root_opt; got 0; expected 1 to 2}); }; my $check3; sub nth_root_slurp { $check3 ||= compile( Num, slurpy ArrayRef[Num] ); [ $check3->(@_) ]; } subtest "nth_root_slurp()" => sub { my $e = exception { nth_root_slurp() }; ok($e->has_minimum); is($e->minimum, 1); ok(!$e->has_maximum); is($e->maximum, undef); is($e->got, 0); like($e, qr{^Wrong number of parameters to main::nth_root_slurp; got 0; expected at least 1}); }; my $silly = exception { Error::TypeTiny::WrongNumberOfParameters->throw( minimum => 3, maximum => 2, got => 0, ); }; like($silly, qr{^Wrong number of parameters; got 0}, 'silly exception which should never happen anyway'); my $unspecific = exception { Error::TypeTiny::WrongNumberOfParameters->throw(got => 0); }; like($unspecific, qr{^Wrong number of parameters; got 0}, 'unspecific exception'); done_testing; aliases-devel-lexalias.t000664001750001750 1036715111656240 23751 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L supports alias=>1 using L implementation. =head1 DEPENDENCIES Requires Devel::LexAlias. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'Devel::LexAlias'; use Eval::TypeTiny; Eval::TypeTiny::_force_implementation( Eval::TypeTiny::IMPLEMENTATION_DEVEL_LEXALIAS ); my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = <<'SRC'; sub { if (!@_) { return defined tied($foo); } return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env, alias => 1); ok( ! $closure->(), 'tied implementation was not used', ); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); ${ $env{'$foo'} } = 'FOO'; @{ $env{'@bar'} } = ('BAR'); %{ $env{'%baz'} } = ('BAZ' => 99); is_deeply( [ $closure->('$foo') ], [ 'FOO' ], 'closure over scalar - worked', ); is_deeply( [ $closure->('@bar') ], [ 'BAR' ], 'closure over array - worked', ); is_deeply( [ $closure->('%baz') ], [ 'BAZ' => 99 ], 'closure over hash - worked', ); my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42); is($destroyed, 0); } is($destroyed, 1, 'closed over variables disappear on cue'); } if (0) { # BROKEN my @store; { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub method_of_mine { 42 } } tie(my($var), 'MyTie'); $var = 1; my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->method_of_mine }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('method_of_mine'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); { package OtherTie; our @ISA = 'MyTie'; sub method_of_mine { 666 } } tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "method_of_mine" on an undefined value}, '... can be untied'); } if (0) { # ALSO BROKEN my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); } done_testing; aliases-native.t000664001750001750 1063015111656240 22331 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L supports alias=>1 using Perl refaliasing. =head1 DEPENDENCIES Requires Perl 5.22. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'v5.22'; BEGIN { plan skip_all => "cperl does not correctly clean up some references; this is not known to cause any practical issues but causes this test to fail on cperl, so skipping" if "$^V" =~ /c$/; }; use Eval::TypeTiny; Eval::TypeTiny::_force_implementation( Eval::TypeTiny::IMPLEMENTATION_NATIVE ); my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = <<'SRC'; sub { if (!@_) { return defined tied($foo); } return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env, alias => 1); ok( ! $closure->(), 'tied implementation was not used', ); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); ${ $env{'$foo'} } = 'FOO'; @{ $env{'@bar'} } = ('BAR'); %{ $env{'%baz'} } = ('BAZ' => 99); is_deeply( [ $closure->('$foo') ], [ 'FOO' ], 'closure over scalar - worked', ); is_deeply( [ $closure->('@bar') ], [ 'BAR' ], 'closure over array - worked', ); is_deeply( [ $closure->('%baz') ], [ 'BAZ' => 99 ], 'closure over hash - worked', ); my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42); is($destroyed, 0); } is($destroyed, 1, 'closed over variables disappear on cue'); } if (0) { # BROKEN my @store; { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub method_of_mine { 42 } } tie(my($var), 'MyTie'); $var = 1; my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->method_of_mine }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('method_of_mine'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); { package OtherTie; our @ISA = 'MyTie'; sub method_of_mine { 666 } } tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "method_of_mine" on an undefined value}, '... can be untied'); } if (0) { # ALSO BROKEN my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); } done_testing; aliases-padwalker.t000664001750001750 1034015111656240 23013 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L supports alias=>1 using L implementation. =head1 DEPENDENCIES Requires PadWalker. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'PadWalker'; use Eval::TypeTiny; Eval::TypeTiny::_force_implementation( Eval::TypeTiny::IMPLEMENTATION_PADWALKER ); my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = <<'SRC'; sub { if (!@_) { return defined tied($foo); } return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env, alias => 1); ok( ! $closure->(), 'tied implementation was not used', ); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); ${ $env{'$foo'} } = 'FOO'; @{ $env{'@bar'} } = ('BAR'); %{ $env{'%baz'} } = ('BAZ' => 99); is_deeply( [ $closure->('$foo') ], [ 'FOO' ], 'closure over scalar - worked', ); is_deeply( [ $closure->('@bar') ], [ 'BAR' ], 'closure over array - worked', ); is_deeply( [ $closure->('%baz') ], [ 'BAZ' => 99 ], 'closure over hash - worked', ); my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42); is($destroyed, 0); } is($destroyed, 1, 'closed over variables disappear on cue'); } if (0) { # BROKEN my @store; { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub method_of_mine { 42 } } tie(my($var), 'MyTie'); $var = 1; my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->method_of_mine }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('method_of_mine'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); { package OtherTie; our @ISA = 'MyTie'; sub method_of_mine { 666 } } tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "method_of_mine" on an undefined value}, '... can be untied'); } if (0) { # ALSO BROKEN my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); } done_testing; aliases-tie.t000664001750001750 1052215111656240 21624 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L supports alias=>1 using C implementation. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; BEGIN { plan skip_all => "cperl does not correctly clean up some references; this is not known to cause any practical issues but causes this test to fail on cperl, so skipping" if "$^V" =~ /c$/; }; use Eval::TypeTiny; Eval::TypeTiny::_force_implementation( Eval::TypeTiny::IMPLEMENTATION_TIE ); my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = <<'SRC'; sub { if (!@_) { return defined tied($foo); } return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env, alias => 1); ok( $closure->(), 'tied implementation was loaded', ); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); ${ $env{'$foo'} } = 'FOO'; @{ $env{'@bar'} } = ('BAR'); %{ $env{'%baz'} } = ('BAZ' => 99); is_deeply( [ $closure->('$foo') ], [ 'FOO' ], 'closure over scalar - worked', ); is_deeply( [ $closure->('@bar') ], [ 'BAR' ], 'closure over array - worked', ); is_deeply( [ $closure->('%baz') ], [ 'BAZ' => 99 ], 'closure over hash - worked', ); my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42); is($destroyed, 0); } is($destroyed, 1, 'closed over variables disappear on cue'); } if (0) { # BROKEN my @store; { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub method_of_mine { 42 } } tie(my($var), 'MyTie'); $var = 1; my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->method_of_mine }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('method_of_mine'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); { package OtherTie; our @ISA = 'MyTie'; sub method_of_mine { 666 } } tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "method_of_mine" on an undefined value}, '... can be untied'); } if (0) { # ALSO BROKEN my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); } done_testing; basic.t000664001750001750 1310515111656240 20505 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Eval::TypeTiny; subtest "constants exist" => sub { my @constants = qw( HAS_LEXICAL_SUBS ALIAS_IMPLEMENTATION IMPLEMENTATION_DEVEL_LEXALIAS IMPLEMENTATION_PADWALKER IMPLEMENTATION_NATIVE IMPLEMENTATION_TIE ); for my $c (@constants) { subtest "constant $c" => sub { my $can = Eval::TypeTiny->can($c); ok $can, "constant $c exists"; is exception { $can->() }, undef, "... and doesn't throw an error"; is $can->(undef), $can->(999), "... and seems to be constant"; }; } }; my $s = <<'SRC'; sub { return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return; } SRC my %sources = (string => $s, arrayref => [split /\n/, $s]); foreach my $key (reverse sort keys %sources) { subtest "compiling $key source" => sub { my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, ); my $source = $sources{$key}; my $closure = eval_closure(source => $source, environment => \%env); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); }; } my $external = 40; my $closure2 = eval_closure( source => 'sub { $xxx += 2 }', environment => { '$xxx' => \$external }, alias => 1, ); $closure2->(); is($external, 42, 'closing over variables really really really works!'); if ("$^V" =~ /c$/) { diag "cperl: skipping variable destruction test"; } else { my $destroyed = 0; { package MyIndicator; sub DESTROY { $destroyed++ } } subtest 'closed over variables disappear on cue' => sub { { my $number = bless \(my $foo), "MyIndicator"; $$number = 40; my $closure = eval_closure( source => 'sub { $$xxx += 2 }', environment => { '$xxx' => \$number }, alias => 1, ); $closure->(); is($$number, 42, 'closure works'); is($destroyed, 0, 'closed over variable still exists'); } is($destroyed, 1, 'closed over variable destroyed once closure has been destroyed'); }; } { my @store; Eval::TypeTiny::_force_implementation( Eval::TypeTiny::IMPLEMENTATION_TIE ); { package MyTie; use Tie::Scalar (); our @ISA = 'Tie::StdScalar'; sub STORE { my $self = shift; push @store, $_[0]; $self->SUPER::STORE(@_); } sub method_of_mine { 42 } } { package OtherTie; our @ISA = 'MyTie'; sub method_of_mine { 666 } } tie(my($var), 'MyTie'); $var = 1; subtest "tied variables can be closed over (even with tied alias implementation)" => sub { my $closure = eval_closure( source => 'sub { $xxx = $_[0]; tied($xxx)->method_of_mine }', environment => { '$xxx' => \$var }, alias => 1, ); is($closure->(2), 42, 'can close over tied variables ... AUTOLOAD stuff'); $closure->(3); my $nother_closure = eval_closure( source => 'sub { tied($xxx)->can(@_) }', environment => { '$xxx' => \$var }, alias => 1, ); ok( $nother_closure->('method_of_mine'), '... can'); ok(!$nother_closure->('your_method'), '... !can'); is_deeply( \@store, [ 1 .. 3], '... tie still works', ); tie($var, 'OtherTie'); is($closure->(4), 666, '... can be retied'); untie($var); my $e = exception { $closure->(5) }; like($e, qr{^Can't call method "method_of_mine" on an undefined value}, '... can be untied'); }; } my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); subtest "exception for syntax error" => sub { my $e3 = exception { eval_closure source => 'sub {' }; ok( $e3->isa('Error::TypeTiny::Compilation'), 'proper exceptions thrown for compilation errors' ); is( $e3->code, 'sub {', '$exception->code' ); like( $e3->errstr, qr/Missing right curly/, '$exception->errstr' ); is( ref $e3->context, 'HASH', '$exception->context' ); }; subtest "exception for syntax error (given arrayref)" => sub { my $e3 = exception { eval_closure source => ['sub {', ''] }; ok( $e3->isa('Error::TypeTiny::Compilation'), 'proper exceptions thrown for compilation errors' ); is( $e3->code, "sub {\n", '$exception->code' ); like( $e3->errstr, qr/Missing right curly/, '$exception->errstr' ); is( ref $e3->context, 'HASH', '$exception->context' ); }; subtest "exception for wrong reference type" => sub { my $e3 = exception { eval_closure source => 'sub {', environment => { '%foo' => [] } }; ok($e3->isa('Error::TypeTiny'), 'exception was thrown'); if (Eval::TypeTiny::_EXTENDED_TESTING) { like($e3->message, qr/^Expected a variable name and ref/, 'correct exception message'); } }; subtest "_pick_alternative" => sub { is Eval::TypeTiny::_pick_alternative( if => 1, 'foo' ) || 'bar', 'foo'; is Eval::TypeTiny::_pick_alternative( if => 0, 'foo' ) || 'bar', 'bar'; }; done_testing; lexical-subs.t000664001750001750 437615111656240 22011 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L with experimental lexical subs. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'v5.18'; use Test::Fatal; use Eval::TypeTiny; my $variable; my %env = ( '$foo' => do { my $x = "foo"; \$x }, '@bar' => [ "bar" ], '%baz' => { "baz" => "1" }, '&quux' => sub { $variable }, '&quuux' => sub { $variable + 40 }, ); my $source = <<'SRC'; sub { package Kill::La::NonLexikill; return $foo if $_[0] eq '$foo'; return @bar if $_[0] eq '@bar'; return %baz if $_[0] eq '%baz'; return quux() if $_[0] eq '&quux'; return quuux if $_[0] eq '&quuux'; return; } SRC my $closure = eval_closure(source => $source, environment => \%env); is_deeply( [ $closure->('$foo') ], [ 'foo' ], 'closure over scalar', ); is_deeply( [ $closure->('@bar') ], [ 'bar' ], 'closure over array', ); is_deeply( [ $closure->('%baz') ], [ 'baz' => 1 ], 'closure over hash', ); is_deeply( [ $closure->('&quux') ], [ undef ], 'closure over lexical sub - undef', ); $variable = 2; is_deeply( [ $closure->('&quux') ], [ 2 ], 'closure over lexical sub - 2', ); is_deeply( [ $closure->('&quuux') ], [ 42 ], 'closure over lexical sub - 42', ); my $e = exception { eval_closure(source => 'sub { 1 ]') }; isa_ok( $e, 'Error::TypeTiny::Compilation', '$e', ); like( $e, qr{^Failed to compile source because: syntax error}, 'throw exception when code does not compile', ); like( $e->errstr, qr{^syntax error}, '$e->errstr', ); like( $e->code, qr{sub \{ 1 \]}, '$e->code', ); my $c1 = eval_closure(source => 'sub { die("BANG") }', description => 'test1'); my $e1 = exception { $c1->() }; like( $e1, qr{^BANG at test1 line 1}, '"description" option works', ); my $c2 = eval_closure(source => 'sub { die("BANG") }', description => 'test2', line => 222); my $e2 = exception { $c2->() }; like( $e2, qr{^BANG at test2 line 222}, '"line" option works', ); done_testing; basic.t000664001750001750 225015111656240 23534 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny-CodeAccumulator=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; ok( require Eval::TypeTiny::CodeAccumulator ); my $make_adder = 'Eval::TypeTiny::CodeAccumulator'->new( description => 'adder', ); my $n = 40; my $varname = $make_adder->add_variable( '$addend' => \$n ); is $varname, '$addend'; is $make_adder->add_variable( '$addend' => \999 ), '$addend_2'; $make_adder->add_line( 'sub {' ); $make_adder->increase_indent; $make_adder->add_placeholder( 'unpack-args' ); $make_adder->add_placeholder( 'dummy' ); $make_adder->add_gap; $make_adder->add_line( 'return ' . $varname . ' + $other_addend;' ); $make_adder->decrease_indent; $make_adder->add_line( '}' ); $make_adder->fill_placeholder( 'unpack-args', 'my $other_addend = shift;' ); my $adder = $make_adder->compile; note( $make_adder->code ); is $adder->( 2 ), 42; done_testing; callback.t000664001750001750 231515111656240 24211 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Eval-TypeTiny-CodeAccumulator=pod =encoding utf-8 =head1 PURPOSE Tests L using the callback returned from C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; ok( require Eval::TypeTiny::CodeAccumulator ); my $make_adder = 'Eval::TypeTiny::CodeAccumulator'->new( description => 'adder', ); my $n = 40; my $varname = $make_adder->add_variable( '$addend' => \$n ); is $varname, '$addend'; is $make_adder->add_variable( '$addend' => \999 ), '$addend_2'; $make_adder->add_line( 'sub {' ); $make_adder->increase_indent; my $ph_1 = $make_adder->add_placeholder( 'unpack-args' ); my $ph_2 = $make_adder->add_placeholder( 'dummy' ); $make_adder->add_gap; $make_adder->add_line( 'return ' . $varname . ' + $other_addend;' ); $make_adder->decrease_indent; $make_adder->add_line( '}' ); $ph_1->( 'my $other_addend = shift;' ); my $adder = $make_adder->compile; note( $make_adder->code ); is $adder->( 2 ), 42; done_testing; basic.t000664001750001750 370515111656240 20522 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Test-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L (which is somewhat important because Test::TypeTiny is itself used for the majority of the type constraint tests). In particular, this tests that everything works when the C<< $EXTENDED_TESTING >> environment variable is false. =head1 DEPENDENCIES Requires L 0.109. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { $ENV{EXTENDED_TESTING} = 0; if (eval { require Test::Tester }) { Test::Tester->import(tests => 48); } else { require Test::More; Test::More->import(skip_all => 'requires Test::Tester'); } } use Test::TypeTiny; use Types::Standard qw( Int Num ); check_test( sub { should_pass(1, Int) }, { ok => 1, name => 'Value "1" passes type constraint Int', diag => '', type => '', }, 'successful should_pass', ); check_test( sub { should_pass([], Int) }, { ok => 0, name => 'Reference [] passes type constraint Int', diag => '', type => '', }, 'unsuccessful should_pass', ); check_test( sub { should_fail([], Int) }, { ok => 1, name => 'Reference [] fails type constraint Int', diag => '', type => '', }, 'successful (i.e. failing) should_fail', ); check_test( sub { should_fail(1, Int) }, { ok => 0, name => 'Value "1" fails type constraint Int', diag => '', type => '', }, 'unsuccessful (i.e. passing) should_fail', ); check_test( sub { ok_subtype(Num, Int) }, { ok => 1, name => 'Num subtype: Int', diag => '', type => '', }, 'successful ok_subtype', ); check_test( sub { ok_subtype(Int, Num) }, { ok => 0, name => 'Int subtype: Num', diag => '', type => '', }, 'unsuccessful ok_subtype', ); extended.t000664001750001750 230215111656240 21231 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Test-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L works when the C<< $EXTENDED_TESTING >> environment variable is true. Note that L appears to have issues with subtests, so currently C and C are not tested. =head1 DEPENDENCIES Requires L 0.109. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { $ENV{EXTENDED_TESTING} = 1; if (eval { require Test::Tester }) { Test::Tester->import(tests => 16); } else { require Test::More; Test::More->import(skip_all => 'requires Test::Tester'); } } use Test::TypeTiny; use Types::Standard qw( Int Num ); check_test( sub { ok_subtype(Num, Int) }, { ok => 1, name => 'Num subtype: Int', diag => '', type => '', }, 'successful ok_subtype', ); check_test( sub { ok_subtype(Int, Num) }, { ok => 0, name => 'Int subtype: Num', diag => '', type => '', }, 'unsuccessful ok_subtype', ); matchfor.t000664001750001750 502315111656240 21237 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Test-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Tests L (which is somewhat important because Test::TypeTiny is itself used for the majority of the type constraint tests). In particular, this tests that everything works when the C<< $EXTENDED_TESTING >> environment variable is false. =head1 DEPENDENCIES Requires L 0.109. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { $ENV{EXTENDED_TESTING} = 0; if (eval { require Test::Tester }) { require Test::More; Test::Tester->import(tests => 6); } else { require Test::More; Test::More->import(skip_all => 'requires Test::Tester'); } } use Test::TypeTiny qw(matchfor); my $mf = matchfor("foo", "bar"); Test::More::is("$mf", "foo", "stringification"); Test::More::subtest "successful matchfor(qr//)" => sub { check_test( sub { Test::More::is( "Hello world", matchfor(qr/hello/i, qr/hiya/i, "Greeting::Global"), 'ONE', ); }, { ok => 1, name => 'ONE', diag => '', type => '', }, 'successful matchfor(qr//)', ); }; Test::More::subtest "successful matchfor(qr//) 2" => sub { check_test( sub { Test::More::is( "Hiya world", matchfor(qr/hello/i, qr/hiya/i, "Greeting::Global"), 'TWO', ); }, { ok => 1, name => 'TWO', diag => '', type => '', }, 'successful matchfor(qr//)', ); }; Test::More::subtest 'unsuccessful matchfor(qr//)' => sub { check_test( sub { Test::More::is( "Booooooooooooooo", matchfor(qr/hello/i, qr/hiya/i, "Greeting::Global"), 'THREE', ); }, { ok => 0, name => 'THREE', }, 'unsuccessful matchfor(qr//)', ); }; Test::More::subtest 'successful matchfor(CLASS)' => sub { check_test( sub { Test::More::is( bless({}, "Greeting::Global"), matchfor(qr/hello/i, qr/hiya/i, "Greeting::Global"), 'FOUR', ); }, { ok => 1, name => 'FOUR', diag => '', type => '', }, 'successful matchfor(CLASS)', ); }; Test::More::subtest 'unsuccessful successful matchfor(CLASS)' => sub { check_test( sub { Test::More::is( bless({}, "Greeting::Local"), matchfor(qr/hello/i, qr/hiya/i, "Greeting::Global"), 'FIVE', ); }, { ok => 0, name => 'FIVE', }, 'unsuccessful successful matchfor(CLASS)', ); }; basic.t000664001750001750 1077215111656240 20522 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion works. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use BiggerLib -types, -coercions; is( BigInteger->coercion->coerce(2), 12, 'coercion works', ); is( BigInteger->coercion->(2), 12, 'coercion overloads &{}', ); ok( BigInteger->coercion->has_coercion_for_type(ArrayRef), 'BigInteger has_coercion_for_type ArrayRef', ); ok( BigInteger->coercion->has_coercion_for_type(SmallInteger), 'BigInteger has_coercion_for_type SmallInteger', ); ok( !BigInteger->coercion->has_coercion_for_type(HashRef), 'not BigInteger has_coercion_for_type SmallInteger', ); cmp_ok( BigInteger->coercion->has_coercion_for_type(BigInteger), eq => '0 but true', 'BigInteger has_coercion_for_type BigInteger eq "0 but true"' ); my $BiggerInteger = BigInteger->create_child_type( constraint => sub { $_ > 1_000_000 }, ); cmp_ok( BigInteger->coercion->has_coercion_for_type($BiggerInteger), eq => '0 but true', 'BigInteger has_coercion_for_type $BiggerInteger eq "0 but true"' ); ok( BigInteger->coercion->has_coercion_for_value([]), 'BigInteger has_coercion_for_value []', ); ok( BigInteger->coercion->has_coercion_for_value(2), 'BigInteger has_coercion_for_value 2', ); ok( !BigInteger->coercion->has_coercion_for_value({}), 'not BigInteger has_coercion_for_value {}', ); cmp_ok( BigInteger->coercion->has_coercion_for_value(200), eq => '0 but true', 'BigInteger has_coercion_for_value 200 eq "0 but true"' ); is( exception { BigInteger->coerce([]) }, undef, "coerce doesn't throw an exception if it can coerce", ); is( exception { BigInteger->coerce({}) }, undef, "coerce doesn't throw an exception if it can't coerce", ); is( exception { BigInteger->assert_coerce([]) }, undef, "assert_coerce doesn't throw an exception if it can coerce", ); like( exception { BigInteger->assert_coerce({}) }, qr{^Reference \{\} did not pass type constraint "BigInteger"}, "assert_coerce DOES throw an exception if it can't coerce", ); isa_ok( ArrayRefFromAny, 'Type::Coercion', 'ArrayRefFromAny', ); is_deeply( ArrayRefFromAny->coerce(1), [1], 'ArrayRefFromAny coercion works', ); my $sum1 = 'Type::Coercion'->add(ArrayRefFromAny, ArrayRefFromPiped); is_deeply( $sum1->coerce("foo|bar"), ["foo|bar"], "Coercion $sum1 prioritizes ArrayRefFromAny", ); my $sum2 = 'Type::Coercion'->add(ArrayRefFromPiped, ArrayRefFromAny); is_deeply( $sum2->coerce("foo|bar"), ["foo","bar"], "Coercion $sum2 prioritizes ArrayRefFromPiped", ); my $arr = ArrayRef->plus_fallback_coercions(ArrayRefFromAny); is_deeply( $arr->coerce("foo|bar"), ["foo|bar"], "Type \$arr coercion works", ); my $sum3 = $arr->plus_fallback_coercions(ArrayRefFromPiped); is_deeply( $sum3->coerce("foo|bar"), ["foo|bar"], "Type \$sum3 coercion works", ); my $sum4 = $arr->plus_coercions(ArrayRefFromPiped); is_deeply( $sum4->coerce("foo|bar"), ["foo","bar"], "Type \$sum4 coercion works", ); use Test::TypeTiny; my $arrayref_from_piped = ArrayRef->plus_coercions(ArrayRefFromPiped); my $coercibles = $arrayref_from_piped->coercibles; should_pass([], $coercibles); should_pass('1|2|3', $coercibles); should_fail({}, $coercibles); should_pass([], ArrayRef->coercibles); should_fail('1|2|3', ArrayRef->coercibles); should_fail({}, ArrayRef->coercibles); is($arrayref_from_piped->coercibles, $arrayref_from_piped->coercibles, '$arrayref_from_piped->coercibles == $arrayref_from_piped->coercibles'); # ensure that add_type_coercion can handle Type::Coercions subtest 'add a Type::Coercion to a Type::Coercion' => sub { my $coercion = Type::Coercion->new; ok( !$coercion->has_coercion_for_type( Str ), "empty coercion can't coerce a Str" ); is( exception { $coercion->add_type_coercions( ArrayRefFromPiped ) }, undef, "add a coercion from Str" ); ok( $coercion->has_coercion_for_type( Str ), "check that coercion was added" ); # now see if coercion actually works my $arrayref_from_piped = ArrayRef->plus_coercions($coercion); my $coercibles = $arrayref_from_piped->coercibles; should_pass('1|2|3', $coercibles, "can coerce from a Str"); }; done_testing; esoteric.t000664001750001750 267615111656240 21242 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks various undocumented Type::Coercion methods. The fact that these are tested here should not be construed to mean tht they are any any way a stable, supported part of the Type::Coercion API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Coercion; use Types::Standard -types; my $type = Int->create_child_type; $type->coercion->add_type_coercions( Num, q[int($_)] ); like( exception { $type->coercion->meta }, qr/^Not really a Moose::Meta::TypeCoercion/, '$type->coercion->meta', ); $type->coercion->_compiled_type_coercion( Type::Coercion->new( type_coercion_map => [ ArrayRef, q[666] ], ), ); $type->coercion->_compiled_type_coercion( sub { 999 }, ); is($type->coerce(3.1), 3, '$type->coercion->add_type_coercions(TYPE, STR)'); is($type->coerce([]), 666, '$type->coercion->_compiled_type_coercion(OBJECT)'); is($type->coerce(undef), 999, '$type->coercion->_compiled_type_coercion(CODE)'); my $J = Types::Standard::Join; is("$J", 'Join'); like($J->_stringify_no_magic, qr/^Type::Coercion=HASH\(0x[0-9a-f]+\)$/i); done_testing; frozen.t000664001750001750 326215111656240 20720 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Type::Coercion objects are mutable, unlike Type::Tiny objects. However, they can be frozen, making them immutable. (And Type::Tiny will freeze them occasionally, if it feels it has to.) =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Requires Moose 2.0000 =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { Moose => 2.0000 }; use Test::More; use Test::Fatal; use BiggerLib -types; ok(!BigInteger->coercion->frozen, 'coercions are not initially frozen'); BigInteger->coercion->add_type_coercions(Undef, sub { 777 }); ok(!BigInteger->coercion->frozen, 'coercions do not freeze because of adding code'); is(BigInteger->coerce(undef), 777, '... and they work'); BigInteger->coercion->moose_coercion; ok(BigInteger->coercion->frozen, 'coercions do freeze when forced inflation to Moose'); my $e = exception { BigInteger->coercion->add_type_coercions(Item, sub { 999 }) }; like($e, qr{Attempt to add coercion code to a Type::Coercion which has been frozen}, 'cannot add code to a frozen coercion'); BigInteger->coercion->i_really_want_to_unfreeze; ok(!BigInteger->coercion->frozen, 'i_really_want_to_unfreeze'); $e = exception { BigInteger->coercion->add_type_coercions(Item, sub { 888 }) }; is($e, undef, '... can now add coercions'); is(BigInteger->coerce(\$e), 888, '... ... which work'); done_testing; inlining.t000664001750001750 256715111656240 21233 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion can be inlined. =head1 DEPENDENCIES Requires JSON::PP 2.27105. Test is skipped if this module is not present. Note that this is bundled with Perl v5.13.11 and above. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "JSON::PP" => "2.27105" }; use Test::More; use Test::Fatal; { package T; require JSON::PP; use Type::Library -base, -declare => qw/ JsonHash JsonArray /; use Type::Utils; use Types::Standard -types; declare JsonHash, as HashRef; declare JsonArray, as ArrayRef; coerce JsonHash, from Str, 'JSON::PP::decode_json($_)'; coerce JsonArray, from Str, 'JSON::PP::decode_json($_)'; __PACKAGE__->meta->make_immutable; } my $code = T::JsonArray->coercion->inline_coercion('$::foo'); our $foo = "[3,2,1]"; is_deeply( eval $code, [3,2,1], 'inlined coercion works', ); $foo = [5,4,3]; is_deeply( eval $code, [5,4,3], 'no coercion necessary', ); $foo = {foo => "bar"}; is_deeply( eval $code, {foo => "bar"}, 'no coercion possible', ); done_testing; parameterized.t000664001750001750 1112715111656240 22270 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks the C and C parameterized coercions from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use utf8; use Test::More; use Test::Requires { "Encode" => 0 }; use Test::TypeTiny; use Encode; use Types::Standard qw( Str ArrayRef HashRef Join Split ); use Type::Utils; my $chars = "Café Paris|Garçon"; my $bytes_utf8 = Encode::encode("utf-8", $chars); my $bytes_western = Encode::encode("iso-8859-1", $chars); is(length($chars), 17, 'length $chars == 17'); is(length($bytes_utf8), 19, 'length $bytes_utf8 == 19'); is(length($bytes_western), 17, 'length $bytes_western == 17'); my $SplitSpace = (ArrayRef[Str])->plus_coercions(Split[qr/\s/]); my $SplitPipe = (ArrayRef[Str])->plus_coercions(Split[qr/\|/]); ok($SplitSpace->can_be_inlined, '$SplitSpace can be inlined'); ok($SplitPipe->can_be_inlined, '$SplitPipe can be inlined'); is_deeply( $SplitSpace->coerce($chars), [ "Café", "Paris|Garçon" ], '$SplitSpace->coerce($chars)', ); is_deeply( $SplitSpace->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_utf8)', ); is_deeply( $SplitSpace->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_western)', ); should_pass($SplitSpace->coerce($chars), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_utf8), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_western), ArrayRef[Str]); is_deeply( my $arr_chars = $SplitPipe->coerce($chars), [ "Café Paris", "Garçon" ], '$SplitPipe->coerce($chars)', ); is_deeply( my $arr_bytes_utf8 = $SplitPipe->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_utf8)', ); is_deeply( my $arr_bytes_western = $SplitPipe->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_western)', ); my $JoinPipe = Str->plus_coercions(Join["|"]); is( $_ = $JoinPipe->coerce($arr_chars), $chars, '$JoinPipe->coerce($arr_chars)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_utf8), $bytes_utf8, '$JoinPipe->coerce($arr_bytes_utf8)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_western), $bytes_western, '$JoinPipe->coerce($arr_bytes_western)', ); should_pass($_, Str); # Re-parameterization stuff: { # A type constraint with a useless parameter... # my $Stringy = Str->create_child_type( name => 'Stringy', parent => Str, constraint_generator => sub { sub {} }, ); ok($Stringy->is_parameterizable, '$Stringy->is_parameterizable'); # A parameterizable coercion... my $Joiny = 'Type::Coercion'->new( name => 'Joiny', type_constraint => $Stringy, type_coercion_map => [ HashRef, sub { 'hello' } ], coercion_generator => sub { my ($self, $type, $from, $to) = @_; my $joinchar = ':'; if ($type->is_a_type_of($Stringy) and $type->is_parameterized) { $joinchar = $type->type_parameter; } return ( @{ $self->type_coercion_map }, ArrayRef, sub { my @arr = @$_; join($joinchar, @arr[$from..$to]) }, ); }, ); isa_ok( $Joiny, 'Type::Coercion', 'parameterizable coercion', ); is( $Joiny->coerce({}), 'hello', '... coercion included in base definition works' ); is_deeply( $Joiny->coerce(['a'..'z']), ['a'..'z'], '... coercion generated by parameterization does not exist yet' ); my $Joiny23 = $Joiny->parameterize(2, 3); isa_ok( $Joiny23, 'Type::Coercion', 'parameterized coercion which has not yet been combined with type constraint', ); is( $Joiny23->coerce({}), 'hello', '... coercion included in base definition works' ); is( $Joiny23->coerce(['a'..'z']), 'c:d', '... coercion generated by parameterization works' ); my $StringyPipe = $Stringy->parameterize('|')->plus_coercions($Joiny23); isa_ok( $StringyPipe, 'Type::Tiny', 'type constraint consuming parameterized coercion', ); is( $StringyPipe->coerce({}), 'hello', '... coercion included in base definition works' ); is( $StringyPipe->coerce(['a'..'z']), 'c|d', '... coercion generated by parameterization works; must have been regenerated' ); } done_testing; smartmatch.t000664001750001750 144015111656240 21554 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion overload of C<< ~~ >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Type::Tiny (); BEGIN { Type::Tiny::SUPPORT_SMARTMATCH or plan skip_all => 'smartmatch support not available for this version or Perl'; } use Types::Standard qw( Num Int ); my $type = Int->plus_coercions( Num, sub{+int} ); no warnings; #!! ok ( 3.1 ~~ $type->coercion ); ok not ( [ ] ~~ $type->coercion ); done_testing; typetiny-constructor.t000664001750001750 213315111656240 23661 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion=pod =encoding utf-8 =head1 PURPOSE Checks proper Type::Coercion objects are automatically created by the Type::Tiny constructor. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Type::Tiny; use Types::Standard qw( Int Num Any ); subtest "coercion => ARRAY" => sub { my $type = Type::Tiny->new( name => 'Test', parent => Int, coercion => [ Num, sub { int($_) } ], ); ok $type->has_coercion; is $type->coercion->type_coercion_map->[0], Num; is $type->coerce(3.2), 3; }; subtest "coercion => CODE" => sub { my $type = Type::Tiny->new( name => 'Test', parent => Int, coercion => sub { int($_) }, ); ok $type->has_coercion; is $type->coercion->type_coercion_map->[0], Any; is $type->coerce(3.2), 3; }; done_testing; basic.t000664001750001750 373615111656240 22410 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion-FromMoose=pod =encoding utf-8 =head1 PURPOSE Checks the types adopted from Moose still have a coercion which works. =head1 DEPENDENCIES Moose 2.0000; otherwise skipped. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => '2.0000' }; use Test::TypeTiny; use Moose::Util::TypeConstraints; my $Rounded = do { subtype 'RoundedInt', as 'Int'; coerce 'RoundedInt', from 'Num', via { int($_) }; find_type_constraint 'RoundedInt'; }; my $Array_of_Rounded = do { use Types::Standard -types; ArrayRef[$Rounded]; }; isa_ok( $Array_of_Rounded->type_parameter, 'Type::Tiny', '$Array_of_Rounded->type_parameter', ); isa_ok( $Array_of_Rounded->type_parameter->coercion, 'Type::Coercion', '$Array_of_Rounded->type_parameter->coercion', ); isa_ok( $Array_of_Rounded->type_parameter->coercion, 'Type::Coercion::FromMoose', '$Array_of_Rounded->type_parameter->coercion', ); is_deeply( $Array_of_Rounded->coerce([ 9.1, 1.1, 2.2, 3.3 ]), [ 9, 1..3 ], 'coercion works', ); # Making this work might prevent coercions from being inlined # unless the coercion has been frozen. # # See https://rt.cpan.org/Ticket/Display.html?id=93345#txn-1395097 # TODO: { local $TODO = "\$Array_of_Rounded's coercion has already been compiled"; coerce 'RoundedInt', from 'Undef', via { 0 }; is_deeply( $Array_of_Rounded->coerce([ 9.1, 1.1, undef, 3.3 ]), [ 9, 1, 0, 3 ], 'coercion can be altered later', ); }; my $tt_Rounded = Types::TypeTiny::to_TypeTiny( $Rounded ); is( $tt_Rounded->coercion->moose_coercion, $Rounded->coercion ); delete $tt_Rounded->coercion->{moose_coercion}; is( $tt_Rounded->coercion->moose_coercion, $Rounded->coercion ); done_testing; errors.t000664001750001750 317715111656240 22642 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion-FromMoose=pod =encoding utf-8 =head1 PURPOSE Checks crazy Type::Coercion::FromMoose errors. =head1 DEPENDENCIES Moose 2.0000; otherwise skipped. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => '2.0000' }; use Test::Fatal; use Types::Standard -types; use Types::TypeTiny qw( to_TypeTiny ); use Scalar::Util qw(refaddr); my $orig = do { use Moose::Util::TypeConstraints; subtype 'RoundedInt', as 'Int'; coerce 'RoundedInt', from 'Num', via { int($_) }; find_type_constraint 'RoundedInt'; }; my $type = to_TypeTiny($orig); is( refaddr($type->coercion->moose_coercion), refaddr($orig->coercion), ); is( refaddr($type->moose_type->coercion), refaddr($orig->coercion), ); TODO: { local $TODO = "Adding coercions to Type::Coercion::FromMoose not currently supported"; is( exception { $type->coercion->add_type_coercions(Any, sub {666}) }, undef, 'no exception adding coercions to a Moose-imported type constraint', ); is( $type->coerce([]), 666, '... and the coercion works' ); }; # Fake a T:C:FromMoose where the Type::Tiny object has been reaped... require Type::Coercion::FromMoose; my $dummy = Type::Coercion::FromMoose->new; like ( exception { $dummy->moose_coercion }, qr/^The type constraint attached to this coercion has been garbage collected... PANIC/, ); done_testing; basic.t000664001750001750 504115111656240 21561 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Coercion-Union=pod =encoding utf-8 =head1 PURPOSE Checks Type::Coercion::Union works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard -types; use Type::Utils; my $RoundedInteger = declare RoundedInteger => as Int; $RoundedInteger->coercion->add_type_coercions(Num, 'int($_)')->freeze; should_pass("4", $RoundedInteger); should_fail("1.1", $RoundedInteger); should_fail("xyz", $RoundedInteger); my $String3 = declare String3 => as StrMatch[qr/^.{3}$/]; $String3->coercion->add_type_coercions(Str, 'substr("$_ ", 0, 3)')->freeze; should_pass("xyz", $String3); should_fail("x", $String3); should_fail("wxyz", $String3); my $Union1 = union Union1 => [$RoundedInteger, $String3]; should_pass("3.4", $Union1); should_pass("30", $Union1); should_fail("3.12", $Union1); should_fail("wxyz", $Union1); is( $RoundedInteger->coerce("3.4"), "3", "RoundedInteger coerces from Num", ); is( $RoundedInteger->coerce("xyz"), "xyz", "RoundedInteger does not coerce from Str", ); is( $String3->coerce("30"), "30 ", "String3 coerces from Str", ); my $arr = []; is( $String3->coerce($arr), $arr, "String3 does not coerce from ArrayRef", ); ok( $Union1->has_coercion, "unions automatically have a coercion if their child constraints do", ); note $Union1->coercion->inline_coercion('$X'); ok( union([Str, ArrayRef]), "unions do not automatically have a coercion if their child constraints do not", ); is( $Union1->coerce("4"), "4", "Union1 does not need to coerce an Int", ); is( $Union1->coerce("xyz"), "xyz", "Union1 does not need to coerce a String3", ); is( $Union1->coerce("3.1"), "3.1", "Union1 does not need to coerce a String3, even if it looks like a Num", ); is( $Union1->coerce("abcde"), "abc", "Union1 coerces Str -> String3", ); is( $Union1->coerce("3.123"), "3", "given the choice of two valid coercions, Union1 prefers RoundedInteger because it occurs sooner", ); is( $Union1->coerce($arr), $arr, "Union1 cannot coerce an arrayref", ); like( exception { $Union1->coercion->add_type_coercions(ArrayRef, q[ scalar(@$_) ]) }, qr/^Adding coercions to Type::Coercion::Union not currently supported/, "Cannot add to Type::Tiny::Union's coercion", ); done_testing; assert.t000664001750001750 236715111656240 20566 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks that the assertion functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use BiggerLib qw( :assert ); ok assert_String("rats"), "assert_String works (value that should pass)"; like( exception { assert_String([]) }, qr{^is not a string}, "assert_String works (value that should fail)" ); ok BiggerLib::assert_String("rats"), "BiggerLib::assert_String works (value that should pass)"; like( exception { BiggerLib::assert_String([]) }, qr{^is not a string}, "BiggerLib::assert_String works (value that should fail)" ); ok assert_SmallInteger(5), "assert_SmallInteger works (value that should pass)"; like( exception { assert_SmallInteger([]) }, qr{^ARRAY\(\w+\) is too big}, "assert_SmallInteger works (value that should fail)" ); done_testing; declared-types.t000664001750001750 240115111656240 22157 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests that placeholder objects generated by C<< -declare >> work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; BEGIN { package MyTypes; use Type::Library -base, -declare => 'MyHashRef'; use Types::Standard -types; my $tmp = MyHashRef; my $coderef = \&MyHashRef; sub get_tmp { $tmp } sub get_coderef { $coderef } __PACKAGE__->add_type( name => MyHashRef, parent => HashRef[ Int | MyHashRef ], ); }; should_pass( { foo => 1, bar => { quux => 2 } }, MyTypes->get_tmp ); should_fail( { foo => 1, bar => { quux => 2.1 } }, MyTypes->get_tmp ); should_pass( { foo => 1, bar => { quux => 2 } }, MyTypes->get_coderef->() ); should_fail( { foo => 1, bar => { quux => 2.1 } }, MyTypes->get_coderef->() ); isnt( MyTypes->get_coderef, \&MyTypes::MyHashRef, 'coderef got redefined' ); note( MyTypes->get_tmp->inline_check(q/$xyz/) ); note( MyTypes->get_coderef->()->inline_check(q/$xyz/) ); done_testing; deprecation.t000664001750001750 321515111656240 21553 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks Type::Library warns about deprecated types. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny; BEGIN { package Local::Library; use Type::Library -base; my $t1 = Type::Tiny->new(name => "Base"); my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1); my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1); my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3); my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0); __PACKAGE__->meta->add_type($_) for $t1, $t2, $t3, $t4, $t5; $INC{'Local/Library.pm'} = __FILE__; }; { my @WARNINGS; sub get_warnings { [@WARNINGS] } sub reset_warnings { @WARNINGS = () } $SIG{__WARN__} = sub { push @WARNINGS, $_[0] }; }; reset_warnings(); eval q{ package Local::Example1; use Local::Library qw(Derived_1); 1; } or die($@); is_deeply(get_warnings(), []); reset_warnings(); eval q{ package Local::Example2; use Local::Library qw(Derived_2); 1; } or die($@); like(get_warnings()->[0], qr/^Exporting deprecated type Derived_2 to package Local::Example2/); reset_warnings(); eval q{ package Local::Example3; use Local::Library -allow_deprecated, qw(Derived_2); 1; } or die($@); is_deeply(get_warnings(), []); done_testing; errors.t000664001750001750 223615111656240 20574 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests errors thrown by L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Type::Library -base; use Type::Tiny; my $e1 = exception { my $m = __PACKAGE__->meta; $m->add_type(name => 'Foo'); $m->add_type(name => 'Foo'); }; like( $e1, qr/^Type Foo already exists in this library/, 'cannot add same type constraint twice', ); my $e2 = exception { my $m = __PACKAGE__->meta; $m->add_type(constraint => sub { 0 }); }; like( $e2, qr/^Cannot add anonymous type to a library/, 'cannot add an anonymous type constraint to a library', ); my $e3 = exception { my $m = __PACKAGE__->meta; $m->add_coercion(name => 'Foo'); }; like( $e3, qr/^Coercion Foo conflicts with type of same name/, 'cannot add a coercion with same name as a constraint', ); done_testing; exportables-duplicated.t000664001750001750 147215111656240 23725 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests type libraries can detect two types trying to export the same functions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; my $e = do { package My::Types; use Type::Library -base, -utils; # This should create constants ABC_DEF_GHI and ABC_DEF_JKL enum( 'Abc_Def', [qw/ ghi jkl /] ); local $@; eval { # This should also create constant ABC_DEF_GHI enum( 'Abc', [qw/ def_ghi /] ); 1; }; $@; }; like $e, qr/Function ABC_DEF_GHI is provided by types Abc_Def and Abc/; done_testing; exportables.t000664001750001750 775115111656240 21617 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests correct things are exported by type libraries. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Test::Deep'; BEGIN { package My::Types; use Type::Library -base, -utils; enum 'Rainbow', [ qw( red orange yellow green blue purple ) ]; class_type 'HTTP::Tiny'; $INC{'My/Types.pm'} = __FILE__; }; cmp_deeply( \@My::Types::EXPORT, bag(), '@EXPORT', ) or diag explain( \@My::Types::EXPORT ); cmp_deeply( \@My::Types::EXPORT_OK, bag( qw/ assert_HTTPTiny assert_Rainbow RAINBOW_RED RAINBOW_ORANGE RAINBOW_YELLOW RAINBOW_GREEN RAINBOW_BLUE RAINBOW_PURPLE is_HTTPTiny is_Rainbow to_HTTPTiny to_Rainbow HTTPTiny Rainbow / ), '@EXPORT_OK', ) or diag explain( \@My::Types::EXPORT_OK ); cmp_deeply( \%My::Types::EXPORT_TAGS, { assert => bag( qw/ assert_HTTPTiny assert_Rainbow / ), constants => bag( qw/ RAINBOW_RED RAINBOW_ORANGE RAINBOW_YELLOW RAINBOW_GREEN RAINBOW_BLUE RAINBOW_PURPLE / ), is => bag( qw/ is_HTTPTiny is_Rainbow / ), to => bag( qw/ to_HTTPTiny to_Rainbow / ), types => bag( qw/ HTTPTiny Rainbow / ), }, '%EXPORT_TAGS', ) or diag explain( \%My::Types::EXPORT_TAGS ); { my %imported; use My::Types { into => \%imported }, qw( -assert ); cmp_deeply( \%imported, { assert_HTTPTiny => ignore(), assert_Rainbow => ignore(), }, 'qw( -assert )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( -constants ); cmp_deeply( \%imported, { RAINBOW_RED => ignore(), RAINBOW_ORANGE => ignore(), RAINBOW_YELLOW => ignore(), RAINBOW_GREEN => ignore(), RAINBOW_BLUE => ignore(), RAINBOW_PURPLE => ignore(), }, 'qw( -constants )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( -is ); cmp_deeply( \%imported, { is_HTTPTiny => ignore(), is_Rainbow => ignore(), }, 'qw( -is )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( -to ); cmp_deeply( \%imported, { to_HTTPTiny => ignore(), to_Rainbow => ignore(), }, 'qw( -to )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( -types ); cmp_deeply( \%imported, { HTTPTiny => ignore(), Rainbow => ignore(), }, 'qw( -types )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( -all ); cmp_deeply( \%imported, { assert_HTTPTiny => ignore(), assert_Rainbow => ignore(), RAINBOW_RED => ignore(), RAINBOW_ORANGE => ignore(), RAINBOW_YELLOW => ignore(), RAINBOW_GREEN => ignore(), RAINBOW_BLUE => ignore(), RAINBOW_PURPLE => ignore(), is_HTTPTiny => ignore(), is_Rainbow => ignore(), to_HTTPTiny => ignore(), to_Rainbow => ignore(), HTTPTiny => ignore(), Rainbow => ignore(), }, 'qw( -all )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( +HTTPTiny ); cmp_deeply( \%imported, { assert_HTTPTiny => ignore(), is_HTTPTiny => ignore(), to_HTTPTiny => ignore(), HTTPTiny => ignore(), }, 'qw( +HTTPTiny )', ) or diag explain ( \%imported ); } { my %imported; use My::Types { into => \%imported }, qw( +Rainbow ); cmp_deeply( \%imported, { assert_Rainbow => ignore(), RAINBOW_RED => ignore(), RAINBOW_ORANGE => ignore(), RAINBOW_YELLOW => ignore(), RAINBOW_GREEN => ignore(), RAINBOW_BLUE => ignore(), RAINBOW_PURPLE => ignore(), is_Rainbow => ignore(), to_Rainbow => ignore(), Rainbow => ignore(), }, 'qw( +Rainbow )', ) or diag explain ( \%imported ); } done_testing; import-params.t000664001750001750 411015111656240 22044 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks C<< of >> and C<< where >> import options works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; BEGIN { package MyTypes; use Type::Library -base; $INC{'MyTypes.pm'} = __FILE__; __PACKAGE__->add_type( name => 'Ref', constraint => sub { ref $_[0] }, constraint_generator => sub { my $x = shift; sub { ref $_[0] eq $x }; }, ); }; use MyTypes 'Ref'; should_pass([], Ref); should_pass({}, Ref); should_pass(sub {}, Ref); should_fail(1, Ref); should_pass([], Ref['ARRAY']); should_fail({}, Ref['ARRAY']); should_fail(sub {}, Ref['ARRAY']); should_fail(1, Ref['ARRAY']); should_pass({}, Ref['HASH']); should_fail([], Ref['HASH']); should_fail(sub {}, Ref['HASH']); should_fail(1, Ref['HASH']); use MyTypes Ref => { of => 'HASH', -as => 'HashRef' }; should_pass({}, HashRef); should_fail([], HashRef); should_fail(sub {}, HashRef); should_fail(1, HashRef); use MyTypes Ref => { where => sub { ref $_[0] eq 'ARRAY' or ref $_[0] eq 'HASH' }, -as => 'ContainerRef', }; should_pass({}, ContainerRef); should_pass([], ContainerRef); should_fail(sub {}, ContainerRef); should_fail(1, ContainerRef); use MyTypes is_Ref => { of => 'HASH', -as => 'is_HashRef' }; ok is_HashRef({}); ok !is_HashRef([]); ok !is_HashRef(sub {}); ok !is_HashRef(1); BEGIN { package My::Types::Two; use Type::Library 1.011005 -utils, -extends => [ 'Types::Standard' ], -declare => 'JSONCapable'; declare JSONCapable, as Undef | ScalarRef[ Enum[ 0..1 ] ] | Num | Str | ArrayRef[ JSONCapable ] | HashRef[ JSONCapable ] ; } use My::Types::Two 'is_JSONCapable'; my $var = { foo => 1, bar => [ \0, "baz", [] ], }; ok is_JSONCapable $var; done_testing; inheritance.t000664001750001750 630415111656240 21551 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks that it's possible to extend existing type libraries. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use utf8; use Test::More; use Test::Requires { Encode => 0 }; use Test::TypeTiny; BEGIN { package Local::Types; use Type::Library -base; use Type::Utils -all; extends 'Types::Standard'; declare "Foo", as "Str"; }; use Local::Types -all; use Type::Utils; my $chars = "Café Paris|Garçon"; my $bytes_utf8 = Encode::encode("utf-8", $chars); my $bytes_western = Encode::encode("iso-8859-1", $chars); is(length($chars), 17, 'length $chars == 17'); is(length($bytes_utf8), 19, 'length $bytes_utf8 == 19'); is(length($bytes_western), 17, 'length $bytes_western == 17'); my $SplitSpace = (ArrayRef[Str])->plus_coercions(Split[qr/\s/]); my $SplitPipe = (ArrayRef[Foo])->plus_coercions(Split[qr/\|/]); ok($SplitSpace->can_be_inlined, '$SplitSpace can be inlined'); ok($SplitPipe->can_be_inlined, '$SplitPipe can be inlined'); is_deeply( $SplitSpace->coerce($chars), [ "Café", "Paris|Garçon" ], '$SplitSpace->coerce($chars)', ); is_deeply( $SplitSpace->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_utf8)', ); is_deeply( $SplitSpace->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café", "Paris|Garçon" ], '$SplitSpace->coerce($bytes_western)', ); should_pass($SplitSpace->coerce($chars), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_utf8), ArrayRef[Str]); should_pass($SplitSpace->coerce($bytes_western), ArrayRef[Str]); is_deeply( my $arr_chars = $SplitPipe->coerce($chars), [ "Café Paris", "Garçon" ], '$SplitPipe->coerce($chars)', ); is_deeply( my $arr_bytes_utf8 = $SplitPipe->coerce($bytes_utf8), [ map Encode::encode("utf-8", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_utf8)', ); is_deeply( my $arr_bytes_western = $SplitPipe->coerce($bytes_western), [ map Encode::encode("iso-8859-1", $_), "Café Paris", "Garçon" ], '$SplitPipe->coerce($bytes_western)', ); my $JoinPipe = Foo->plus_coercions(Join["|"]); is( $_ = $JoinPipe->coerce($arr_chars), $chars, '$JoinPipe->coerce($arr_chars)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_utf8), $bytes_utf8, '$JoinPipe->coerce($arr_bytes_utf8)', ); should_pass($_, Str); is( $_ = $JoinPipe->coerce($arr_bytes_western), $bytes_western, '$JoinPipe->coerce($arr_bytes_western)', ); should_pass($_, Str); BEGIN { package Local::Types2; use Types::Standard -base, -utils; declare "Bar", as "Str"; }; ok 'Local::Types2'->isa( 'Type::Library' ), 'use Types::Standard -base will set up a type library'; ok 'Local::Types2'->isa( 'Types::Standard' ), 'use Types::Standard -base will inherit from Types::Standard'; ok 'Local::Types2'->has_type( 'Bar' ), 'new type works'; ok 'Local::Types2'->has_type( 'ArrayRef' ), 'inherited type works'; done_testing; is.t000664001750001750 222715111656240 17673 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks that the check functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use BiggerLib qw( :is ); ok is_String("rats"), "is_String works (value that should pass)"; ok !is_String([]), "is_String works (value that should fail)"; ok is_Number(5.5), "is_Number works (value that should pass)"; ok !is_Number("rats"), "is_Number works (value that should fail)"; ok is_Integer(5), "is_Integer works (value that should pass)"; ok !is_Integer(5.5), "is_Integer works (value that should fail)"; ok is_SmallInteger(5), "is_SmallInteger works (value that should pass)"; ok !is_SmallInteger(12), "is_SmallInteger works (value that should fail)"; done_testing; own-registry.t000664001750001750 231015111656240 21722 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks type libraries put types in their own type registries. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; BEGIN { package Local::Library; use Type::Library -base; use Type::Tiny; my $t1 = Type::Tiny->new(name => "Base"); my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1); my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1); my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3); my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0); __PACKAGE__->meta->add_type($_) for $t1, $t2, $t3, $t4, $t5; }; require Type::Registry; is_deeply( [ sort keys %{ Type::Registry->for_class( 'Local::Library' ) } ], [ sort qw( Base Derived_1 Derived_2 Double_Derived_1 Double_Derived_2 ) ], 'Type libraries automatically put types into their own registry', ); done_testing; recursive-type-definitions.t000664001750001750 440315111656240 24555 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests that types may be defined recursively. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; BEGIN { package MyTypes; use Type::Library -base, -declare => 'MyHashRef'; use Types::Standard -types; __PACKAGE__->add_type( name => MyHashRef, parent => HashRef[ Int | MyHashRef ], ); $INC{'MyTypes.pm'} = __FILE__; # stop `use` from complaining }; use MyTypes -types; my %good1 = ( foo => 1, bar => 2 ); my %good2 = ( %good1, bat => {}, baz => { foo => 3 } ); my %good3 = ( %good2, quux => { quuux => { quuuux => 0, xyzzy => {} } } ); my %bad1 = ( %good1, bar => \1 ); my %bad2 = ( %good2, baz => { foo => \1 } ); my %bad3 = ( %good3, quux => { quuux => { quuuux => 0, xyzzy => \1 } } ); ok( MyHashRef->can_be_inlined ); ok( MyHashRef->check( {} ) ); ok( MyHashRef->check( \%good1 ) ); ok( MyHashRef->check( \%good2 ) ); ok( MyHashRef->check( \%good3 ) ); ok( ! MyHashRef->check( \%bad1 ) ); ok( ! MyHashRef->check( \%bad2 ) ); ok( ! MyHashRef->check( \%bad3 ) ); ok( ! MyHashRef->check( undef ) ); ok( ! MyHashRef->check( \1 ) ); #use B::Deparse; #note( B::Deparse->new->coderef2text( \&MyTypes::is_MyHashRef ) ); BEGIN { package MyTypes2; use Type::Library -base, -declare => qw( StringArray StringHash StringContainer ); use Types::Standard -types; __PACKAGE__->add_type( name => StringArray, parent => ArrayRef[ Str | StringArray | StringHash ], ); __PACKAGE__->add_type( name => StringHash, parent => HashRef[ Str | StringArray | StringHash ], ); __PACKAGE__->add_type( name => StringContainer, parent => StringHash | StringArray, ); $INC{'MyTypes2.pm'} = __FILE__; # stop `use` from complaining }; use MyTypes2 -types; ok( StringContainer->check({ foo => [], bar => ['a', 'b', { c => 'd' }], baz => 'e' }) ); ok( ! StringContainer->check({ foo => [], bar => ['a', 'b', { c => \42 }], baz => 'e' }) ); #use B::Deparse; #note( B::Deparse->new->coderef2text( \&MyTypes2::is_StringContainer ) ); done_testing; remove-type.t000664001750001750 167315111656240 21540 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Tests Type::Library's hidden C<_remove_type> method. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::Requires 'namespace::clean'; use Test::More; use Types::Standard (); # hack delete( Types::Standard->meta->{immutable} ); # do it! Types::Standard->_remove_type( Types::Standard::Str() ); ok !Types::Standard->can('Str'); ok !Types::Standard->can('is_Str'); ok !Types::Standard->can('assert_Str'); ok !Types::Standard->can('to_Str'); my %h; Types::Standard->import( { into => \%h } ); ok !exists $h{Str}; ok !exists $h{is_Str}; ok !exists $h{assert_Str}; ok !exists $h{to_Str}; ok eval 'use Types::Standard -all; 1'; done_testing; to.t000664001750001750 166215111656240 17704 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks that the coercion functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal qw(dies_ok); use BiggerLib qw(:to); is( to_BigInteger(8), 18, 'to_BigInteger converts a small integer OK' ); is( to_BigInteger(17), 17, 'to_BigInteger leaves an existing BigInteger OK' ); is( to_BigInteger(3.14), 3.14, 'to_BigInteger ignores something it cannot coerce' ); dies_ok { to_Str [] } "no coercion for Str - should die"; done_testing; types.t000664001750001750 454315111656240 20427 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Library=pod =encoding utf-8 =head1 PURPOSE Checks that the type functions exported by a type library work as expected. =head1 DEPENDENCIES Uses the bundled DemoLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use DemoLib -types; isa_ok String, "Type::Tiny", "String"; isa_ok Number, "Type::Tiny", "Number"; isa_ok Integer, "Type::Tiny", "Integer"; isa_ok DemoLib::String, "Type::Tiny", "DemoLib::String"; isa_ok DemoLib::Number, "Type::Tiny", "DemoLib::Number"; isa_ok DemoLib::Integer, "Type::Tiny", "DemoLib::Integer"; is(String."", "String", "String has correct stringification"); is(Number."", "Number", "Number has correct stringification"); is(Integer."", "Integer", "Integer has correct stringification"); is(DemoLib::String."", "String", "DemoLib::String has correct stringification"); is(DemoLib::Number."", "Number", "DemoLib::Number has correct stringification"); is(DemoLib::Integer."", "Integer", "DemoLib::Integer has correct stringification"); is( exception { Integer->(5) }, undef, "coderef overload (with value that should pass type constraint) does not die", ); is( Integer->(5), 5, "coderef overload returns correct value", ); like( exception { Integer->(5.5) }, qr{^Value "5\.5" did not pass type constraint "Integer"}, "coderef overload (value that should fail type constraint) dies", ); use DemoLib String => { -prefix => "foo", -as => "bar", -suffix => "baz", }; is(foobarbaz->qualified_name, "DemoLib::String", "Sub::Exporter-style export renaming"); ok( Integer eq Integer, 'eq works', ); use Types::Standard qw(ArrayRef Int); my $int = Int; my $arrayref = ArrayRef; my $arrayref_int = ArrayRef[Int]; is_deeply( [ 1, 2, Int, 3, 4 ], [ 1, 2, $int, 3, 4 ], 'type constant in list context', ); is_deeply( [ 1, 2, ArrayRef, 3, 4 ], [ 1, 2, $arrayref, 3, 4 ], 'parameterizable type constant in list context', ); is_deeply( [ 1, 2, ArrayRef[Int], 3, 4 ], [ 1, 2, $arrayref_int, 3, 4 ], 'parameterized type constant in list context', ); done_testing; alias.t000664001750001750 276015111656240 20172 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test C supports parameter aliases. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use Test::More; use Test::Fatal; use Types::Standard -types; use Type::Params qw( compile_named_oo ); { my $check; sub adder { $check ||= compile_named_oo( first_number => Int, { alias => [ 'x' ] }, second_number => Int, { alias => 'y' }, ); my ( $arg ) = &$check; my $sum = $arg->first_number + $arg->second_number; wantarray ? ( $sum, $arg ) : $sum; } } is( adder( first_number => 40, second_number => 2 ), 42, 'real args' ); is( adder( x => 40, y => 3 ), 43, 'aliases for args' ); is( adder( first_number => 40, y => 4 ), 44, 'mixed 1' ); is( adder( x => 40, second_number => 5 ), 45, 'mixed 2' ); is( adder( { x => 60, y => 3 } ), 63, 'hashref' ); my $e1 = exception{ adder( { first_number => 40, x => 41, y => 2 } ); }; like $e1, qr/Superfluous alias "x" for argument "first_number"/, 'error'; my ( $sum, $arg ) = adder( x => 1, y => 2 ); is_deeply( [ grep !/caller/, sort keys %$arg ], [ 'first_number', 'second_number' ], 'correct hash keys in $arg', ); can_ok( $arg, 'first_number', 'second_number' ); ok !$arg->can( 'x' ), 'no method "x"'; ok !$arg->can( 'y' ), 'no method "y"'; done_testing; badsigs.t000664001750001750 177515111656240 20522 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Check that people doing silly things with Test::Params get =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile ); use Types::Standard qw( Optional Int ArrayRef slurpy ); like( exception { compile(Optional[Int], Int) }, qr{^Non-Optional parameter following Optional parameter}, "Cannot follow an optional parameter with a required parameter", ); like( exception { compile(slurpy ArrayRef[Int], Optional[Int]) }, qr{^Parameter following slurpy parameter}, "Cannot follow a slurpy parameter with anything", ); is( exception { compile(slurpy Int) }, undef, "This makes no sense, but no longer throws an exception", ); done_testing; carping.t000664001750001750 165015111656240 20521 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L' interaction with L: use Type::Params compile => { confess => 1 }; =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params compile => { confess => 1 }; use Types::Standard qw(Int); my $check; #line 1 "testsub1.chunk" sub testsub1 { $check ||= compile(Int); [ $check->(@_) ]; } #line 1 "testsub2.chunk" sub testsub2 { testsub1(@_); } #line 52 "params-carping.t" my $e = exception { testsub2(1.1); }; isa_ok($e, 'Error::TypeTiny'); like( $e, qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)}, ); done_testing; clone.t000664001750001750 241215111656240 20173 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test C and C support autocloned parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use Test::More; use Test::Requires 'Storable'; use Test::Fatal; use Types::Standard -types; use Type::Params qw( compile compile_named ); use Scalar::Util qw( refaddr ); my $arr = []; { my $check = compile( ArrayRef, { clone => 0 } ); my ( $got ) = $check->( $arr ); is( refaddr( $got ), refaddr( $arr ), 'compile with clone => 0' ); } { my $check = compile( ArrayRef, { clone => 1 } ); my ( $got ) = $check->( $arr ); isnt( refaddr( $got ), refaddr( $arr ), 'compile with clone => 1' ); } { my $check = compile_named( xxx => ArrayRef, { clone => 0 } ); my ( $got ) = $check->( xxx => $arr ); is( refaddr( $got->{xxx} ), refaddr( $arr ), 'compile_named with clone => 0' ); } { my $check = compile_named( xxx => ArrayRef, { clone => 1 } ); my ( $got ) = $check->( xxx => $arr ); isnt( refaddr( $got->{xxx} ), refaddr( $arr ), 'compile_named with clone => 1' ); } done_testing; coerce.t000664001750001750 303715111656240 20337 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage of types with coercions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; use Type::Utils; use Scalar::Util qw(refaddr); my $RoundedInt = declare as Int; coerce $RoundedInt, from Num, q{ int($_) }; my $chk = compile(Int, $RoundedInt, Num); is_deeply( [ $chk->(1, 2, 3.3) ], [ 1, 2, 3.3 ] ); is_deeply( [ $chk->(1, 2.2, 3.3) ], [ 1, 2, 3.3 ] ); like( exception { $chk->(1.1, 2.2, 3.3) }, qr{^Value "1\.1" did not pass type constraint "Int" \(in \$_\[0\]\)}, ); my $chk2 = compile(ArrayRef[$RoundedInt]); is_deeply( [ $chk2->([1, 2, 3]) ], [ [1, 2, 3] ] ); is_deeply( [ $chk2->([1.1, 2.2, 3.3]) ], [ [1, 2, 3] ] ); is_deeply( [ $chk2->([1.1, 2, 3.3]) ], [ [1, 2, 3] ] ); my $arr = [ 1 ]; my $arr2 = [ 1.1 ]; is( refaddr( [$chk2->($arr)]->[0] ), refaddr($arr), 'if value passes type constraint; no need to clone arrayref' ); isnt( refaddr( [$chk2->($arr2)]->[0] ), refaddr($arr2), 'if value fails type constraint; need to clone arrayref' ); my $chk3 = compile($RoundedInt->no_coercions); like( exception { $chk3->(1.1) }, qr{^Value "1\.1" did not pass type constraint}, ); done_testing; compile-named-avoidcallbacks.t000664001750001750 1777115111656240 24603 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L' C function with $AvoidCallbacks true. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile_named validate_named); use Types::Standard -types, "slurpy"; use Type::Utils; use Scalar::Util qw(refaddr); $Type::Tiny::AvoidCallbacks = 1; { my $e = exception { compile_named()->(foo => 1) }; like($e, qr{^Unrecognized parameter: foo}); } { package Type::Tiny::_Test::X; sub new { bless $_[1], $_[0] } } sub simple_test { my ($name, @spec) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { _simple_test( validate_named => sub { validate_named(\@_, @spec) } ); _simple_test( compile_named => compile_named(@spec) ); }; } sub slurpy_test { my ($name, @spec) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { _slurpy_test( validate_named => sub { validate_named(\@_, @spec) } ); _slurpy_test( compile_named => compile_named(@spec) ); }; } sub _simple_test { my ($name, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), { foo => 3, bar => 42 }, 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), { foo => 3, bar => 42, baz => [1..3] }, 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), { foo => 3, bar => 42 }, 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), { foo => 3, bar => 42, baz => [1..4] }, 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), { foo => 3, bar => 42 }, 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), { foo => 3, bar => 42, baz => [1..3] }, 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), { foo => 3, bar => 42 }, 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), { foo => 3, bar => 42, baz => [1..4] }, 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1 }) }, qr/^Unrecognized parameter: xxx/, 'additional parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }) }, qr/^Unrecognized parameters: xxx, yyy, zzz/, 'additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } sub _slurpy_test { my ($name, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), { XXX => {}, foo => 3, bar => 42 }, 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), { XXX => {}, foo => 3, bar => 42, baz => [1..3] }, 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), { XXX => {}, foo => 3, bar => 42 }, 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), { XXX => {}, foo => 3, bar => 42, baz => [1..4] }, 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), { XXX => {}, foo => 3, bar => 42 }, 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), { XXX => {}, foo => 3, bar => 42, baz => [1..3] }, 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), { XXX => {}, foo => 3, bar => 42 }, 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), { XXX => {}, foo => 3, bar => 42, baz => [1..4] }, 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1 }), { XXX => { xxx => 1 }, foo => 3, bar => 42 }, 'additional parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'additional parameters', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1.1, yyy => 2.2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'coercion of additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } my $Rounded; $Rounded = Int->plus_coercions(Num, q{ int($_) }); simple_test( "simple test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, q{ int($_) }); slurpy_test( "slurpy test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); subtest "Shortcuts for Any and Optional[Any]" => sub { my $chk = compile_named(foo => 1, bar => 0); is( exception { $chk->(foo => "xyz") }, undef, ); is( exception { $chk->(foo => "xyz", bar => "abc") }, undef, ); like( exception { $chk->(foo => "xyz", bar => "abc", baz => "def") }, qr/(Unrecognized parameter)|(Wrong number of parameters)/, ); like( exception { $chk->(bar => "abc") }, qr/^Missing required parameter/, ); }; done_testing; compile-named-bless.t000664001750001750 2477115111656240 22747 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L' brand spanking new C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile_named validate_named); use Types::Standard -types, "slurpy"; use Type::Utils; use Scalar::Util qw(refaddr); { package # hide Type::Tiny::_Test::Blessed; sub new { bless $_[1], 'Type::Tiny::_Test::Constructed' } sub new2 { bless $_[1], 'Type::Tiny::_Test::Constructed2' } } sub simple_test { my ($name, @spec) = @_; unshift @spec, my $opts = {}; my $expected_class = undef; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { subtest "bless => CLASS" => sub { %$opts = (bless => 'Type::Tiny::_Test::Blessed'); $expected_class = 'Type::Tiny::_Test::Blessed'; _simple_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _simple_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => CLASS" => sub { %$opts = (class => 'Type::Tiny::_Test::Blessed'); $expected_class = 'Type::Tiny::_Test::Constructed'; _simple_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _simple_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => [CLASS, METHOD]" => sub { %$opts = (class => ['Type::Tiny::_Test::Blessed', 'new2']); $expected_class = 'Type::Tiny::_Test::Constructed2'; _simple_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _simple_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => CLASS, constructor METHOD" => sub { %$opts = (class => 'Type::Tiny::_Test::Blessed', constructor => 'new2'); $expected_class = 'Type::Tiny::_Test::Constructed2'; _simple_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _simple_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; }; } sub slurpy_test { my ($name, @spec) = @_; unshift @spec, my $opts = {}; my $expected_class = undef; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { subtest "bless => CLASS" => sub { %$opts = (bless => 'Type::Tiny::_Test::Blessed'); $expected_class = 'Type::Tiny::_Test::Blessed'; _slurpy_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _slurpy_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => CLASS" => sub { %$opts = (class => 'Type::Tiny::_Test::Blessed'); $expected_class = 'Type::Tiny::_Test::Constructed'; _slurpy_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _slurpy_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => [CLASS, METHOD]" => sub { %$opts = (class => ['Type::Tiny::_Test::Blessed', 'new2']); $expected_class = 'Type::Tiny::_Test::Constructed2'; _slurpy_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _slurpy_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; subtest "class => CLASS, constructor METHOD" => sub { %$opts = (class => 'Type::Tiny::_Test::Blessed', constructor => 'new2'); $expected_class = 'Type::Tiny::_Test::Constructed2'; _slurpy_test( validate_named => $expected_class, sub { validate_named(\@_, $opts, @spec) } ); _slurpy_test( compile_named => $expected_class, compile_named($opts, @spec) ); }; }; } sub _simple_test { my ($name, $expected_class, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), bless({ foo => 3, bar => 42 }, $expected_class), 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), bless({ foo => 3, bar => 42, baz => [1..3] }, $expected_class), 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), bless({ foo => 3, bar => 42 }, $expected_class), 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), bless({ foo => 3, bar => 42, baz => [1..4] }, $expected_class), 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), bless({ foo => 3, bar => 42 }, $expected_class), 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), bless({ foo => 3, bar => 42, baz => [1..3] }, $expected_class), 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), bless({ foo => 3, bar => 42 }, $expected_class), 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), bless({ foo => 3, bar => 42, baz => [1..4] }, $expected_class), 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1 }) }, qr/^Unrecognized parameter: xxx/, 'additional parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }) }, qr/^Unrecognized parameters: xxx, yyy, and zzz/, 'additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } sub _slurpy_test { my ($name, $expected_class, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), bless({ XXX => {}, foo => 3, bar => 42 }, $expected_class), 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), bless({ XXX => {}, foo => 3, bar => 42, baz => [1..3] }, $expected_class), 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), bless({ XXX => {}, foo => 3, bar => 42 }, $expected_class), 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), bless({ XXX => {}, foo => 3, bar => 42, baz => [1..4] }, $expected_class), 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), bless({ XXX => {}, foo => 3, bar => 42 }, $expected_class), 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), bless({ XXX => {}, foo => 3, bar => 42, baz => [1..3] }, $expected_class), 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), bless({ XXX => {}, foo => 3, bar => 42 }, $expected_class), 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), bless({ XXX => {}, foo => 3, bar => 42, baz => [1..4] }, $expected_class), 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1 }), { XXX => { xxx => 1 }, foo => 3, bar => 42 }, 'additional parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'additional parameters', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1.1, yyy => 2.2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'coercion of additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } my $Rounded; $Rounded = Int->plus_coercions(Num, q{ int($_) }); simple_test( "simple test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, q{ int($_) }); slurpy_test( "slurpy test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ) if 0; $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ) if 0; done_testing; compile-named-oo-pp.t000664001750001750 1171115111656240 22657 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C function, with L set to "0". =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BEGIN { $ENV{PERL_TYPE_PARAMS_XS} = 0; }; use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile_named_oo ); use Types::Standard qw( -types ); my $coderef = compile_named_oo( foo => Int, bar => Optional[Int], baz => Optional[HashRef], { getter => 'bazz', predicate => 'haz' }, ); ok(CodeRef->check($coderef), 'compile_named_oo returns a coderef'); my @object; $object[0] = $coderef->( foo => 42, bar => 69, baz => { quux => 666 } ); $object[1] = $coderef->({ foo => 42, bar => 69, baz => { quux => 666 } }); $object[2] = $coderef->( foo => 42 ); $object[3] = $coderef->({ foo => 42 }); for my $i (0 .. 1) { ok(Object->check($object[$i]), "\$object[$i] is an object"); can_ok($object[$i], qw( foo bar has_bar bazz haz )); is($object[$i]->foo, 42, "\$object[$i]->foo == 42"); is($object[$i]->bar, 69, "\$object[$i]->bar == 69"); is($object[$i]->bazz->{quux}, 666, "\$object[$i]->bazz->{quux} == 666"); ok($object[$i]->has_bar, "\$object[$i]->has_bar"); ok($object[$i]->haz, "\$object[$i]->haz"); ok(! $object[$i]->can("has_foo"), 'no has_foo method'); ok(! $object[$i]->can("has_baz"), 'no has_baz method'); } for my $i (2 .. 3) { ok(Object->check($object[$i]), "\$object[$i] is an object"); can_ok($object[$i], qw( foo bar has_bar bazz haz )); is($object[$i]->foo, 42, "\$object[$i]->foo == 42"); is($object[$i]->bar, undef, "not defined \$object[$i]->bar"); is($object[$i]->bazz, undef, "not defined \$object[$i]->bazz"); ok(! $object[$i]->has_bar, "!\$object[$i]->has_bar"); ok(! $object[$i]->haz, "!\$object[$i]->haz"); ok(! $object[$i]->can("has_foo"), 'no has_foo method'); ok(! $object[$i]->can("has_baz"), 'no has_baz method'); } my $e = exception { compile_named_oo( 999 => Int ); }; ok(defined $e, 'exception thrown for bad accessor name'); like("$e", qr/bad accessor name/i, 'correct message'); my $coderef2 = compile_named_oo( bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); my $coderef2obj = $coderef2->(foo => 1.1, bar => []); is(ref($object[0]), ref($coderef2obj), 'packages reused when possible'); my $details = compile_named_oo( { want_details => 1 }, fooble => Int ); like($details->{source}, qr/fooble/, 'want_details'); { my $coderef3 = compile_named_oo( { head => [ Int->plus_coercions( Num, sub {int $_} ) ], tail => [ ArrayRef, ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note explain($coderef3); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { my $coderef3 = compile_named_oo( { head => [ Int->where('1')->plus_coercions( Num->where('1'), q{int $_} ) ], tail => [ ArrayRef->where('1'), ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note($coderef3->{source}); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { my $coderef3 = compile_named_oo( { head => [ Int->where(sub{1})->plus_coercions( Num->where(sub{1}), sub {int $_} ) ], tail => [ ArrayRef->where(sub{1}), ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note($coderef3->{source}); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { package Local::Foo; my $c; sub bar { $c ||= ::compile_named_oo( foo => ::Int ); return $c->(@_); } } my $args = Local::Foo::bar( foo => 42 ); ok Type::Params::ArgsObject->check($args), 'ArgsObject'; ok Type::Params::ArgsObject->of('Local::Foo::bar')->check($args), 'ArgsObject["Local::Foo::bar"]'; note explain($args); done_testing; compile-named-oo.t000664001750001750 1173715111656240 22252 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile_named_oo ); use Types::Standard qw( -types ); my $coderef = compile_named_oo( foo => Int, bar => Optional[Int], baz => Optional[HashRef], { getter => 'bazz', predicate => 'haz' }, ); ok(CodeRef->check($coderef), 'compile_named_oo returns a coderef'); my @object; $object[0] = $coderef->( foo => 42, bar => 69, baz => { quux => 666 } ); $object[1] = $coderef->({ foo => 42, bar => 69, baz => { quux => 666 } }); $object[2] = $coderef->( foo => 42 ); $object[3] = $coderef->({ foo => 42 }); for my $i (0 .. 1) { ok(Object->check($object[$i]), "\$object[$i] is an object"); can_ok($object[$i], qw( foo bar has_bar bazz haz )); is($object[$i]->foo, 42, "\$object[$i]->foo == 42"); is($object[$i]->bar, 69, "\$object[$i]->bar == 69"); is($object[$i]->bazz->{quux}, 666, "\$object[$i]->bazz->{quux} == 666"); ok($object[$i]->has_bar, "\$object[$i]->has_bar"); ok($object[$i]->haz, "\$object[$i]->haz"); ok(! $object[$i]->can("has_foo"), 'no has_foo method'); ok(! $object[$i]->can("has_baz"), 'no has_baz method'); } for my $i (2 .. 3) { ok(Object->check($object[$i]), "\$object[$i] is an object"); can_ok($object[$i], qw( foo bar has_bar bazz haz )); is($object[$i]->foo, 42, "\$object[$i]->foo == 42"); is($object[$i]->bar, undef, "not defined \$object[$i]->bar"); is($object[$i]->bazz, undef, "not defined \$object[$i]->bazz"); ok(! $object[$i]->has_bar, "!\$object[$i]->has_bar"); ok(! $object[$i]->haz, "!\$object[$i]->haz"); ok(! $object[$i]->can("has_foo"), 'no has_foo method'); ok(! $object[$i]->can("has_baz"), 'no has_baz method'); } my $e = exception { compile_named_oo( 999 => Int ); }; ok(defined $e, 'exception thrown for bad accessor name'); like("$e", qr/bad accessor name/i, 'correct message'); my $coderef2 = compile_named_oo( bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); my $coderef2obj = $coderef2->(foo => 1.1, bar => []); is(ref($object[0]), ref($coderef2obj), 'packages reused when possible'); my $details = compile_named_oo( { want_details => 1 }, fooble => Int ); like($details->{source}, qr/fooble/, 'want_details'); { my $coderef3 = compile_named_oo( { head => [ Int->plus_coercions( Num, sub {int $_} ) ], tail => [ ArrayRef, ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note($coderef3->{source}); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { my $coderef3 = compile_named_oo( { head => [ Int->where('1')->plus_coercions( Num->where('1'), q{int $_} ) ], tail => [ ArrayRef->where('1'), ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note($coderef3->{source}); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { my $coderef3 = compile_named_oo( { head => [ Int->where(sub{1})->plus_coercions( Num->where(sub{1}), sub {int $_} ) ], tail => [ ArrayRef->where(sub{1}), ArrayRef ], want_details => 1, }, bar => Optional[ArrayRef], baz => Optional[CodeRef], { getter => 'bazz', predicate => 'haz' }, foo => Num, ); note($coderef3->{source}); #is($coderef3->{max_args}, 9); ok($coderef3->{min_args} >= 3); my @r = $coderef3->{closure}->(1.1, foo => 1.2, bar => [], [1,2,3], ["foo"]); is($r[0], 1); is($r[1]->foo, 1.2); is_deeply($r[1]->bar, []); is($r[1]->bazz, undef); ok(!$r[1]->haz); is_deeply($r[2], [1,2,3]); is_deeply($r[3], ["foo"]); } { package Local::Foo; my $c; sub bar { $c ||= ::compile_named_oo( foo => ::Int ); return $c->(@_); } } my $args = Local::Foo::bar( foo => 42 ); ok Type::Params::ArgsObject->check($args), 'ArgsObject'; ok Type::Params::ArgsObject->of('Local::Foo::bar')->check($args), 'ArgsObject["Local::Foo::bar"]'; ok !Type::Params::ArgsObject->of('Local::Foo::baz')->check($args), '!ArgsObject["Local::Foo::barz"]'; note explain($args); done_testing; compile-named.t000664001750001750 1774015111656240 21637 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L' brand spanking new C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile_named validate_named); use Types::Standard -types, "slurpy"; use Type::Utils; use Scalar::Util qw(refaddr); { my $e = exception { compile_named()->(foo => 1) }; like($e, qr{^Unrecognized parameter: foo}); } { package Type::Tiny::_Test::X; sub new { bless $_[1], $_[0] } } sub simple_test { my ($name, @spec) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { _simple_test( validate_named => sub { validate_named(\@_, @spec) } ); _simple_test( compile_named => compile_named(@spec) ); }; } sub slurpy_test { my ($name, @spec) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name => sub { _slurpy_test( validate_named => sub { validate_named(\@_, @spec) } ); _slurpy_test( compile_named => compile_named(@spec) ); }; } sub _simple_test { my ($name, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), { foo => 3, bar => 42 }, 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), { foo => 3, bar => 42, baz => [1..3] }, 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), { foo => 3, bar => 42 }, 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), { foo => 3, bar => 42, baz => [1..4] }, 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), { foo => 3, bar => 42 }, 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), { foo => 3, bar => 42, baz => [1..3] }, 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), { foo => 3, bar => 42 }, 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), { foo => 3, bar => 42, baz => [1..4] }, 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1 }) }, qr/^Unrecognized parameter: xxx/, 'additional parameter', ); like( exception { $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }) }, qr/^Unrecognized parameters: xxx, yyy, and zzz/, 'additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } sub _slurpy_test { my ($name, $check) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1; subtest $name, sub { is_deeply( $check->( foo => 3, bar => 42 ), { XXX => {}, foo => 3, bar => 42 }, 'accept a hash', ); is_deeply( $check->( foo => 3, bar => 42, baz => [1..3] ), { XXX => {}, foo => 3, bar => 42, baz => [1..3] }, 'accept a hash, with optional parameter', ); is_deeply( $check->( foo => 3.1, bar => 42 ), { XXX => {}, foo => 3, bar => 42 }, 'accept a hash, and coerce', ); is_deeply( $check->( foo => 3.1, bar => 42, baz => [1..3, 4.2] ), { XXX => {}, foo => 3, bar => 42, baz => [1..4] }, 'accept a hash, with optional parameter, and coerce', ); is_deeply( $check->({ foo => 3, bar => 42 }), { XXX => {}, foo => 3, bar => 42 }, 'accept a hashref', ); is_deeply( $check->({ foo => 3, bar => 42, baz => [1..3] }), { XXX => {}, foo => 3, bar => 42, baz => [1..3] }, 'accept a hashref, with optional parameter', ); is_deeply( $check->({ foo => 3.1, bar => 42 }), { XXX => {}, foo => 3, bar => 42 }, 'accept a hashref, and coerce', ); is_deeply( $check->({ foo => 3.1, bar => 42, baz => [1..3, 4.2] }), { XXX => {}, foo => 3, bar => 42, baz => [1..4] }, 'accept a hashref, with optional parameter, and coerce', ); like( exception { $check->({ foo => [], bar => 42 }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "foo" parameter', ); like( exception { $check->({ foo => 3, bar => [] }) }, qr/^Reference \[\] did not pass type constraint/, 'bad "bar" parameter', ); like( exception { $check->({ foo => {}, bar => [] }) }, qr/^Reference \{\} did not pass type constraint/, 'two bad parameters; "foo" throws before "bar" gets a chance', ); like( exception { $check->({ foo => 3, bar => 42, baz => {} }) }, qr/^Reference \{\} did not pass type constraint/, 'bad optional "baz" parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1 }), { XXX => { xxx => 1 }, foo => 3, bar => 42 }, 'additional parameter', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1, yyy => 2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'additional parameters', ); is_deeply( $check->({ foo => 3, bar => 42, xxx => 1.1, yyy => 2.2, zzz => 3 }), { XXX => { xxx => 1, yyy => 2, zzz => 3 }, foo => 3, bar => 42 }, 'coercion of additional parameters', ); like( exception { $check->({ }) }, qr/^Missing required parameter: foo/, 'missing parameter', ); }; } my $Rounded; $Rounded = Int->plus_coercions(Num, q{ int($_) }); simple_test( "simple test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); simple_test( "simple test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], ); $Rounded = Int->plus_coercions(Num, q{ int($_) }); slurpy_test( "slurpy test with everything inlineable", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); $Rounded = Int->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with inlineable types, but non-inlineable coercion", foo => $Rounded, bar => Int, baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); $Rounded = Int->where(sub { !!1 })->plus_coercions(Num, sub { int($_) }); slurpy_test( "slurpy test with everything non-inlineable", foo => $Rounded, bar => Int->where(sub { !!1 }), baz => Optional[ArrayRef->of($Rounded)], XXX => slurpy HashRef[$Rounded], ); subtest "Shortcuts for Any and Optional[Any]" => sub { my $chk = compile_named(foo => 1, bar => 0); is( exception { $chk->(foo => "xyz") }, undef, ); is( exception { $chk->(foo => "xyz", bar => "abc") }, undef, ); like( exception { $chk->(foo => "xyz", bar => "abc", baz => "def") }, qr/(Unrecognized parameter)|(Wrong number of parameters)/, ); like( exception { $chk->(bar => "abc") }, qr/^Missing required parameter/, ); }; done_testing; defaults.t000664001750001750 664615111656240 20717 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test C and C support defaults for parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use Test::More; use Test::Fatal; use Types::Standard -types; use Type::Params qw( compile compile_named ); my @rv; is( exception { @rv = compile(Int, { default => 42 } )->() }, undef, 'compile: no exception thrown because of defaulted argument' ); is_deeply( \@rv, [42], 'compile: default applied correctly' ); @rv = (); is( exception { @rv = compile(Int, { default => sub { 42 } } )->() }, undef, 'compile: no exception thrown because of defaulted argument via coderef' ); is_deeply( \@rv, [42], 'compile: default applied correctly via coderef' ); @rv = (); is( exception { @rv = compile(Int, { default => \'(40+2)' })->() }, undef, 'compile: no exception thrown because of defaulted argument via Perl source code' ); is_deeply( \@rv, [42], 'compile: default applied correctly via Perl source code' ); @rv = (); is( exception { @rv = compile(ArrayRef, { default => [] } )->() }, undef, 'compile: no exception thrown because of defaulted argument via arrayref' ); is_deeply( \@rv, [[]], 'compile: default applied correctly via arrayref' ); @rv = (); is( exception { @rv = compile(HashRef, { default => {} } )->() }, undef, 'compile: no exception thrown because of defaulted argument via hashref' ); is_deeply( \@rv, [{}], 'compile: default applied correctly via hashref' ); @rv = (); is( exception { @rv = compile(Any, { default => undef } )->() }, undef, 'compile: no exception thrown because of defaulted argument via undef' ); is_deeply( \@rv, [undef], 'compile: default applied correctly via undef' ); @rv = (); is( exception { @rv = compile_named(thing => Int, { default => 42 } )->() }, undef, 'compile_named: no exception thrown because of defaulted argument' ); is_deeply( \@rv, [{ thing => 42 }], 'compile_named: default applied correctly' ); @rv = (); is( exception { @rv = compile_named(thing => Int, { default => sub { 42 } } )->() }, undef, 'compile_named: no exception thrown because of defaulted argument via coderef' ); is_deeply( \@rv, [{ thing => 42 }], 'compile_named: default applied correctly via coderef' ); @rv = (); is( exception { @rv = compile_named(thing => ArrayRef, { default => [] } )->() }, undef, 'compile_named: no exception thrown because of defaulted argument via arrayref' ); is_deeply( \@rv, [{ thing => [] }], 'compile_named: default applied correctly via arrayref' ); @rv = (); is( exception { @rv = compile_named(thing => HashRef, { default => {} } )->() }, undef, 'compile_named: no exception thrown because of defaulted argument via hashref' ); is_deeply( \@rv, [{ thing => {} }], 'compile_named: default applied correctly via hashref' ); @rv = (); is( exception { @rv = compile_named(thing => Any, { default => undef } )->() }, undef, 'compile_named: no exception thrown because of defaulted argument via undef' ); is_deeply( \@rv, [{ thing => undef }], 'compile_named: default applied correctly via undef' ); like( exception { compile(HashRef, { default => \*STDOUT } ) }, qr/Default expected to be/, 'compile: exception because bad default' ); done_testing; goto_next.t000664001750001750 374715111656240 21115 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C option. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile_named_oo ); use Types::Standard -types; { sub _foobar { $_ = my $arg = shift; wantarray ? ( $arg->foo, $arg->bar ) : [ $arg->foo, $arg->bar ]; } my $sig; sub foobar { unshift @_, \&_foobar; goto( $sig ||= compile_named_oo { goto_next => 1 }, foo => Bool, bar => Int ); } } subtest "goto_next => 1" => sub { is_deeply( [ foobar( foo => [], bar => 42 ) ], [ !!1, 42 ], 'list context', ); is_deeply( scalar( foobar( foo => [], bar => 42 ) ), [ !!1, 42 ], 'scalar context', ); }; { sub _foobar2 { $_ = my $arg = shift; wantarray ? ( $arg->foo, $arg->bar ) : [ $arg->foo, $arg->bar ]; } my $sig; sub foobar2 { goto( $sig ||= compile_named_oo { goto_next => \&_foobar2 }, foo => Bool, bar => Int ); } } subtest "goto_next => CODEREF" => sub { is_deeply( [ foobar2( foo => [], bar => 42 ) ], [ !!1, 42 ], 'list context', ); is_deeply( scalar( foobar2( foo => [], bar => 42 ) ), [ !!1, 42 ], 'scalar context', ); }; { my $_foobar3 = sub { $_ = my $arg = shift; wantarray ? ( $arg->foo, $arg->bar ) : [ $arg->foo, $arg->bar ]; }; *foobar3 = compile_named_oo { package => 'main', subname => 'foobar3', goto_next => $_foobar3 }, foo => Bool, bar => Int; } subtest "goto_next => CODEREF (assign to glob)" => sub { is_deeply( [ foobar3( foo => [], bar => 42 ) ], [ !!1, 42 ], 'list context', ); is_deeply( scalar( foobar3( foo => [], bar => 42 ) ), [ !!1, 42 ], 'scalar context', ); is( $_->{'~~caller'}, 'main::foobar3', 'meta' ); }; done_testing; hashorder.t000664001750001750 336115111656240 21056 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L' brand spanking new C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile_named); use Types::Standard qw(Int); subtest "predictable error message when problems with two parameters" => sub { for my $i (1..20) { my $check1 = compile_named( a => Int, b => Int ); my $check2 = compile_named( b => Int, a => Int ); like( exception { $check1->( c => 1, c => 1 ) }, qr/Missing required parameter: a/, "Iteration $i, check 1, missing parameters", ); like( exception { $check1->(a => [], b => {}) }, qr/Reference \[\] did not pass type constraint "Int"/, "Iteration $i, check 1, invalid values", ); like( exception { $check1->(a => 1, b => 2, c => '3PO', r2d => 2) }, qr/(Unrecognized parameters: c and r2d)|(Wrong number of parameters)/, "Iteration $i, check 1, extra values", ); like( exception { $check2->() }, qr/(Missing required parameter: b)|(Wrong number of parameters)/, "Iteration $i, check 2, missing parameters", ); like( exception { $check2->(a => [], b => {}) }, qr/Reference \{\} did not pass type constraint "Int"/, "Iteration $i, check 2, invalid values", ); like( exception { $check2->(a => 1, b => 2, c => '3PO', r2d => 2) }, qr/(Unrecognized parameters: c and r2d)|(Wrong number of parameters)/, "Iteration $i, check 2, extra values", ); } }; done_testing; methods.t000664001750001750 344315111656240 20543 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage for method calls. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Silly::String; use Type::Params qw(Invocant compile); use Types::Standard qw(ClassName Object Str Int); my %chk; sub new { $chk{new} ||= compile(ClassName, Str); my ($class, $str) = $chk{new}->(@_); bless \$str, $class; } sub repeat { $chk{repeat} ||= compile(Object, Int); my ($self, $n) = $chk{repeat}->(@_); $self->get x $n; } sub get { $chk{get} ||= compile(Object); my ($self) = $chk{get}->(@_); $$self; } sub set { $chk{set} ||= compile(Invocant, Str); my ($proto, $str) = $chk{set}->(@_); Object->check($proto) ? ($$proto = $str) : $proto->new($str); } } is( exception { my $o = Silly::String->new("X"); is($o->get, "X"); is($o->repeat(4), "XXXX"); $o->set("Y"); is($o->repeat(4), "YYYY"); my $p = Silly::String->set("Z"); is($p->repeat(4), "ZZZZ"); }, undef, 'clean operation', ); like( exception { Silly::String::new() }, qr{^Wrong number of parameters to Silly::String::new; got 0; expected 2}, 'exception calling new() with no args', ); like( exception { Silly::String->new() }, qr{^Wrong number of parameters to Silly::String::new; got 1; expected 2}, 'exception calling ->new() with no args', ); like( exception { Silly::String::set() }, qr{^Wrong number of parameters to Silly::String::set; got 0; expected 2}, 'exception calling set() with no args', ); done_testing; mixednamed.t000664001750001750 201515111656240 21205 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage with mix of positional and named parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; my $chk = compile(ClassName, slurpy Dict[ foo => Int, bar => Str, baz => ArrayRef, ]); is_deeply( [ $chk->("Type::Tiny", foo => 1, bar => "Hello", baz => []) ], [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] ); is_deeply( [ $chk->("Type::Tiny", bar => "Hello", baz => [], foo => 1) ], [ "Type::Tiny", { foo => 1, bar => "Hello", baz => [] } ] ); like( exception { $chk->("Type::Tiny", foo => 1, bar => "Hello") }, qr{did not pass type constraint "Dict}, ); done_testing; multisig-custom-message.t000664001750001750 457015111656240 23671 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Make sure that custom C messages work. =head1 AUTHOR Benct Philip Jonsson Ebpjonsson@gmail.comE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Benct Philip Jonsson. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( multisig ); use Types::Standard qw( Optional Str Int Bool Dict slurpy ); sub _maybe_slurpy { my @sig = @_; $sig[-1] = slurpy $sig[-1]; return ( [@_], \@sig ); } my $foo_args; sub foo { $foo_args ||= multisig( { description => "parameter validation for foo()", message => 'USAGE: foo($string [, \%options|%options])', }, _maybe_slurpy( Str, Dict[ bool => Optional[Bool], num => Optional[Int] ] ), ); return $foo_args->(@_); } my $bar_args; sub bar { $bar_args ||= multisig( { description => "parameter validation for bar()", message => 'USAGE: bar()', }, [], ); return $bar_args->(@_); } my @tests = ( [ 'bar(1)' => sub { bar( 1 ) }, 'USAGE: bar()', undef ], [ 'bar()' => sub { bar() }, "", 0 ], [ 'foo($string, num => "x")' => sub { foo( "baz", num => "x" ) }, 'USAGE: foo($string [, \\%options|%options])', undef, ], [ 'foo([], num => 42)' => sub { foo( [], num => 42 ) }, 'USAGE: foo($string [, \\%options|%options])', undef, ], [ 'foo($string, quux => 0)' => sub { foo( "baz", quux => 0 ) }, 'USAGE: foo($string [, \\%options|%options])', undef, ], [ 'foo($string, [])' => sub { foo( "baz", [] ) }, 'USAGE: foo($string [, \\%options|%options])', undef, ], [ 'foo($string, bool => 1)', sub { is_deeply [ foo( "baz", bool => 1 ) ], [ "baz", { bool => 1 } ], 'slurpy options'; }, "", 1, ], [ 'foo($string, { bool => 1 })', sub { is_deeply [ foo( "baz", { bool => 1 } ) ], [ "baz", { bool => 1 } ], 'hashref options'; }, "", 0 ], [ 'foo($string)', sub { is_deeply [ foo( "baz" ) ], [ "baz", {} ], 'no options'; }, "", 1 ], ); for my $test ( @tests ) { no warnings 'uninitialized'; my($name, $code, $expected, $sig) = @$test; like( exception { $code->() } || '', qr/\A\Q$expected/, $name ); is ${^_TYPE_PARAMS_MULTISIG}, $sig, "$name \${^_TYPE_PARAMS_MULTISIG}"; } done_testing; multisig-gotonext.t000664001750001750 415115111656240 22577 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C signatures work with C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package MyTest; use Types::Common -sigs, -types; signature_for f => ( method => Str, multiple => [ { named => [ x => Num, y => Num, note => Str, { default => '(no note)' }, ], named_to_list => 1, }, { positional => [ Num, Num, Str, { default => '(no note)' } ], }, { positional => [ Tuple[ Num, Num ], Str, { default => '(no note)' } ], goto_next => sub { my ( $class, $xy, $note ) = @_; my ( $x, $y ) = @{ $xy }; return ( $class, $x, $y, $note ); }, }, ], ); sub f { my ( $class, $x, $y, $note ) = @_; $class eq __PACKAGE__ or die; return { x => $x, y => $y, note => $note, }; } } is_deeply( MyTest->f( x => 1, y => 2, note => 'foo' ), { x => 1, y => 2, note => 'foo' }, "MyTest->f( x => 1, y => 2, note => 'foo' )", ); is_deeply( MyTest->f( x => 3, y => 4 ), { x => 3, y => 4, note => '(no note)' }, "MyTest->f( x => 3, y => 4 )", ); is_deeply( MyTest->f( { x => 1, y => 2, note => 'foo' } ), { x => 1, y => 2, note => 'foo' }, "MyTest->f( { x => 1, y => 2, note => 'foo' } )", ); is_deeply( MyTest->f( { x => 3, y => 4 } ), { x => 3, y => 4, note => '(no note)' }, "MyTest->f( { x => 3, y => 4 } )", ); is_deeply( MyTest->f( 1, 2, 'foo' ), { x => 1, y => 2, note => 'foo' }, "MyTest->f( 1, 2, 'foo' )", ); is_deeply( MyTest->f( 3, 4 ), { x => 3, y => 4, note => '(no note)' }, "MyTest->f( 3, 4 )", ); is_deeply( MyTest->f( [ 5, 6 ], 'foo' ), { x => 5, y => 6, note => 'foo' }, "MyTest->f( [ 5, 6 ], 'foo' )", ); is_deeply( MyTest->f( [ 7, 8 ] ), { x => 7, y => 8, note => '(no note)' }, "MyTest->f( [ 7, 8 ] )", ); done_testing; multisig.t000664001750001750 552515111656240 20740 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. Portions by Diab Jerius Edjerius@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( multisig compile validate ); use Types::Standard qw( -types slurpy ); my $Rounded = Int->plus_coercions(Num, 'int($_)'); my $sig = multisig( [ Int, ArrayRef[$Rounded] ], [ ArrayRef[$Rounded], Int ], [ HashRef[Num] ], ); is_deeply( [ $sig->( 1, [2,3,4] ) ], [ 1, [2,3,4] ], 'first choice in multi, no coercion, should pass', ); is( ${^_TYPE_PARAMS_MULTISIG}, 0, '...${^_TYPE_PARAMS_MULTISIG}', ); is_deeply( [ $sig->( 1, [2.2,3.3,4.4] ) ], [ 1, [2,3,4] ], 'first choice in multi, coercion, should pass', ); is( ${^_TYPE_PARAMS_MULTISIG}, 0, '...${^_TYPE_PARAMS_MULTISIG}', ); like( exception { $sig->( 1.1, [2.2,3.3,4.4] ) }, qr{^Parameter validation failed}, 'first choice in multi, should fail', ); is_deeply( [ $sig->( [2,3,4], 1 ) ], [ [2,3,4], 1 ], 'second choice in multi, no coercion, should pass', ); is( ${^_TYPE_PARAMS_MULTISIG}, 1, '...${^_TYPE_PARAMS_MULTISIG}', ); is_deeply( [ $sig->( [2.2,3.3,4.4], 1 ) ], [ [2,3,4], 1 ], 'second choice in multi, coercion, should pass', ); is( ${^_TYPE_PARAMS_MULTISIG}, 1, '...${^_TYPE_PARAMS_MULTISIG}', ); like( exception { $sig->( [2.2,3.3,4.4], 1.1 ) }, qr{^Parameter validation failed}, 'second choice in multi, should fail', ); is_deeply( [ $sig->( { a => 1.1, b => 7 } ) ], [ { a => 1.1, b => 7 } ], 'third choice in multi, no coercion, should pass', ); is( ${^_TYPE_PARAMS_MULTISIG}, 2, '...${^_TYPE_PARAMS_MULTISIG}', ); like( exception { $sig->( { a => 1.1, b => 7, c => "Hello" } ) }, qr{^Parameter validation failed}, 'third choice in multi, should fail', ); my $a = Dict [ a => Num ]; my $b = Dict [ b => Num ]; is exception { validate( [ { a => 3 } ], $a ); validate( [ a => 3 ], slurpy $a ); }, undef; is exception { my $check = multisig( [ $a ], [ $b ] ); $check->( { a => 3 } ); $check->( { b => 3 } ); }, undef; is exception { my $check = multisig( [ slurpy $a ], [ slurpy $b ] ); $check->( a => 3 ); $check->( b => 3 ); }, undef; is exception { my $check = multisig( compile(slurpy $a), compile(slurpy $b) ); $check->( a => 3 ); $check->( b => 3 ); }, undef; { my $error; my $other = multisig( { on_die => sub { $error = shift->message; () } }, [ Int, ArrayRef[$Rounded] ], [ ArrayRef[$Rounded], Int ], [ HashRef[Num] ], ); $other->(); is( $error, 'Parameter validation failed', 'on_die works', ); } done_testing; named-to-list.t000664001750001750 347515111656240 21562 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage with named parameters and C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw(Int); use Type::Params qw(compile_named); my $check1 = compile_named( { named_to_list => 1 }, foo => Int, bar => Int, ); is_deeply( [$check1->(foo => 1, bar => 2)], [1, 2], ); is_deeply( [$check1->(bar => 2, foo => 1)], [1, 2], ); is_deeply( [$check1->(bar => 2, foo => 99)], [99, 2], ); my $check2 = compile_named( { named_to_list => 1 }, foo => Int, bar => Int, baz => Int, { optional => 1 }, ); is_deeply( [$check2->(foo => 1, bar => 2)], [1, 2, undef], ); is_deeply( [$check2->(bar => 2, foo => 1)], [1, 2, undef], ); is_deeply( [$check2->(bar => 2, foo => 99)], [99, 2, undef], ); is_deeply( [$check2->(baz => 666, foo => 1, bar => 2)], [1, 2, 666], ); is_deeply( [$check2->(bar => 2, baz => 666, foo => 1)], [1, 2, 666], ); is_deeply( [$check2->(bar => 2, foo => 99, baz => 666)], [99, 2, 666], ); my $check3 = compile_named( { named_to_list => [qw(baz bar)] }, foo => Int, bar => Int, baz => Int, { optional => 1 }, ); is_deeply( [$check3->(foo => 1, bar => 2)], [undef, 2], ); is_deeply( [$check3->(bar => 2, foo => 1)], [undef, 2], ); is_deeply( [$check3->(bar => 2, foo => 99)], [undef, 2], ); is_deeply( [$check3->(baz => 666, foo => 1, bar => 2)], [666, 2], ); is_deeply( [$check3->(bar => 2, baz => 666, foo => 1)], [666, 2], ); is_deeply( [$check3->(bar => 2, foo => 99, baz => 666)], [666, 2], ); done_testing; named.t000664001750001750 231115111656240 20155 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage with named parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, "slurpy"; my $chk = compile slurpy Dict[ foo => Int, bar => Str, baz => ArrayRef, ]; is_deeply( [ $chk->(foo => 1, bar => "Hello", baz => []) ], [ { foo => 1, bar => "Hello", baz => [] } ] ); is_deeply( [ $chk->(bar => "Hello", baz => [], foo => 1) ], [ { foo => 1, bar => "Hello", baz => [] } ] ); like( exception { $chk->(foo => 1, bar => "Hello") }, qr{did not pass type constraint "Dict}, ); my $chk2 = compile slurpy Dict[ foo => Int, bar => Str, baz => Optional[ArrayRef], ]; is_deeply( [ $chk2->(foo => 1, bar => "Hello") ], [ { foo => 1, bar => "Hello" } ] ); like( exception { $chk2->(foo => 1, bar => "Hello", zab => []) }, qr{did not pass type constraint "Dict}, ); done_testing; noninline.t000664001750001750 350515111656240 21070 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L with type constraints that cannot be inlined. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard qw(Num ArrayRef); use Type::Utils; my $NumX = declare NumX => as Num, where { $_ != 42 }; my $check; sub nth_root { $check ||= compile( $NumX, $NumX ); [ $check->(@_) ]; } is_deeply( nth_root(1, 2), [ 1, 2 ], '(1, 2)', ); is_deeply( nth_root("1.1", 2), [ "1.1", 2 ], '(1.1, 2)', ); { my $e = exception { nth_root() }; like($e, qr{^Wrong number of parameters to main::nth_root; got 0; expected 2}, '()'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters to main::nth_root; got 1; expected 2}, '(1)'); } { my $e = exception { nth_root(undef, 1) }; like($e, qr{^Undef did not pass type constraint "NumX" \(in \$_\[0\]\)}, '(undef, 1)'); } { my $e = exception { nth_root(41, 42) }; like($e, qr{^Value "42" did not pass type constraint "NumX" \(in \$_\[1\]\)}, '(42)'); } my $check2; sub nth_root_coerce { $check2 ||= compile( $NumX->plus_coercions( Num, sub { 21 }, # non-inline ArrayRef, q { scalar(@$_) }, # inline ), $NumX, ); [ $check2->(@_) ]; } is_deeply( nth_root_coerce(42, 11), [21, 11], '(42, 11)' ); is_deeply( nth_root_coerce([1..3], 11), [3, 11], '([1..3], 11)' ); { my $e = exception { nth_root_coerce([1..41], 42) }; like($e, qr{^Value "42" did not pass type constraint "NumX" \(in \$_\[1\]\)}, '([1..41], 42)'); } done_testing; on-die.t000664001750001750 234015111656240 20246 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L support for C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile compile_named ); use Types::Standard -types, "slurpy"; subtest "compile" => sub { my ( $E, @R ); my $coderef = compile( { on_die => sub { $E = shift; 'XXX' } }, Int, ); is( exception { @R = $coderef->("foo") }, undef, 'No exception thrown', ); is_deeply( \@R, [ 'XXX' ], 'Correct value returned', ); is( $E->type->name, 'Int', 'Passed exception to callback', ); }; subtest "compile_named" => sub { my ( $E, @R ); my $coderef = compile_named( { on_die => sub { $E = shift; 'XXX' } }, foo => Int, ); is( exception { @R = $coderef->(foo => "foo") }, undef, 'No exception thrown', ); is_deeply( \@R, [ 'XXX' ], 'Correct value returned', ); is( $E->type->name, 'Int', 'Passed exception to callback', ); }; done_testing; optional.t000664001750001750 344415111656240 20726 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage with optional parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types; my $chk1 = compile(Num, Optional[Int], Optional[ArrayRef], Optional[HashRef]); my $chk2 = compile(Num, Int, {optional=>1}, ArrayRef, {optional=>1}, HashRef, {optional=>1}); my $chk3 = compile(Num, Int, {optional=>1}, Optional[ArrayRef], HashRef, {optional=>1}); my $chk4 = compile(Num, Int, {optional=>1}, Optional[ArrayRef], {optional=>1}, HashRef, {optional=>1}); my $chk5 = compile(Num, {optional=>0}, Optional[Int], Optional[ArrayRef], Optional[HashRef]); for my $chk ($chk1, $chk2, $chk3, $chk4, $chk5) { is_deeply( [ $chk->(1.1, 2, [], {}) ], [ 1.1, 2, [], {} ] ); is_deeply( [ $chk->(1.1, 2, []) ], [ 1.1, 2, [] ] ); is_deeply( [ $chk->(1.1, 2) ], [ 1.1, 2 ] ); is_deeply( [ $chk->(1.1) ], [ 1.1 ] ); like( exception { $chk->(1.1, 2, {}) }, qr{^Reference \{\} did not pass type constraint "(Optional\[)?ArrayRef\]?" \(in \$_\[2\]\)}, ); like( exception { $chk->() }, qr{^Wrong number of parameters; got 0; expected 1 to 4}, ); like( exception { $chk->(1 .. 5) }, qr{^Wrong number of parameters; got 5; expected 1 to 4}, ); like( exception { $chk->(1, 2, undef) }, qr{^Undef did not pass type constraint}, ); } my $chk99 = compile(1, 0, 0); like( exception { $chk99->() }, qr{^Wrong number of parameters; got 0; expected 1 to 3}, ); done_testing; positional.t000664001750001750 622615111656240 21263 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L positional parameters, a la the example in the documentation: sub nth_root { state $check = compile( Num, Num ); my ($x, $n) = $check->(@_); return $x ** (1 / $n); } =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types, 'slurpy'; { my $e = exception { compile()->(1) }; like($e, qr{^Wrong number of parameters; got 1; expected 0}, 'empty compile()'); } my $check; sub nth_root { $check ||= compile( Num, Num ); [ $check->(@_) ]; } is_deeply( nth_root(1, 2), [ 1, 2 ], '(1, 2)', ); is_deeply( nth_root("1.1", 2), [ "1.1", 2 ], '(1.1, 2)', ); { my $e = exception { nth_root() }; like($e, qr{^Wrong number of parameters to main::nth_root; got 0; expected 2}, '(1)'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters to main::nth_root; got 1; expected 2}, '(1)'); } { my $e = exception { nth_root(undef, 1) }; like($e, qr{^Undef did not pass type constraint "Num" \(in \$_\[0\]\)}, '(undef, 1)'); } { my $e = exception { nth_root(1, 2, 3) }; like($e, qr{^Wrong number of parameters to main::nth_root; got 3; expected 2}, '(1)'); } my $fooble_check; sub fooble { $fooble_check = compile( { head => [ ArrayRef, CodeRef ], tail => [ HashRef, ScalarRef, Int->plus_coercions(Num, q{int $_}) ], }, Num, slurpy ArrayRef[Int], ); $fooble_check->(@_); } my $random_code = sub {}; is_deeply( [ fooble( [1], $random_code, 1.1, 1, 2, 3, 4, { foo=>1 }, \42, 1.2 ) ], [ [1], $random_code, 1.1, [1, 2, 3, 4], { foo=>1 }, \42, 1 ], 'head and tail work', ); like( exception { fooble() }, qr/got 0; expected at least 6/, ); like( exception { fooble([]) }, qr/got 1; expected at least 6/, ); like( exception { fooble( undef, $random_code, 1.1, 1, 2, 3, 4, { foo=>1 }, \42, 1.2 ) }, qr/^Undef did not pass type constraint "ArrayRef" \(in \$_\[0\]\)/, ); like( exception { fooble( [1], undef, 1.1, 1, 2, 3, 4, { foo=>1 }, \42, 1.2 ) }, qr/^Undef did not pass type constraint "CodeRef" \(in \$_\[1\]\)/, ); like( exception { fooble( [1], $random_code, undef, 1, 2, 3, 4, { foo=>1 }, \42, 1.2 ) }, qr/^Undef did not pass type constraint "Num" \(in \$_\[2\]\)/, ); like( exception { fooble( [1], $random_code, 1.1, 1, 2, 3, 4, undef, \42, 1.2 ) }, qr/^Undef did not pass type constraint "HashRef" \(in \$_\[-3\]\)/, ); like( exception { fooble( [1], $random_code, 1.1, 1, 2, 3, 4, { foo=>1 }, undef, 1.2 ) }, qr/^Undef did not pass type constraint "ScalarRef" \(in \$_\[-2\]\)/, ); like( exception { fooble( [1], $random_code, 1.1, 1, 2, 3, 4, { foo=>1 }, \42, undef ) }, qr/Undef did not pass type constraint "Int" \(in \$_\[-1\]\)/, ); like( exception { fooble( [1], $random_code, 1.1, 1, undef, 3, 4, { foo=>1 }, \42, 1.2 ) }, qr/did not pass type constraint/, ); done_testing; slurpy.t000664001750001750 1412415111656240 20454 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L usage with slurpy parameters. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params qw( compile signature ); use Types::Standard -types, "slurpy"; my $chk = compile(Str, slurpy HashRef[Int]); is_deeply( [ $chk->("Hello", foo => 1, bar => 2) ], [ "Hello", { foo => 1, bar => 2 } ], 'simple test', ); is_deeply( [ $chk->("Hello", { foo => 1, bar => 2 }) ], [ "Hello", { foo => 1, bar => 2 } ], 'simple test with ref', ); like( exception { $chk->("Hello", foo => 1, bar => 2.1) }, qr{did not pass type constraint "HashRef\[Int\]" \(in \$SLURPY\)}, 'simple test failing type check', ); subtest "Different styles of slurpy work" => sub { for my $compile_this ( [ 'Str, slurpy HashRef' => Str, slurpy HashRef ], [ 'Str, Slurpy[HashRef]' => Str, Slurpy[HashRef] ], [ 'Str, HashRef, { slurpy => 1 }' => Str, HashRef, { slurpy => 1 } ], [ 'Str, { slurpy => HashRef }' => Str, { 'slurpy' => HashRef } ], ) { my ( $desc, @args ) = @$compile_this; subtest "Compiling: $desc" => sub { my $chk2 = compile @args; is_deeply( [ $chk2->("Hello", foo => 1, bar => 2) ], [ "Hello", { foo => 1, bar => 2 } ] ); is_deeply( [ $chk2->("Hello", { foo => 1, bar => 2 }) ], [ "Hello", { foo => 1, bar => 2 } ] ); like( exception { $chk2->("Hello", foo => 1, "bar") }, qr{^Odd number of elements in HashRef}, ); }; } }; subtest "slurpy Map works" => sub { my $chk3 = compile(Str, slurpy Map); is_deeply( [ $chk3->("Hello", foo => 1, "bar" => 2) ], [ Hello => { foo => 1, bar => 2 } ], ); like( exception { $chk3->("Hello", foo => 1, "bar") }, qr{^Odd number of elements in Map}, ); }; subtest "slurpy Tuple works" => sub { my $chk4 = compile(Str, slurpy Tuple[Str, Int, Str]); is_deeply( [ $chk4->("Hello", foo => 1, "bar") ], [ Hello => [ qw/ foo 1 bar / ] ], ); }; { my $check; sub xyz { $check ||= compile( Int, Slurpy[HashRef] ); my ($num, $hr) = $check->(@_); return [ $num, $hr ]; } subtest "Slurpy[HashRef] works" => sub { is_deeply( xyz( 5, foo => 1, bar => 2 ), [ 5, { foo => 1, bar => 2 } ] ); is_deeply( xyz( 5, { foo => 1, bar => 2 } ), [ 5, { foo => 1, bar => 2 } ] ); note compile( { want_source => 1 }, Int, Slurpy[HashRef] ); }; } { my $check; sub xyz2 { $check ||= compile( Int, HashRef, { slurpy => 1 } ); my ($num, $hr) = $check->(@_); return [ $num, $hr ]; } subtest "HashRef { slurpy => 1 } works" => sub { is_deeply( xyz2( 5, foo => 1, bar => 2 ), [ 5, { foo => 1, bar => 2 } ] ); is_deeply( xyz2( 5, { foo => 1, bar => 2 } ), [ 5, { foo => 1, bar => 2 } ] ); }; } { my $check; sub xyz3 { $check ||= compile( Int, { slurpy => HashRef } ); my ($num, $hr) = $check->(@_); return [ $num, $hr ]; } subtest "{ slurpy => HashRef } works" => sub { is_deeply( xyz3( 5, foo => 1, bar => 2 ), [ 5, { foo => 1, bar => 2 } ] ); is_deeply( xyz3( 5, { foo => 1, bar => 2 } ), [ 5, { foo => 1, bar => 2 } ] ); }; } { my $check; sub xyz4 { $check ||= compile( Int, ( Slurpy[HashRef] )->where( '1' ) ); my ($num, $hr) = $check->(@_); return [ $num, $hr ]; } subtest "Subtype of Slurpy[HashRef] works" => sub { is_deeply( xyz4( 5, foo => 1, bar => 2 ), [ 5, { foo => 1, bar => 2 } ] ); is_deeply( xyz4( 5, { foo => 1, bar => 2 } ), [ 5, { foo => 1, bar => 2 } ] ); note compile( { want_source => 1 }, Int, ( Slurpy[HashRef] )->where( '1' ) ); }; } { my $e = exception { signature( positional => [ Slurpy[ArrayRef], ArrayRef ], ); }; like( $e, qr/Parameter following slurpy parameter/, 'Exception thrown for parameter after a slurpy in positional signature', ); } { my $e = exception { signature( positional => [ Slurpy[ArrayRef], Slurpy[ArrayRef] ], ); }; like( $e, qr/Parameter following slurpy parameter/, 'Exception thrown for slurpy parameter after a slurpy in positional signature', ); } { my $e = exception { signature( named => [ foo => Slurpy[ArrayRef], bar => Slurpy[ArrayRef] ], ); }; like( $e, qr/Found multiple slurpy parameters/i, 'Exception thrown for named signature with two slurpies', ); } { my $e = exception { signature( named => [ foo => Slurpy[ArrayRef] ], ); }; like( $e, qr/Signatures with named parameters can only have slurpy parameters which are a subtype of HashRef/i, 'Exception thrown for named signature with ArrayRef slurpy', ); } { my $check; my $e = exception { $check = signature( named => [ bar => Slurpy[HashRef], foo => ArrayRef ], bless => 0, ); }; is( $e, undef, 'Named signature may have slurpy parameter before others', ); is_deeply( [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ], [ { foo => [ 1..4 ], bar => { abc => 1, def => 2 } } ], '... and expected behaviour', ) or diag explain [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ]; } { my $check; my $e = exception { $check = signature( named => [ bar => Slurpy[HashRef], foo => ArrayRef ], named_to_list => 1, ); }; is( $e, undef, 'Named-to-list => 1 signature may have slurpy parameter before others', ); is_deeply( [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ], [ { abc => 1, def => 2 }, [ 1..4 ] ], '... and expected behaviour', ) or diag explain [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ]; } { my $check; my $e = exception { $check = signature( named => [ bar => Slurpy[HashRef], foo => ArrayRef ], named_to_list => [ qw( foo bar ) ], ); }; is( $e, undef, 'Named-to-list => ARRAY signature may have slurpy parameter before others', ); is_deeply( [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ], [ [ 1..4 ], { abc => 1, def => 2 } ], '... and expected behaviour', ) or diag explain [ $check->( foo => [ 1..4 ], abc => 1, def => 2 ) ]; } done_testing; strictness.t000664001750001750 565615111656240 21311 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test L C option. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; BEGIN { $ENV{PERL_TYPE_TINY_XS} = 0; } use Test::More; use Test::Fatal; use Type::Params qw(compile); use Types::Standard -types; sub code_contains { s/\s+//msg for ( my ( $code, $want ) = @_ ); index( $code, $want ) >= 0; } subtest 'strictness => CONDITION_STRING' => sub { my $got = compile( { strictness => '$::CHECK_TYPES', want_source => 1 }, Int, ArrayRef, ); my $expected = <<'EXPECTED'; # Parameter $_[0] (type: Int) ( not $::CHECK_TYPES ) or (do { my $tmp = $_[0]; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ }) or Type::Tiny::_failed_check( 13, "Int", $_[0], varname => "\$_[0]" ); EXPECTED ok code_contains( $got, $expected ), 'code contains expected Int check' or diag( $got ); is( ref(eval $got), 'CODE', 'code compiles' ) or diag( $got ); }; subtest 'strictness => 1' => sub { my $got = compile( { strictness => 1, want_source => 1 }, Int, ArrayRef, ); my $expected = <<'EXPECTED'; # Parameter $_[0] (type: Int) (do { my $tmp = $_[0]; defined($tmp) and !ref($tmp) and $tmp =~ /\A-?[0-9]+\z/ }) or Type::Tiny::_failed_check( 13, "Int", $_[0], varname => "\$_[0]" ); EXPECTED ok code_contains( $got, $expected ), 'code contains expected Int check' or diag( $got ); is( ref(eval $got), 'CODE', 'code compiles' ) or diag( $got ); }; subtest 'strictness => 0' => sub { my $got = compile( { strictness => 0, want_source => 1 }, Int, ArrayRef, ); my $expected = <<'EXPECTED'; # Parameter $_[0] (type: Int) 1; # ... nothing to do EXPECTED ok code_contains( $got, $expected ), 'code contains expected Int check' or diag( $got ); is( ref(eval $got), 'CODE', 'code compiles' ) or diag( $got ); }; my $check = compile( { strictness => '$::CHECK_TYPES' }, Int, ArrayRef, ); # Type checks are skipped { local $::CHECK_TYPES = 0; my $e = exception { my ( $number, $list ) = $check->( {}, {} ); my ( $numbe2, $lis2 ) = $check->(); }; is $e, undef; } # Type checks are performed { local $::CHECK_TYPES = 1; my $e = exception { my ( $number, $list ) = $check->( {}, {} ); }; like $e, qr/did not pass type constraint "Int"/; } my $check2 = compile( { strictness => '$::CHECK_TYPES' }, Int, ArrayRef, { strictness => 1 } ); # Type check for Int is skipped { local $::CHECK_TYPES = 0; my $e = exception { my ( $number, $list ) = $check2->( {}, [] ); }; is $e, undef; } # Type check for ArrayRef is performed { local $::CHECK_TYPES = 0; my $e = exception { my ( $number, $list ) = $check2->( {}, {} ); }; like $e, qr/did not pass type constraint "ArrayRef"/; } done_testing; v2-allowdash.t000664001750001750 370115111656240 21400 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test allow_dash option for Type::Params. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw( Int ); use Type::Params qw( signature_for ); signature_for test1 => ( allow_dash => 0, named => [ foo => Int, bar => Int, ], ); sub test1 { my $args = shift; return $args->foo + $args->bar; } is test1( foo => 1, bar => 2 ), 3; ok exception { test1( -foo => 1, bar => 2 ) }; ok exception { test1( foo => 1, -bar => 2 ) }; ok exception { test1( -foo => 1, -bar => 2 ) }; signature_for test2 => ( allow_dash => 1, named => [ foo => Int, bar => Int, ], ); sub test2 { my $args = shift; return $args->foo + $args->bar; } is test2( foo => 1, bar => 2 ), 3; is test2( -foo => 1, bar => 2 ), 3; is test2( foo => 1, -bar => 2 ), 3; is test2( -foo => 1, -bar => 2 ), 3; signature_for test3 => ( allow_dash => 1, named => [ foo => Int, bar => Int, { alias => 'baz' }, ], ); sub test3 { my $args = shift; return $args->foo + $args->bar; } is test3( foo => 1, bar => 2 ), 3; is test3( -foo => 1, bar => 2 ), 3; is test3( foo => 1, -bar => 2 ), 3; is test3( -foo => 1, -bar => 2 ), 3; is test3( foo => 1, baz => 2 ), 3; is test3( -foo => 1, baz => 2 ), 3; is test3( foo => 1, -baz => 2 ), 3; is test3( -foo => 1, -baz => 2 ), 3; signature_for test4 => ( allow_dash => 1, named => [ foo => Int, bar => Int, { allow_dash => 0 }, ], ); sub test4 { my $args = shift; return $args->foo + $args->bar; } is test4( foo => 1, bar => 2 ), 3; is test4( -foo => 1, bar => 2 ), 3; ok exception { test4( foo => 1, -bar => 2 ) }; ok exception { test4( -foo => 1, -bar => 2 ) }; done_testing; v2-default-on-undef.t000664001750001750 254715111656240 22566 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Tests that Type::Params supports C. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -types; use Type::Params -sigs; signature_for foo1 => ( pos => [ Optional, { default => 42 } ], next => sub { shift } ); signature_for foo2 => ( pos => [ Optional, { default => 42, default_on_undef => !!1 } ], next => sub { shift } ); is foo1(60), 60; is foo1(42), 42; is foo1(), 42; is foo1(undef), undef; is foo1(''), ''; is foo2(60), 60; is foo2(42), 42; is foo2(), 42; is foo2(undef), 42; is foo2(''), ''; signature_for foo3 => ( named => [ foo => Optional, { default => 42 } ], next => sub { shift->foo } ); signature_for foo4 => ( named => [ foo => Optional, { default => 42, default_on_undef => !!1 } ], next => sub { shift->foo } ); is foo3(foo=>60), 60; is foo3(foo=>42), 42; is foo3(), 42; is foo3(foo=>undef), undef; is foo3(foo=>''), ''; is foo4(foo=>60), 60; is foo4(foo=>42), 42; is foo4(), 42; is foo4(foo=>undef), 42; is foo4(foo=>''), ''; done_testing; v2-defaults.t000664001750001750 151315111656240 21230 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Check that Type::Params v2 default coderefs get passed an invocant. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Local::FooBar; use Types::Common -types, -sigs; sub foo { 42 } my $check; sub bar { $check ||= signature( method => 1, positional => [ Int, { default => sub { shift->foo } }, ], ); my ( $self, $num ) = &$check; return $num / 2; } } my $object = bless {}, 'Local::FooBar'; is( $object->bar, 21 ); is( $object->bar(666), 333 ); done_testing; v2-delayed-compilation.t000664001750001750 211515111656240 23343 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Tests that Type::Params v2 C delays signature compilation. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -types; use Type::Params -sigs; my $compiled = 0; my $MyStr = Str->create_child_type( name => 'MyStr', constraint => sub { 1 }, inlined => sub { ++$compiled; Str->inline_check( pop ); }, ); signature_for xyz => ( pos => [ $MyStr ] ); sub xyz { my $got = shift; return scalar reverse $got; } is( $compiled, 0, 'type constraint has not been compiled yet', ); is( xyz('foo'), 'oof', 'function worked' ); is( $compiled, 1, 'type constraint has been compiled', ); is( xyz('bar'), 'rab', 'function worked' ); is( $compiled, 1, 'type constraint has not been re-compiled', ); done_testing; v2-exceptions.t000664001750001750 426615111656240 21612 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test a few Type::Params v2 exceptions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -types, -sigs; subtest "signature extra_arg => ( positional => ... )" => sub { my $e = exception { my $sig = signature extra_arg => ( positional => [ Int ], ); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/expected even-sized list/i; }; subtest "signature_for( positional => ... )" => sub { my $e = exception { signature_for( positional => [ Int ], ); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/expected odd-sized list/i; }; subtest "signature( named => ..., positional => ... )" => sub { my $e = exception { my $sig = signature( positional => [ Int ], named => [ foo => Int ], ); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/cannot have both positional and named arguments/i; }; subtest "signature_for bleh => ( named => ..., positional => ... )" => sub { my $e = exception { signature_for bleh => ( positional => [ Int ], named => [ foo => Int ], goto_next => sub {}, ); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/cannot have both positional and named arguments/i; }; subtest "signature_for function_does_not_exist => ( positional => ... )" => sub { my $e = exception { signature_for function_does_not_exist => ( positional => [ Int ], ); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/not found to wrap/i; }; subtest "signature()" => sub { my $e = exception { signature() }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/Signature must be positional, named, or multiple/i; }; sub bleh333 {} subtest "signature_for bleh333 => ()" => sub { my $e = exception { signature_for bleh333 => (); }; ok $e->isa( 'Error::TypeTiny' ); like $e->message, qr/Signature must be positional, named, or multiple/i; }; done_testing; v2-fallback.t000664001750001750 142315111656240 21160 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test the C<< fallback >> option for modern Type::Params v2 API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -types; use Type::Params -sigs; sub xyz { return 666; } signature_for [ 'xyz' ] => ( pos => [ Int, Int ], fallback => sub { $_[0] + $_[1] }, ); is( xyz( 40, 2 ), 666 ); signature_for [ 'abc' ] => ( pos => [ Int, Int ], fallback => sub { $_[0] + $_[1] }, ); is( abc( 40, 2 ), 42 ); done_testing; v2-listtonamed.t000664001750001750 421715111656240 21750 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test list_to_named option for Type::Params. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw( Int ScalarRef ); use Type::Params qw( signature_for ); signature_for test1 => ( named => [ foo => Int, bar => Int ], list_to_named => !!1, oo_trace => !!0, ); sub test1 { my $args = shift; return +{%$args}; } is_deeply( test1( foo => 3, bar => 4 ), { foo => 3, bar => 4 } ); is_deeply( test1( bar => 4, foo => 3 ), { foo => 3, bar => 4 } ); is_deeply( test1( { foo => 3, bar => 4 } ), { foo => 3, bar => 4 } ); is_deeply( test1( { bar => 4, foo => 3 } ), { foo => 3, bar => 4 } ); is_deeply( test1( 3, bar => 4 ), { foo => 3, bar => 4 } ); is_deeply( test1( 3, { bar => 4 } ), { foo => 3, bar => 4 } ); is_deeply( test1( 4, foo => 3 ), { foo => 3, bar => 4 } ); is_deeply( test1( 4, { foo => 3 } ), { foo => 3, bar => 4 } ); is_deeply( test1( 3, 4 ), { foo => 3, bar => 4 } ); like exception { test1( 3, { foo => 1, bar => 4 } ) }, qr/^Superfluous positional arguments/; like exception { test1( 3, foo => 1, bar => 4 ) }, qr/^Superfluous positional arguments/; signature_for test2 => ( named => [ foo => Int, bar => ScalarRef ], list_to_named => !!1, oo_trace => !!0, ); sub test2 { my $args = shift; return +{%$args}; } is_deeply( test2( \3, 4 ), { foo => 4, bar => \3 } ); is_deeply( test2( 3, \4 ), { foo => 3, bar => \4 } ); is_deeply( test2( \3, foo => 4 ), { foo => 4, bar => \3 } ); is_deeply( test2( 3, bar => \4 ), { foo => 3, bar => \4 } ); signature_for test3 => ( named => [ foo => Int, bar => ScalarRef, { in_list => 0 } ], list_to_named => !!1, oo_trace => !!0, ); sub test3 { my $args = shift; return +{%$args}; } is_deeply( test3( 3, bar => \4 ), { foo => 3, bar => \4 } ); like exception { test3( 3, \4 ) }, qr/Missing required parameter/; done_testing; v2-multi.t000664001750001750 2154615111656240 20603 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Tests new C option in Type::Params. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -sigs, -types; { my $sig; sub array_lookup { $sig ||= signature( method => 1, multi => [ { multi => [ { pos => [ ArrayRef, Int ] }, { pos => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } }, { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } }, sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die }, ], ); my ( $self, $arr, $ix ) = &$sig; return $arr->[$ix]; } subtest "signature( multi => [...] )" => sub { note signature( method => 1, multi => [ { multi => [ { pos => [ ArrayRef, Int ] }, { pos => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } }, { named => [ ARRAY => ArrayRef, INDEX => Int ], named_to_list => 1 }, sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die }, ], want_source => 1, ); note signature( method => 1, multi => [ { multi => [ { pos => [ ArrayRef, Int ] }, { pos => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } }, { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } }, sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die }, ], want_object => 1, )->make_class_pp_code; my @arr = qw( foo bar baz quux ); my $ix = 2; my $expect = 'baz'; is( __PACKAGE__->array_lookup( \@arr, $ix ), $expect, 'first alternative', ); is( __PACKAGE__->array_lookup( $ix, \@arr ), $expect, 'second alternative', ); is( __PACKAGE__->array_lookup( array => \@arr, index => $ix ), $expect, 'third alternative (hash)', ); is( __PACKAGE__->array_lookup( { array => \@arr, index => $ix } ), $expect, 'third alternative (hashref)', ); is( __PACKAGE__->array_lookup( array => \@arr, ix => $ix ), $expect, 'third alternative (hash, alias)', ); is( __PACKAGE__->array_lookup( { array => \@arr, ix => $ix } ), $expect, 'third alternative (hashref, alias)', ); is( array_lookup( \@arr, $ix ), $expect, 'fourth alternative', ); is( __PACKAGE__->array_lookup( LIST => \@arr, INDEX => $ix ), $expect, 'fifth alternative', ); is( array_lookup( 'HELLOWORLD' ), 'helloworld', 'final alternative', ); my $e = exception { array_lookup() }; like $e, qr/Parameter validation failed/; is ${^_TYPE_PARAMS_MULTISIG}, undef; }; } { signature_for array_lookup2 => ( method => 1, multi => [ { multi => [ { ID =>'foo', pos => [ ArrayRef, Int ] }, { ID =>'bar', pos => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } }, ] }, { ID =>'third', named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { ID =>'fourth', pos => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } }, { ID =>'fifth', named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } }, sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die }, ], ); sub array_lookup2 { my ( $self, $arr, $ix ) = @_; return $arr->[$ix]; } subtest "signature_for function => ( multi => [...] )" => sub { my @arr = qw( foo bar baz quux ); my $ix = 2; my $expect = 'baz'; is( __PACKAGE__->array_lookup2( \@arr, $ix ), $expect, 'first alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 0; is( __PACKAGE__->array_lookup2( $ix, \@arr ), $expect, 'second alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 0; is( __PACKAGE__->array_lookup2( array => \@arr, index => $ix ), $expect, 'third alternative (hash)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup2( { array => \@arr, index => $ix } ), $expect, 'third alternative (hashref)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup2( array => \@arr, ix => $ix ), $expect, 'third alternative (hash, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup2( { array => \@arr, ix => $ix } ), $expect, 'third alternative (hashref, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( array_lookup2( \@arr, $ix ), $expect, 'fourth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'fourth'; is( __PACKAGE__->array_lookup2( LIST => \@arr, INDEX => $ix ), $expect, 'fifth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'fifth'; is( array_lookup2( 'HELLOWORLD' ), 'helloworld', 'final alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 4; my $e = exception { array_lookup2() }; like $e, qr/Parameter validation failed/; is ${^_TYPE_PARAMS_MULTISIG}, undef; }; } { signature_for array_lookup3 => ( method => 1, multi => { first => { pos => [ ArrayRef, Int ] }, second => { pos => [ Int, ArrayRef ], next => sub { @_[0, 2, 1] } }, third => { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, fourth => { pos => [ ArrayRef, Int ], method => 0, next => sub { ( undef, @_ ) } }, fifth => { named => [ LIST => ArrayRef, INDEX => Int ], next => sub { my $arg = pop; ( undef, $arg->LIST, $arg->INDEX ) } }, sixth => sub { return ( undef, ['helloworld'], 0 ) if ( $_[0] and $_[0] eq 'HELLOWORLD' ); die }, }, ); sub array_lookup3 { my ( $self, $arr, $ix ) = @_; return $arr->[$ix]; } subtest "signature_for function => ( multi => {...} )" => sub { my @arr = qw( foo bar baz quux ); my $ix = 2; my $expect = 'baz'; is( __PACKAGE__->array_lookup3( \@arr, $ix ), $expect, 'first alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'first'; is( __PACKAGE__->array_lookup3( $ix, \@arr ), $expect, 'second alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'second'; is( __PACKAGE__->array_lookup3( array => \@arr, index => $ix ), $expect, 'third alternative (hash)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup3( { array => \@arr, index => $ix } ), $expect, 'third alternative (hashref)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup3( array => \@arr, ix => $ix ), $expect, 'third alternative (hash, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( __PACKAGE__->array_lookup3( { array => \@arr, ix => $ix } ), $expect, 'third alternative (hashref, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 'third'; is( array_lookup3( \@arr, $ix ), $expect, 'fourth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'fourth'; is( __PACKAGE__->array_lookup3( LIST => \@arr, INDEX => $ix ), $expect, 'fifth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'fifth'; is( array_lookup3( 'HELLOWORLD' ), 'helloworld', 'final alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 'sixth'; my $e = exception { array_lookup3() }; like $e, qr/Parameter validation failed/; is ${^_TYPE_PARAMS_MULTISIG}, undef; }; } { my $sig; sub xyz { $sig ||= signature( named => [ { next => sub { shift->foo } }, foo => Int, { alias => 'foolish' } ], pos => [ Int ], multi => 1, ); my ( $int ) = &$sig; return $int; } subtest "signature( named => ..., pos => ..., multi => 1 )" => sub { note signature( named => [ { next => sub { shift->foo } }, foo => Int, { alias => 'foolish' } ], pos => [ Int ], multi => 1, want_source => 1, ); is xyz( foo => 666 ), 666; is ${^_TYPE_PARAMS_MULTISIG}, 0; is xyz( { foolish => 999 } ), 999; is ${^_TYPE_PARAMS_MULTISIG}, 0; is xyz(42), 42; is ${^_TYPE_PARAMS_MULTISIG}, 1; }; } my $e = exception { signature multiple => [ 123 ]; }; like $e, qr/Alternative signatures must be CODE, HASH, or ARRAY refs/; done_testing; v2-named-backcompat.t000664001750001750 475115111656240 22616 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Named parameter tests for modern Type::Params v2 API on Perl 5.8. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package Local::MyPackage; use strict; use warnings; use Types::Standard -types; use Type::Params -sigs; signature_for myfunc => ( method => Object | Str, named => [ arr => ArrayRef, int => Int ], ); sub myfunc { my ( $self, $arg ) = @_; return $arg->arr->[ $arg->int ]; } my $signature; sub myfunc2 { $signature ||= signature( method => 1, named => [ arr => ArrayRef, int => Int ], ); my ( $self, $arg ) = &$signature; return $arg->arr->[ $arg->int ]; } }; my $o = bless {} => 'Local::MyPackage'; my @arr = ( 'a' .. 'z' ); is $o->myfunc( arr => \@arr, int => 2 ), 'c', 'myfunc (happy path)'; is $o->myfunc2( arr => \@arr, int => 4 ), 'e', 'myfunc2 (happy path)'; { my $e = exception { $o->myfunc( arr => \@arr, int => undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc (type exception)' } { my $e = exception { $o->myfunc2( arr => \@arr, int => undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc2 (type exception)' } { my $e = exception { $o->myfunc( arr => \@arr, int => 6, 'debug' ); }; like $e, qr/Wrong number of parameters/, 'myfunc (param count exception)' } { my $e = exception { $o->myfunc2( arr => \@arr, int => 8, 'debug' ); }; like $e, qr/Wrong number of parameters/, 'myfunc2 (param count exception)' } BEGIN { package Local::MyPackage2; use strict; use warnings; use Types::Standard -types; use Type::Params -sigs; signature_for test => ( method => !!1, named => [ foo => Optional, bar => Optional[Any] ], ); sub test { my ( $self, $arg ) = @_; my $sum; $sum += $arg->foo if $arg->has_foo; $sum += $arg->bar if $arg->has_bar; return $sum; } } subtest 'Optional and Optional[Any] treated the same' => sub { my $o = bless {}, 'Local::MyPackage2'; my $e = exception { is $o->test( foo => 2, bar => 5 ), 7; is $o->test( bar => 5 ), 5; is $o->test( foo => 2 ), 2; is $o->test( ), undef; }; is $e, undef, 'No exception'; }; done_testing; v2-named-plus-slurpy.t000664001750001750 142515111656240 23024 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Named slurpy parameter tests for modern Type::Params v2 API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Common -sigs, -types; my $sig = signature( named => [ in => Str, out => Str, options => Any, { slurpy => 1 }, ], ); my ( $arg ) = $sig->( in => 'IN', out => 'OUT', foo => 'FOO', bar => 'BAR', ); is( $arg->in, 'IN' ); is( $arg->out, 'OUT' ); is_deeply( $arg->options, { foo => 'FOO', bar => 'BAR' }, ); done_testing; v2-named.t000664001750001750 620115111656240 20504 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Named parameter tests for modern Type::Params v2 API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires '5.020'; use Test::Fatal; use Test::TypeTiny; use Type::Params qw( ArgsObject ); use Types::Common qw( HashRef ); BEGIN { package Local::MyPackage; our $LAST; use strict; use warnings; use feature 'state'; use experimental 'signatures'; use Types::Standard -types; use Type::Params -sigs; signature_for myfunc => ( method => Object | Str, named => [ arr => ArrayRef, int => Int ], ); sub myfunc ( $self, $arg ) { $LAST = $arg; return $arg->arr->[ $arg->int ]; } sub myfunc2 { state $signature = signature( method => 1, named => [ arr => ArrayRef, int => Int ], ); my ( $self, $arg ) = &$signature; $LAST = $arg; return $arg->arr->[ $arg->int ]; } }; my $o = bless {} => 'Local::MyPackage'; my @arr = ( 'a' .. 'z' ); { local $Local::MyPackage::LAST; is $o->myfunc( arr => \@arr, int => 2 ), 'c', 'myfunc (happy path)'; should_pass $Local::MyPackage::LAST, $_ for ArgsObject, ArgsObject['Local::MyPackage::myfunc']; should_fail $Local::MyPackage::LAST, $_ for HashRef, ArgsObject['Local::MyPackage::myfunc2']; } { local $Local::MyPackage::LAST; is $o->myfunc2( arr => \@arr, int => 4 ), 'e', 'myfunc2 (happy path)'; should_pass $Local::MyPackage::LAST, $_ for ArgsObject, ArgsObject['Local::MyPackage::myfunc2']; should_fail $Local::MyPackage::LAST, $_ for HashRef, ArgsObject['Local::MyPackage::myfunc']; } { my $e = exception { $o->myfunc( arr => \@arr, int => undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc (type exception)' } { my $e = exception { $o->myfunc2( arr => \@arr, int => undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc2 (type exception)' } { my $e = exception { $o->myfunc( arr => \@arr, int => 6, 'debug' ); }; like $e, qr/Wrong number of parameters/, 'myfunc (param count exception)' } { my $e = exception { $o->myfunc2( arr => \@arr, int => 8, 'debug' ); }; like $e, qr/Wrong number of parameters/, 'myfunc2 (param count exception)' } BEGIN { package Local::MyPackage2; use strict; use warnings; use experimental 'signatures'; use Types::Standard -types; use Type::Params -sigs; signature_for test => ( method => !!1, named => [ foo => Optional, bar => Optional[Any] ], ); sub test ( $self, $arg ) { my $sum; $sum += $arg->foo if $arg->has_foo; $sum += $arg->bar if $arg->has_bar; return $sum; } } subtest 'Optional and Optional[Any] treated the same' => sub { my $o = bless {}, 'Local::MyPackage2'; my $e = exception { is $o->test( foo => 2, bar => 5 ), 7; is $o->test( bar => 5 ), 5; is $o->test( foo => 2 ), 2; is $o->test( ), undef; }; is $e, undef, 'No exception'; }; done_testing; v2-positional-backcompat.t000664001750001750 323315111656240 23705 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params =encoding utf-8 =head1 PURPOSE Positional parameter tests for modern Type::Params v2 API on Perl 5.8. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; BEGIN { package Local::MyPackage; use strict; use warnings; use Types::Standard -types; use Type::Params -sigs; signature_for myfunc => ( method => Object | Str, pos => [ ArrayRef, Int ], ); sub myfunc { my ( $self, $arr, $int ) = @_; return $arr->[$int]; } my $signature; sub myfunc2 { $signature ||= signature( method => 1, pos => [ ArrayRef, Int ], ); my ( $self, $arr, $int ) = &$signature; return $arr->[$int]; } }; my $o = bless {} => 'Local::MyPackage'; my @arr = ( 'a' .. 'z' ); is $o->myfunc( \@arr, 2 ), 'c', 'myfunc (happy path)'; is $o->myfunc2( \@arr, 4 ), 'e', 'myfunc2 (happy path)'; { my $e = exception { $o->myfunc( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc (type exception)' } { my $e = exception { $o->myfunc2( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc2 (type exception)' } { my $e = exception { $o->myfunc( \@arr, 6, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc (param count exception)' } { my $e = exception { $o->myfunc2( \@arr, 8, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc2 (param count exception)' } done_testing; v2-positional-plus-slurpy.t000664001750001750 150715111656240 24122 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Named slurpy parameter tests for modern Type::Params v2 API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Common -sigs, -types; my $sig = signature( positional => [ Str, Str, Any, { slurpy => 1 }, ], ); my ( $in, $out, $slurpy ) = $sig->( qw/ IN OUT FOO BAR / ); is( $in, 'IN' ); is( $out, 'OUT' ); is_deeply( $slurpy, [ 'FOO', 'BAR' ] ); my $sig2; my $e = exception { $sig2 = signature pos => [ Int, { slurpy => 1 } ]; $sig2->( 42 ); }; isnt $e, undef; done_testing; v2-positional.t000664001750001750 556015111656240 21610 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Positional parameter tests for modern Type::Params v2 API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires '5.020'; use Test::Fatal; BEGIN { package Local::MyPackage; use strict; use warnings; use feature 'state'; use experimental 'signatures'; use Types::Standard -types; use Type::Params -sigs; my $meta = signature_for myfunc => ( method => Object | Str, pos => [ ArrayRef, Int ], ); sub get_meta { $meta } sub myfunc ( $self, $arr, $int ) { return $arr->[$int]; } sub myfunc2 { state $signature = signature( method => 1, pos => [ ArrayRef, Int ], ); my ( $self, $arr, $int ) = &$signature; return $arr->[$int]; } signature_for myfunc3 => ( method => Object | Str, pos => [ ArrayRef, Int ], goto_next => sub ( $self, $arr, $int ) { return $arr->[$int]; }, ); sub myfunc4 { state $signature = signature( method => 1, pos => [ ArrayRef, Int ], goto_next => sub ( $self, $arr, $int ) { return $arr->[$int]; }, ); return &$signature; } }; my $o = bless {} => 'Local::MyPackage'; my @arr = ( 'a' .. 'z' ); ok( Local::MyPackage->get_meta->isa('Type::Params::Signature'), 'return value of signature_for' ); is $o->myfunc( \@arr, 2 ), 'c', 'myfunc (happy path)'; is $o->myfunc2( \@arr, 4 ), 'e', 'myfunc2 (happy path)'; is $o->myfunc3( \@arr, 6 ), 'g', 'myfunc3 (happy path)'; is $o->myfunc4( \@arr, 8 ), 'i', 'myfunc4 (happy path)'; { my $e = exception { $o->myfunc( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc (type exception)' } { my $e = exception { $o->myfunc2( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc2 (type exception)' } { my $e = exception { $o->myfunc3( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc3 (type exception)' } { my $e = exception { $o->myfunc4( \@arr, undef ); }; like $e, qr/Undef did not pass type constraint "Int"/, 'myfunc4 (type exception)' } { my $e = exception { $o->myfunc( \@arr, 6, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc (param count exception)' } { my $e = exception { $o->myfunc2( \@arr, 8, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc2 (param count exception)' } { my $e = exception { $o->myfunc3( \@arr, 8, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc3 (param count exception)' } { my $e = exception { $o->myfunc4( \@arr, 8, undef ); }; like $e, qr/Wrong number of parameters/, 'myfunc4 (param count exception)' } done_testing; v2-returns.t000664001750001750 630615111656240 21130 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Check that Type::Params v2 supports return typrs. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2024-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Params -sigs; use Types::Common -types; subtest "Simple return type" => sub { signature_for test1 => ( pos => [ Num, Num ], returns => Int, ); sub test1 { my ( $x, $y ) = @_; return $x + $y; } is( scalar( test1( 2, 3 ) ), 5, 'happy path, scalar context' ); is_deeply( [ test1( 2, 3 ) ], [ 5 ], 'happy path, list context' ); is( do { test1( 2, 3 ); 1 }, 1, 'happy path, void context' ); ok( exception { scalar( test1( 2.1, 3 ) ) }, 'bad path, scalar context' ); ok( exception { [ test1( 2.1, 3 ) ] }, 'bad path, list context' ); ok( !exception { do { test1( 2.1, 3 ); 1 } }, 'bad path, void context' ); }; subtest "Non-inlinable return type" => sub { signature_for test2 => ( pos => [ Num, Num ], returns => Int->where(sub { 1 }), ); sub test2 { my ( $x, $y ) = @_; return $x + $y; } is( scalar( test2( 2, 3 ) ), 5, 'happy path, scalar context' ); is_deeply( [ test2( 2, 3 ) ], [ 5 ], 'happy path, list context' ); is( do { test2( 2, 3 ); 1 }, 1, 'happy path, void context' ); ok( exception { scalar( test2( 2.1, 3 ) ) }, 'bad path, scalar context' ); ok( exception { [ test2( 2.1, 3 ) ] }, 'bad path, list context' ); ok( !exception { do { test2( 2.1, 3 ); 1 } }, 'bad path, void context' ); }; subtest "Per-context return types" => sub { signature_for test3 => ( pos => [ Num ], returns_scalar => Int, returns_list => HashRef[ Int ], ); sub test3 { my ( $x ) = @_; wantarray ? ( foo => $x ) : $x; } is( scalar( test3( 5 ) ), 5, 'happy path, scalar context' ); is_deeply( [ test3( 5 ) ], [ foo => 5 ], 'happy path, list context' ); is( do { test3( 5 ); 1 }, 1, 'happy path, void context' ); ok( exception { scalar( test3( 5.1 ) ) }, 'bad path, scalar context' ); ok( exception { [ test3( 5.1 ) ] }, 'bad path, list context' ); ok( !exception { do { test3( 5.1 ); 1 } }, 'bad path, void context' ); }; subtest "Multi + return types" => sub { my $T = signature_for test4 => ( multi => [ [Int], [Num] ], returns => Int, ); sub test4 { shift; } ok( !exception { my $z = test4( 1 ) } ); ok( exception { my $z = test4( 1.1 ) } ); ok( !exception { test4( 1.1 ); undef; } ); }; subtest "Simple return type, but stringy types" => sub { signature_for test5 => ( pos => [ 'Num', 'Num' ], returns => 'Int', ); sub test5 { my ( $x, $y ) = @_; return $x + $y; } is( scalar( test5( 2, 3 ) ), 5, 'happy path, scalar context' ); is_deeply( [ test5( 2, 3 ) ], [ 5 ], 'happy path, list context' ); is( do { test5( 2, 3 ); 1 }, 1, 'happy path, void context' ); ok( exception { scalar( test5( 2.1, 3 ) ) }, 'bad path, scalar context' ); ok( exception { [ test5( 2.1, 3 ) ] }, 'bad path, list context' ); ok( !exception { do { test5( 2.1, 3 ); 1 } }, 'bad path, void context' ); }; done_testing; v2-shortcuts.t000664001750001750 320315111656240 21455 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test C and C shortcuts. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw( Num ScalarRef ); use Type::Params qw( signature_for_func ); signature_for_func add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], named_to_list => 1, ); sub add_to_ref { my ( $ref, $add ) = @_; $$ref += $add; } ok( exception { signature_for_func( 'zzz', {} ) }, 'wrong number of parameters' ); { my $sum = 0; add_to_ref( ref => \$sum, add => 1 ); add_to_ref( \$sum, 2 ); add_to_ref( 3, \$sum ); add_to_ref( 4, { -ref => \$sum } ); is $sum, 10; } { package Local::Calculator; use Types::Standard qw( Num ScalarRef ); use Type::Params qw( signature_for_method ); sub new { my $class = shift; return bless {}, $class; } signature_for_method add_to_ref => ( named => [ ref => ScalarRef[Num], add => Num ], named_to_list => 1, ); sub add_to_ref { my ( $self, $ref, $add ) = @_; $$ref += $add; } ::ok( ::exception { signature_for_method( 'zzz', {} ) }, 'wrong number of parameters' ); } { my $calc = Local::Calculator->new; my $sum = 0; $calc->add_to_ref( ref => \$sum, add => 1 ); $calc->add_to_ref( \$sum, 2 ); $calc->add_to_ref( 3, \$sum ); $calc->add_to_ref( 4, { -ref => \$sum } ); is $sum, 10; } done_testing; v2-warnings.t000664001750001750 425715111656240 21261 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Tests warnings from Type::Params. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Test::Warnings'; use Test::Warnings 'warning', 'warnings'; use Types::Common -sigs, -types; { my $sig; my $w = warning { $sig = signature( package => __PACKAGE__, subname => 'test', positional => [ ArrayRef, { default => sub { [ 1 .. 4 ] } }, Slurpy[ArrayRef], { default => sub { [ 1 .. 4 ] } }, ], ); }; like $w, qr/default for the slurpy parameter will be ignored/i, 'correct warning'; is ref($sig), 'CODE', 'compilation succeeded'; is_deeply( [ $sig->( [ 'a' .. 'z' ] ) ], [ [ 'a' .. 'z' ], [] ], 'correct signature behaviour', ); } { my $sig; my @w = warnings { $sig = signature( package => __PACKAGE__, subname => 'test2', multi => [ { positional => [ ArrayRef, ArrayRef, { default => sub { [ 1 .. 4 ] }, bad1 => 1 }, ], bad2 => 2, }, { named => [ foo => ArrayRef, bar => ArrayRef, ], bad3 => 3, }, { named => [ Foo => ArrayRef, Bar => ArrayRef, ], }, ], bad4 => 4, ); }; # No guarantees about what order they happen in! @w = sort @w; ok @w == 5 or diag explain( \@w ); like $w[0], qr/^Warning: unrecognized parameter option: bad1, continuing anyway/, 'warning for parameter'; like $w[1], qr/^Warning: unrecognized signature option: bad4, continuing anyway/, 'warning for outer signature'; like $w[2], qr/^Warning: unrecognized signature option: bad4, continuing anyway/, 'warning for third nested signature'; like $w[3], qr/^Warning: unrecognized signature options: bad2 and bad4, continuing anyway/, 'warning for first nested signature'; like $w[4], qr/^Warning: unrecognized signature options: bad3 and bad4, continuing anyway/, 'warning for second nested signature'; } done_testing; v2-wrap-inherited-method.t000664001750001750 200015111656240 23611 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Check that Type::Params v2 C can find methods to wrap using inheritance. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Local::Base; sub new { my $class = shift; bless [], $class; } sub add_nums { return $_[1] + $_[2]; } } { package Local::Derived; use Types::Common -sigs, -types; our @ISA = 'Local::Base'; signature_for add_nums => ( method => 1, positional => [ Int, Int ], ); } my $o = Local::Derived->new; is( $o->add_nums( 2, 40 ), 42 ); like( exception { $o->add_nums( 40.6, 1.6 ) }, qr/did not pass type constraint "Int"/, ); my $o2 = Local::Base->new; is( int( $o2->add_nums( 40.6, 1.6 ) ), 42, ); done_testing; wrap.t000664001750001750 726715111656240 20061 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params=pod =encoding utf-8 =head1 PURPOSE Test C and C from L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; { package Local::Test1; use Types::Standard qw( Str Int Num ArrayRef ); use Type::Params qw( wrap_subs wrap_methods compile_named ); sub abc { return @_; } sub xyz { return @_; } wrap_subs( abc => [Int, Int, Int], uvw => [Str], # wraps sub {} xyz => compile_named({ subname => 'xyz' }, x => Int, y => Int, z => Int), ); } subtest "simple use of wrap_subs" => sub { is_deeply( [ Local::Test1::abc(1, 2, 3) ], [ 1, 2, 3 ], ); is_deeply( [Local::Test1::uvw('hello world')], [], ); is_deeply( [ Local::Test1::xyz(x => 1, y => 2, z => 3) ], [{ x => 1, y => 2, z => 3 }], ); my $e = exception { Local::Test1::abc(1, 2), }; like($e, qr/Wrong number of parameters/); $e = exception { Local::Test1::uvw({}), }; like($e, qr/Reference \{\} did not pass type constraint "Str" \(in \$_\[0]\)/); $e = exception { Local::Test1::xyz(x => 1, y => 2, z => []), }; like($e, qr/Reference \[\] did not pass type constraint "Int" \(in \$_\{"z"\}\)/); }; { package Local::Test2; use Types::Standard qw( Str Int Num ArrayRef ); use Type::Params qw( wrap_subs wrap_methods compile_named ); sub abc { return @_; } sub def { return @_; } sub xyz { return @_; } wrap_methods( abc => [Int, Int, Int], uvw => [Str], # wraps sub {} xyz => compile_named({ subname => 'xyz' }, x => Int, y => Int, z => Int), ); } subtest "simple use of wrap_methods" => sub { is_deeply( [ Local::Test2->abc(1, 2, 3) ], [ 'Local::Test2', 1, 2, 3 ], ); is_deeply( [ Local::Test2->uvw('hello world') ], [], ); is_deeply( [ Local::Test2->xyz(x => 1, y => 2, z => 3) ], [ 'Local::Test2', { x => 1, y => 2, z => 3 }], ); my $e = exception { Local::Test2->abc(1, 2), }; like($e, qr/Wrong number of parameters/); $e = exception { Local::Test2->uvw({}), }; like($e, qr/Reference \{\} did not pass type constraint "Str" \(in \$_\[1]\)/); $e = exception { Local::Test2->xyz(x => 1, y => 2, z => []), }; like($e, qr/Reference \[\] did not pass type constraint "Int" \(in \$_\{"z"\}\)/); }; { package Local::Test3; our @ISA = 'Local::Test2'; use Types::Standard qw( Str Int Num ArrayRef ); use Type::Params qw( wrap_subs wrap_methods compile_named ); my $Even = Int->where(q{ $_ % 2 == 0 }); wrap_methods( abc => [$Even, $Even, $Even], def => [Num], # inherited ); } subtest "wrap_methods with inheritance" => sub { is_deeply( [ Local::Test3->abc(2, 4, 6) ], [ 'Local::Test3', 2, 4, 6 ], ); is_deeply( [ Local::Test3->def(3.1) ], [ 'Local::Test3', 3.1 ], ); is_deeply( [ Local::Test3->uvw('hello world') ], [], ); is_deeply( [ Local::Test3->xyz(x => 1, y => 2, z => 3) ], [ 'Local::Test3', { x => 1, y => 2, z => 3 }], ); my $e = exception { Local::Test3->abc(1, 2, 2), }; like($e, qr/Value "1" did not pass type constraint \(in \$_\[1\]\)/); $e = exception { Local::Test3->def({}), }; like($e, qr/Reference \{\} did not pass type constraint "Num" \(in \$_\[1]\)/); $e = exception { Local::Test3->uvw({}), }; like($e, qr/Reference \{\} did not pass type constraint "Str" \(in \$_\[1]\)/); $e = exception { Local::Test3->xyz(x => 1, y => 2, z => []), }; like($e, qr/Reference \[\] did not pass type constraint "Int" \(in \$_\{"z"\}\)/); }; done_testing; basic.t000664001750001750 242615111656240 22120 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Params-Signature=pod =encoding utf-8 =head1 PURPOSE Basic tests that C<< Type::Params::Signature->new_from_compile >> works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Type::Params::Signature; my $sig = 'Type::Params::Signature'->new_from_compile( named => ( { head => [ Any ], quux => 123 }, { quux => 'xyzzy' }, foo => Int, { quux => 123 }, bar => Str, ), ); is( $sig->{quux}, 'xyzzy' ); ok( not $sig->head->[0]->has_name ); ok( $sig->head->[0]->has_type ); is( $sig->head->[0]->name, undef ); is( $sig->head->[0]->type, Any ); ok( $sig->has_parameters ); is( scalar( @{ $sig->parameters } ), 2 ); ok( $sig->parameters->[0]->has_name ); ok( $sig->parameters->[0]->has_type ); is( $sig->parameters->[0]->name, 'foo' ); is( $sig->parameters->[0]->type, Int ); is( $sig->parameters->[0]->{quux}, 123 ); ok( $sig->parameters->[1]->has_name ); ok( $sig->parameters->[1]->has_type ); is( $sig->parameters->[1]->name, 'bar' ); is( $sig->parameters->[1]->type, Str ); done_testing; basic.t000664001750001750 1734315111656240 20216 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Parser=pod =encoding utf-8 =head1 PURPOSE Checks Type::Parser works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; use Type::Parser qw( _std_eval parse extract_type ); use Types::Standard qw( -types slurpy ); use Type::Utils; sub types_equal { my ($a, $b) = map { ref($_) ? $_ : _std_eval($_) } @_[0, 1]; my ($A, $B) = map { $_->inline_check('$X') } ($a, $b); my $msg = "$_[0] eq $_[1]"; $msg = "$msg - $_[2]" if $_[2]; @_ = ($A, $B, $msg); goto \&Test::More::is; } note "Basics"; types_equal("Int", Int); types_equal("(Int)", Int, "redundant parentheses"); types_equal("((((Int))))", Int, "many redundant parentheses"); note "Class types"; types_equal("DateTime::", InstanceOf["DateTime"]); types_equal("InstanceOf['DateTime']", InstanceOf["DateTime"]); types_equal("Tied[Foo::]", Tied["Foo"]); types_equal("Tied['Foo']", Tied["Foo"]); note "Parameterization"; types_equal("Int[]", Int, "empty parameterization against non-parameterizable type"); types_equal("Tuple[]", Tuple[], "empty parameterization against parameterizble type"); types_equal("ArrayRef[]", ArrayRef, "empty parameterization against parameterizable type"); types_equal("ArrayRef[Int]", ArrayRef[Int], "parameterized type"); types_equal("Overload[15]", Overload[15], "numeric parameter (decimal integer)"); types_equal("Overload[0x0F]", Overload[15], "numeric parameter (hexadecimal integer)"); types_equal("Overload[0x0f]", Overload[15], "numeric parameter (hexadecimal integer, lowercase)"); types_equal("Overload[-0xF]", Overload[-15], "numeric parameter (hexadecimal integer, negative)"); types_equal("Overload[1.5]", Overload[1.5], "numeric parameter (float)"); types_equal("Ref['HASH']", Ref['HASH'], "string parameter (singles)"); types_equal("Ref[\"HASH\"]", Ref['HASH'], "string parameter (doubles)"); types_equal("Ref[q(HASH)]", Ref['HASH'], "string parameter (q)"); types_equal("Ref[qq(HASH)]", Ref['HASH'], "string parameter (qq)"); types_equal("StrMatch[qr{foo}]", StrMatch[qr{foo}], "regexp parameter"); # No, Overload[15] doesn't make much sense, but it's one of the few types in # Types::Standard that accept pretty much any list of strings as parameters. note "Unions"; types_equal("Int|HashRef", Int|HashRef); types_equal("Int|HashRef|ArrayRef", Int|HashRef|ArrayRef); types_equal("ArrayRef[Int|HashRef]", ArrayRef[Int|HashRef], "union as a parameter"); types_equal("ArrayRef[Int|HashRef[Int]]", ArrayRef[Int|HashRef[Int]]); types_equal("ArrayRef[HashRef[Int]|Int]", ArrayRef[HashRef([Int]) | Int]); note "Intersections"; types_equal("Int&Num", Int & Num); types_equal("Int&Num&Defined", Int & Num & Defined); types_equal("ArrayRef[Int]&Defined", (ArrayRef[Int]) & Defined); note "Union + Intersection"; types_equal("Int&Num|ArrayRef", (Int & Num) | ArrayRef); types_equal("(Int&Num)|ArrayRef", (Int & Num) | ArrayRef); types_equal("Int&(Num|ArrayRef)", Int & (Num | ArrayRef)); types_equal("Int&Num|ArrayRef&Ref", intersection([Int, Num]) | intersection([ArrayRef, Ref])); note "Complementary types"; types_equal("~Int", ~Int); types_equal("~ArrayRef[Int]", ArrayRef([Int])->complementary_type); types_equal("~Int|CodeRef", (~Int)|CodeRef); types_equal("~(Int|CodeRef)", ~(Int|CodeRef), 'precedence of "~" versus "|"'); note "Comma"; types_equal("Map[Num,Int]", Map[Num,Int]); types_equal("Map[Int,Num]", Map[Int,Num]); types_equal("Map[Int,Int|ArrayRef[Int]]", Map[Int,Int|ArrayRef[Int]]); types_equal("Map[Int,ArrayRef[Int]|Int]", Map[Int,ArrayRef([Int])|Int]); types_equal("Dict[foo=>Int,bar=>Num]", Dict[foo=>Int,bar=>Num]); types_equal("Dict['foo'=>Int,'bar'=>Num]", Dict[foo=>Int,bar=>Num]); types_equal("Dict['foo',Int,'bar',Num]", Dict[foo=>Int,bar=>Num]); note "Slurpy"; types_equal("Dict[slurpy=>Int,bar=>Num]", Dict[slurpy=>Int,bar=>Num]); types_equal("Tuple[Str, Int, slurpy ArrayRef[Int]]", Tuple[Str, Int, slurpy ArrayRef[Int]]); types_equal("Tuple[Str, Int, slurpy(ArrayRef[Int])]", Tuple[Str, Int, slurpy ArrayRef[Int]]); note "Complexity"; types_equal( "ArrayRef[DateTime::]|HashRef[Int|DateTime::]|CodeRef", ArrayRef([InstanceOf["DateTime"]]) | HashRef([Int|InstanceOf["DateTime"]]) | CodeRef ); types_equal( "ArrayRef [DateTime::] |HashRef[ Int|\tDateTime::]|CodeRef ", ArrayRef([InstanceOf["DateTime"]]) | HashRef([Int|InstanceOf["DateTime"]]) | CodeRef, "gratuitous whitespace", ); note "Bad expressions"; like( exception { _std_eval('%hello') }, qr{^Unexpected token in primary type expression; got '%hello'}, 'weird token' ); like( exception { _std_eval('Str Int') }, qr{^Unexpected tail on type expression: Int}, 'weird stuff 1' ); like( exception { _std_eval('ArrayRef(Int)') }, qr{^Unexpected tail on type expression: .Int.}, 'weird stuff 2' ); note "Tail retention"; my ($ast, $remaining) = parse("ArrayRef [DateTime::] |HashRef[ Int|\tDateTime::]|CodeRef monkey nuts "); is($remaining, " monkey nuts ", "remainder is ok"); ($ast, $remaining) = parse("Int, Str"); is($remaining, ", Str", "comma can indicate beginning of remainder"); require Type::Registry; my $type; my $reg = Type::Registry->new; $reg->add_types( -Standard ); ($type, $remaining) = extract_type('ArrayRef [ Int ] yah', $reg); types_equal($type, ArrayRef[Int], 'extract_type works'); like($remaining, qr/\A\s?yah\z/, '... and provides proper remainder too'); note "Parsing edge cases"; is_deeply( scalar parse('Xyzzy[Foo]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Foo' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[Foo] - parameter is treated as a type constraint' ); is_deeply( scalar parse('Xyzzy["Foo"]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'QUOTELIKE', '"Foo"' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy["Foo"] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[-100]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '-100' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[-100] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[200]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '200' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[200] - parameter is treated as a string' ); is_deeply( scalar parse('Xyzzy[+20.0]'), { 'type' => 'parameterized', 'base' => { 'type' => 'primary', 'token' => bless( [ 'TYPE', 'Xyzzy' ], 'Type::Parser::Token' ), }, 'params' => { 'type' => 'list', 'list' => [ { 'type' => 'primary', 'token' => bless( [ 'STRING', '+20.0' ], 'Type::Parser::Token' ), } ], }, }, 'Xyzzy[+20.0] - parameter is treated as a string' ); done_testing; moosextypes.t000664001750001750 176215111656240 21512 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Parser=pod =encoding utf-8 =head1 PURPOSE Checks Type::Parser can pick up MooseX::Types type constraints. =head1 DEPENDENCIES Requires L 2.0201 and L 0.001004; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'Moose' => '2.0201' }; use Test::Requires { 'MooseX::Types::Common' => '0.001004' }; use Test::TypeTiny; use Test::Fatal; use Type::Parser qw(_std_eval parse); use Types::Standard qw(-types slurpy); use Type::Utils; my $type = _std_eval("ArrayRef[MooseX::Types::Common::Numeric::PositiveInt]"); should_pass([1,2,3], $type); should_pass([], $type); should_fail([1,-2,3], $type); done_testing; automagic.t000664001750001750 145415111656240 21436 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry->for_class is automagically populated. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Types::Common::Numeric PositiveOrZeroInt => { -as => 'NonNegativeInt' }; ok( !$INC{'Type/Registry.pm'}, 'Type::Registry is not automatically loaded', ); require Type::Registry; my $reg = Type::Registry->for_me; ok( $reg->lookup('NonNegativeInt') == NonNegativeInt, 'Type::Registry was auto-populated', ); done_testing; basic.t000664001750001750 634215111656240 20547 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; { package Local::Pkg1; use Type::Registry "t"; ::is(t(), Type::Registry->for_me, 'Type::Registry->for_me works'); ::is(t(), Type::Registry->for_class(__PACKAGE__), 'Type::Registry->for_class works'); t->add_types(-Standard); ::like( ::exception { t->add_types(-MonkeyNutsAndChimpanzeeRaisins) }, qr{^Types::MonkeyNutsAndChimpanzeeRaisins is not a type library}, 'cannot add non-existant type library to registry', ); t->alias_type(Int => "Integer"); ::like( ::exception { t->alias_type(ChimpanzeeRaisins => "ChimpSultanas") }, qr{^Expected existing type constraint name}, 'cannot alias non-existant type in registry', ); ::ok(t->Integer == Types::Standard::Int(), 'alias works'); ::ok(t("Integer") == Types::Standard::Int(), 'alias works via simple_lookup'); ::ok(t("Integer[]") == Types::Standard::Int(), 'alias works via lookup'); } { package Local::Pkg2; use Type::Registry "t"; t->add_types(-Standard => [ -types => { -prefix => 'XYZ_' } ]); ::ok(t->XYZ_Int == Types::Standard::Int(), 'prefix works'); } ok( exception { Local::Pkg2::t->lookup("Integer") }, 'type registries are separate', ); my $no_e = exception { do { my $obj = Type::Registry->new; }; # DESTROY called }; is($no_e, undef, 'DESTROY does not cause problems'); my $r = Type::Registry->for_class("Local::Pkg1"); should_pass([1, 2, 3], $r->lookup("ArrayRef[Integer]")); should_fail([1, 2, 3.14159], $r->lookup("ArrayRef[Integer]")); like( exception { $r->lookup('%foo') }, qr{^Unexpected token in primary type expression; got '\%foo'}, 'type constraint invalid syntax', ); like( exception { $r->lookup('MonkeyNuts') }, qr{^MonkeyNuts is not a known type constraint }, 'type constraint unknown type', ); like( exception { $r->MonkeyNuts }, qr{^Can't locate object method "MonkeyNuts" via package}, 'type constraint unknown type (as method call)', ); is( $r->lookup('MonkeyNuts::')->class, 'MonkeyNuts', 'class type', ); require Type::Tiny::Enum; $r->add_type('Type::Tiny::Enum'->new(values => [qw/Monkey Nuts/]), 'MonkeyNuts'); my $mn = $r->lookup('MonkeyNuts'); should_pass('Monkey', $mn); should_pass('Nuts', $mn); should_fail('Cashews', $mn); use Type::Utils qw(dwim_type role_type class_type); is( dwim_type('MonkeyNuts')->class, 'MonkeyNuts', 'DWIM - class type', ); is( dwim_type('MonkeyNuts', does => 1)->role, 'MonkeyNuts', 'DWIM - role type', ); is( dwim_type('ArrayRef[MonkeyNuts | Foo::]', does => 1)->inline_check('$X'), Types::Standard::ArrayRef()->parameterize(role_type({role=>"MonkeyNuts"}) | class_type({class=>"Foo"}))->inline_check('$X'), 'DWIM - complex type', ); my $reg = Type::Registry->new; $reg->add_types(qw/ -Common::Numeric -Common::String /); ok exists $reg->{'NonEmptyStr'}; ok exists $reg->{'PositiveInt'}; done_testing; methods.t000664001750001750 356015111656240 21130 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks various newish Type::Registry method calls. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; use Type::Registry qw( t ); use Types::Standard -types; sub types_equal { my ($a, $b) = map { ref($_) ? $_ : do { require Type::Parser; Type::Parser::_std_eval($_) } } @_[0, 1]; my ($A, $B) = map { $_->inline_check('$X') } ($a, $b); my $msg = "$_[0] eq $_[1]"; $msg = "$msg - $_[2]" if $_[2]; @_ = ($A, $B, $msg); goto \&Test::More::is; } t->add_types( -Standard ); types_equal( t->make_class_type("Foo"), InstanceOf["Foo"], 't->make_class_type', ); types_equal( t->make_role_type("Foo"), ConsumerOf["Foo"], 't->make_role_type', ); types_equal( t->make_union(t->ArrayRef, t->Int), ArrayRef|Int, 't->make_union', ); types_equal( t->make_intersection(t->ArrayRef, t->Int), ArrayRef() &+ Int(), 't->make_intersection', ); my $type = t->foreign_lookup('Types::Common::Numeric::PositiveInt'); should_pass(420, $type); should_fail(-42, $type); t->add_type($type); should_pass(420, t->PositiveInt); should_fail(-42, t->PositiveInt); t->add_type($type, 'PossyWossy1'); should_pass(420, t->PossyWossy1); should_fail(-42, t->PossyWossy1); t->add_type($type->create_child_type, 'PossyWossy2'); should_pass(420, t->PossyWossy2); should_fail(-42, t->PossyWossy2); like( exception { t->add_type($type->create_child_type) }, qr/^Expected named type constraint; got anonymous type constraint/, 'cannot add an anonymous type without giving it an alias', ); done_testing; moosextypes.t000664001750001750 217615111656240 22066 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry works with MooseX::Types. =head1 DEPENDENCIES Requires L 2.0201 and L 0.001004; kipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'Moose' => '2.0201' }; use Test::Requires { 'MooseX::Types::Common' => '0.001004' }; use Test::TypeTiny; use Test::Fatal; use Type::Registry 't'; t->add_types(-Standard); my $ucstrs = t->lookup('ArrayRef[MooseX::Types::Common::String::UpperCaseStr]'); should_pass([], $ucstrs); should_pass(['FOO', 'BAR'], $ucstrs); should_fail(['FOO', 'Bar'], $ucstrs); t->add_types('MooseX::Types::Common::Numeric'); should_pass(8, t->SingleDigit); should_pass(9, t->SingleDigit); should_fail(10, t->SingleDigit); should_pass(10, t->PositiveInt); done_testing; mousextypes.t000664001750001750 206615111656240 22072 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry works with MouseX::Types. =head1 DEPENDENCIES Requires L 0.001000; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'MouseX::Types::Common' => '0.001000' }; use Test::TypeTiny; use Test::Fatal; use Type::Registry 't'; t->add_types(-Standard); my $nestr = t->lookup('ArrayRef[MouseX::Types::Common::String::NonEmptyStr]'); should_pass([], $nestr); should_pass(['FOO', 'BAR'], $nestr); should_fail(['FOO', ''], $nestr); t->add_types('MouseX::Types::Common::Numeric'); should_pass(8, t->SingleDigit); should_pass(9, t->SingleDigit); should_fail(10, t->SingleDigit); should_pass(10, t->PositiveInt); done_testing; parent.t000664001750001750 225615111656240 20757 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Check the Type::Registrys can have parents. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; use Types::Standard; { package Local::Pkg1; use Type::Registry "t"; t->add_type(Types::Standard::Int); t->alias_type( 'Int' => 'Integer' ); } { package Local::Pkg2; use Type::Registry "t"; t->add_type(Types::Standard::ArrayRef); t->alias_type( 'ArrayRef' => 'List' ); t->set_parent( 'Local::Pkg1' ); } my $reg = Type::Registry->for_class('Local::Pkg2'); my $type = $reg->lookup('List[Integer]'); should_pass([1,2,3], $type); should_fail([1,2,3.1], $type); $reg->clear_parent; ok ! $reg->get_parent; my $e = exception { $reg->lookup('List[Integer]'); }; like( $e, qr/Integer is not a known type constraint/, 'after clearing parent, do not know parent registry types' ); done_testing; refcount.t000664001750001750 136115111656240 21307 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Registry=pod =encoding utf-8 =head1 PURPOSE Checks Type::Registry refcount stuff. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Devel::Refcount'; use Devel::Refcount 'refcount'; use Types::Standard qw( Int ); use Type::Registry; my $orig_count = refcount( Int ); note "COUNT: $orig_count"; { my $reg = Type::Registry->new; $reg->add_types(qw/ -Standard /); is refcount( Int ), 1 + $orig_count; } is refcount( Int ), $orig_count; done_testing; 01basic.t000664001750001750 425715111656240 17624 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie compiles and seems to work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Tie; use Types::Standard qw( Int Num ); ttie my $count, Int, 0; is( tied($count)->type, Int ); $count++; is($count, 1); $count = 2; is($count, 2); like( exception { $count = "Monkey!" }, qr{^Value "Monkey!" did not pass type constraint "Int"}, ); is( scalar( @{ tied($count) } ), Type::Tie::BASE::_NEXT_SLOT(), '_NEXT_SLOT', ); ttie my @numbers, Int, 1, 2, 3; unshift @numbers, 0; $numbers[4] = 4; push @numbers, scalar @numbers; is_deeply( \@numbers, [ 0..5 ], ); like( exception { push @numbers, 1, 2, 3, "Bad", 4 }, qr{^Value "Bad" did not pass type constraint "Int"}, ); like( exception { unshift @numbers, 1, 2, 3, "Bad", 4 }, qr{^Value "Bad" did not pass type constraint "Int"}, ); like( exception { $numbers[2] .= "Bad" }, qr{^Value "2Bad" did not pass type constraint "Int"}, ); is_deeply( \@numbers, [ 0..5 ], ); splice @numbers, 1, 0, 999, 666; like( exception { splice @numbers, 1, 0, "Foo", "Bar"; }, qr{^Value "Foo" did not pass type constraint "Int"}, ); is_deeply( \@numbers, [ 0, 999, 666, 1..5 ], ); shift @numbers for 0..2; pop @numbers; is_deeply( \@numbers, [ 1..4 ], ); # These don't really make sense for arrays, so I don't care about the # results so much. Mostly just checking they don't throw an exception. is( exists($numbers[0]), exists( tied(@numbers)->_REF->[0] ) ); delete $numbers[0]; $#numbers = 3; ttie my %stuff, Int, foo => 1; $stuff{bar} = 2; is_deeply( \%stuff, { foo => 1, bar => 2 }, ); like( exception { $stuff{baz} = undef }, qr{^Undef did not pass type constraint "Int"}, ); delete $stuff{bar}; is_deeply( \%stuff, { foo => 1 }, ); # Just test this throws no exception. Don't really care what it # returns. scalar( %stuff ); done_testing; 02moosextypes.t000664001750001750 305615111656240 21137 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie seems to work with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires 'MooseX::Types::Moose'; use Type::Tie; use MooseX::Types::Moose qw( Int Num ); use Moose::Util::TypeConstraints; my $Rounded = Int->create_child_type; coerce($Rounded, from Num, via { int($_) }); ttie my $count, $Rounded, 0; $count++; is($count, 1); $count = 2; is($count, 2); $count = 3.14159; is($count, 3); like( exception { $count = "Monkey!" }, qr{^Validation failed}, ); ttie my @numbers, $Rounded, 1, 2, 3.14159; unshift @numbers, 0.1; $numbers[4] = 4.4; push @numbers, scalar @numbers; is_deeply( \@numbers, [ 0..5 ], ); like( exception { push @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Validation failed}, ); like( exception { unshift @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Validation failed}, ); like( exception { $numbers[2] .= "Bad" }, qr{^Validation failed}, ); is_deeply( \@numbers, [ 0..5 ], ); ttie my %stuff, Int, foo => 1; $stuff{bar} = 2; is_deeply( \%stuff, { foo => 1, bar => 2 }, ); like( exception { $stuff{baz} = undef }, qr{^Validation failed}, ); delete $stuff{bar}; is_deeply( \%stuff, { foo => 1 }, ); done_testing; 03prototypicalweirdness.t000664001750001750 114115111656240 23207 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that C prototype works. Test case suggested by Graham Knop (HAARG). =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tie; use Types::Standard qw( ArrayRef Num ); ttie my $foo, ArrayRef[Num], [1,2,3]; is_deeply( $foo, [1..3], ); done_testing; 04nots.t000664001750001750 427115111656240 17525 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie works with a home-made type constraint system conforming to L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Tie; use constant Int => do { package Local::Type::Int; sub DOES { return 1 if $_[1] eq "Type::API::Constraint"; return 1 if $_[1] eq "Type::API::Constraint::Coercible"; shift->SUPER::DOES(@_); } sub check { defined($_[1]) && $_[1] =~ /\A-?[0-9]+\z/; } sub get_message { defined($_[1]) ? "Value \"$_[1]\" does not meet type constraint Int" : "Undef does not meet type constraint Int" } my $x; bless \$x; }; use constant Rounded => do { package Local::Type::Rounded; our @ISA = 'Local::Type::Int'; sub has_coercion { 1; } sub coerce { defined($_[1]) && !ref($_[1]) && $_[1] =~ /\A[Ee0-9.-]+\z/ ? int($_[1]) : $_[1]; } my $x; bless \$x; }; ttie my $count, Rounded, 0; $count++; is($count, 1); $count = 2; is($count, 2); $count = 3.14159; is($count, 3); like( exception { $count = "Monkey!" }, qr{^Value "Monkey!" does not meet type constraint Int}, ); ttie my @numbers, Rounded, 1, 2, 3.14159; unshift @numbers, 0.1; $numbers[4] = 4.4; push @numbers, scalar @numbers; is_deeply( \@numbers, [ 0..5 ], ); like( exception { push @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Value "Bad" does not meet type constraint Int}, ); like( exception { unshift @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Value "Bad" does not meet type constraint Int}, ); like( exception { $numbers[2] .= "Bad" }, qr{^Value "2Bad" does not meet type constraint Int}, ); is_deeply( \@numbers, [ 0..5 ], ); ttie my %stuff, Int, foo => 1; $stuff{bar} = 2; is_deeply( \%stuff, { foo => 1, bar => 2 }, ); like( exception { $stuff{baz} = undef }, qr{^Undef does not meet type constraint Int}, ); delete $stuff{bar}; is_deeply( \%stuff, { foo => 1 }, ); done_testing; 05typetiny.t000664001750001750 305515111656240 20427 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie seems to work with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2018-2019, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Tie; use Types::Standard qw( Int Num ); ttie my $count, Int->plus_coercions(Num, 'int($_)'), 0; $count++; is($count, 1); $count = 2; is($count, 2); $count = 3.14159; is($count, 3); like( exception { $count = "Monkey!" }, qr{^Value "Monkey!" did not pass type constraint}, ); ttie my @numbers, Int->plus_coercions(Num, 'int($_)'), 1, 2, 3.14159; unshift @numbers, 0.1; $numbers[4] = 4.4; push @numbers, scalar @numbers; is_deeply( \@numbers, [ 0..5 ], ); like( exception { push @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Value "Bad" did not pass type constraint}, ); like( exception { unshift @numbers, 1, 2.2, 3, "Bad", 4 }, qr{^Value "Bad" did not pass type constraint}, ); like( exception { $numbers[2] .= "Bad" }, qr{^Value "2Bad" did not pass type constraint}, ); is_deeply( \@numbers, [ 0..5 ], ); ttie my %stuff, Int, foo => 1; $stuff{bar} = 2; is_deeply( \%stuff, { foo => 1, bar => 2 }, ); like( exception { $stuff{baz} = undef }, qr{^Undef did not pass type constraint}, ); delete $stuff{bar}; is_deeply( \%stuff, { foo => 1 }, ); done_testing; 06clone.t000664001750001750 213115111656240 17635 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie works with Clone::clone =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Clone'; use Test::Fatal; use Type::Tie; use Types::Standard qw( Int ); use Clone qw(clone); # Hashes ttie my %hash, Int; my $ref = \%hash; my $hashDclone = clone(\%hash); eval { $hashDclone->{a} = 1; }; ok(! $@); eval { $hashDclone->{a} = 'a'; }; ok($@); # Arrays ttie my @array, Int; my $arrayDclone = clone(\@array); eval { push @$arrayDclone, 1; }; ok(! $@); eval { push @$arrayDclone, 'a'; }; ok($@); # Scalar my $scalarContainer = [ '' ]; ttie $scalarContainer->[0], Int; my $scalarContainerDclone = clone($scalarContainer); eval { $scalarContainerDclone->[0] = 1; }; ok(! $@); eval { $scalarContainerDclone->[0] = 'a'; }; ok($@); done_testing(); 06storable.t000664001750001750 216215111656240 20354 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tie works with Storable::dclone =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Storable'; use Test::Fatal; use Type::Tie; use Types::Standard qw( Int ); use Storable qw(dclone); # Hashes ttie my %hash, Int; my $ref = \%hash; my $hashDclone = dclone(\%hash); eval { $hashDclone->{a} = 1; }; ok(! $@); eval { $hashDclone->{a} = 'a'; }; ok($@); # Arrays ttie my @array, Int; my $arrayDclone = dclone(\@array); eval { push @$arrayDclone, 1; }; ok(! $@); eval { push @$arrayDclone, 'a'; }; ok($@); # Scalar my $scalarContainer = [ '' ]; ttie $scalarContainer->[0], Int; my $scalarContainerDclone = dclone($scalarContainer); eval { $scalarContainerDclone->[0] = 1; }; ok(! $@); eval { $scalarContainerDclone->[0] = 'a'; }; ok($@); done_testing(); basic.t000664001750001750 237615111656240 17463 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test that this sort of thing works: tie my $var, Int; =head1 DEPENDENCIES Requires L; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard qw( ArrayRef Int ); use Test::Fatal; subtest "tied scalar" => sub { tie my($int), Int; is( exception { $int = 42 }, undef, ); isnt( exception { $int = 4.2 }, undef, ); is($int, 42); done_testing; }; subtest "tied array" => sub { tie my(@ints), Int; is( exception { $ints[0] = 1; push @ints, 2; unshift @ints, 0; }, undef, ); isnt( exception { $ints[3] = 3.5 }, undef, ); is_deeply( \@ints, [ 0..2 ], ); done_testing; }; subtest "tied hash" => sub { tie my(%ints), Int; is( exception { $ints{one} = 1; $ints{two} = 2; }, undef, ); isnt( exception { $ints{three} = 3.5 }, undef, ); is_deeply( \%ints, { one => 1, two => 2 }, ); done_testing; }; done_testing; very-minimal.t000664001750001750 146015111656240 21004 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tie=pod =encoding utf-8 =head1 PURPOSE Test Type::Tie with a very minimal object, with only a C method. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Tie; use Scalar::Util qw( looks_like_number ); sub Local::TypeConstraint::check { my $coderef = shift; &$coderef; }; my $Num = bless( sub { looks_like_number $_[0] }, 'Local::TypeConstraint', ); ttie my($x), $Num, 0; $x = 1; is $x, 1; like( exception { $x = 'Foo' }, qr/^Value "Foo" does not meet type constraint/, ); done_testing; arithmetic.t000664001750001750 1136015111656240 20746 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Tests overloading of bitwise operators and numeric comparison operators for L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard -all; my $var = 123; should_fail(\$var, ~ScalarRef); should_fail([], ~ArrayRef); should_fail(+{}, ~HashRef); should_fail(sub {0}, ~CodeRef); should_fail(\*STDOUT, ~GlobRef); should_fail(\(\"Hello"), ~Ref); should_fail(\*STDOUT, ~FileHandle); should_fail(qr{x}, ~RegexpRef); should_fail(1, ~Str); should_fail(1, ~Num); should_fail(1, ~Int); should_fail(1, ~Defined); should_fail(1, ~Value); should_fail(undef, ~Undef); should_fail(undef, ~Item); should_fail(undef, ~Any); should_fail('Type::Tiny', ~ClassName); should_fail('Type::Library', ~RoleName); should_fail(undef, ~Bool); should_fail('', ~Bool); should_fail(0, ~Bool); should_fail(1, ~Bool); should_pass(7, ~Bool); should_fail(\(\"Hello"), ~ScalarRef); should_pass('Type::Tiny', ~RoleName); should_pass([], ~Str); should_pass([], ~Num); should_pass([], ~Int); should_fail("4x4", ~Str); should_pass("4x4", ~Num); should_pass("4.2", ~Int); should_pass(undef, ~Str); should_pass(undef, ~Num); should_pass(undef, ~Int); should_pass(undef, ~Defined); should_pass(undef, ~Value); { package Local::Class1; use strict; } { no warnings 'once'; $Local::Class2::VERSION = 0.001; @Local::Class3::ISA = qw(UNIVERSAL); @Local::Dummy1::FOO = qw(UNIVERSAL); } { package Local::Class4; sub XYZ () { 1 } package Local::Class5; use constant XZY => 2 } should_pass(undef, ~ClassName); should_pass([], ~ClassName); should_fail("Local::Class$_", ~ClassName) for 2..5; should_pass("Local::Dummy1", ~ClassName); should_fail([], ~(ArrayRef[Int])); should_fail([1,2,3], ~(ArrayRef[Int])); should_pass([1.1,2,3], ~(ArrayRef[Int])); should_pass([1,2,3.1], ~(ArrayRef[Int])); should_pass([[]], ~(ArrayRef[Int])); should_fail([[3]], ~(ArrayRef[ArrayRef[Int]])); should_pass([["A"]], ~(ArrayRef[ArrayRef[Int]])); should_fail(undef, ~(Maybe[Int])); should_fail(123, ~(Maybe[Int])); should_pass(1.3, ~(Maybe[Int])); my $even = "Type::Tiny"->new( name => "Even", parent => Int, constraint => sub { !(abs($_) % 2) }, ); my $odd = "Type::Tiny"->new( name => "Even", parent => Int, constraint => sub { !!(abs($_) % 2) }, ); my $positive = "Type::Tiny"->new( name => "Positive", parent => Int, constraint => sub { $_ > 0 }, ); my $negative = "Type::Tiny"->new( name => "Negative", parent => Int, constraint => sub { $_ < 0 }, ); should_pass(-2, $even & $negative); should_pass(-1, $odd & $negative); should_pass(0, $even & ~$negative & ~$positive); should_pass(1, $odd & $positive); should_pass(2, $even & $positive); should_pass(3, $even | $odd); should_pass(4, $even | $odd); should_pass(5, $negative | $positive); should_pass(-6, $negative | $positive); should_fail(-3, $even & $negative); should_fail(1, $odd & $negative); should_fail(1, $even & ~$negative & ~$positive); should_fail(2, $odd & $positive); should_fail(1, $even & $positive); should_fail("Str", $even | $odd); should_fail(1.1, $even | $odd); should_fail(0, $negative | $positive); should_fail("Str", $negative | $positive); is( ($even & ~$negative & ~$positive)->display_name, "Even&~Negative&~Positive", "coolio stringification", ); ok(Item > Value, "Item > Value"); ok(Value > Str, "Value > Str"); ok(Str > Num, "Str > Num"); ok(Num > Int, "Num > Int"); ok(Int > $odd, "Int > \$odd"); ok(Item >= Value, "Item >= Value"); ok(Value >= Str, "Value >= Str"); ok(Str >= Num, "Str >= Num"); ok(Num >= Int, "Num >= Int"); ok(Int >= $odd, "Int >= \$odd"); ok(Value() < Item, "Value < Item"); ok(Str() < Value, "Str < Value"); ok(Num() < Str, "Num < Str"); ok(Int() < Num, "Int < Num"); ok($even < Int, "\$even < Int"); ok(Value() <= Item, "Value <= Item"); ok(Str() <= Value, "Str <= Value"); ok(Num() <= Str, "Num <= Str"); ok(Int() <= Num, "Int <= Num"); ok($even <= Int, "\$even < Int"); ok(not(Int > Int), "not(Int > Int)"); ok(not(Int() < Int), "not(Int < Int)"); ok(Int() <= Int, "Int <= Int"); ok(Int >= Int, "Int >= Int"); ok(not((ArrayRef[Int]) > (ArrayRef[Num])), 'not(ArrayRef[Int] > ArrayRef[Num])'); ok(not((ArrayRef[Int]) == (ArrayRef[Num])), 'not(ArrayRef[Int] == ArrayRef[Num])'); ok((ArrayRef[Int]) == (ArrayRef[Int]), 'ArrayRef[Int] == ArrayRef[Int]'); ok(not(ArrayRef == ArrayRef[Int]), 'not(ArrayRef == ArrayRef[Int])'); ok(ArrayRef > ArrayRef[Int], 'ArrayRef > ArrayRef[Int]'); done_testing; basic.t000664001750001750 1217615111656240 17704 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny; ok("Type::Tiny"->can('new'), 'Type::Tiny can works for valid methods'); ok( !"Type::Tiny"->can('will_never_be_a_method'), 'Type::Tiny can works for invalid methods' ); my $Any = "Type::Tiny"->new(name => "Any"); ok(!$Any->is_anon, "Any is not anon"); is($Any->name, "Any", "Any is called Any"); ok($Any->can_be_inlined, 'Any can be inlined'); should_pass($_, $Any) for 1, 1.2, "Hello World", [], {}, undef, \*STDOUT; like( exception { $Any->create_child_type(name => "1") }, qr{^"1" is not a valid type name}, "bad type constraint name", ); my $Int = $Any->create_child_type( constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, ); ok($Int->is_anon, "\$Int is anon"); is($Int->name, "__ANON__", "\$Int is called __ANON__"); ok(!$Int->can_be_inlined, '$Int cannot be inlined'); should_pass($_, $Int) for 1, -1, 0, 100, 10000, 987654; should_fail($_, $Int) for 1.2, "Hello World", [], {}, undef, \*STDOUT; ok_subtype($Any, $Int); ok($Any->is_supertype_of($Int), 'Any is_supertype_of $Int'); ok($Int->is_a_type_of($Any), '$Int is_a_type_of Any'); ok($Int->is_a_type_of($Int), '$Int is_a_type_of $Int'); ok(!$Int->is_subtype_of($Int), 'not $Int is_subtype_of $Int'); my $Below = $Int->create_child_type( name => "Below", constraint_generator => sub { my $param = shift; return sub { $_ < $param }; }, ); ok($Below->is_parameterizable, 'Below is_parameterizable'); ok(!$Below->is_parameterized, 'not Below is_parameterized'); should_pass($_, $Below) for 1, -1, 0, 100, 10000, 987654; should_fail($_, $Below) for 1.2, "Hello World", [], {}, undef, \*STDOUT; my $Below5 = $Below->parameterize(5); ok($Below5->is_anon, '$Below5 is anon'); is($Below5->display_name, 'Below[5]', '... but still has a nice display name'); should_pass($_, $Below5) for 1, -1, 0; should_fail($_, $Below5) for 1.2, "Hello World", [], {}, undef, \*STDOUT, 100, 10000, 987654; ok_subtype($_, $Below5) for $Any, $Int, $Below; ok($Below5->is_parameterized, 'Below[5] is_parameterized'); ok(!$Below->has_parameters, 'has_parameters method works - negative'); ok($Below5->has_parameters, 'has_parameters method works - positive'); is_deeply($Below5->parameters, [5], 'parameters method works'); my $Ref = "Type::Tiny"->new( name => "Ref", constraint => sub { ref($_) }, inlined => sub { "ref($_)" }, ); my $ArrayRef = "Type::Tiny"->new( name => "ArrayRef", parent => $Ref, constraint => sub { ref($_) eq 'ARRAY' }, inlined => sub { undef, "ref($_) eq 'ARRAY'" }, ); is( $ArrayRef->inline_check('$xxx'), q[(((ref($xxx))) && (ref($xxx) eq 'ARRAY'))], 'inlining stuff can return a list', ); use Types::Standard (); { my $subtype_of_Num = Types::Standard::Num->create_child_type; my $subtype_of_Int = Types::Standard::Int->create_child_type; ok( $subtype_of_Int->is_subtype_of( $subtype_of_Num ), 'loose subtype comparison 1', ); ok( ! $subtype_of_Int->is_strictly_subtype_of( $subtype_of_Num ), 'strict subtype comparison 1', ); ok( $subtype_of_Num->is_supertype_of( $subtype_of_Int ), 'loose supertype comparison 1', ); ok( ! $subtype_of_Num->is_strictly_supertype_of( $subtype_of_Int ), 'strict supertype comparison 1', ); ok( Types::Standard::Int->is_subtype_of( Types::Standard::Num ), 'loose subtype comparison 2', ); ok( Types::Standard::Int->is_strictly_subtype_of( Types::Standard::Num ), 'strict subtype comparison 2', ); ok( Types::Standard::Num->is_supertype_of( Types::Standard::Int ), 'loose supertype comparison 2', ); ok( Types::Standard::Num->is_strictly_supertype_of( Types::Standard::Int ), 'strict supertype comparison 2', ); } my $t1 = Types::Standard::Int; my $t2 = $t1->create_child_type(name => 'T2'); my $t3 = $t2->create_child_type(name => 'T3'); my $t4 = $t3->create_child_type(name => 'T4'); my $t5 = $t4->create_child_type(name => 'T5'); my $t6 = $t5->create_child_type(name => 'T6'); my $found = $t6->find_parent(sub { $_->has_parent and $_->parent->name eq 'Int' }); is($found->name, 'T2', 'find_parent (scalar context)'); my ($found2, $n2) = $t6->find_parent(sub { $_->has_parent and $_->parent->name eq 'Int' }); is($found2->name, 'T2', 'find_parent (list context)'); is($n2, 4, '... includes a count'); my ($found3, $n3) = $t6->find_parent(sub { $_->name eq 'Kristoff' }); is($found3, undef, 'find_parent (null result)'); is($3, undef, '... includes an undef count'); { my $Any = "Type::Tiny"->new(name => "Any"); my $Blah = $Any->create_child_type->create_child_type(constraint => sub { "yes" }); my $Bleh = $Blah->create_child_type(name => "Bleh")->create_child_type; is($Bleh->find_constraining_type->{uniq}, $Blah->{uniq}, 'find_constraining_type'); } done_testing; cmp.t000664001750001750 732215111656240 17357 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Test new type comparison stuff with Type::Tiny objects. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Type::Tiny; use Test::More; use Test::TypeTiny; my $string = Type::Tiny->new( constraint => sub { defined($_) && !ref($_) }, ); my $integer = $string->where(sub { /^-?[0-9]+$/ and not $_ eq '-0' }); my $natural = $integer->where(sub { $_ >= 0 }); my $digit = $natural->where(sub { $_ < 10 }); my $undef = Type::Tiny->new(constraint => sub { !defined }); my ($stringX, $integerX, $naturalX, $digitX) = map { $_->plus_coercions($undef, sub { 0 }); } ($string, $integer, $natural, $digit); ok_subtype($string => $integer, $natural, $digit, $stringX, $integerX, $naturalX, $digitX); ok_subtype($stringX => $string, $integer, $natural, $digit, $integerX, $naturalX, $digitX); ok_subtype($integer => $natural, $digit, $integerX, $naturalX, $digitX); ok_subtype($integerX => $integer, $natural, $digit, $naturalX, $digitX); ok_subtype($natural => $digit, $naturalX, $digitX); ok_subtype($naturalX => $natural, $digit, $digitX); ok_subtype($digit => $digitX); ok_subtype($digitX => $digit); ok !$string->is_a_type_of($undef); ok !$undef->is_a_type_of($string); ok !$digit->is_a_type_of($undef); ok !$undef->is_a_type_of($digit); ok !$stringX->is_a_type_of($undef); ok !$undef->is_a_type_of($stringX); ok !$digitX->is_a_type_of($undef); ok !$undef->is_a_type_of($digitX); is(Type::Tiny::cmp($string, $digit), Type::Tiny::CMP_SUPERTYPE); is(Type::Tiny::cmp($stringX, $digit), Type::Tiny::CMP_SUPERTYPE); is(Type::Tiny::cmp($string, $digitX), Type::Tiny::CMP_SUPERTYPE); is(Type::Tiny::cmp($stringX, $digitX), Type::Tiny::CMP_SUPERTYPE); is(Type::Tiny::cmp($digit, $string), Type::Tiny::CMP_SUBTYPE); is(Type::Tiny::cmp($digit, $stringX), Type::Tiny::CMP_SUBTYPE); is(Type::Tiny::cmp($digitX, $string), Type::Tiny::CMP_SUBTYPE); is(Type::Tiny::cmp($digitX, $stringX), Type::Tiny::CMP_SUBTYPE); is(Type::Tiny::cmp($string, $stringX), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($stringX, $string), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($digit, $digitX), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($digitX, $digit), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($string, $undef), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($stringX, $undef), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($undef, $string), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($undef, $stringX), Type::Tiny::CMP_UNKNOWN); my $type1 = Type::Tiny->new(constraint => '$_ eq "FLIBBLE"'); my $type2 = Type::Tiny->new(constraint => '$_ eq "FLIBBLE"'); my $type3 = Type::Tiny->new(constraint => '$_ eq "FLOBBLE"'); is(Type::Tiny::cmp($type1, $type2), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($type1, $type3), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($type2, $type1), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($type2, $type3), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($type3, $type1), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($type3, $type2), Type::Tiny::CMP_UNKNOWN); is(Type::Tiny::cmp($type1, $type2->create_child_type), Type::Tiny::CMP_EQUAL); is(Type::Tiny::cmp($type1, $type2->where(sub { 0 })), Type::Tiny::CMP_SUPERTYPE); { package MyBleh; use Type::Registry 't'; use Types::Standard -types; t->alias_type( Int => 'WholeNumber' ); my $child = Int->where( '$_ > 42' ); ::ok( $child->is_strictly_a_type_of(Int) ); ::ok( $child->is_strictly_a_type_of('Int') ); ::ok( $child->is_strictly_a_type_of('WholeNumber') ); } done_testing; coercion-modifiers.t000664001750001750 376415111656240 22366 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks C, C and C methods work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal qw(dies_ok); use BiggerLib -types; my $new_type = BigInteger->plus_coercions( HashRef, "999", Undef, sub { 666 }, ); my $arr = []; my $hash = {}; ok( $new_type->coercion->has_coercion_for_type(HashRef), 'has_coercian_for_type - obvious', ); ok( $new_type->coercion->has_coercion_for_type(HashRef[Num]), 'has_coercian_for_type - subtle', ); ok( not($new_type->coercion->has_coercion_for_type(Ref["CODE"])), 'has_coercian_for_type - negative', ); is($new_type->coerce($hash), 999, 'plus_coercions - added coercion'); is($new_type->coerce(undef), 666, 'plus_coercions - added coercion'); is($new_type->coerce(-1), 11, 'plus_coercions - retained coercion'); is($new_type->coerce($arr), 100, 'plus_coercions - retained coercion'); my $newer_type = $new_type->minus_coercions(ArrayRef, Undef); is($newer_type->coerce($hash), 999, 'minus_coercions - retained coercion'); is($newer_type->coerce(undef), undef, 'minus_coercions - removed coercion'); is($newer_type->coerce(-1), 11, 'minus_coercions - retained coercion'); is($newer_type->coerce($arr), $arr, 'minus_coercions - removed coercion'); my $no_coerce = $new_type->no_coercions; dies_ok { $no_coerce->coerce($hash) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce(undef) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce(-1) } 'no_coercions - removed coercion'; dies_ok { $no_coerce->coerce($arr) } 'no_coercions - removed coercion'; done_testing; constraint-strings.t000664001750001750 227415111656240 22454 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works accepts strings of Perl code as constraints. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Types::Standard -types; my $Str = Str->where( 'length($_) > 0' ); my $Arr = ArrayRef->where( '@$_ > 0' ); my $Hash = HashRef->where( 'keys(%$_) > 0' ); use Test::More; use Test::Fatal; is( exception { $Str->assert_valid( 'u' ) }, undef, 'non-empty string, okay', ); isa_ok( exception { $Str->assert_valid( '' ) }, 'Error::TypeTiny', 'result of empty string', ); is( exception { $Arr->assert_valid( [undef] ) }, undef, 'non-empty arrayref, okay', ); isa_ok( exception { $Arr->assert_valid( [] ) }, 'Error::TypeTiny', 'result of empty arrayref', ); is( exception { $Hash->assert_valid( { '' => undef } ) }, undef, 'non-empty hashref, okay', ); isa_ok( exception { $Hash->assert_valid( +{} ) }, 'Error::TypeTiny', 'result of empty hashref', ); done_testing; custom-exception-classes.t000664001750001750 207315111656240 23537 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Test Type::Tiny's C attribute. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard qw( Int ); { package Custom::Exception; use base 'Error::TypeTiny::Assertion'; } my $type1 = Int->create_child_type( constraint => q{ $_ > 3 }, exception_class => 'Custom::Exception', ); my $type2 = $type1->create_child_type( constraint => q{ $_ < 5 }, ); $type1->assert_valid( 4 ); $type2->assert_valid( 4 ); { my $e = exception { $type1->assert_valid( 2 ); }; isa_ok( $e, 'Custom::Exception' ); } { my $e = exception { $type2->assert_valid( 6 ); }; isa_ok( $e, 'Custom::Exception' ); } # The inlined code includes the exception_class. note( $type2->inline_assert( '$value' ) ); done_testing; definition-context.t000664001750001750 134515111656240 22411 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks the C method. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Common qw( -types t ); use Type::Utils; # line 31 "definition-context.t" declare 'SmallInt', as Int, where { $_ >= 0 and $_ < 10 }; is_deeply( t->SmallInt->definition_context, { 'package' => 'main', 'line' => 31, 'file' => 'definition-context.t', }, 'expected definition context', ); done_testing; deprecation.t000664001750001750 174115111656240 21074 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny's C attribute works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny; my $t1 = Type::Tiny->new(name => "Base"); my $t2 = Type::Tiny->new(name => "Derived_1", parent => $t1); my $t3 = Type::Tiny->new(name => "Derived_2", parent => $t1, deprecated => 1); my $t4 = Type::Tiny->new(name => "Double_Derived_1", parent => $t3); my $t5 = Type::Tiny->new(name => "Double_Derived_2", parent => $t3, deprecated => 0); ok not $t1->deprecated; ok not $t2->deprecated; ok $t3->deprecated; ok $t4->deprecated; ok not $t5->deprecated; done_testing; esoteric.t000664001750001750 620615111656240 20415 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks various undocumented Type::Tiny methods. The fact that these are tested here should not be construed to mean tht they are any any way a stable, supported part of the Type::Tiny API. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny; use Types::Standard -types; is_deeply( Int->inline_environment, {}, '$type->inline_environment', ); my $check = Int->_inline_check('$foo'); ok( eval("my \$foo = 42; $check") && !eval("my \$foo = 4.2; $check"), '$type->_inline_check', ); ok( Int->_compiled_type_constraint->("42") && !Int->_compiled_type_constraint->("4.2"), '$type->_compiled_type_constraint', ); like( exception { Any->meta }, qr/^Not really a Moose::Meta::TypeConstraint/, '$type->meta', ); ok( Int->compile_type_constraint->("42") && !Int->compile_type_constraint->("4.2"), '$type->compile_type_constraint', ); ok( Int->_actually_compile_type_constraint->("42") && !Int->_actually_compile_type_constraint->("4.2"), '$type->_actually_compile_type_constraint', ); is( Int->hand_optimized_type_constraint, undef, '$type->hand_optimized_type_constraint', ); ok( !Int->has_hand_optimized_type_constraint, '$type->has_hand_optimized_type_constraint', ); ok( (ArrayRef[Int])->__is_parameterized && !Int->__is_parameterized, '$type->__is_parameterized', ); ok( (ArrayRef[Int])->has_parameterized_from && !Int->has_parameterized_from, '$type->has_parameterized_from', ); my $Int = Int->create_child_type; $Int->_add_type_coercions(Num, q[int($_)]); is( $Int->coerce(42.1), 42, '$type->_add_type_coercions', ); is( Int->_as_string, 'Types::Standard::Int', '$type->_as_string', ); like( Int->_stringify_no_magic, qr/^Type::Tiny=HASH\(0x[0-9a-f]+\)$/i, '$type->_stringify_no_magic', ); is( $Int->_compiled_type_coercion->(6.2), 6, '$type->_compiled_type_coercion', ); ok( Int->_identity != $Int->_identity, '$type->_identity', ); my $union = Int->_unite(ArrayRef); ok( $union->equals( Int | ArrayRef ), '$type->_unite', ); { package Type::Tiny::Subclass; our @ISA = qw( Type::Tiny ); sub assert_return { my ( $self ) = ( shift ); ++( $self->{ __PACKAGE__ . '::count' } ||= 0 ); $self->SUPER::assert_return( @_ ); } sub counter { my ( $self ) = ( shift ); $self->{ __PACKAGE__ . '::count' }; } } my $child = 'Type::Tiny::Subclass'->new( parent => Int, constraint => sub { $_ % 3 }, ); ok exception { $child->( 6 ) }, 'overridden assert_return works (failing value)'; ok !exception { $child->( 7 ) }, 'overridden assert_return works (passing value)'; is( $child->counter, 2, 'overridden assert_return is used by &{} overload' ); is_deeply( eval( '[' . Int->____make_key( [1..4], { quux => \"abc" }, undef ) . ']' ), [ Int, [1..4], { quux => \"abc" }, undef ], '$type->____make_key' ); done_testing; inline-assert.t000664001750001750 544715111656240 21363 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Tests for Type::Tiny's C method. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw( Int ); # Exceptions do seem to work on older Perls, but checking them with like() # seems to break stuff, so just skip. use constant SANE_PERL => ($] ge '5.008001'); my ($inline_assert, @VALUE, $r); local $@; note("INLINE ASSERTION, INLINABLE TYPE, NO TYPEVAR"); note($inline_assert = Int->inline_assert('$VALUE[0]')); @VALUE = (12); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, 1234, 'successful check'); @VALUE = (1.2); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, undef, 'successful throw'); like($@, qr/Value "1.2" did not pass type constraint "Int"/, '... with correct exception') if SANE_PERL; note("INLINE ASSERTION, INLINABLE TYPE, WITH TYPEVAR"); my $type = Int; note($inline_assert = $type->inline_assert('$VALUE[0]', '$type')); @VALUE = (12); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, 1234, 'successful check'); @VALUE = (1.2); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, undef, 'successful throw'); like($@, qr/Value "1.2" did not pass type constraint "Int"/, '... with correct exception') if SANE_PERL; undef $type; @VALUE = (1.2); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, undef, 'successful throw even when $type is undef'); like($@, qr/Value "1.2" did not pass type constraint "Int"/, '... with correct exception') if SANE_PERL; is($@->type, undef, '... but the exception does not know which type it was thrown by') if SANE_PERL; note("INLINE ASSERTION, NON-INLINABLE TYPE, NO TYPEVAR"); $type = Int->where(sub {1}); # cannot be inlined undef $inline_assert; my $e = exception { $inline_assert = $type->inline_assert('$VALUE[0]'); }; isnt($e, undef, 'cannot be done!'); note("INLINE ASSERTION, NON-INLINABLE TYPE, WITH TYPEVAR"); note($inline_assert = $type->inline_assert('$VALUE[0]', '$type')); @VALUE = (12); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, 1234, 'successful check'); @VALUE = (1.2); $@ = undef; $r = eval "$inline_assert; 1234"; is($r, undef, 'successful throw'); like($@, qr/Value "1.2" did not pass type constraint "Int"/, '... with correct exception') if SANE_PERL; note("INLINE ASSERTION, NON-INLINABLE TYPE, WITH TYPEVAR AND EXTRAS"); note($inline_assert = $type->inline_assert('$VALUE[0]', '$type', foo => "bar")); @VALUE = (1.2); $@ = undef; $r = eval "$inline_assert; 1234"; is($@->{foo}, 'bar', 'extras work') if SANE_PERL; done_testing; list-methods.t000664001750001750 1213715111656240 21234 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny's list processing methods. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard -types; my %subtests = ( 'inlineable base types' => sub { my $type = shift; return $type; }, 'non-inlineable base types' => sub { my $type = shift; return $type->where( sub { 1 } ); }, ); for my $kind ( sort keys %subtests ) { my $maybe_subtype = $subtests{$kind}; subtest "Tests with $kind" => sub { my $Rounded2 = Int->$maybe_subtype->plus_coercions( Num, 'int($_)' ); can_ok( $Rounded2, $_ ) for qw( grep map sort rsort first any all assert_any assert_all ); can_ok( Int->$maybe_subtype, $_ ) for qw( grep sort rsort first any all assert_any assert_all ); ok ! Int->$maybe_subtype->can('map'); is_deeply( [ Int->$maybe_subtype->grep(qw/ yeah 1 1.5 hello world 2 /, [], qw/ 3 4 5 /, '' ) ], [ qw/ 1 2 3 4 5 / ], 'Int->grep', ); is( Int->$maybe_subtype->first(qw/ yeah 1.5 hello world 2 /, [], qw/ 3 4 5 /, '' ), 2, 'Int->first', ); my $e = exception { Int->$maybe_subtype->map( qw/ yeah 1 1.5 hello world 2 /, [], qw/ 3 4 5 /, '' ) }; like( $e, qr/no coercion/i, 'map() requires a coercion' ); my $Rounded = Int->$maybe_subtype->plus_coercions( Num, sub { int $_ } ); is_deeply( [ $Rounded->map( qw/ 1 2.1 3 4 5 / ) ], [ qw/ 1 2 3 4 5 / ], '$Rounded->map', ); is_deeply( [ $Rounded->map( qw/ 1 2.1 foo 4 5 / ) ], [ qw/ 1 2 foo 4 5 / ], '$Rounded->map with uncoercible values', ); like( exception { Any->$maybe_subtype->sort(qw/ 1 2 3/) }, qr/No sorter/i, 'Any->sort', ); is_deeply( [ Int->$maybe_subtype->sort(qw/ 11 2 1 /) ], [ qw/ 1 2 11 / ], 'Int->sort', ); is_deeply( [ $Rounded->sort(qw/ 11 2 1 /) ], [ qw/ 1 2 11 / ], '$Rounded->sort', ); is_deeply( [ Str->$maybe_subtype->sort(qw/ 11 2 1 /) ], [ qw/ 1 11 2 / ], 'Str->sort', ); is_deeply( [ Int->$maybe_subtype->rsort(qw/ 11 2 1 /) ], [ reverse qw/ 1 2 11 / ], 'Int->rsort', ); is_deeply( [ $Rounded->rsort(qw/ 11 2 1 /) ], [ reverse qw/ 1 2 11 / ], '$Rounded->rsort', ); is_deeply( [ Str->$maybe_subtype->rsort(qw/ 11 2 1 /) ], [ reverse qw/ 1 11 2 / ], 'Str->rsort', ); my $CrazyInt = Int->$maybe_subtype->create_child_type( sorter => [ sub { $_[0] cmp $_[1] }, sub { scalar reverse($_[0]) } ], ); is_deeply( [ $CrazyInt->sort(qw/ 8 56 12 90 80 333 431 /) ], [ qw/ 80 90 431 12 333 56 8 / ], '$CrazyInt->sort' ) or diag explain [ $CrazyInt->sort(qw/ 8 56 12 90 80 333 431 /) ]; is_deeply( [ $CrazyInt->rsort(qw/ 8 56 12 90 80 333 431 /) ], [ reverse qw/ 80 90 431 12 333 56 8 / ], '$CrazyInt->rsort' ) or diag explain [ $CrazyInt->rsort(qw/ 8 56 12 90 80 333 431 /) ]; ok( ! Int->$maybe_subtype->any(qw//), 'not Int->any(qw//)', ); ok( Int->$maybe_subtype->any(qw/ foo 1 bar /), 'Int->any(qw/ foo 1 bar /)', ); ok( ! Int->$maybe_subtype->any(qw/ foo bar /), 'not Int->any(qw/ foo bar /)', ); ok( Int->$maybe_subtype->any(qw/ 1 2 3 /), 'Int->any(qw/ 1 2 3 /)', ); ok( Int->$maybe_subtype->all(qw//), 'Int->all(qw//)', ); ok( ! Int->$maybe_subtype->all(qw/ foo 1 bar /), 'not Int->all(qw/ foo 1 bar /)', ); ok( ! Int->$maybe_subtype->all(qw/ foo bar /), 'not Int->all(qw/ foo bar /)', ); ok( Int->$maybe_subtype->all(qw/ 1 2 3 /), 'Int->all(qw/ 1 2 3 /)', ); like( exception { Int->$maybe_subtype->assert_any(qw//) }, qr/Undef did not pass type constraint/, 'Int->assert_any(qw//) --> exception', ); is_deeply( [ Int->$maybe_subtype->assert_any(qw/ foo 1 bar /) ], [ qw/ foo 1 bar / ], 'Int->assert_any(qw/ foo 1 bar /)', ); like( exception { Int->$maybe_subtype->assert_any(qw/ foo bar /) }, qr/Value "bar" did not pass type constraint/, 'Int->assert_any(qw/ foo bar /) --> exception', ); is_deeply( [ Int->$maybe_subtype->assert_any(qw/ 1 2 3 /) ], [ qw/ 1 2 3 / ], 'Int->assert_any(qw/ 1 2 3 /)', ); is_deeply( [ Int->$maybe_subtype->assert_all(qw//) ], [ ], 'Int->assert_all(qw//)', ); like( exception { Int->$maybe_subtype->assert_all(qw/ foo 1 bar /) }, qr/Value "foo" did not pass type constraint/, 'Int->assert_all(qw/ foo 1 bar /) --> exception', ); like( exception { Int->$maybe_subtype->assert_all(qw/ foo bar /) }, qr/Value "foo" did not pass type constraint/, 'Int->assert_all(qw/ foo bar /) --> exception', ); is_deeply( [ Int->$maybe_subtype->assert_all(qw/ 1 2 3 /) ], [ qw/ 1 2 3 / ], 'Int->assert_all(qw/ 1 2 3 /)', ); like( exception { Int->$maybe_subtype->_build_util('xxxx') }, qr/^Unknown function: xxxx/, 'Int->_build_util("xxxx") --> exception' ); }; } done_testing; my-methods.t000664001750001750 156015111656240 20664 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny's C attribute. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Types::Standard qw(Num); my $type = Num->create_child_type( name => 'Number', my_methods => { round_off => sub { int($_[1]) } } ); my $type2 = $type->create_child_type(name => 'Number2'); can_ok($_, 'my_round_off') for $type, $type2; is($_->my_round_off(42.3), 42, "$_ my_round_off works") for $type, $type2; ok(!$_->can('my_smirnoff'), "$_ cannot my_smirnoff") for $type, $type2; done_testing; parameterization.t000664001750001750 420215111656240 22150 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE There are loads of tests for parameterization in C, C, C, C, C, C, etc. This file includes a handful of other parameterization-related tests that didn't fit anywhere else. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny -all; use Test::Fatal; use Types::Standard qw/ -types slurpy /; my $p1 = ArrayRef[Int]; my $p2 = ArrayRef[Int]; my $p3 = ArrayRef[Int->create_child_type()]; is($p1->{uniq}, $p2->{uniq}, "Avoid duplicating parameterized types"); isnt($p1->{uniq}, $p3->{uniq}, "... except when necessary!"); my $p4 = ArrayRef[sub { $_ eq "Bob" }]; my $p5 = ArrayRef[sub { $_ eq "Bob" or die "not Bob" }]; my $p6 = ArrayRef[Str & +sub { $_ eq "Bob" or die "not Bob" }]; should_pass(["Bob"], $p4); should_pass(["Bob", "Bob"], $p4); should_fail(["Bob", "Bob", "Suzie"], $p4); should_pass(["Bob"], $p5); should_pass(["Bob", "Bob"], $p5); should_fail(["Bob", "Bob", "Suzie"], $p5); should_pass(["Bob"], $p6); should_pass(["Bob", "Bob"], $p6); should_fail(["Bob", "Bob", "Suzie"], $p6); is( $p4->parameters->[0]->validate("Suzie"), 'Value "Suzie" did not pass type constraint', 'error message when a coderef returns false', ); like( $p5->parameters->[0]->validate("Suzie"), qr{^not Bob}, 'error message when a coderef dies', ); my $p7 = ArrayRef[Dict[foo =>Int, slurpy Any]]; my $p8 = ArrayRef[Dict[foo =>Int, slurpy Any]]; is($p7->inline_check(q/$X/), $p8->inline_check(q/$X/), '$p7 and $p8 stringify the same'); is($p7->{uniq}, $p8->{uniq}, '$p7 and $p8 are the same'); is( Type::Tiny::____make_key( [ 1..5, \0, [ { foo => undef, bar => Int } ] ] ), '["1","2","3","4","5",\("0"),[{"bar",$Type::Tiny::ALL_TYPES{' . Int->{uniq} . '},"foo",undef}]]', ); done_testing; refcount.t000664001750001750 175115111656240 20425 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny refcount stuff. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Devel::Refcount'; use Devel::Refcount 'refcount'; use Test::TypeTiny; use Type::Tiny; use Type::Registry; my $ref = []; my $orig_count = refcount( $ref ); note "COUNT: $orig_count"; { my $type = 'Type::Tiny'->new( name => 'AnswerToLifeTheUniverseAndEverything', constraint => sub { $_ eq 42 }, inlined => sub { my $var = pop; "$var eq 42" }, dummy_attr => $ref, ); is refcount( $ref ), 1 + $orig_count; should_fail( 41, $type ); should_pass( 42, $type ); is refcount( $ref ), 1 + $orig_count; } is refcount( $ref ), $orig_count; done_testing; shortcuts.t000664001750001750 146015111656240 20633 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Test the C<< ->of >> and C<< ->where >> shortcut methods. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny -all; use Types::Standard -types; my $p1 = ArrayRef->parameterize( Int ); my $p2 = ArrayRef->of( Int ); is($p1->{uniq}, $p2->{uniq}, "->of method works same as ->parameterize"); my $p3 = ArrayRef->where(sub { $_->[0] eq 'Bob' }); should_pass ['Bob', 'Alice'], $p3; should_fail ['Alice', 'Bob'], $p3; done_testing; smartmatch.t000664001750001750 224015111656240 20735 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works with the smartmatch operator. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Type::Tiny (); BEGIN { Type::Tiny::SUPPORT_SMARTMATCH or plan skip_all => 'smartmatch support not available for this version or Perl'; } use Types::Standard -all; no warnings; # !! ok( 42 ~~ Int ); ok( 42 ~~ Num ); ok not( 42 ~~ ArrayRef ); ok( 42 ~~ \&is_Int ); ok not( 42 ~~ \&is_ArrayRef ); TODO: { use feature qw(switch); given (4) { when ( \&is_RegexpRef ) { fail('regexpref') } when ( \&is_Int ) { pass('int') } default { fail('default') } } local $TODO = 'this would be nice, but probably requires changes to perl'; given (4) { when ( RegexpRef ) { fail('regexpref') } when ( Int ) { pass('int') } default { fail('default') } } }; done_testing; strictmode-off.t000664001750001750 234615111656240 21526 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Check Type::Tiny C<< / >> overload in lax mode. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BEGIN { $ENV{$_} = 0 for qw( EXTENDED_TESTING AUTHOR_TESTING RELEASE_TESTING PERL_STRICT ); }; use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Standard -types; subtest "Type constraint object overloading /" => sub { my $type = ArrayRef[ Int / Str ]; should_pass( [] => $type ); should_pass( [ 1 .. 3 ] => $type ); should_pass( [ "foo", "bar" ] => $type ); should_fail( [ {} ] => $type ); should_fail( {} => $type ); }; subtest "Type::Parser support for /" => sub { use Type::Registry qw( t ); my $type = t( 'ArrayRef[ Int / Str ]' ); should_pass( [] => $type ); should_pass( [ 1 .. 3 ] => $type ); should_pass( [ "foo", "bar" ] => $type ); should_fail( [ {} ] => $type ); should_fail( {} => $type ); }; done_testing; strictmode-on.t000664001750001750 240115111656240 21360 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Check Type::Tiny C<< / >> overload in strict mode. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut BEGIN { $ENV{$_} = 0 for qw( EXTENDED_TESTING AUTHOR_TESTING RELEASE_TESTING PERL_STRICT ); $ENV{PERL_STRICT} = 1; }; use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Standard -types; subtest "Type constraint object overloading /" => sub { my $type = ArrayRef[ Int / Str ]; should_pass( [] => $type ); should_pass( [ 1 .. 3 ] => $type ); should_fail( [ "foo", "bar" ] => $type ); should_fail( [ {} ] => $type ); should_fail( {} => $type ); }; subtest "Type::Parser support for /" => sub { use Type::Registry qw( t ); my $type = t( 'ArrayRef[ Int / Str ]' ); should_pass( [] => $type ); should_pass( [ 1 .. 3 ] => $type ); should_fail( [ "foo", "bar" ] => $type ); should_fail( [ {} ] => $type ); should_fail( {} => $type ); }; done_testing; syntax.t000664001750001750 342215111656240 20123 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks that all this Type[Param] syntactic sugar works. In particular, the following three type constraints are expected to be equivalent to each other: use Types::Standard qw( ArrayRef Int Num Str ); use Type::Utils qw( union intersection ); my $type1 = ArrayRef[Int] | ArrayRef[Num & ~Int] | ArrayRef[Str & ~Num]; my $type2 = union [ ArrayRef[Int], ArrayRef[Num & ~Int], ArrayRef[Str & ~Num], ]; my $type3 = union([ ArrayRef->parameterize(Int), ArrayRef->parameterize( intersection([ Num, Int->complementary_type, ]), ), ArrayRef->parameterize( intersection([ Str, Num->complementary_type, ]), ), ]); =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Types::Standard qw( ArrayRef Int Num Str ); use Type::Utils qw( union intersection ); my $type1 = ArrayRef[Int] | ArrayRef[Num & ~Int] | ArrayRef[Str & ~Num]; my $type2 = union [ ArrayRef[Int], ArrayRef[Num & ~Int], ArrayRef[Str & ~Num], ]; my $type3 = union([ ArrayRef->parameterize(Int), ArrayRef->parameterize( intersection([ Num, Int->complementary_type, ]), ), ArrayRef->parameterize( intersection([ Str, Num->complementary_type, ]), ), ]); ok($type1==$type2, '$type1==$type2'); ok($type1==$type3, '$type1==$type3'); ok($type2==$type3, '$type2==$type3'); done_testing; to-moose.t000664001750001750 223715111656240 20342 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny objects can be converted to Moose type constraint objects. =head1 DEPENDENCIES Requires Moose 2.0000; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'Moose' => '2.0000' }; use Test::TypeTiny; use Type::Tiny; my $Any = "Type::Tiny"->new(name => "Anything"); my $Int = $Any->create_child_type( name => "Integer", constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, ); my $mAny = $Any->moose_type; my $mInt = $Int->moose_type; isa_ok($mAny, 'Moose::Meta::TypeConstraint', '$mAny'); isa_ok($mInt, 'Moose::Meta::TypeConstraint', '$mInt'); is($mInt->parent, $mAny, 'type constraint inheritance seems right'); should_pass(42, $mAny); should_pass([], $mAny); should_pass(42, $mInt); should_fail([], $mInt); done_testing; to-mouse.t000664001750001750 213515111656240 20345 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny objects can be converted to Mouse type constraint objects. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'Mouse' => '1.00' }; use Test::TypeTiny; use Type::Tiny; my $Any = "Type::Tiny"->new(name => "Anything"); my $Int = $Any->create_child_type( name => "Integer", constraint => sub { defined($_) and !ref($_) and $_ =~ /^[+-]?[0-9]+$/sm }, ); my $mAny = $Any->mouse_type; my $mInt = $Int->mouse_type; isa_ok($mAny, 'Mouse::Meta::TypeConstraint', '$mAny'); isa_ok($mInt, 'Mouse::Meta::TypeConstraint', '$mInt'); is($mInt->parent, $mAny, 'type constraint inheritance seems right'); should_pass(42, $mAny); should_pass([], $mAny); should_pass(42, $mInt); should_fail([], $mInt); done_testing; type_default.t000664001750001750 446315111656240 21270 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny's C attribute works. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard -types; is( Any->type_default->(), undef, 'Any->type_default', ); is( Item->type_default->(), undef, 'Item->type_default (inherited from Any)', ); is( Defined->type_default, undef, 'Defined->type_default (not inherited from Item)', ); is( Str->type_default->(), '', 'Str->type_default', ); is( $_->type_default->(), 0, "$_\->type_default", ) for Int, Num, StrictNum, LaxNum; is( Bool->type_default->(), !!0, 'Bool->type_default', ); is( Undef->type_default->(), undef, 'Undef->type_default', ); is( Maybe->type_default->(), undef, 'Maybe->type_default', ); is( Maybe->of( Str )->type_default->(), '', 'Maybe[Str]->type_default generated for parameterized type', ); is_deeply( ArrayRef->type_default->(), [], 'ArrayRef->type_default', ); is_deeply( ArrayRef->of( Str )->type_default->(), [], 'ArrayRef[Str]->type_default generated for parameterized type', ); is( ArrayRef->of( Str, 1, 2 )->type_default, undef, 'ArrayRef[Str, 1, 2]->type_default not generated', ); is_deeply( HashRef->type_default->(), {}, 'HashRef->type_default', ); is_deeply( HashRef->of( Str )->type_default->(), {}, 'HashRef[Str]->type_default generated for parameterized type', ); is_deeply( Map->type_default->(), {}, 'Map->type_default', ); is_deeply( Map->of( Str, Int )->type_default->(), {}, 'Map[Str, Int]->type_default generated for parameterized type', ); subtest "quasi-curry" => sub { my @got; my $type = ArrayRef->create_child_type( name => 'MyArrayRef', type_default => sub { @got = @_; return $_ }, ); my $td = $type->type_default( 1 .. 5 ); is( ref($td), 'CODE', 'quasi-curry worked' ); is_deeply( $td->( bless {}, 'Local::Dummy' ), [ 1 .. 5 ], 'quasi-curried arguments', ); is_deeply( \@got, [ bless {}, 'Local::Dummy' ], 'regular arguments', ); }; done_testing; basic.t000664001750001750 607315111656240 21403 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Bitfielduse strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Common qw( Str is_CodeRef ); use Type::Tiny::Bitfield LineStyle => { RED => 1, BLUE => 2, GREEN => 4, DOTTED => 64, }; is( LineStyle->name, 'LineStyle' ); is( LineStyle->parent->name, 'PositiveOrZeroInt' ); should_pass( $_, LineStyle ) for 0, 1, 2, 3, 4, 5, 6, 7, 64, 65, 66, 67, 68, 69, 70, 71; should_fail( $_, LineStyle ) for 8, 9, 10, 11, 12, 13, 14, 15, 62, 63, 72; should_fail( 'RED', LineStyle ); should_fail( -4, LineStyle ); is_deeply( [ sort { $a cmp $b } LineStyle->constant_names ], [ qw/ LINESTYLE_BLUE LINESTYLE_DOTTED LINESTYLE_GREEN LINESTYLE_RED / ], 'LineStyle->constant_names', ); is( LINESTYLE_RED, 1, 'LINESTYLE_RED' ); is( LINESTYLE_BLUE, 2, 'LINESTYLE_BLUE' ); is( LINESTYLE_GREEN, 4, 'LINESTYLE_GREEN' ); is( LINESTYLE_DOTTED, 64, 'LINESTYLE_DOTTED' ); is( LineStyle->RED, 1, 'LineStyle->RED' ); is( LineStyle->BLUE, 2, 'LineStyle->BLUE' ); is( LineStyle->GREEN, 4, 'LineStyle->GREEN' ); is( LineStyle->DOTTED, 64, 'LineStyle->DOTTED' ); like( exception { LineStyle->YELLOW }, qr/Can't locate object method "YELLOW" via package "Type::Tiny::Bitfield"/, 'LineStyle->YELLOW fails' ); ok( is_CodeRef( LineStyle->can( 'RED' ) ), q{LineStyle->can( 'RED' )} ); ok( !is_CodeRef( LineStyle->can( 'YELLOW' ) ), q{!LineStyle->can( 'YELLOW' )} ); is( LineStyle->can( 'GREEN' )->(), 4, q{LineStyle->can( 'GREEN' )->()} ); ok( is_LineStyle( LINESTYLE_RED ), 'is_LineStyle( LINESTYLE_RED )' ); my $RedDottedLine = LINESTYLE_RED | LINESTYLE_DOTTED; is( $RedDottedLine, 65 ); ok( is_LineStyle( $RedDottedLine ) ); ok( !is_LineStyle( 'RED' ) ); ok( !is_LineStyle( -4 ) ); ok( is_LineStyle( $_ ), "is_LineStyle($_)" ) for 0, 1, 2, 3, 4, 5, 6, 7, 64, 65, 66, 67, 68, 69, 70, 71; ok( !is_LineStyle( $_ ), "!is_LineStyle($_)" ) for 8, 9, 10, 11, 12, 13, 14, 15, 62, 63, 72; subtest 'Bad bitfield numbering' => sub { local $@; ok !eval q{ use Type::Tiny::Bitfield Abcdef => { RED => 1, BLUE => 2, GREEN => 3, DOTTED => 4, }; 1; }; like $@, qr/^Not a positive power of 2/, 'error message'; }; subtest 'Bad bitfield naming' => sub { local $@; ok !eval q{ use Type::Tiny::Bitfield Abcdef => { red => 1 }; 1; }; like $@, qr/^Not an all-caps name in a bitfield/, 'error message'; }; ok( LineStyle->can_be_inlined, 'can be inlined' ); note LineStyle->inline_check( '$VALUE' ); subtest 'Coercion from string' => sub { ok LineStyle->has_coercion; ok LineStyle->coercion->has_coercion_for_type( Str ); is( to_LineStyle('reD'), 1 ); is( to_LineStyle('GREEN reD'), 5 ); is( to_LineStyle('reD | grEEn'), 5 ); is( to_LineStyle('green+blue'), 6 ); is( to_LineStyle('linestyle_dotted'), 64 ); is( LineStyle->from_string('reD | grEEn'), 5 ); }; subtest 'Coercion to string' => sub { is( LineStyle->to_string( 2 ), 'BLUE' ); is( LineStyle->to_string( 6 ), 'BLUE|GREEN' ); is( LineStyle->to_string( 65 ), 'RED|DOTTED' ); is( LineStyle->to_string( [] ), undef ); is( LineStyle->to_string( -1 ), undef ); is( LineStyle_to_Str( 65 ), 'RED|DOTTED' ); }; done_testing; errors.t000664001750001750 210515111656240 21626 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Bitfielduse strict; use warnings; use Test::More; use Test::Fatal; use Type::Tiny::Bitfield; use Types::Common qw( ArrayRef ); like( exception { Type::Tiny::Bitfield->new( parent => ArrayRef, values => {} ), }, qr/cannot have a parent constraint passed to the constructor/i, ); like( exception { Type::Tiny::Bitfield->new( constraint => sub { 0 }, values => {} ), }, qr/cannot have a constraint coderef passed to the constructor/i, ); like( exception { Type::Tiny::Bitfield->new( inlined => sub { 0 }, values => {} ), }, qr/cannot have a inlining coderef passed to the constructor/i, ); like( exception { Type::Tiny::Bitfield->new(), }, qr/Need to supply hashref of values/i, ); like( exception { Type::Tiny::Bitfield->new( values => { foo => 2 } ), }, qr/Not an all-caps name in a bitfield/i, ); like( exception { Type::Tiny::Bitfield->new( values => { FOO => 3 } ), }, qr/Not a positive power of 2 in a bitfield/i, ); like( exception { Type::Tiny::Bitfield->new( values => { FOO => 1, BAR => 1 } ), }, qr/Duplicate value in a bitfield/i, ); done_testing; import-options.t000664001750001750 34415111656240 23300 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Bitfielduse strict; use warnings; use Test::More; use Type::Tiny::Bitfield ( Colour => { RED => 0x01, BLUE => 0x02, GREEN => 0x04, -prefix => 'My' }, ); is( MyColour->display_name, 'Colour' ); is( MyCOLOUR_RED, 1 ); done_testing; plus.t000664001750001750 407415111656240 21304 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Bitfielduse strict; use warnings; use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard qw( ArrayRef ); use Type::Tiny::Bitfield ( Colour => { RED => 0x01, BLUE => 0x02, GREEN => 0x04 }, Style => { DOTTED => 0x08, ZIGZAG => 0x10, BLINK => 0x20 }, ); my $Combined = Colour + Style; ok( $Combined->isa('Type::Tiny::Bitfield'), "$Combined isa Type::Tiny::Bitfield" ); is( $Combined->display_name, 'Colour+Style', "$Combined display_name" ); ok( $Combined->is_anon, "$Combined is_anon" ); should_pass( $_, $Combined ) for 0 .. 0x3F; should_fail( $_, $Combined ) for 0x40, 'BLEH', [], -1, undef, ArrayRef; is( $Combined->coerce( 'RED|GREEN|ZIGZAG' ), 21, 'coerce' ); like( exception { my $x = Colour + ArrayRef; }, qr/Bad overloaded operation/, 'Exception when trying to add Bitfield type and non-Bitfield type', ); like( exception { my $x = ArrayRef() + Colour; }, qr/Bad overloaded operation/, 'Exception when trying to add non-Bitfield type and Bitfield type', ); like( exception { my $x = Colour + []; }, qr/Bad overloaded operation/, 'Exception when trying to add Bitfield type and non-type', ); like( exception { my $x = [] + Colour; }, qr/Bad overloaded operation/, 'Exception when trying to add non-type and Bitfield type', ); like( exception { my $x = Colour + Type::Tiny::Bitfield->new( name => 'Shape', values => { CIRCLE => 0x40, BLUE => 0x80 }, ); }, qr/Conflicting value: BLUE/, 'Exception when trying to combine conflicting Bitfield types', ); my $zzz = 0; sub combine_types_with_coercions { my ( $x, $y ) = map { my $coercion = $_; ++$zzz; Type::Tiny::Bitfield->new( values => { "ZZZ$zzz" => 2 ** $zzz }, coercion => $coercion, ); } @_; return $x + $y; } subtest 'Combining Bitfield types with and without coercions works' => sub { ok( ! combine_types_with_coercions( undef, undef )->has_coercion ); ok( combine_types_with_coercions( undef, 1 )->has_coercion ); ok( combine_types_with_coercions( 1, undef )->has_coercion ); ok( combine_types_with_coercions( 1, 1 )->has_coercion ); }; done_testing; basic.t000664001750001750 335515111656240 20726 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Class=pod =encoding utf-8 =head1 PURPOSE Checks class type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(FooBar, "Type::Tiny", "FooBar"); isa_ok(FooBar, "Type::Tiny::Class", "FooBar"); isa_ok(FooBaz, "Type::Tiny", "FooBaz"); isa_ok(FooBaz, "Type::Tiny::Class", "FooBaz"); isa_ok(FooBar->new, "Foo::Bar", "FooBar->new"); isa_ok(FooBaz->new, "Foo::Baz", "FooBaz->new"); isa_ok(FooBar->class->new, "Foo::Bar", "FooBar->class->new"); isa_ok(FooBaz->class->new, "Foo::Baz", "FooBaz->class->new"); should_pass("Foo::Bar"->new, FooBar); should_pass("Foo::Baz"->new, FooBar); should_fail("Foo::Bar"->new, FooBaz); should_pass("Foo::Baz"->new, FooBaz); should_fail(undef, FooBar); should_fail(undef, FooBaz); should_fail({}, FooBar); should_fail({}, FooBaz); should_fail(FooBar, FooBar); should_fail(FooBar, FooBaz); should_fail(FooBaz, FooBar); should_fail(FooBaz, FooBaz); should_fail("Foo::Bar", FooBar); should_fail("Foo::Bar", FooBaz); should_fail("Foo::Baz", FooBar); should_fail("Foo::Baz", FooBaz); is( ref(FooBar->new), ref(FooBar->class->new), 'DWIM Type::Tiny::Class::new', ); is( 'Type::Tiny::Class'->new( class => 'Xyzzy' )->inline_check('$x'), 'Type::Tiny::Class'->new({ class => 'Xyzzy' })->inline_check('$x'), 'constructor can be passed a hash or hashref', ); done_testing; errors.t000664001750001750 276215111656240 21162 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Class=pod =encoding utf-8 =head1 PURPOSE Checks class type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int); use Type::Tiny::Class; like( exception { Type::Tiny::Class->new(parent => Int, class => 'Foo') }, qr/^Class type constraints cannot have a parent/, ); like( exception { Type::Tiny::Class->new(constraint => sub { 1 }, class => 'Foo') }, qr/^Class type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Class->new(inlined => sub { 1 }, class => 'Foo') }, qr/^Class type constraints cannot have an inlining coderef/, ); like( exception { Type::Tiny::Class->new() }, qr/^Need to supply class name/, ); { package Quux; our @ISA = qw(); sub new { bless [], shift } } { package Quuux; our @ISA = qw(); } { package Baz; our @ISA = qw(Quuux); } { package Bar; our @ISA = qw(Baz Quux); } my $e = exception { Type::Tiny::Class ->new(name => "Elsa", class => "Foo") ->assert_valid( Bar->new ); }; is_deeply( $e->explain, [ '"Elsa" requires that the reference isa Foo', 'The reference isa Bar, Baz, Quuux, and Quux', ], ); done_testing; exporter.t000664001750001750 116315111656240 21510 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Class=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Class can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tiny::Class 'HTTP::Tiny'; isa_ok HTTPTiny, 'Type::Tiny', 'HTTPTiny'; ok is_HTTPTiny( bless {}, 'HTTP::Tiny' ); require Type::Registry; is( 'Type::Registry'->for_me->{'HTTPTiny'}, HTTPTiny ); done_testing; exporter_with_options.t000664001750001750 115015111656240 24312 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Class=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Class can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tiny::Class HT => { class => 'HTTP::Tiny' }; isa_ok HT, 'Type::Tiny', 'HT'; ok is_HT( bless {}, 'HTTP::Tiny' ); require Type::Registry; is( 'Type::Registry'->for_me->{'HT'}, HT ); done_testing; plus-constructors.t000664001750001750 477315111656240 23403 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Class=pod =encoding utf-8 =head1 PURPOSE Checks the C's C method. =head1 DEPENDENCIES Requires Moose 2.00; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use utf8; use Test::More; use Test::Requires { Moose => 2.00 }; use Test::TypeTiny; my ($Address, $Person); BEGIN { package Address; use Moose; use Types::Standard qw( Str ); use Type::Utils; has [qw/ line1 line2 town county postcode country /] => ( is => "ro", isa => Str, ); sub _new_from_array { my $class = shift; my @addr = ref($_[0]) ? @{$_[0]} : @_; $class->new( line1 => $addr[0], line2 => $addr[1], town => $addr[2], county => $addr[3], postcode => $addr[4], country => $addr[5], ); } $Address = class_type { class => __PACKAGE__ }; }; BEGIN { package Person; use Moose; use Types::Standard qw( Str Join Tuple HashRef ); use Type::Utils; has name => ( required => 1, coerce => 1, is => "ro", isa => Str->plus_coercions(Join[" "]), ); has addr => ( coerce => 1, is => "ro", isa => $Address->plus_constructors( (Tuple[(Str) x 6]) => "_new_from_array", (HashRef) => "new", ), ); sub _new_from_name { my $class = shift; my ($name) = @_; $class->new(name => $name); } $Person = class_type { class => __PACKAGE__ }; }; ok( "Person"->meta->get_attribute("addr")->type_constraint->is_a_type_of($Address), q["Person"->meta->get_attribute("addr")->type_constraint->is_a_type_of($Address)], ); my $me = Person->new( name => ["Toby", "Inkster"], addr => ["Flat 2, 39 Hartington Road", "West Ealing", "LONDON", "", "W13 8QL", "United Kingdom"], ); my $me2 = Person->new( name => "Toby Inkster", addr => Address->new( line1 => "Flat 2, 39 Hartington Road", line2 => "West Ealing", town => "LONDON", county => "", postcode => "W13 8QL", country => "United Kingdom", ), ); is_deeply($me, $me2, 'coercion worked'); my $you = $Person->plus_constructors->coerce({ name => "Livvy" }); my $you2 = Person->new(name => "Livvy"); is_deeply($you, $you2, 'coercion worked (plus_constructors with no parameters)'); done_testing; basic.t000664001750001750 630415111656240 23256 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-ConstrainedObject=pod =encoding utf-8 =head1 PURPOSE Check C, C, and C work for L, L, and L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; BEGIN { package Local::Class; use overload ( q[""] => sub { shift->as_string }, q[0+] => sub { shift->as_number }, fallback => 1, ); sub new { my $class = shift; my %args = ref $_[0] ? %{$_[0]} : @_; bless \%args => $class; } sub AUTOLOAD { my $self = shift; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/^.*:://; $self->{$method}; } sub DOES { my $self = shift; my ($role) = @_; return 1 if $role eq 'Local::Role'; $self->SUPER::DOES(@_); } sub can { my $self = shift; my ($method) = @_; my $r = $self->SUPER::can(@_); return $r if $r; if ($method !~ /^__/) { return sub { shift->{$method} }; } $r; } sub DESTROY { } }; use Type::Tiny::Class; use Type::Tiny::Duck; use Type::Tiny::Role; use Types::Standard -types; my $class_type = Type::Tiny::Class->new(class => 'Local::Class'); my $role_type = Type::Tiny::Role->new(role => 'Local::Role'); my $duck_type = Type::Tiny::Duck->new(methods => [qw/foo bar baz quux/]); my @test_types = ( [ $class_type, 'Class types...' ], [ $role_type, 'Role types...' ], [ $duck_type, 'Duck types...' ], ); for my $tt (@test_types) { my ($base_type, $label) = @$tt; should_pass( Local::Class->new, $base_type, $label, ); should_pass( Local::Class->new( as_string => '3', as_number => '3.1' ), $base_type->stringifies_to( Int ), '... stringifies_to (should pass)', ); should_fail( Local::Class->new( as_string => '3.1', as_number => '3.1' ), $base_type->stringifies_to( Int ), '... stringifies_to (should fail)', ); should_pass( Local::Class->new( as_string => '3.1', as_number => '3' ), $base_type->numifies_to( Int ), '... numifies_to (should pass)', ); should_fail( Local::Class->new( as_string => '3.1', as_number => '3.1' ), $base_type->numifies_to( Int ), '... numifies_to (should fail)', ); should_pass( Local::Class->new( foo => 1, bar => 'ABARA', baz => 3 ), $base_type->with_attribute_values( foo => Int, bar => qr/BAR/, baz => '$_%2' ), '... with_attribute_values (should pass)', ); should_fail( Local::Class->new( foo => 'xyz', bar => 'ABARA', baz => 3 ), $base_type->with_attribute_values( foo => Int, bar => qr/BAR/, baz => '$_%2' ), '... with_attribute_values (should fail because of foo)', ); should_fail( Local::Class->new( foo => 1, bar => 'XXX', baz => 3 ), $base_type->with_attribute_values( foo => Int, bar => qr/BAR/, baz => '$_%2' ), '... with_attribute_values (should fail because of bar)', ); should_fail( Local::Class->new( foo => 1, bar => 'ABARA', baz => 2 ), $base_type->with_attribute_values( foo => Int, bar => qr/BAR/, baz => '$_%2' ), '... with_attribute_values (should fail because of baz)', ); } done_testing(); basic.t000664001750001750 203015111656240 20534 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Duck=pod =encoding utf-8 =head1 PURPOSE Checks duck type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(CanFooBar, "Type::Tiny", "CanFooBar"); isa_ok(CanFooBaz, "Type::Tiny::Duck", "CanFooBar"); should_pass("Foo::Bar"->new, CanFooBar); should_fail("Foo::Bar"->new, CanFooBaz); should_pass("Foo::Baz"->new, CanFooBar); should_pass("Foo::Baz"->new, CanFooBaz); should_fail(undef, CanFooBar); should_fail({}, CanFooBar); should_fail(FooBar, CanFooBar); should_fail(FooBaz, CanFooBar); should_fail(CanFooBar, CanFooBar); should_fail("Foo::Bar", CanFooBar); done_testing; cmp.t000664001750001750 243115111656240 20237 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Duck=pod =encoding utf-8 =head1 PURPOSE Test new type comparison stuff with Type::Tiny::Duck objects. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Type::Utils qw(duck_type); my $type1 = duck_type Type1 => [qw( foo bar )]; my $type2 = duck_type Type2 => [qw( bar foo )]; my $type3 = duck_type Type3 => [qw( foo bar baz )]; ok_subtype($type1 => $type2, $type3); ok_subtype($type2 => $type1, $type3); ok($type1->equals($type2)); ok($type2->equals($type1)); ok($type3->is_subtype_of($type2)); ok($type2->is_supertype_of($type3)); ok($type1->equals($type2->create_child_type)); ok($type2->equals($type1->create_child_type)); ok($type3->is_subtype_of($type2->create_child_type)); ok($type2->is_supertype_of($type3->create_child_type)); ok($type1->create_child_type->equals($type2)); ok($type2->create_child_type->equals($type1)); ok($type3->create_child_type->is_subtype_of($type2)); ok($type2->create_child_type->is_supertype_of($type3)); done_testing; errors.t000664001750001750 267015111656240 21001 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Duck=pod =encoding utf-8 =head1 PURPOSE Checks duck type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int); use Type::Tiny::Duck; like( exception { Type::Tiny::Duck->new(parent => Int, methods => []) }, qr/^Duck type constraints cannot have a parent/, ); like( exception { Type::Tiny::Duck->new(constraint => sub { 1 }, methods => []) }, qr/^Duck type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Duck->new(inlined => sub { 1 }, methods => []) }, qr/^Duck type constraints cannot have an inlining coderef/, ); like( exception { Type::Tiny::Duck->new() }, qr/^Need to supply list of methods/, ); { package Bar; sub new { bless [], shift }; sub shake { fail("aquiver") }; } my $e = exception { Type::Tiny::Duck ->new(name => "Elsa", methods => [qw/ shake rattle roll /]) ->assert_valid( Bar->new ); }; is_deeply( $e->explain, [ '"Elsa" requires that the reference can "rattle", "roll", and "shake"', 'The reference cannot "rattle"', 'The reference cannot "roll"', ], ); done_testing; exporter.t000664001750001750 130715111656240 21331 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Duck=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Duck can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; { package Local::Agent; sub get {}; sub post {}; } use Type::Tiny::Duck HttpClient => [ 'get', 'post' ]; isa_ok HttpClient, 'Type::Tiny', 'HttpClient'; ok is_HttpClient( bless {}, 'Local::Agent' ); require Type::Registry; is( 'Type::Registry'->for_me->{'HttpClient'}, HttpClient ); done_testing; basic.t000664001750001750 431015111656240 20555 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks enum type constraints work. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Utils qw< enum >; use constant FBB => enum(FBB => [qw/foo bar baz/]); isa_ok(FBB, "Type::Tiny", "FBB"); isa_ok(FBB, "Type::Tiny::Enum", "FBB"); should_pass("foo", FBB); should_pass("bar", FBB); should_pass("baz", FBB); should_fail("quux", FBB); should_fail(" foo", FBB); should_fail("foo\n", FBB); should_fail("\nfoo", FBB); should_fail("\nfoo\n", FBB); should_fail("foo|", FBB); should_fail("|foo", FBB); should_fail(undef, FBB); should_fail({}, FBB); should_fail(\$_, FBB) for "foo", "bar", "baz"; is_deeply( [sort @{FBB->values}], [sort qw/foo bar baz/], 'FBB->values works', ); is_deeply( FBB->values, [qw/foo bar baz/], 'FBB->values retains order', ); is_deeply( [@{ +FBB }], [qw/foo bar baz/], 'overload retains order', ); isnt( exception { push @{ +FBB }, 'quux' }, undef, 'cannot push to overloaded arrayref' ); use Scalar::Util qw(refaddr); is( refaddr(FBB->compiled_check), refaddr(enum(FBB2 => [qw/foo foo foo bar baz/])->compiled_check), "don't create duplicate coderefs", ); { my $exportables = FBB->exportables; my %exportables = map {; $_->{name} => $_->{code} } @$exportables; is_deeply( [ sort keys %exportables ], [ sort qw( FBB is_FBB assert_FBB to_FBB FBB_FOO FBB_BAR FBB_BAZ ) ], 'correct exportables', ) or diag explain( \%exportables ); is( $exportables{FBB_BAZ}->(), 'baz', 'exported constant actually works', ); } { my $type = enum( FBB2 => [qw/ foo bar baz ... /] ); my $exportables = $type->exportables; my %exportables = map {; $_->{name} => $_->{code} } @$exportables; is_deeply( [ sort keys %exportables ], [ sort qw( FBB2 is_FBB2 assert_FBB2 to_FBB2 ) ], 'correct exportables for non-word-safe enum', ) or diag explain( \%exportables ); } done_testing; cmp.t000664001750001750 422115111656240 20254 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Test new type comparison stuff with Type::Tiny::Enum. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Type::Tiny; use Type::Utils qw(enum); use Test::More; use Test::TypeTiny; my $animals = enum Animals => [qw( cat dog mouse rabbit cow horse sheep goat pig zebra lion )]; my $farmAnimals = enum FarmAnimals => [qw( cow horse sheep goat pig )]; my $petAnimals = enum PetAnimals => [qw( cat dog mouse rabbit )]; my $wildAnimals = enum WildAnimals => [qw( zebra lion )]; my $catAnimals = enum CatAnimals => [qw( cat lion )]; my $catAnimals2 = enum FelineAnimals => [qw( lion cat )]; my @combos = ( [ $animals, $animals, Type::Tiny::CMP_EQUAL ], [ $animals, $farmAnimals, Type::Tiny::CMP_SUPERTYPE ], [ $animals, $petAnimals, Type::Tiny::CMP_SUPERTYPE ], [ $animals, $wildAnimals, Type::Tiny::CMP_SUPERTYPE ], [ $farmAnimals, $animals, Type::Tiny::CMP_SUBTYPE ], [ $farmAnimals, $farmAnimals, Type::Tiny::CMP_EQUAL ], [ $farmAnimals, $petAnimals, Type::Tiny::CMP_UNKNOWN ], [ $farmAnimals, $wildAnimals, Type::Tiny::CMP_UNKNOWN ], [ $petAnimals, $animals, Type::Tiny::CMP_SUBTYPE ], [ $petAnimals, $farmAnimals, Type::Tiny::CMP_UNKNOWN ], [ $petAnimals, $petAnimals, Type::Tiny::CMP_EQUAL ], [ $petAnimals, $wildAnimals, Type::Tiny::CMP_UNKNOWN ], [ $wildAnimals, $animals, Type::Tiny::CMP_SUBTYPE ], [ $wildAnimals, $farmAnimals, Type::Tiny::CMP_UNKNOWN ], [ $wildAnimals, $petAnimals, Type::Tiny::CMP_UNKNOWN ], [ $wildAnimals, $wildAnimals, Type::Tiny::CMP_EQUAL ], [ $petAnimals, $catAnimals, Type::Tiny::CMP_UNKNOWN ], [ $catAnimals, $petAnimals, Type::Tiny::CMP_UNKNOWN ], [ $catAnimals, $catAnimals2, Type::Tiny::CMP_EQUAL ], [ $catAnimals2, $catAnimals, Type::Tiny::CMP_EQUAL ], ); for (@combos) { my ($t1, $t2, $r) = @$_; is(Type::Tiny::cmp($t1, $t2), $r, "Relationship between $t1 and $t2"); } done_testing; errors.t000664001750001750 212215111656240 21007 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks enum type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int); use Type::Tiny::Enum; like( exception { Type::Tiny::Enum->new(parent => Int) }, qr/^Enum type constraints cannot have a parent constraint/, ); like( exception { Type::Tiny::Enum->new(constraint => sub { 1 }) }, qr/^Enum type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Enum->new(inlined => sub { 1 }) }, qr/^Enum type constraints cannot have a inlining coderef/, ); like( exception { Type::Tiny::Enum->new() }, qr/^Need to supply list of values/, ); ok( !exception { Type::Tiny::Enum->new(values => [qw/foo bar/]) }, ); done_testing; exporter.t000664001750001750 121315111656240 21343 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Enum can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tiny::Enum Status => [ 'alive', 'dead' ]; isa_ok Status, 'Type::Tiny', 'Status'; ok is_Status( STATUS_DEAD ); ok is_Status( STATUS_ALIVE ); require Type::Registry; is( 'Type::Registry'->for_me->{'Status'}, Status ); done_testing; exporter_lexical.t000664001750001750 206115111656240 23046 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Enum can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { 'Exporter::Tiny' => '1.006000' }; BEGIN { Exporter::Tiny::_HAS_NATIVE_LEXICAL_SUB or Exporter::Tiny::_HAS_MODULE_LEXICAL_SUB or plan skip_all => "This test requires Exporter::Tiny support for exporting lexical subs"; }; use Type::Tiny::Enum -lexical, Status => [ 'alive', 'dead' ]; isa_ok Status, 'Type::Tiny', 'Status'; ok is_Status( STATUS_DEAD ); ok is_Status( STATUS_ALIVE ); require Type::Registry; ok( ! 'Type::Registry'->for_me->{'Status'}, 'nothing added to registry' ); ok( ! __PACKAGE__->can( $_ ), "no $_ function in symbol table" ) for qw( Status is_Status assert_Status to_Status STATUS_DEAD STATUS_ALIVE ); done_testing; sorter.t000664001750001750 145215111656240 21016 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Enum's sorter. =head1 REQUIREMENTS Requires Perl 5.8 because earlier versions of Perl didn't have stable sort. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires '5.008'; use Test::Fatal; use Type::Tiny::Enum; my $enum = 'Type::Tiny::Enum'->new( name => 'FooBarBaz', values => [qw/ foo bar baz /], ); is_deeply( [ $enum->sort(qw/ xyzzy bar quux baz foo bar quuux /) ], [ qw/ foo bar bar baz xyzzy quux quuux / ], 'sorted', ); done_testing; union_intersection.t000664001750001750 160715111656240 23420 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks enums form natural unions and intersections. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard qw( Enum ); my $foo = Enum[ 1, 2, 3 ]; my $bar = Enum[ 1, 4, 5 ]; isa_ok( ( my $foo_union_bar = $foo | $bar ), 'Type::Tiny::Enum', '$foo_union_bar', ); is_deeply( $foo_union_bar->unique_values, [ 1 .. 5 ], '$foo_union_bar->unique_values', ); isa_ok( ( my $foo_intersect_bar = $foo & $bar ), 'Type::Tiny::Enum', '$foo_intersect_bar', ); is_deeply( $foo_intersect_bar->unique_values, [ 1 ], '$foo_intersect_bar->unique_values', ); done_testing;use_eq.t000664001750001750 422415111656240 20761 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Enum=pod =encoding utf-8 =head1 PURPOSE Checks the C attribute of Type::Tiny::Enum =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut # Force Type::Tiny::XS to not be used BEGIN { $ENV{PERL_TYPE_TINY_XS} = 0; }; use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Type::Tiny::Enum; my $ExplicitUseRE = Type::Tiny::Enum->new( use_eq => 0, values => [qw/ foo bar1 /] ); my $ExplicitUseEq = Type::Tiny::Enum->new( use_eq => 1, values => [qw/ foo bar1 bar2 bar3 bar4 bar5 /] ); my $ImplicitUseRE = Type::Tiny::Enum->new( values => [qw/ foo bar1 bar2 bar3 bar4 bar5 /] ); my $ImplicitUseEq = Type::Tiny::Enum->new( values => [qw/ foo bar1 /] ); ok !$ExplicitUseRE->use_eq, 'accessor for explicit use_eq=>false'; ok $ExplicitUseEq->use_eq, 'accessor for explicit use_eq=>true'; ok !$ImplicitUseRE->use_eq, 'accessor for defaulted use_eq=>false'; ok $ImplicitUseEq->use_eq, 'accessor for defaulted use_eq=>true'; like $ExplicitUseRE->inline_check('$VAR'), qr/\$VAR\s*=~/, 'explicit use_eq=>false seems to generate correct code'; like $ExplicitUseEq->inline_check('$VAR'), qr/\$VAR\s*eq/, 'explicit use_eq=>true seems to generate correct code'; like $ImplicitUseRE->inline_check('$VAR'), qr/\$VAR\s*=~/, 'defaulted use_eq=>false seems to generate correct code'; like $ImplicitUseEq->inline_check('$VAR'), qr/\$VAR\s*eq/, 'defaulted use_eq=>true seems to generate correct code'; should_pass $_, $ExplicitUseRE for 'foo', 'bar1'; should_fail $_, $ExplicitUseRE for 'foo1', 'bar2', undef, []; should_pass $_, $ExplicitUseEq for 'foo', 'bar1', 'bar2'; should_fail $_, $ExplicitUseEq for 'foo1', undef, []; should_pass $_, $ImplicitUseEq for 'foo', 'bar1'; should_fail $_, $ImplicitUseEq for 'foo1', 'bar2', undef, []; should_pass $_, $ImplicitUseRE for 'foo', 'bar1', 'bar2'; should_fail $_, $ImplicitUseRE for 'foo1', undef, []; done_testing; basic.t000664001750001750 454715111656240 22333 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Intersection=pod =encoding utf-8 =head1 PURPOSE Checks intersection type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use BiggerLib qw( :types ); use Type::Utils qw( intersection ); { my $x; sub FooBarAndDoesQuux () { $x ||= intersection(FooBarAndDoesQuux => [FooBar, DoesQuux]) } } isa_ok( FooBarAndDoesQuux, 'Type::Tiny::Intersection', 'FooBarAndDoesQuux', ); isa_ok( FooBarAndDoesQuux->[0], 'Type::Tiny::Class', 'FooBarAndDoesQuux->[0]', ); isa_ok( FooBarAndDoesQuux->[1], 'Type::Tiny::Role', 'FooBarAndDoesQuux->[1]', ); is( FooBarAndDoesQuux."", 'FooBar&DoesQuux', 'stringification good', ); my $something = bless [] => do { package Something; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail("Foo::Bar"->new, FooBarAndDoesQuux); should_pass("Foo::Baz"->new, FooBarAndDoesQuux); should_fail($something, FooBarAndDoesQuux); my $something_else = bless [] => do { package Something::Else; sub DOES { return 1 if $_[1] eq 'Else'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail($something_else, FooBarAndDoesQuux); should_fail("Foo::Bar", FooBarAndDoesQuux); should_fail("Foo::Baz", FooBarAndDoesQuux); require Types::Standard; my $reftype_array = Types::Standard::Ref["ARRAY"]; { my $x; sub NotherSect () { $x ||= intersection(NotherUnion => [FooBarAndDoesQuux, $reftype_array]) } } is( scalar @{+NotherSect}, 3, "intersections don't get unnecessarily deep", ); note NotherSect->inline_check('$X'); should_pass(bless([], "Foo::Baz"), NotherSect); should_fail(bless({}, "Foo::Baz"), NotherSect); my $SmallEven = SmallInteger & sub { $_ % 2 == 0 }; isa_ok($SmallEven, "Type::Tiny::Intersection"); ok(!$SmallEven->can_be_inlined, "not ($SmallEven)->can_be_inlined"); should_pass(2, $SmallEven); should_fail(20, $SmallEven); should_fail(3, $SmallEven); isnt( exception { push @{ $SmallEven }, 'quux' }, undef, 'cannot push to overloaded arrayref' ); done_testing; cmp.t000664001750001750 304615111656240 22022 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Intersection=pod =encoding utf-8 =head1 PURPOSE Check cmp for Type::Tiny::Intersection. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Types::Common::Numeric qw(PositiveInt); use Types::Standard qw(Int Num); my $Even = Int->create_child_type(name => 'Even', constraint => sub { not $_ % 2 }); my $PositiveEven = $Even & +PositiveInt; should_pass(2, $PositiveEven); should_fail(-2, $PositiveEven); should_fail(1, $PositiveEven); ok_subtype( Num ,=> Int, PositiveInt, $Even, $PositiveEven ); ok_subtype( Int ,=> PositiveInt, $Even, $PositiveEven ); ok_subtype( PositiveInt ,=> $PositiveEven ); ok_subtype( $Even ,=> $PositiveEven ); ok_subtype(Num->create_child_type, Int, PositiveInt, $Even, $PositiveEven->create_child_type); ok_subtype(Int->create_child_type, PositiveInt, $Even, $PositiveEven->create_child_type); ok_subtype(PositiveInt->create_child_type, $PositiveEven->create_child_type); ok_subtype($Even->create_child_type, $PositiveEven->create_child_type); ok_subtype($PositiveEven, $PositiveEven->create_child_type); ok($Even > $PositiveEven, 'Even >'); ok($PositiveEven < $Even, '< Even'); ok(Int > $PositiveEven, 'Int >'); ok($PositiveEven < Int, '< Int'); ok($PositiveEven == $PositiveEven->create_child_type, '=='); done_testing; constrainedobject.t000664001750001750 563715111656240 24753 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Intersection=pod =encoding utf-8 =head1 PURPOSE Check C, C, and C work for L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; BEGIN { package Local::Class; use overload ( q[""] => sub { shift->as_string }, q[0+] => sub { shift->as_number }, fallback => 1, ); sub new { my $class = shift; my %args = ref $_[0] ? %{$_[0]} : @_; bless \%args => $class; } sub AUTOLOAD { my $self = shift; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/^.*:://; $self->{$method}; } sub DOES { my $self = shift; my ($role) = @_; return 1 if $role eq 'Local::Role'; $self->SUPER::DOES(@_); } sub can { my $self = shift; my ($method) = @_; my $r = $self->SUPER::can(@_); return $r if $r; if ($method !~ /^__/) { return sub { shift->{$method} }; } $r; } sub DESTROY { } }; use Type::Tiny::Class; use Type::Tiny::Duck; use Type::Tiny::Role; use Types::Standard -types; my $class_type = Type::Tiny::Class->new(class => 'Local::Class'); my $role_type = Type::Tiny::Role->new(role => 'Local::Role'); my $duck_type = Type::Tiny::Duck->new(methods => [qw/foo bar baz quux/]); my $intersect = $class_type & $role_type & $duck_type; my $new = $intersect->with_attribute_values(foo => '%_<5'); my @new = @{ $new->type_constraints }; ok($new->[0] == $class_type->with_attribute_values(foo => '%_<5')); ok($new->[1] == $role_type); ok($new->[2] == $duck_type); # nothing can pass this constraint but that doesn't matter my $new2 = ((Int) & $class_type & (ArrayRef) & $role_type & $duck_type) ->with_attribute_values(foo => '%_<5'); my @new2 = @{ $new2->type_constraints }; ok($new2->[0] == Int); ok($new2->[1] == $class_type->with_attribute_values(foo => '%_<5')); ok($new2->[2] == ArrayRef); ok($new2->[3] == $role_type); ok($new2->[4] == $duck_type); my $new3 = ((Int) & $class_type & (ArrayRef) & $role_type & $duck_type) ->stringifies_to( Enum['abc','xyz'] ); ok($new3->[0] == Int); ok($new3->[1] == $class_type->stringifies_to( Enum['abc','xyz'] )); ok($new3->[2] == ArrayRef); ok($new3->[3] == $role_type); ok($new3->[4] == $duck_type); my $new4 = ((Int) & $class_type & (ArrayRef) & $role_type & $duck_type) ->numifies_to( Enum[1..4] ); ok($new4->[0] == Int); ok($new4->[1] == $class_type->numifies_to( Enum[1..4] )); ok($new4->[2] == ArrayRef); ok($new4->[3] == $role_type); ok($new4->[4] == $duck_type); my $working = ( (Ref['HASH']) & ($class_type) )->numifies_to(Enum[42]); ok $working->can_be_inlined; should_pass( 'Local::Class'->new( as_number => 42 ), $working ); should_fail( 'Local::Class'->new( as_number => 41 ), $working ); done_testing(); errors.t000664001750001750 301515111656240 22553 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Intersection=pod =encoding utf-8 =head1 PURPOSE Checks intersection type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int ArrayRef); use Type::Tiny::Intersection; like( exception { Type::Tiny::Intersection->new(parent => Int) }, qr/^Intersection type constraints cannot have a parent constraint/, ); like( exception { Type::Tiny::Intersection->new(constraint => sub { 1 }) }, qr/^Intersection type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Intersection->new(inlined => sub { 1 }) }, qr/^Intersection type constraints cannot have a inlining coderef/, ); like( exception { Type::Tiny::Intersection->new() }, qr/^Need to supply list of type constraints/, ); my $e = exception { Type::Tiny::Intersection ->new(name => "Elsa", type_constraints => [Int, Int]) ->assert_valid( 3.14159 ); }; is_deeply( $e->explain, [ '"Int&Int" requires that the value pass "Int" and "Int"', 'Value "3.14159" did not pass type constraint "Int"', '"Int" is defined as: (do { my $tmp = $_; defined($tmp) and !ref($tmp) and $tmp =~ /\\A-?[0-9]+\\z/ })', ], ) or diag explain($e->explain); done_testing; basic.t000664001750001750 216315111656240 20556 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Role=pod =encoding utf-8 =head1 PURPOSE Checks role type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); isa_ok(DoesQuux, "Type::Tiny", "DoesQuux"); isa_ok(DoesQuux, "Type::Tiny::Role", "DoesQuux"); should_fail("Foo::Bar"->new, DoesQuux); should_pass("Foo::Baz"->new, DoesQuux); should_fail(undef, DoesQuux); should_fail({}, DoesQuux); should_fail(FooBar, DoesQuux); should_fail(FooBaz, DoesQuux); should_fail(DoesQuux, DoesQuux); should_fail("Quux", DoesQuux); is( 'Type::Tiny::Role'->new( role => 'Xyzzy' )->inline_check('$x'), 'Type::Tiny::Role'->new({ role => 'Xyzzy' })->inline_check('$x'), 'constructor can be passed a hash or hashref', ); done_testing; errors.t000664001750001750 345115111656240 21012 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Role=pod =encoding utf-8 =head1 PURPOSE Checks role type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int); use Type::Tiny::Role; like( exception { Type::Tiny::Role->new(parent => Int, role => 'Foo') }, qr/^Role type constraints cannot have a parent/, ); like( exception { Type::Tiny::Role->new(constraint => sub { 1 }, role => 'Foo') }, qr/^Role type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Role->new(inlined => sub { 1 }, role => 'Foo') }, qr/^Role type constraints cannot have an inlining coderef/, ); like( exception { Type::Tiny::Role->new() }, qr/^Need to supply role name/, ); { package Bar; sub new { bless [], shift } sub DOES { 0 } } { my $e = exception { Type::Tiny::Role ->new(name => "Elsa", role => "Foo") ->assert_valid( Bar->new ); }; like( $e->message, qr/did not pass type constraint "Elsa" \(not DOES Foo\)/, ); is_deeply( $e->explain, [ '"Elsa" requires that the reference does Foo', "The reference doesn't Foo", ], ) or diag explain($e->explain); } { my $e = exception { Type::Tiny::Role ->new(role => "Foo") ->assert_valid( Bar->new ); }; like( $e->message, qr/did not pass type constraint \(not DOES Foo\)/, ); is_deeply( $e->explain, [ '"__ANON__" requires that the reference does Foo', "The reference doesn't Foo", ], ) or diag explain($e->explain); } done_testing; exporter.t000664001750001750 123315111656240 21342 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Role=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny::Role can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Tiny::Role 'Local::Foo'; { package Local::Bar; sub DOES { 1 } } isa_ok LocalFoo, 'Type::Tiny', 'LocalFoo'; ok is_LocalFoo( bless {}, 'Local::Bar' ); require Type::Registry; is( 'Type::Registry'->for_me->{'LocalFoo'}, LocalFoo ); done_testing; basic.t000664001750001750 626515111656240 20754 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Union=pod =encoding utf-8 =head1 PURPOSE Checks union type constraints work. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use BiggerLib qw( :types ); use Type::Utils qw( union class_type ); { my $x; sub FooBarOrDoesQuux () { $x ||= union(FooBarOrDoesQuux => [FooBar, DoesQuux]) } } isa_ok( FooBarOrDoesQuux, 'Type::Tiny::Union', 'FooBarOrDoesQuux', ); isa_ok( FooBarOrDoesQuux->[0], 'Type::Tiny::Class', 'FooBarOrDoesQuux->[0]', ); isa_ok( FooBarOrDoesQuux->[1], 'Type::Tiny::Role', 'FooBarOrDoesQuux->[1]', ); is( FooBarOrDoesQuux."", 'FooBar|DoesQuux', 'stringification good', ); my $something = bless [] => do { package Something; sub DOES { return 1 if $_[1] eq 'Quux'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_pass("Foo::Bar"->new, FooBarOrDoesQuux); should_pass("Foo::Baz"->new, FooBarOrDoesQuux); should_pass($something, FooBarOrDoesQuux); my $something_else = bless [] => do { package Something::Else; sub DOES { return 1 if $_[1] eq 'Else'; $_[0]->isa($_[0]); } __PACKAGE__; }; should_fail($something_else, FooBarOrDoesQuux); should_fail("Foo::Bar", FooBarOrDoesQuux); should_fail("Foo::Baz", FooBarOrDoesQuux); { my $x; sub NotherUnion () { $x ||= union(NotherUnion => [BigInteger, FooBarOrDoesQuux, SmallInteger]) } } is( scalar @{+NotherUnion}, 4, "unions don't get unnecessarily deep", ); { package Local::A } { package Local::B } { package Local::C } { package Local::A::A; our @ISA = qw(Local::A) } { package Local::A::B; our @ISA = qw(Local::A) } { package Local::A::AB; our @ISA = qw(Local::A::A Local::A::B) } { package Local::A::X; our @ISA = qw(Local::A) } my $c1 = union [ class_type({ class => "Local::A::AB" }), class_type({ class => "Local::A::X" }), ]; ok( $c1->parent == class_type({ class => "Local::A" }), "can climb up parents of union type constraints to find best common ancestor", ); my $c2 = union [ class_type({ class => "Local::A" }), class_type({ class => "Local::B" }), class_type({ class => "Local::C" }), ]; isnt( exception { push @{ $c2 }, 'quux' }, undef, 'cannot push to overloaded arrayref' ); ok( $c2->parent == Types::Standard::Object(), "can climb up parents of union type constraints to find best common ancestor (again)", ); is( $c2->find_type_for( bless({}, 'Local::B') )->class, 'Local::B', 'Union find_type_for', ); is( $c2->find_type_for( bless({}, 'Local::A::A') )->class, 'Local::A', 'Union find_type_for (less obvious)', ); is( $c2->find_type_for( bless({}, 'Local::A::AB') )->class, 'Local::A', 'Union find_type_for (ambiguous)', ); is( $c2->find_type_for( bless({}, 'Local::D') ), undef, 'Union find_type_for (none)', ); ok( (FooBar|DoesQuux)==(DoesQuux|FooBar), 'Union equals', ); ok( (FooBar|DoesQuux)!=(DoesQuux|SmallInteger), 'Union not equals', ); done_testing; constrainedobject.t000664001750001750 415415111656240 23366 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Union=pod =encoding utf-8 =head1 PURPOSE Check C, C, and C work for L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; BEGIN { package Local::Class; use overload ( q[""] => sub { shift->as_string }, q[0+] => sub { shift->as_number }, fallback => 1, ); sub new { my $class = shift; my %args = ref $_[0] ? %{$_[0]} : @_; bless \%args => $class; } sub AUTOLOAD { my $self = shift; our $AUTOLOAD; (my $method = $AUTOLOAD) =~ s/^.*:://; $self->{$method}; } sub DOES { my $self = shift; my ($role) = @_; return 1 if $role eq 'Local::Role'; $self->SUPER::DOES(@_); } sub can { my $self = shift; my ($method) = @_; my $r = $self->SUPER::can(@_); return $r if $r; if ($method !~ /^__/) { return sub { shift->{$method} }; } $r; } sub DESTROY { } }; use Type::Tiny::Class; use Type::Tiny::Duck; use Type::Tiny::Role; use Types::Standard -types; my $class_type = Type::Tiny::Class->new(class => 'Local::Class'); my $role_type = Type::Tiny::Role->new(role => 'Local::Role'); my $duck_type = Type::Tiny::Duck->new(methods => [qw/foo bar baz quux/]); my $intersect = $class_type | $role_type | $duck_type; my $new = $intersect->with_attribute_values(foo => '%_<5'); my @new = @{ $new->type_constraints }; ok($new->[0] == $class_type->with_attribute_values(foo => '%_<5')); ok($new->[1] == $role_type->with_attribute_values(foo => '%_<5')); ok($new->[2] == $duck_type->with_attribute_values(foo => '%_<5')); my $object = 'Local::Class'->new( as_string => 'OBJ', as_number => 1.2 ); ok $intersect->stringifies_to(Enum['OBJ'])->check($object); ok ! $intersect->stringifies_to(Enum['XXX'])->check($object); ok $intersect->numifies_to(Num)->check($object); ok ! $intersect->numifies_to(Int)->check($object); done_testing(); errors.t000664001750001750 345215111656240 21202 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Union=pod =encoding utf-8 =head1 PURPOSE Checks union type constraints throw sane error messages. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Types::Standard qw(Int ArrayRef); use Type::Tiny::Union; like( exception { Type::Tiny::Union->new(parent => Int) }, qr/^Union type constraints cannot have a parent constraint/, ); like( exception { Type::Tiny::Union->new(constraint => sub { 1 }) }, qr/^Union type constraints cannot have a constraint coderef/, ); like( exception { Type::Tiny::Union->new(inlined => sub { 1 }) }, qr/^Union type constraints cannot have a inlining coderef/, ); like( exception { Type::Tiny::Union->new() }, qr/^Need to supply list of type constraints/, ); my $e = exception { Type::Tiny::Union ->new(name => "Elsa", type_constraints => [Int, ArrayRef[Int]]) ->assert_valid( 3.14159 ); }; is_deeply( $e->explain, [ '"Int|ArrayRef[Int]" requires that the value pass "ArrayRef[Int]" or "Int"', 'Value "3.14159" did not pass type constraint "Int"', ' Value "3.14159" did not pass type constraint "Int"', ' "Int" is defined as: (do { my $tmp = $_; defined($tmp) and !ref($tmp) and $tmp =~ /\\A-?[0-9]+\\z/ })', 'Value "3.14159" did not pass type constraint "ArrayRef[Int]"', ' "ArrayRef[Int]" is a subtype of "ArrayRef"', ' "ArrayRef" is a subtype of "Ref"', ' Value "3.14159" did not pass type constraint "Ref"', ' "Ref" is defined as: (!!ref($_))', ], ) or diag explain($e->explain); done_testing; relationships.t000664001750001750 224015111656240 22544 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-Union=pod =encoding utf-8 =head1 PURPOSE Checks union type constraint subtype/supertype relationships. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use BiggerLib qw( :types ); use Type::Utils qw( union class_type ); use Types::Standard Object => { -as => "Blessed" }; { my $x; sub FooBarOrDoesQuux () { $x ||= union(FooBarOrDoesQuux => [FooBar, DoesQuux]) } } ok( FooBarOrDoesQuux->is_a_type_of(FooBarOrDoesQuux), ); ok( FooBarOrDoesQuux->is_supertype_of(FooBar), ); ok( FooBarOrDoesQuux->is_supertype_of(DoesQuux), ); ok( FooBarOrDoesQuux->is_a_type_of(Blessed), ); ok( ! FooBarOrDoesQuux->is_supertype_of(Blessed), ); ok( ! FooBarOrDoesQuux->is_subtype_of(FooBarOrDoesQuux), ); ok( FooBarOrDoesQuux->is_subtype_of(Blessed), ); done_testing; double-union.t000664001750001750 136015111656240 22502 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-_HalfOp=pod =encoding utf-8 =head1 PURPOSE Ensure that the following works: ArrayRef[Str] | Undef | Str =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Types::Standard -all; my $union = eval { ArrayRef[Str] | Undef | Str }; SKIP: { ok $union or skip 'broken type', 6; ok $union->check([qw/ a b /]); ok !$union->check([[]]); ok $union->check(undef); ok $union->check("a"); ok !$union->check([undef]); ok !$union->check({}); } done_testing; extra-params.t000664001750001750 165315111656240 22513 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-_HalfOp=pod =encoding utf-8 =head1 PURPOSE Ensure that the following works consistently on all supported Perls: HashRef[Int]|Undef, @extra_parameters =head1 AUTHOR Graham Knop Ehaarg@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Graham Knop. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Types::Standard -all; my $union = eval { Dict[ welp => HashRef[Int]|Undef, guff => ArrayRef[Int] ] }; SKIP: { ok $union or skip 'broken type', 6; ok $union->check({welp => {blorp => 1}, guff => [2]}); ok $union->check({welp => undef, guff => [2]}); ok $union->check({welp => {}, guff => []}); ok !$union->check({welp => {}, guff => {}}); ok !$union->check({welp => {blorp => 1}}); ok !$union->check({guff => [2]}); } done_testing; overload-precedence.t000664001750001750 146115111656240 24012 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Tiny-_HalfOp=pod =encoding utf-8 =head1 PURPOSE Ensure that the following works consistently on all supported Perls: ArrayRef[Int] | HashRef[Int] =head1 AUTHOR Graham Knop Ehaarg@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Graham Knop. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Types::Standard -all; my $union = eval { ArrayRef[Int] | HashRef[Int] }; SKIP: { ok $union or skip 'broken type', 6; ok $union->check({welp => 1}); ok !$union->check({welp => 1.4}); ok !$union->check({welp => "guff"}); ok $union->check([1]); ok !$union->check([1.4]); ok !$union->check(["guff"]); } done_testing; auto-registry.t000664001750001750 201715111656240 21567 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Checks Type::Utils declaration functions put types in the caller type registry. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; BEGIN { package Local::Package; use Type::Utils -all; declare 'Reference', where { ref $_ }; }; require Type::Registry; is_deeply( [ sort keys %{ Type::Registry->for_class( 'Local::Package' ) } ], [ sort qw( Reference ) ], 'Declaration functions add types to registries', ); ok( Type::Registry->for_class( 'Local::Package' )->Reference->check( [] ) ); ok( Type::Registry->for_class( 'Local::Package' )->Reference->check( {} ) ); ok( not Type::Registry->for_class( 'Local::Package' )->Reference->check( 42 ) ); done_testing; classifier.t000664001750001750 214315111656240 21075 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Test L C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Type::Utils qw( classifier ); use Types::Standard -types; my $classify = classifier(Num, Str, Int, Ref, ArrayRef, HashRef, Any, InstanceOf['Type::Tiny']); sub classified ($$) { my $got = $classify->($_[0]); my $expected = $_[1]; local $Test::Builder::Level = $Test::Builder::Level + 1; is( $got->name, $expected->name, sprintf("%s classified as %s", Type::Tiny::_dd($_[0]), $expected), ); } classified(42, Int); classified(1.1, Num); classified("Hello world", Str); classified("42", Int); classified("1.1", Num); classified((\(my $x)), Ref); classified([], ArrayRef); classified({}, HashRef); classified(undef, Any); classified(Num, InstanceOf['Type::Tiny']); done_testing; dwim-both.t000664001750001750 251715111656240 20650 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Checks sane behaviour of C from L when both Moose and Mouse are loaded. =head1 DEPENDENCIES Mouse 1.00 and Moose 2.0000; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; { package AAA; use Test::Requires { "Mouse" => "1.00" } }; { package BBB; use Test::Requires { "Moose" => "2.0000" } }; { package Minnie; use Mouse; use Mouse::Util::TypeConstraints qw(:all); subtype "FortyFive", as "Int", where { $_ == 40 or $_ == 5 }; } { package Bulwinkle; use Moose; use Moose::Util::TypeConstraints qw(:all); subtype "FortyFive", as "Int", where { $_ == 45 }; } use Test::TypeTiny; use Type::Utils 0.015 qw(dwim_type); my $mouse = dwim_type "FortyFive", for => "Minnie"; should_fail 2, $mouse; should_pass 5, $mouse; should_pass 40, $mouse; should_fail 45, $mouse; should_fail 99, $mouse; my $moose = dwim_type "FortyFive", for => "Bulwinkle"; should_fail 2, $moose; should_fail 5, $moose; should_fail 40, $moose; should_pass 45, $moose; should_fail 99, $moose; done_testing; dwim-moose.t000664001750001750 473215111656240 21037 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Checks Moose type constraints, and L type constraints are picked up by C from L. =head1 DEPENDENCIES Moose 2.0201 and MooseX::Types 0.31; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "Moose" => "2.0201" }; use Test::Requires { "MooseX::Types" => "0.31" }; use Test::TypeTiny; use Moose; use Moose::Util::TypeConstraints qw(:all); use Type::Utils qw(dwim_type); # Creating a type constraint with Moose subtype "Two", as "Int", where { $_ eq 2 }; my $two = dwim_type("Two"); my $twos = dwim_type("ArrayRef[Two]"); isa_ok($two, 'Type::Tiny', '$two'); isa_ok($twos, 'Type::Tiny', '$twos'); should_pass(2, $two); should_fail(3, $two); should_pass([2, 2, 2], $twos); should_fail([2, 3, 2], $twos); # Creating a type constraint with MooseX::Types { package MyTypes; use MooseX::Types -declare => ["Three"]; use MooseX::Types::Moose "Int"; subtype Three, as Int, where { $_ eq 3 }; $INC{'MyTypes.pm'} = __FILE__; } # Note that MooseX::Types namespace-prefixes its types. my $three = dwim_type("MyTypes::Three"); my $threes = dwim_type("ArrayRef[MyTypes::Three]"); isa_ok($three, 'Type::Tiny', '$three'); isa_ok($threes, 'Type::Tiny', '$threes'); should_pass(3, $three); should_fail(4, $three); should_pass([3, 3, 3], $threes); should_fail([3, 4, 3], $threes); { my $testclass = 'Local::Some::Class'; my $fallback = dwim_type($testclass); should_pass(bless({}, $testclass), $fallback); should_fail(bless({}, 'main'), $fallback); my $fallbackp = dwim_type("ArrayRef[$testclass]"); should_pass([bless({}, $testclass)], $fallbackp); should_pass([], $fallbackp); should_fail([bless({}, 'main')], $fallbackp); my $fallbacku = dwim_type("ArrayRef[$testclass]", fallback => []); is($fallbacku, undef); } { my $testclass = 'Local::Some::Class'; my $fallback = dwim_type("$testclass\::"); should_pass(bless({}, $testclass), $fallback); should_fail(bless({}, 'main'), $fallback); my $fallbackp = dwim_type("ArrayRef[$testclass\::]"); should_pass([bless({}, $testclass)], $fallbackp); should_pass([], $fallbackp); should_fail([bless({}, 'main')], $fallbackp); } done_testing; dwim-mouse.t000664001750001750 473615111656240 21051 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Checks Mouse type constraints, and L type constraints are picked up by C from L. =head1 DEPENDENCIES Mouse 1.00 and MouseX::Types 0.06; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "Mouse" => "1.00" }; use Test::Requires { "MouseX::Types" => "0.06" }; use Test::TypeTiny; use Mouse; use Mouse::Util::TypeConstraints qw(:all); use Type::Utils 0.015 qw(dwim_type); # Creating a type constraint with Mouse subtype "Two", as "Int", where { $_ eq 2 }; my $two = dwim_type("Two"); my $twos = dwim_type("ArrayRef[Two]"); isa_ok($two, 'Type::Tiny', '$two'); isa_ok($twos, 'Type::Tiny', '$twos'); should_pass(2, $two); should_fail(3, $two); should_pass([2, 2, 2], $twos); should_fail([2, 3, 2], $twos); # Creating a type constraint with MouseX::Types { package MyTypes; use MouseX::Types -declare => ["Three"]; use MouseX::Types::Moose "Int"; subtype Three, as Int, where { $_ eq 3 }; $INC{'MyTypes.pm'} = __FILE__; } # Note that MouseX::Types namespace-prefixes its types. my $three = dwim_type("MyTypes::Three"); my $threes = dwim_type("ArrayRef[MyTypes::Three]"); isa_ok($three, 'Type::Tiny', '$three'); isa_ok($threes, 'Type::Tiny', '$threes'); should_pass(3, $three); should_fail(4, $three); should_pass([3, 3, 3], $threes); should_fail([3, 4, 3], $threes); { my $testclass = 'Local::Some::Class'; my $fallback = dwim_type($testclass); should_pass(bless({}, $testclass), $fallback); should_fail(bless({}, 'main'), $fallback); my $fallbackp = dwim_type("ArrayRef[$testclass]"); should_pass([bless({}, $testclass)], $fallbackp); should_pass([], $fallbackp); should_fail([bless({}, 'main')], $fallbackp); my $fallbacku = dwim_type("ArrayRef[$testclass]", fallback => []); is($fallbacku, undef); } { my $testclass = 'Local::Some::Class'; my $fallback = dwim_type("$testclass\::"); should_pass(bless({}, $testclass), $fallback); should_fail(bless({}, 'main'), $fallback); my $fallbackp = dwim_type("ArrayRef[$testclass\::]"); should_pass([bless({}, $testclass)], $fallbackp); should_pass([], $fallbackp); should_fail([bless({}, 'main')], $fallbackp); } done_testing; is.t000664001750001750 222315111656240 17363 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Test L C function. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { 'Test::Warnings' => 0.005 }; use Test::Warnings ':all'; use Test::Fatal; use Type::Utils "is" => { -as => "isntnt" }, "assert"; use Types::Standard "Str"; ok ! isntnt(Str, undef); ok isntnt(Str, ''); ok ! isntnt('Str', undef); ok isntnt('Str', ''); my @warnings = warnings { ok ! isntnt( undef, undef ); }; like( $warnings[0], qr/Expected type, but got undef/, 'warning from is(undef, $value)' ); @warnings = warnings { ok ! isntnt( [], undef ); }; like( $warnings[0], qr/Expected type, but got reference \[/, 'warning from is([], $value)' ); is assert(Str, 'foo'), 'foo'; like exception { assert(Str, []) }, qr/did not pass type constraint/; like exception { assert('*', []) }, qr/Expected type, but got value/; done_testing; match-on-type.t000664001750001750 1152715111656240 21464 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Test L C and C functions. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Type::Utils qw( match_on_type compile_match_on_type ); use Types::Standard -types; sub to_json; *to_json = compile_match_on_type( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ ' . ( join ", " => map { to_json($_) } @$array ) . ' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, ScalarRef() &+ sub { Bool->check($$_) } => q { $$_ ? 'true' : 'false' }, => sub { die "$_ is not acceptable json type" }, ); is( to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef, xyzzy => \1 }), '{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null, "xyzzy" : true }', 'to_json using compile_match_on_type works', ); sub to_json_2 { return match_on_type $_[0] => ( HashRef() => sub { my $hash = shift; '{ ' . ( join ", " => map { '"' . $_ . '" : ' . to_json_2( $hash->{$_} ) } sort keys %$hash ) . ' }'; }, ArrayRef() => sub { my $array = shift; '[ ' . ( join ", " => map { to_json_2($_) } @$array ) . ' ]'; }, Num() => q {$_}, Str() => q { '"' . $_ . '"' }, Undef() => q {'null'}, ScalarRef() &+ sub { Bool->check($$_) } => q { $$_ ? 'true' : 'false' }, => sub { die "$_ is not acceptable json type" }, ); } is( to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef, xyzzy => \1 }), '{ "bar" : 2, "baz" : [ 3, 4, 5 ], "foo" : 1, "quux" : null, "xyzzy" : true }', 'to_json_2 using match_on_type works', ); like( exception { to_json(do { my $x = "hello"; \$x }) }, qr{\ASCALAR\(\w+\) is not acceptable json type}, "fallthrough works for compile_match_on_type", ); like( exception { to_json_2(do { my $x = "hello"; \$x }) }, qr{\ASCALAR\(\w+\) is not acceptable json type}, "fallthrough works for match_on_type", ); my $compiled1 = compile_match_on_type( HashRef() => sub { 'HASH' }, ArrayRef() => sub { 'ARRAY' }, ); is(ref($compiled1), 'CODE', 'compile_match_on_type returns a coderef'); is($compiled1->({}), 'HASH', '... correct result'); is($compiled1->([]), 'ARRAY', '... correct result'); like( exception { $compiled1->(42) }, qr/^No cases matched for Value "?42"?/, '... correct exception', ); if ($ENV{EXTENDED_TESTING}) { require Benchmark; my $iters = 5_000; my $standard = Benchmark::timethis( $iters, '::to_json_2({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})', 'standard', 'none', ); diag "match_on_type: " . Benchmark::timestr($standard); my $compiled = Benchmark::timethis( $iters, '::to_json({foo => 1, bar => 2, baz => [3 .. 5], quux => undef})', 'compiled', 'none', ); diag "compile_match_on_type: " . Benchmark::timestr($compiled); } like( exception { match_on_type([], Int, sub { 44 }); }, qr/^No cases matched/, 'match_on_type with no match', ); like( exception { compile_match_on_type(Int, sub { 44 })->([]); }, qr/^No cases matched/, 'coderef compiled by compile_match_on_type with no match', ); our $context; MATCH_VOID: { match_on_type([], ArrayRef, sub { $context = wantarray }); ok(!defined($context), 'match_on_type void context'); }; MATCH_SCALAR: { my $x = match_on_type([], ArrayRef, sub { $context = wantarray }); ok(defined($context) && !$context, 'match_on_type scalar context'); }; MATCH_LIST: { my @x = match_on_type([], ArrayRef, sub { $context = wantarray }); ok(defined($context) && $context, 'match_on_type list context'); }; MATCH_VOID_STRINGOFCODE: { match_on_type([], ArrayRef, q{ $::context = wantarray }); ok(!defined($context), 'match_on_type void context (string of code)'); }; MATCH_SCALAR_STRINGOFCODE: { my $x = match_on_type([], ArrayRef, q{ $::context = wantarray }); ok(defined($context) && !$context, 'match_on_type scalar context (string of code)'); }; MATCH_LIST_STRINGOFCODE: { my @x = match_on_type([], ArrayRef, q{ $::context = wantarray }); ok(defined($context) && $context, 'match_on_type list context (string of code)'); }; my $compiled = compile_match_on_type(ArrayRef, sub { $context = wantarray }); COMPILE_VOID: { $compiled->([]); ok(!defined($context), 'compile_match_on_type void context'); }; COMPILE_SCALAR: { my $x = $compiled->([]); ok(defined($context) && !$context, 'compile_match_on_type scalar context'); }; COMPILE_LIST: { my @x = $compiled->([]); ok(defined($context) && $context, 'compile_match_on_type list context'); }; done_testing; warnings.t000664001750001750 174215111656240 20605 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Type-Utils=pod =encoding utf-8 =head1 PURPOSE Tests warnings raised by L. =head1 DEPENDENCIES Requires Perl 5.14 and L; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires '5.014'; use Test::Requires { 'Test::Warnings' => 0.005 }; #warnings added in this version use Test::Warnings qw( :no_end_test warnings ); use Type::Library -base, -declare => qw/WholeNumber/; use Type::Utils -all; use Types::Standard qw/Int/; my @warnings = warnings { declare WholeNumber as Int; }; like( $warnings[0], qr/^Possible missing comma after 'declare WholeNumber'/, 'warning for missing comma', ); done_testing; basic.t000664001750001750 176415111656240 20355 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common=pod =encoding utf-8 =head1 PURPOSE Tests L. =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; { my %imported; use Types::Common { into => \%imported }, -all; my @libs = qw( Types::Standard Types::Common::Numeric Types::Common::String Types::TypeTiny ); my @types = map $_->type_names, @libs; my @coercions = map $_->coercion_names, @libs; is_deeply( [ sort keys %imported ], [ sort { $a cmp $b } ( @types, map( "assert_$_", @types ), map( "is_$_", @types ), map( "to_$_", @types ), @coercions, @{ $Type::Params::EXPORT_TAGS{sigs} || [] }, qw( t ), ) ], 'correct imports', ); ok( $imported{t}->( 'Str' ) == Types::Standard::Str(), 't() is preloaded' ); } done_testing; immutable.t000664001750001750 107415111656240 21245 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common=pod =encoding utf-8 =head1 PURPOSE Tests L cannot be added to! =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; use Types::Common; my $e = exception { Types::Common->add_type( { name => 'Boomerang' } ); }; like $e, qr/Type library is immutable/; done_testing; basic.t000664001750001750 634215111656240 21752 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-Numeric=pod =encoding utf-8 =head1 PURPOSE Tests constraints for L. These tests are based on tests from L. =head1 AUTHORS =over 4 =item * Matt S Trout - mst (at) shadowcatsystems.co.uk (L) =item * K. James Cheetham =item * Guillermo Roditi =back Test cases ported to L by Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::TypeTiny; use Types::Common::Numeric -all; should_fail(100, SingleDigit, "SingleDigit 100"); should_fail(10, SingleDigit, "SingleDigit 10"); should_pass(9, SingleDigit, "SingleDigit 9"); should_pass(1, SingleDigit, "SingleDigit 1"); should_pass(0, SingleDigit, "SingleDigit 0"); should_pass(-1, SingleDigit, "SingleDigit -1"); should_pass(-9, SingleDigit, "SingleDigit -9"); should_fail(-10, SingleDigit, "SingleDigit -10"); should_fail(-100, PositiveInt, "PositiveInt (-100)"); should_fail(0, PositiveInt, "PositiveInt (0)"); should_fail(100.885, PositiveInt, "PositiveInt (100.885)"); should_pass(100, PositiveInt, "PositiveInt (100)"); should_fail(0, PositiveNum, "PositiveNum (0)"); should_pass(100.885, PositiveNum, "PositiveNum (100.885)"); should_fail(-100.885, PositiveNum, "PositiveNum (-100.885)"); should_pass(0.0000000001, PositiveNum, "PositiveNum (0.0000000001)"); should_fail(-100, PositiveOrZeroInt, "PositiveOrZeroInt (-100)"); should_pass(0, PositiveOrZeroInt, "PositiveOrZeroInt (0)"); should_fail(100.885, PositiveOrZeroInt, "PositiveOrZeroInt (100.885)"); should_pass(100, PositiveOrZeroInt, "PositiveOrZeroInt (100)"); should_pass(0, PositiveOrZeroNum, "PositiveOrZeroNum (0)"); should_pass(100.885, PositiveOrZeroNum, "PositiveOrZeroNum (100.885)"); should_fail(-100.885, PositiveOrZeroNum, "PositiveOrZeroNum (-100.885)"); should_pass(0.0000000001, PositiveOrZeroNum, "PositiveOrZeroNum (0.0000000001)"); should_fail(100, NegativeInt, "NegativeInt (100)"); should_fail(-100.885, NegativeInt, "NegativeInt (-100.885)"); should_pass(-100, NegativeInt, "NegativeInt (-100)"); should_fail(0, NegativeInt, "NegativeInt (0)"); should_pass(-100.885, NegativeNum, "NegativeNum (-100.885)"); should_fail(100.885, NegativeNum, "NegativeNum (100.885)"); should_fail(0, NegativeNum, "NegativeNum (0)"); should_pass(-0.0000000001, NegativeNum, "NegativeNum (-0.0000000001)"); should_fail(100, NegativeOrZeroInt, "NegativeOrZeroInt (100)"); should_fail(-100.885, NegativeOrZeroInt, "NegativeOrZeroInt (-100.885)"); should_pass(-100, NegativeOrZeroInt, "NegativeOrZeroInt (-100)"); should_pass(0, NegativeOrZeroInt, "NegativeOrZeroInt (0)"); should_pass(-100.885, NegativeOrZeroNum, "NegativeOrZeroNum (-100.885)"); should_fail(100.885, NegativeOrZeroNum, "NegativeOrZeroNum (100.885)"); should_pass(0, NegativeOrZeroNum, "NegativeOrZeroNum (0)"); should_pass(-0.0000000001, NegativeOrZeroNum, "NegativeOrZeroNum (-0.0000000001)"); done_testing; immutable.t000664001750001750 112715111656240 22644 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-Numeric=pod =encoding utf-8 =head1 PURPOSE Tests L cannot be added to! =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; use Types::Common::Numeric; my $e = exception { Types::Common::Numeric->add_type( { name => 'Boomerang' } ); }; like $e, qr/Type library is immutable/; done_testing; ranges.t000664001750001750 1026115111656240 22163 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-Numeric=pod =encoding utf-8 =head1 PURPOSE Tests constraints for L's C and C. =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::TypeTiny qw( -all ); use Test::Fatal; BEGIN { plan skip_all => "https://github.com/perl11/cperl/issues/409" if "$^V" =~ /c$/; }; use Types::Common::Numeric -all; should_fail($_, IntRange[10,15]) for -19 .. +9; should_pass($_, IntRange[10,15]) for 10 .. 15; should_fail($_, IntRange[10,15]) for 16 .. 20; should_fail($_ + 0.5, IntRange[10,15]) for -9 .. 20; should_fail($_, IntRange[10,15]) for ([], {}, sub { 3 }, "hello world"); should_fail($_, IntRange[10]) for -19 .. 9; should_pass($_, IntRange[10]) for 10 .. 24, 1000, 1_000_000; ########### should_fail($_, NumRange[10,15]) for -19 .. +9; should_pass($_, NumRange[10,15]) for 10 .. 15; should_fail($_, NumRange[10,15]) for 16 .. 20; should_fail($_ + 0.5, NumRange[10,15]) for -9 .. 9; should_pass($_ + 0.5, NumRange[10,15]) for 10 .. 14; should_fail($_ + 0.5, NumRange[10,15]) for 15 .. 20; should_fail($_, NumRange[10,15]) for ([], {}, sub { 3 }, "hello world"); should_fail($_, NumRange[10]) for -19 .. 9; should_pass($_, NumRange[10]) for 10 .. 24, 1000, 1_000_000; ########### should_fail( '9.99', NumRange[10,15,0,0] ); should_pass( '10.00', NumRange[10,15,0,0] ); should_pass( '10.01', NumRange[10,15,0,0] ); should_pass( '12.50', NumRange[10,15,0,0] ); should_pass( '14.99', NumRange[10,15,0,0] ); should_pass( '15.00', NumRange[10,15,0,0] ); should_fail( '15.01', NumRange[10,15,0,0] ); should_fail( '9.99', NumRange[10,15,1,0] ); should_fail( '10.00', NumRange[10,15,1,0] ); should_pass( '10.01', NumRange[10,15,1,0] ); should_pass( '12.50', NumRange[10,15,1,0] ); should_pass( '14.99', NumRange[10,15,1,0] ); should_pass( '15.00', NumRange[10,15,1,0] ); should_fail( '15.01', NumRange[10,15,1,0] ); should_fail( '9.99', NumRange[10,15,0,1] ); should_pass( '10.00', NumRange[10,15,0,1] ); should_pass( '10.01', NumRange[10,15,0,1] ); should_pass( '12.50', NumRange[10,15,0,1] ); should_pass( '14.99', NumRange[10,15,0,1] ); should_fail( '15.00', NumRange[10,15,0,1] ); should_fail( '15.01', NumRange[10,15,0,1] ); should_fail( '9.99', NumRange[10,15,1,1] ); should_fail( '10.00', NumRange[10,15,1,1] ); should_pass( '10.01', NumRange[10,15,1,1] ); should_pass( '12.50', NumRange[10,15,1,1] ); should_pass( '14.99', NumRange[10,15,1,1] ); should_fail( '15.00', NumRange[10,15,1,1] ); should_fail( '15.01', NumRange[10,15,1,1] ); ########### should_pass(1, IntRange); should_fail($_, IntRange) for ([], {}, sub { 3 }, "hello world", '1.2345'); should_pass(1, NumRange); should_fail($_, NumRange) for ([], {}, sub { 3 }, "hello world"); should_pass('1.2345', NumRange); ########### foreach my $test ( [NumRange, [{}, 5], qr/NumRange min must be a num/, "NumRange non-numeric min"], [NumRange, [5, {}], qr/NumRange max must be a num/, "NumRange non-numeric max"], [NumRange, [5, 10, {}], qr/NumRange minexcl must be a boolean/, "NumRange non-boolean minexcl"], [NumRange, [5, 10, 0, {}], qr/NumRange maxexcl must be a boolean/, "NumRange non-boolean maxexcl"], [NumRange, [{}, {}], qr/NumRange min must be a num/, "NumRange non-numeric min and max"], [IntRange, [{}, 5], qr/IntRange min must be a int/, "IntRange non-numeric min"], [IntRange, [5, {}], qr/IntRange max must be a int/, "IntRange non-numeric max"], [IntRange, [5, 10, {}], qr/IntRange minexcl must be a boolean/, "IntRange non-boolean minexcl"], [IntRange, [5, 10, 0, {}], qr/IntRange maxexcl must be a boolean/, "IntRange non-boolean maxexcl"], [IntRange, [{}, {}], qr/IntRange min must be a int/, "IntRange non-numeric min and max"], [IntRange, [1.1, 5], qr/IntRange min must be a int/, "IntRange non-integer min"], [IntRange, [5, 9.9], qr/IntRange max must be a int/, "IntRange non-integer max"], ) { my ($base, $params, $qr, $desc) = @$test; my $e = exception { $base->of(@$params) }; like($e, $qr, "Exception thrown for $desc"); } done_testing; basic.t000664001750001750 543115111656240 21614 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-String=pod =encoding utf-8 =head1 PURPOSE Tests constraints for L. These tests are based on tests from L. =head1 AUTHORS =over 4 =item * Matt S Trout - mst (at) shadowcatsystems.co.uk (L) =item * K. James Cheetham =item * Guillermo Roditi =back Test cases ported to L by Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::TypeTiny; use Types::Common::String -all; should_pass('', SimpleStr, "SimpleStr"); should_pass('a string', SimpleStr, "SimpleStr 2"); should_fail("another\nstring", SimpleStr, "SimpleStr 3"); should_fail(join('', ("long string" x 25)), SimpleStr, "SimpleStr 4"); should_fail('', NonEmptyStr, "NonEmptyStr"); should_pass('a string', NonEmptyStr, "NonEmptyStr 2"); should_pass("another string", NonEmptyStr, "NonEmptyStr 3"); should_pass(join('', ("long string" x 25)), NonEmptyStr, "NonEmptyStr 4"); should_pass('good str', NonEmptySimpleStr, "NonEmptySimplrStr"); should_fail('', NonEmptySimpleStr, "NonEmptyStr 2"); should_fail('no', Password, "Password"); should_pass('okay', Password, "Password 2"); should_fail('notokay', StrongPassword, "StrongPassword"); should_pass('83773r_ch01c3', StrongPassword, "StrongPassword 2"); should_fail('NOTOK', LowerCaseSimpleStr, "LowerCaseSimpleStr"); should_pass('ok', LowerCaseSimpleStr, "LowerCaseSimpleStr 2"); should_fail('NOTOK_123`"', LowerCaseSimpleStr, "LowerCaseSimpleStr 3"); should_pass('ok_123`"', LowerCaseSimpleStr, "LowerCaseSimpleStr 4"); should_fail('notok', UpperCaseSimpleStr, "UpperCaseSimpleStr"); should_pass('OK', UpperCaseSimpleStr, "UpperCaseSimpleStr 2"); should_fail('notok_123`"', UpperCaseSimpleStr, "UpperCaseSimpleStr 3"); should_pass('OK_123`"', UpperCaseSimpleStr, "UpperCaseSimpleStr 4"); should_fail('NOTOK', LowerCaseStr, "LowerCaseStr"); should_pass("ok\nok", LowerCaseStr, "LowerCaseStr 2"); should_fail('NOTOK_123`"', LowerCaseStr, "LowerCaseStr 3"); should_pass("ok\n_123`'", LowerCaseStr, "LowerCaseStr 4"); should_fail('notok', UpperCaseStr, "UpperCaseStr"); should_pass("OK\nOK", UpperCaseStr, "UpperCaseStr 2"); should_fail('notok_123`"', UpperCaseStr, "UpperCaseStr 3"); should_pass("OK\n_123`'", UpperCaseStr, "UpperCaseStr 4"); should_pass('032', NumericCode, "NumericCode lives"); should_fail('abc', NumericCode, "NumericCode dies"); should_fail('x18', NumericCode, "mixed NumericCode dies"); done_testing; coerce.t000664001750001750 240115111656240 21765 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-String=pod =encoding utf-8 =head1 PURPOSE Tests coercions for L. These tests are based on tests from L. =head1 AUTHORS =over 4 =item * Matt S Trout - mst (at) shadowcatsystems.co.uk (L) =item * K. James Cheetham =item * Guillermo Roditi =back =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Types::Common::String qw( +LowerCaseSimpleStr +UpperCaseSimpleStr +LowerCaseStr +UpperCaseStr +NumericCode ); is(to_UpperCaseSimpleStr('foo'), 'FOO', 'uppercase str' ); is(to_LowerCaseSimpleStr('BAR'), 'bar', 'lowercase str' ); is(to_UpperCaseStr('foo'), 'FOO', 'uppercase str' ); is(to_LowerCaseStr('BAR'), 'bar', 'lowercase str' ); is(to_NumericCode('4111-1111-1111-1111'), '4111111111111111', 'numeric code' ); is(to_NumericCode('+1 (800) 555-01-23'), '18005550123', 'numeric code' ); done_testing; immutable.t000664001750001750 112415111656240 22505 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-String=pod =encoding utf-8 =head1 PURPOSE Tests L cannot be added to! =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; use Types::Common::String; my $e = exception { Types::Common::String->add_type( { name => 'Boomerang' } ); }; like $e, qr/Type library is immutable/; done_testing; strlength.t000664001750001750 171715111656240 22550 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-String=pod =encoding utf-8 =head1 PURPOSE Tests constraints for L's Ctring =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use utf8; use strict; use warnings FATAL => 'all'; use Test::More; use Test::TypeTiny; use Types::Common::String -all; my $type = StrLength[5,10]; should_fail($_, $type) for ([], {}, sub { 3 }, undef, "", 123, "Hiya", "Hello World"); should_pass($_, $type) for ("Hello", "Hello!", " " x 8, "HelloWorld"); my $type2 = StrLength[4,4]; should_pass("café", $type2); should_pass("™ķ⁹—", $type2); my $type3 = StrLength[4]; should_fail($_, $type3) for ([], {}, sub { 3 }, undef, "", 123); should_pass($_, $type3) for ("Hello", "Hello!", " " x 8, "HelloWorld", "Hiya", "Hello World"); done_testing; unicode.t000664001750001750 310515111656240 22155 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Common-String=pod =encoding utf-8 =head1 PURPOSE Tests Unicode support for L. These tests are based on tests from L. =head1 AUTHORS =over 4 =item * Matt S Trout - mst (at) shadowcatsystems.co.uk (L) =item * K. James Cheetham =item * Guillermo Roditi =back Test cases ported to L by Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Matt S Trout - mst (at) shadowcatsystems.co.uk (L). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use utf8; use Test::More; use Test::TypeTiny; use Types::Common::String -all; should_pass('CAFÉ', UpperCaseStr, "CAFÉ is uppercase"); should_fail('CAFé', UpperCaseStr, "CAFé is not (entirely) uppercase"); should_fail('ŐħĤăĩ', UpperCaseStr, "----- not entirely uppercase"); should_fail('ŐħĤăĩ', LowerCaseStr, "----- not entirely lowercase"); should_pass('café', LowerCaseStr, "café is lowercase"); should_fail('cafÉ', LowerCaseStr, "cafÉ is not (entirely) lowercase"); should_pass('CAFÉ', UpperCaseSimpleStr, "CAFÉ is uppercase"); should_fail('CAFé', UpperCaseSimpleStr, "CAFé is not (entirely) uppercase"); should_pass('café', LowerCaseSimpleStr, "café is lowercase"); should_fail('cafÉ', LowerCaseSimpleStr, "cafÉ is not (entirely) lowercase"); done_testing; arrayreflength.t000664001750001750 270015111656240 22610 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks the new ArrayRef[$type, $min, $max] from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard qw(ArrayRef Int Any); my $type = ArrayRef[Int, 2]; should_fail([], $type); should_fail([0], $type); should_pass([0..1], $type); should_pass([0..2], $type); should_pass([0..3], $type); should_pass([0..4], $type); should_pass([0..5], $type); should_pass([0..6], $type); should_fail([0..1, "nope"], $type); should_fail(["nope", 0..1], $type); $type = ArrayRef[Int, 2, 4]; should_fail([], $type); should_fail([0], $type); should_pass([0..1], $type); should_pass([0..2], $type); should_pass([0..3], $type); should_fail([0..4], $type); should_fail([0..5], $type); should_fail([0..6], $type); should_fail([0..1, "nope"], $type); should_fail(["nope", 0..1], $type); unlike(ArrayRef->of(Any), qr/for/, 'ArrayRef[Any] optimization'); unlike(ArrayRef->of(Any, 2), qr/for/, 'ArrayRef[Any,2] optimization'); unlike(ArrayRef->of(Any, 2, 4), qr/for/, 'ArrayRef[Any,2,4] optimization'); # diag ArrayRef->of(Any, 2, 4)->inline_check('$XXX'); done_testing; basic.t000664001750001750 1071015111656240 20674 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against the type constraints from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard -all; is(Num->library, "Types::Standard", "->library method"); my $var = 123; should_pass(\$var, ScalarRef); should_pass([], ArrayRef); should_pass(+{}, HashRef); should_pass(sub {0}, CodeRef); should_pass(\*STDOUT, GlobRef); should_pass(\(\"Hello"), Ref); should_pass(\*STDOUT, FileHandle); should_pass(qr{x}, RegexpRef); should_pass(1, Str); should_pass(1, Num); should_pass(1, Int); should_pass(1, Defined); should_pass(1, Value); should_pass(undef, Undef); should_pass(undef, Item); should_pass(undef, Any); should_pass('Type::Tiny', ClassName); should_pass('Type::Library', RoleName); should_pass(undef, Bool); should_pass('', Bool); should_pass(0, Bool); should_pass(1, Bool); should_fail(7, Bool); should_pass(\(\"Hello"), ScalarRef); should_fail('Type::Tiny', RoleName); should_fail([], Str); should_fail([], Num); should_fail([], Int); should_pass("4x4", Str); should_fail("4x4", Num); should_fail("4.2", Int); should_fail(undef, Str); should_fail(undef, Num); should_fail(undef, Int); should_fail(undef, Defined); should_fail(undef, Value); { package Local::Class1; use strict; } { no warnings 'once'; $Local::Class2::VERSION = 0.001; @Local::Class3::ISA = qw(UNIVERSAL); @Local::Dummy1::FOO = qw(UNIVERSAL); } { package Local::Class4; sub XYZ () { 1 } } should_fail(undef, ClassName); should_fail([], ClassName); should_pass("Local::Class$_", ClassName) for 2..4; should_fail("Local::Dummy1", ClassName); should_pass([], ArrayRef[Int]); should_pass([1,2,3], ArrayRef[Int]); should_fail([1.1,2,3], ArrayRef[Int]); should_fail([1,2,3.1], ArrayRef[Int]); should_fail([[]], ArrayRef[Int]); should_pass([[3]], ArrayRef[ArrayRef[Int]]); should_fail([["A"]], ArrayRef[ArrayRef[Int]]); my $deep = ArrayRef[HashRef[ArrayRef[HashRef[Int]]]]; ok($deep->can_be_inlined, "$deep can be inlined"); should_pass([{foo1=>[{bar=>1}]},{foo2=>[{baz=>2}]}], $deep); should_pass([{foo1=>[{bar=>1}]},{foo2=>[]}], $deep); should_fail([{foo1=>[{bar=>1}]},{foo2=>[2]}], $deep); should_pass(undef, Maybe[Int]); should_pass(123, Maybe[Int]); should_fail(1.3, Maybe[Int]); my $i = 1; my $f = 1.1; my $s = "Hello"; should_pass(\$s, ScalarRef[Str]); should_pass(\$f, ScalarRef[Str]); should_pass(\$i, ScalarRef[Str]); should_fail(\$s, ScalarRef[Num]); should_pass(\$f, ScalarRef[Num]); should_pass(\$i, ScalarRef[Num]); should_fail(\$s, ScalarRef[Int]); should_fail(\$f, ScalarRef[Int]); should_pass(\$i, ScalarRef[Int]); should_pass(bless([], "Local::Class4"), Ref["ARRAY"]); should_pass(bless({}, "Local::Class4"), Ref["HASH"]); should_pass([], Ref["ARRAY"]); should_pass({}, Ref["HASH"]); should_fail(bless([], "Local::Class4"), Ref["HASH"]); should_fail(bless({}, "Local::Class4"), Ref["ARRAY"]); should_fail([], Ref["HASH"]); should_fail({}, Ref["ARRAY"]); like( exception { ArrayRef["Int"] }, qr{^Parameter to ArrayRef\[\`a\] expected to be a type constraint; got Int}, qq{ArrayRef["Int"] is not a valid type constraint}, ); like( exception { HashRef[[]] }, qr{^Parameter to HashRef\[\`a\] expected to be a type constraint; got ARRAY}, qq{HashRef[[]] is not a valid type constraint}, ); like( exception { ScalarRef[undef] }, qr{^Parameter to ScalarRef\[\`a\] expected to be a type constraint; got}, qq{ScalarRef[undef] is not a valid type constraint}, ); like( exception { Ref[{}] }, qr{^Parameter to Ref\[\`a\] expected to be a Perl ref type; got HASH}, qq{Ref[{}] is not a valid type constraint}, ); SKIP: { skip "requires Perl 5.8", 3 if $] < 5.008; ok( !!Num->check("Inf") == !Types::Standard::STRICTNUM, "'Inf' passes Num unless Types::Standard::STRICTNUM", ); ok( !!Num->check("-Inf") == !Types::Standard::STRICTNUM, "'-Inf' passes Num unless Types::Standard::STRICTNUM", ); ok( !!Num->check("Nan") == !Types::Standard::STRICTNUM, "'Nan' passes Num unless Types::Standard::STRICTNUM", ); } ok( !!Num->check("0.") == !Types::Standard::STRICTNUM, "'0.' passes Num unless Types::Standard::STRICTNUM", ); ok_subtype(Any, Item); done_testing; cycletuple.t000664001750001750 370115111656240 21746 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal qw(exception); use Types::Standard qw( CycleTuple Num Int HashRef ArrayRef Any Optional slurpy ); use Type::Utils qw( class_type ); my $type1 = CycleTuple[ Int->plus_coercions(Num, 'int($_)'), HashRef, ArrayRef, ]; my $type2 = CycleTuple[ Int->where(sub{2})->plus_coercions(Num, 'int($_)'), HashRef, ArrayRef, ]; my $type3 = CycleTuple[ Int->plus_coercions(Num->where(sub{2}), 'int($_)'), HashRef, ArrayRef, ]; my $type4 = CycleTuple[ Int->where(sub{2})->plus_coercions(Num->where(sub{2}), 'int($_)'), HashRef, ArrayRef, ]; my $i; for my $type ($type1, $type2, $type3, $type4) { ++$i; subtest "\$type$i" => sub { should_fail(undef, $type); should_fail({}, $type); should_pass([], $type); should_fail([{}], $type); should_fail([1], $type); should_fail([1,{}], $type); should_pass([1,{}, []], $type); should_fail([1,{}, [], undef], $type); should_fail([1,{}, [], 2], $type); should_pass([1,{}, [], 2, {}, [1]], $type); is_deeply( $type->coerce([1.1, {}, [], 2.2, {}, [3.3]]), [1, {}, [], 2, {}, [3.3]], 'automagic coercion', ); }; } like( exception { CycleTuple[Any, Optional[Any]] }, qr/cannot be optional/i, 'cannot make CycleTuples with optional slots', ); like( exception { CycleTuple[Any, slurpy ArrayRef] }, qr/cannot be slurpy/i, 'cannot make CycleTuples with slurpy slots', ); # should probably write a test case for this. #diag exception { $type->assert_return([1,{},[],[],[],[]]) }; done_testing; deep-coercions.t000664001750001750 3226615111656240 22524 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE If a coercion exists for type C, then Type::Tiny should be able to auto-generate a coercion for type C<< ArrayRef[Foo] >>, etc. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Types::Standard qw( -types slurpy ); use Type::Utils; ok( ! Dict->of(x => Int)->has_coercion, "Dict of type without coercion shouldn't have coercion", ); ok( Dict->of(x => Int->plus_coercions(Any, 1))->has_coercion, "Dict of type with coercion should have coercion", ); ok( ! Tuple->of(Int)->has_coercion, "Tuple of type without coercion shouldn't have coercion", ); ok( Tuple->of(Int->plus_coercions(Any, 1))->has_coercion, "Tuple of type with coercion should have coercion", ); ok( ! Map->of(Str, Int)->has_coercion, "Map of type without coercion shouldn't have coercion", ); ok( Map->of(Str, Int->plus_coercions(Any, 1))->has_coercion, "Map of type with coercion should have coercion", ); NONINLINED: { my $Foo = declare Foo => as Int; coerce $Foo, from Num, via { int($_) }; my $ArrayOfFoo = declare ArrayOfFoo => as ArrayRef[$Foo], coercion => 1; ok($ArrayOfFoo->has_coercion, '$ArrayOfFoo has coercion'); my $arr1 = [1..3]; my $arr2 = [1..3, "Hello"]; is( $ArrayOfFoo->coerce($arr1), $arr1, '$ArrayOfFoo does not coerce value that needs no coercion', ); is_deeply( $ArrayOfFoo->coerce([1.1, 2.1, 3.1]), [1, 2, 3], '$ArrayOfFoo does coerce value that can be coerced', ); is( $ArrayOfFoo->coerce($arr2), $arr2, '$ArrayOfFoo does not coerce value that cannot be coerced', ); my $HashOfFoo = HashRef[$Foo]; ok($HashOfFoo->has_coercion, '$HashOfFoo has coercion'); my $hsh1 = {one => 1, two => 2, three => 3}; my $hsh2 = {one => 1, two => 2, three => 3, greeting => "Hello"}; is( $HashOfFoo->coerce($hsh1), $hsh1, '$HashOfFoo does not coerce value that needs no coercion', ); is_deeply( $HashOfFoo->coerce({one => 1.1, two => 2.2, three => 3.3}), {one => 1, two => 2, three => 3}, '$HashOfFoo does coerce value that can be coerced', ); is( $HashOfFoo->coerce($hsh2), $hsh2, '$HashOfFoo does not coerce value that cannot be coerced', ); my $RefOfFoo = ScalarRef[$Foo]; ok($RefOfFoo->has_coercion, '$RefOfFoo has coercion'); my $ref1 = do { my $x = 1; \$x }; my $ref2 = do { my $x = "xxx"; \$x }; is( $RefOfFoo->coerce($ref1), $ref1, '$RefOfFoo does not coerce value that needs no coercion', ); is_deeply( ${ $RefOfFoo->coerce(do { my $x = 1.1; \$x }) }, 1, '$RefOfFoo does coerce value that can be coerced', ); is( $RefOfFoo->coerce($ref2), $ref2, '$RefOfFoo does not coerce value that cannot be coerced', ); # This added coercion should be ignored, because undef shouldn't # need coercion! my $MaybeFoo = Maybe[$Foo->plus_coercions(Undef, 999)]; is( $MaybeFoo->coerce(undef), undef, '$MaybeFoo does not coerce undef', ); is( $MaybeFoo->coerce(42), 42, '$MaybeFoo does not coerce integer', ); is( $MaybeFoo->coerce(4.2), 4, '$MaybeFoo does coerce non-integer number', ); is( $MaybeFoo->coerce("xyz"), "xyz", '$MaybeFoo cannot coerce non-number', ); }; INLINED: { my $Bar = declare Bar => as Int; coerce $Bar, from Num, q { int($_) }; $Bar->coercion->freeze; my $ArrayOfBar = ArrayRef[$Bar]; $ArrayOfBar->coercion->freeze; ok($ArrayOfBar->has_coercion, '$ArrayOfBar has coercion'); ok($ArrayOfBar->coercion->can_be_inlined, '$ArrayOfBar coercion can be inlined'); my $arr1 = [1..3]; my $arr2 = [1..3, "Hello"]; is( $ArrayOfBar->coerce($arr1), $arr1, '$ArrayOfBar does not coerce value that needs no coercion', ); is_deeply( $ArrayOfBar->coerce([1.1, 2.1, 3.1]), [1, 2, 3], '$ArrayOfBar does coerce value that can be coerced', ); is( $ArrayOfBar->coerce($arr2), $arr2, '$ArrayOfBar does not coerce value that cannot be coerced', ); my $HashOfBar = HashRef[$Bar]; $HashOfBar->coercion->freeze; ok($HashOfBar->has_coercion, '$HashOfBar has coercion'); ok($HashOfBar->coercion->can_be_inlined, '$HashOfBar coercion can be inlined'); my $hsh1 = {one => 1, two => 2, three => 3}; my $hsh2 = {one => 1, two => 2, three => 3, greeting => "Hello"}; is( $HashOfBar->coerce($hsh1), $hsh1, '$HashOfBar does not coerce value that needs no coercion', ); is_deeply( $HashOfBar->coerce({one => 1.1, two => 2.2, three => 3.3}), {one => 1, two => 2, three => 3}, '$HashOfBar does coerce value that can be coerced', ); is( $HashOfBar->coerce($hsh2), $hsh2, '$HashOfBar does not coerce value that cannot be coerced', ); my $RefOfBar = ScalarRef[$Bar]; $RefOfBar->coercion->freeze; ok($RefOfBar->has_coercion, '$RefOfBar has coercion'); ok($RefOfBar->coercion->can_be_inlined, '$RefOfBar coercion can be inlined'); my $ref1 = do { my $x = 1; \$x }; my $ref2 = do { my $x = "xxx"; \$x }; is( $RefOfBar->coerce($ref1), $ref1, '$RefOfBar does not coerce value that needs no coercion', ); is_deeply( ${ $RefOfBar->coerce(do { my $x = 1.1; \$x }) }, 1, '$RefOfBar does coerce value that can be coerced', ); is( $RefOfBar->coerce($ref2), $ref2, '$RefOfBar does not coerce value that cannot be coerced', ); # This added coercion should be ignored, because undef shouldn't # need coercion! my $MaybeBar = Maybe[$Bar->plus_coercions(Undef, 999)]; $MaybeBar->coercion->freeze; is( $MaybeBar->coerce(undef), undef, '$MaybeBar does not coerce undef', ); is( $MaybeBar->coerce(42), 42, '$MaybeBar does not coerce integer', ); is( $MaybeBar->coerce(4.2), 4, '$MaybeBar does coerce non-integer number', ); is( $MaybeBar->coerce("xyz"), "xyz", '$MaybeBar cannot coerce non-number', ); }; MAP: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; $_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray; my $Map1 = Map[$IntFromNum, $IntFromStr]; ok( $Map1->has_coercion && $Map1->coercion->can_be_inlined, "$Map1 has an inlinable coercion", ); is_deeply( $Map1->coerce({ 1.1 => "Hello", 2.1 => "World", 3.1 => "Hiya" }), { 1 => 5, 2 => 5, 3 => 4 }, "Coercions to $Map1", ); is_deeply( $Map1->coerce({ 1.1 => "Hello", 2.1 => "World", 3.1 => [] }), { 1.1 => "Hello", 2.1 => "World", 3.1 => [] }, "Impossible coercion to $Map1", ); my $m = { 1 => 2 }; is( $Map1->coerce($m), $m, "Unneeded coercion to $Map1", ); my $Map2 = Map[$IntFromNum, $IntFromArray]; ok( $Map2->has_coercion && !$Map2->coercion->can_be_inlined, "$Map2 has a coercion, but it cannot be inlined", ); is_deeply( $Map2->coerce({ 1.1 => [1], 2.1 => [1,2], 3.1 => [] }), { 1 => 1, 2 => 2, 3 => 0 }, "Coercions to $Map2", ); is_deeply( $Map2->coerce({ 1.1 => [1], 2.1 => [1,2], 3.1 => {} }), { 1.1 => [1], 2.1 => [1,2], 3.1 => {} }, "Impossible coercion to $Map2", ); $m = { 1 => 2 }; is( $Map2->coerce($m), $m, "Unneeded coercion to $Map2", ); }; DICT: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; $_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray; my @a = (a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum]); my $Dict1 = Dict[ a => $IntFromStr, b => $IntFromNum, c => Optional[$IntFromNum] ]; ok( $Dict1->has_coercion && $Dict1->coercion->can_be_inlined, "$Dict1 has an inlinable coercion", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1.1, c => 2.2 }), { a => 5, b => 1, c => 2 }, "Coercion (A) to $Dict1", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1 }), { a => 5, b => 1 }, "Coercion (B) to $Dict1", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1, c => [], d => 1 }), { a => "Hello", b => 1, c => [], d => 1 }, "Coercion (C) to $Dict1 - changed in 0.003_11; the presence of an additional value cancels coercion", ); }; DICT_PLUS_SLURPY: { my $Rounded1 = Int->plus_coercions(Num, q[int($_)]); my $Dict1 = Dict[ a => $Rounded1, slurpy Map[$Rounded1, $Rounded1] ]; is_deeply( $Dict1->coerce({ a => 1.1, 2.2 => 3.3, 4.4 => 5 }), { a => 1, 2 => 3, 4 => 5 }, "Coercion to $Dict1 (inlined)", ); my $Rounded2 = Int->plus_coercions(Num, sub { int($_) }); my $Dict2 = Dict[ a => $Rounded2, slurpy Map[$Rounded2, $Rounded2] ]; is_deeply( $Dict2->coerce({ a => 1.1, 2.2 => 3.3, 4.4 => 5 }), { a => 1, 2 => 3, 4 => 5 }, "Coercion to $Dict2 (non-inlined)", ); }; DICT_PLUS_OPTIONAL: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, sub { length($_) }; $IntFromStr->coercion->freeze; my $Dict1 = Dict[ a => $IntFromStr, b => Optional[Int], c => Optional[Int] ]; ok( $Dict1->has_coercion && !$Dict1->coercion->can_be_inlined, "$Dict1 has a non-inlinable coercion", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1, c => 2 }), { a => 5, b => 1, c => 2 }, "Coercion (A) to $Dict1", ); is_deeply( $Dict1->coerce({ a => "Hello", b => 1 }), { a => 5, b => 1 }, "Coercion (B) to $Dict1", ); }; TUPLE: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; my $IntFromNum = declare IntFromNum => as Int; coerce $IntFromNum, from Num, q{ int($_) }; my $IntFromArray = declare IntFromArray => as Int; coerce $IntFromArray, from ArrayRef, via { scalar(@$_) }; $_->coercion->freeze for $IntFromStr, $IntFromNum, $IntFromArray; my $Tuple1 = Tuple[ $IntFromNum, Optional[$IntFromStr], slurpy ArrayRef[$IntFromNum]]; ok( $Tuple1->has_coercion && $Tuple1->coercion->can_be_inlined, "$Tuple1 has an inlinable coercion", ); is_deeply( $Tuple1->coerce([qw( 1.1 1.1 )]), [1, 3], "Coercion (A) to $Tuple1", ); is_deeply( $Tuple1->coerce([qw( 1.1 1.1 2.2 2.2 33 3.3 )]), [1, 3, 2, 2, 33, 3], "Coercion (B) to $Tuple1", ); my $Tuple2 = Tuple[ $IntFromNum ]; is_deeply( $Tuple2->coerce([qw( 1.1 )]), [ 1 ], "Coercion (A) to $Tuple2", ); is_deeply( $Tuple2->coerce([qw( 1.1 2.2 )]), [ 1.1, 2.2 ], "Coercion (B) to $Tuple2 - changed in 0.003_11; the presence of an additional value cancels coercion", ); my $EvenInt = Int->create_child_type( name => 'EvenInt', constraint => sub { not $_ % 2 }, ); my $Tuple3 = Tuple[ $EvenInt->plus_coercions(Int, sub { 2 * $_ }) ]; ok( $Tuple3->check([4]) ); ok( not $Tuple3->check([3]) ); is_deeply( $Tuple3->coerce([4]), [4], "No coercion necessary to $Tuple3", ); is_deeply( $Tuple3->coerce([3]), [6], "Coercion to $Tuple3", ); my $EvenInt2 = Int->create_child_type( name => 'EvenInt2', constraint => sub { not $_ % 2 }, inlined => sub { undef, "not($_ % 2)" }, ); my $Tuple4 = Tuple[ $EvenInt2->plus_coercions(Int, q{ 2 * $_ }) ]; ok( $Tuple4->check([4]) ); ok( not $Tuple4->check([3]) ); is_deeply( $Tuple4->coerce([4]), [4], "No coercion necessary to $Tuple4", ); is_deeply( $Tuple4->coerce([3]), [6], "Coercion to $Tuple4", ); }; TUPLE: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; is_deeply( Tuple->of(HashRef, slurpy ArrayRef[$IntFromStr])->coerce([{}, 1, 2.2, "Hello", "world"]), [{}, 1, 3, 5, 5], 'coercing Tuple with slurpy arrayref' ); }; THINGY1: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, q{ length($_) }; is_deeply( Tuple->of($IntFromStr)->coerce(["Hello","world"]), ["Hello","world"], 'inlinable coercion of Tuple with no slurpy given input with extra fields fails' ); }; THINGY2: { my $IntFromStr = declare IntFromStr => as Int; coerce $IntFromStr, from Str, sub{ length($_) }; is_deeply( Tuple->of($IntFromStr)->coerce(["Hello","world"]), ["Hello","world"], 'non-inlinable coercion of Tuple with no slurpy given input with extra fields fails' ); }; THINGY3: { my $IntFromStr = Int->plus_coercions( Str, 'length($_)' ); my $Tuple = Dict->of( xyz => $IntFromStr, slurpy HashRef[Int] ); is_deeply( $Tuple->coerce( { xyz => "Foo", abc => 4 } ), { xyz => 3, abc => 4 }, 'Dict where key has inlineable coercion but slurpy has no coercion' ); is_deeply( $Tuple->coerce( { xyz => "Foo", abc => 4.1 } ), { xyz => "Foo", abc => 4.1 }, '... all or nothing' ); } THINGY4: { my $IntFromStr = Int->plus_coercions( Str, sub { length($_) } ); my $Tuple = Dict->of( xyz => $IntFromStr, slurpy HashRef[Int] ); is_deeply( $Tuple->coerce( { xyz => "Foo", abc => 4 } ), { xyz => 3, abc => 4 }, 'Dict where key has non-inlineable coercion but slurpy has no coercion' ); is_deeply( $Tuple->coerce( { xyz => "Foo", abc => 4.1 } ), { xyz => "Foo", abc => 4.1 }, '... all or nothing' ); } done_testing; filehandle.t000664001750001750 135115111656240 21667 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 SEE ALSO L =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Requires qw( IO::String ); use Types::Standard qw( FileHandle ); should_pass('IO::String'->new, FileHandle); should_fail('IO::String', FileHandle); done_testing; immutable.t000664001750001750 110215111656240 21545 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Tests L cannot be added to! =head1 AUTHOR Toby Inkster. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; use Types::Standard; my $e = exception { Types::Standard->add_type( { name => 'Boomerang' } ); }; like $e, qr/Type library is immutable/; done_testing; lockdown.t000664001750001750 222315111656240 21413 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =head1 PURPOSE OK, we need to bite the bullet and lock down coercions on core type constraints and parameterized type constraints. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Types::Standard -types; use Types::Common::Numeric -types; my $frozen = qr/\AAttempt to add coercion code to a Type::Coercion/; like( exception { Str->coercion->add_type_coercions(ArrayRef, sub { "@$_" }); }, $frozen, 'Types::Standard core types are frozen', ); like( exception { PositiveInt->coercion->add_type_coercions(NegativeInt, sub { -$_ }); }, $frozen, 'Types::Common types are frozen', ); like( exception { InstanceOf->of("Foo")->coercion->add_type_coercions(HashRef, sub { bless $_, "Foo" }); }, $frozen, 'Parameterized types are frozen', ); done_testing; mxtmlb-alike.t000664001750001750 337215111656240 22167 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Test the following types from L which were inspired by L. =over =item C<< InstanceOf >> =item C<< ConsumerOf >> =item C<< HasMethods >> =item C<< Enum >> =back Rather than checking they work directly, we check they are equivalent to known (and well-tested) type constraints generated using L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Type::Utils; sub same_type { my ($a, $b, $msg) = @_; $msg ||= "$a == $b"; @_ = ($a->inline_check('$x'), $b->inline_check('$x'), $msg); goto \&Test::More::is; } same_type( InstanceOf[], Object, ); same_type( InstanceOf["Foo"], class_type(Foo => {class => "Foo"}), ); same_type( InstanceOf["Foo", "Bar"], union [ class_type(Foo => {class => "Foo"}), class_type(Bar => {class => "Bar"}), ], ); same_type( ConsumerOf[], Object, ); same_type( ConsumerOf["Foo"], role_type(Foo => {role => "Foo"}), ); same_type( ConsumerOf["Foo", "Bar"], intersection [ role_type(Foo => {role => "Foo"}), role_type(Bar => {role => "Bar"}), ], ); same_type( HasMethods[], Object, ); same_type( HasMethods["foo"], duck_type(CanFoo => [qw/foo/]), ); same_type( HasMethods["foo", "bar"], duck_type(CanFooBar => [qw/foo bar/]), ); same_type( Enum[], Str, ); same_type( Enum["foo"], enum(Foo => [qw/foo/]), ); same_type( Enum["foo", "bar"], enum(Foo => [qw/foo bar/]), ); done_testing; optlist.t000664001750001750 275315111656240 21301 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. Checks the standalone C coercion. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( OptList MkOpt ); my $O = OptList; my $OM = OptList->plus_coercions(MkOpt); should_pass([], $O); should_pass([[foo=>undef]], $O); should_pass([[foo=>[]]], $O); should_pass([[foo=>{}]], $O); should_pass([], $OM); should_pass([[foo=>undef]], $OM); should_pass([[foo=>[]]], $OM); should_pass([[foo=>{}]], $OM); should_fail([[undef]], $O); should_fail([[[]]], $O); should_fail([[{}]], $O); should_fail([[undef]], $OM); should_fail([[[]]], $OM); should_fail([[{}]], $OM); ok(!$O->has_coercion, "not $O has coercion"); ok($OM->has_coercion, "$OM has coercion"); is_deeply( $OM->coerce(undef), [], '$OM->coerce(undef)', ); is_deeply( $OM->coerce([]), [], '$OM->coerce([])', ); is_deeply( $OM->coerce([foo => {}, bar => "baz"]), [ [foo => {}], [bar => undef], [baz => undef], ], 'simple $OM coercion test', ); is_deeply( $OM->coerce({foo => []}), [ [foo => []], ], 'another simple $OM coercion test', ); done_testing; overload.t000664001750001750 214315111656240 21407 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( Any Item Defined Ref ArrayRef Object Overload ); my $o = bless [] => do { package Local::Class; use overload q[&] => sub { 1 }, fallback => 1; __PACKAGE__; }; should_pass($o, Any); should_pass($o, Item); should_pass($o, Defined); should_pass($o, Ref); should_pass($o, Ref["ARRAY"]); should_pass($o, Object); should_pass($o, Overload); should_pass($o, Overload["&"]); should_fail($o, Ref["HASH"]); should_fail($o, Overload["|"]); should_fail("Local::Class", Overload); should_fail([], Overload); ok_subtype($_, Overload["&"]) for Item, Defined, Ref, Object, Overload; done_testing; strmatch-allow-callbacks.t000664001750001750 166715111656240 24464 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard when C<< $Type::Tiny::AvoidCallbacks >> is false. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::Requires '5.020'; use Types::Standard 'StrMatch'; BEGIN { eval q{ use Test::Warnings } unless "$^V" =~ /c$/ }; $Type::Tiny::AvoidCallbacks = 0; my $z; my $complex = StrMatch->of(qr/x(?{$z})/); # closure so can't be easily inlined ok($complex->can_be_inlined, "using callbacks, this complex regexp can be inlined"); like($complex->inline_check('$_'), qr/Types::Standard::StrMatch/, '... and looks okay'); done_testing; strmatch-avoid-callbacks.t000664001750001750 203715111656240 24440 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard when C<< $Type::Tiny::AvoidCallbacks >> is true. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; BEGIN { plan skip_all => "cperl's `shadow` warnings catgeory breaks this test; skipping" if "$^V" =~ /c$/; }; use Test::Requires '5.020'; use Test::Requires 'Test::Warnings'; use Types::Standard 'StrMatch'; use Test::Warnings 'warning'; $Type::Tiny::AvoidCallbacks = 1; my $z; my $complex = StrMatch->of(qr/x(?{$z})/); # closure so can't be easily inlined my $warning = warning { $z = $complex->inline_check('$VALUE') }; like($z, qr/Types::Standard::StrMatch::expressions/); like($warning, qr/without callbacks/); done_testing; strmatch.t000664001750001750 564415111656240 21432 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::TypeTiny; use Test::Fatal; use Types::Standard -all, "slurpy"; use Type::Utils; my $e = exception { StrMatch[{}] }; like($e, qr/^First parameter to StrMatch\[\`a\] expected to be a Regexp/, 'error message 1'); $e = exception { StrMatch[qr/(.)/, []] }; like($e, qr/^Second parameter to StrMatch\[\`a\] expected to be a type constraint/, 'error message 2'); my $DistanceUnit = enum DistanceUnit => [qw/ mm cm m km /]; my $Distance = declare Distance => as StrMatch[ qr{^([0-9]+)\s+(.+)$}, Tuple[Int, $DistanceUnit], ]; should_pass("mm", $DistanceUnit); should_pass("cm", $DistanceUnit); should_pass("m", $DistanceUnit); should_pass("km", $DistanceUnit); should_fail("MM", $DistanceUnit); should_fail("mm ", $DistanceUnit); should_fail(" mm", $DistanceUnit); should_fail("miles", $DistanceUnit); should_pass("5 km", $Distance) or diag($Distance->inline_check('$XXX')); should_pass("5 mm", $Distance); should_fail("4 miles", $Distance); should_fail("5.5 km", $Distance); should_fail([qw/5 km/], $Distance); my $Boolean = declare Boolean => as StrMatch[qr{^(?:true|false|0|1)$}ism]; should_pass("true", $Boolean); should_pass("True", $Boolean); should_pass("TRUE", $Boolean); should_pass("false", $Boolean); should_pass("False", $Boolean); should_pass("FALSE", $Boolean); should_pass("0", $Boolean); should_pass("1", $Boolean); should_fail("True ", $Boolean); should_fail("11", $Boolean); my $SecureUrl = declare SecureUrl => as StrMatch[qr{^https://}]; should_pass("https://www.google.com/", $SecureUrl); should_fail("http://www.google.com/", $SecureUrl); my $length_eq_3 = StrMatch[qr/\A...\z/]; should_fail('ab', $length_eq_3); should_pass('abc', $length_eq_3); should_fail('abcd', $length_eq_3); #diag( $length_eq_3->inline_check('$x') ); my $length_ge_3 = StrMatch[qr/\A.../]; should_fail('ab', $length_ge_3); should_pass('abc', $length_ge_3); should_pass('abcd', $length_ge_3); #diag( $length_ge_3->inline_check('$x') ); my $Pair = StrMatch[ qr/ \A ([[:alpha:]]+) : ([[:alpha:]]+) \z /x ]; my @got = $Pair->compiled_check->( 'foo:bar' ); is( scalar( @got ), 1, 'StrMatch->of(...)->compiled_check( $val ) always returns a single value, even in list context', ); my $assertion = Eval::TypeTiny::eval_closure( source => sprintf( 'sub { use warnings; %s }', ArrayRef->of( StrMatch[qr/[A-D]/] )->inline_assert( '$_[0]' ), ), ); like( exception { $assertion->( [ 'ABC', undef, 'DEF' ] ) }, qr/\AReference \[([^]]+)\] did not pass type constraint/ms, ); done_testing; structured.t000664001750001750 4354415111656240 22032 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against structured types from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( . ./t ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard -all, "slurpy"; my $struct1 = Map[Int, Num]; should_pass({1=>111,2=>222}, $struct1); should_pass({1=>1.1,2=>2.2}, $struct1); should_fail({1=>"Str",2=>222}, $struct1); should_fail({1.1=>1,2=>2.2}, $struct1); my $struct2 = Tuple[Int, Num, Optional([Int]), slurpy ArrayRef[Num]]; my $struct3 = Tuple[Int, Num, Optional[Int]]; should_pass([1, 1.1], $struct2); should_pass([1, 1.1, 2], $struct2); should_pass([1, 1.1, 2, 2.2], $struct2); should_pass([1, 1.1, 2, 2.2, 2.3], $struct2); should_pass([1, 1.1, 2, 2.2, 2.3, 2.4], $struct2); should_fail({}, $struct2); should_fail([], $struct2); should_fail([1], $struct2); should_fail([1.1, 1.1], $struct2); should_fail([1, 1.1, 2.1], $struct2); should_fail([1, 1.1, 2.1], $struct2); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4, "xyz"], $struct2); should_fail([1, 1.1, undef], $struct2); should_pass([1, 1.1], $struct3); should_pass([1, 1.1, 2], $struct3); should_fail([1, 1.1, 2, 2.2], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4], $struct3); should_fail({}, $struct3); should_fail([], $struct3); should_fail([1], $struct3); should_fail([1.1, 1.1], $struct3); should_fail([1, 1.1, 2.1], $struct3); should_fail([1, 1.1, 2.1], $struct3); should_fail([1, 1.1, 2, 2.2, 2.3, 2.4, "xyz"], $struct3); should_fail([1, 1.1, undef], $struct3); my $struct4 = Dict[ name => Str, age => Int, height => Optional[Num] ]; should_pass({ name => "Bob", age => 40, height => 1.76 }, $struct4); should_pass({ name => "Bob", age => 40 }, $struct4); should_fail({ name => "Bob" }, $struct4); should_fail({ age => 40 }, $struct4); should_fail({ name => "Bob", age => 40.1 }, $struct4); should_fail({ name => "Bob", age => 40, weight => 80.3 }, $struct4); should_fail({ name => "Bob", age => 40, height => 1.76, weight => 80.3 }, $struct4); should_fail({ name => "Bob", age => 40, height => "xyz" }, $struct4); should_fail({ name => "Bob", age => 40, height => undef }, $struct4); should_fail({ name => "Bob", age => undef, height => 1.76 }, $struct4); my $opt1 = Optional[Int]; ok( $opt1->check(1), "$opt1 check (1)"); ok(!$opt1->check('xxx'), "$opt1 check ('xxx')"); my $slurper = Tuple[ArrayRef, slurpy Map[Num, Int]]; should_pass([ [], 1.1 => 1, 2.1 => 2 ], $slurper); should_pass([ [] ], $slurper); should_fail([ [], 1.1 => 1, xxx => 2 ], $slurper); should_fail([ [], 1.1 => 1, 2.1 => undef ], $slurper); my $struct5 = Dict[ i => Maybe[Int], b => Bool ]; should_pass({ i => 42, b => undef }, $struct5); should_pass({ i => 42, b => '' }, $struct5); should_pass({ i => 42, b => 0 }, $struct5); should_pass({ i => 42, b => 1 }, $struct5); should_pass({ i => undef, b => 1 }, $struct5); should_fail({ b => 42, i => 1 }, $struct5); should_fail({ i => 42 }, $struct5); should_fail({ b => 1 }, $struct5); should_fail({ i => 42, b => 1, a => 1 }, $struct5); should_fail({ i => 42, a => 1 }, $struct5); should_fail({ a => 42, b => 1 }, $struct5); my $anyany = Tuple[Any, Any]; should_pass([1,1], $anyany); should_pass([1,undef], $anyany); should_pass([undef,undef], $anyany); should_pass([undef,1], $anyany); should_fail([1], $anyany); should_fail([undef], $anyany); should_fail([1,1,1], $anyany); should_fail([1,1,undef], $anyany); note "Tuple[] vs Tuple"; should_pass([ ], Tuple[]); should_fail([1], Tuple[]); should_pass([ ], Tuple); should_pass([1], Tuple); note "Dict[] vs Dict"; should_pass(+{ }, Dict[]); should_fail(+{foo=>1}, Dict[]); should_pass(+{ }, Dict); should_pass(+{foo=>1}, Dict); my $gazetteer = Dict[ foo => Int, bar => Optional[Int], slurpy HashRef[Num] ]; note "Dict[ ..., slurpy ... ]"; should_pass({ foo => 42 }, $gazetteer); should_pass({ foo => 42, bar => 666 }, $gazetteer); should_fail({ foo => 4.2 }, $gazetteer); should_fail({ foo => 42, bar => 6.66 }, $gazetteer); should_fail({ foo => 4.2, bar => 6.66 }, $gazetteer); should_fail({ foo => undef }, $gazetteer); should_fail({ }, $gazetteer); should_pass({ foo => 42, baz => 999 }, $gazetteer); should_pass({ foo => 42, bar => 666, baz => 999 }, $gazetteer); should_fail({ foo => 4.2, baz => 999 }, $gazetteer); should_fail({ foo => 42, bar => 6.66, baz => 999 }, $gazetteer); should_fail({ foo => 4.2, bar => 6.66, baz => 999 }, $gazetteer); should_fail({ foo => undef, baz => 999 }, $gazetteer); should_fail({ baz => 999 }, $gazetteer); should_pass({ foo => 42, baz => 9.99 }, $gazetteer); should_pass({ foo => 42, bar => 666, baz => 9.99 }, $gazetteer); should_fail({ foo => 4.2, baz => 9.99 }, $gazetteer); should_fail({ foo => 42, bar => 6.66, baz => 9.99 }, $gazetteer); should_fail({ foo => 4.2, bar => 6.66, baz => 9.99 }, $gazetteer); should_fail({ foo => undef, baz => 9.99 }, $gazetteer); should_fail({ baz => 9.99 }, $gazetteer); should_fail({ foo => 42, baz => "x" }, $gazetteer); should_fail({ foo => 42, bar => 666, baz => "x" }, $gazetteer); should_fail({ foo => 4.2, baz => "x" }, $gazetteer); should_fail({ foo => 42, bar => 6.66, baz => "x" }, $gazetteer); should_fail({ foo => 4.2, bar => 6.66, baz => "x" }, $gazetteer); should_fail({ foo => undef, baz => "x" }, $gazetteer); should_fail({ baz => "x" }, $gazetteer); my $gazetteer2 = Dict[ foo => Int, bar => Optional[Int], slurpy Map[StrMatch[qr/^...$/], Num] ]; should_pass({ foo => 99, jjj => '2.2' }, $gazetteer2); should_fail({ jjj => '2.2' }, $gazetteer2); should_fail({ foo => 99, jjjj => '2.2' }, $gazetteer2); # Slurped thing will always be a hashref (even if an empty one) # so cannot be a Num! my $weird = Dict[ foo => Int, slurpy Num ]; should_fail( { foo => 1 }, $weird ); should_fail( { }, $weird ); subtest slurpy_coderef_thing => sub { my $allow_extras = 1; my $type = Tuple[Int, slurpy sub { $allow_extras }]; isa_ok($type->parameters->[-1], 'Type::Tiny'); isa_ok($type->parameters->[-1]->type_parameter, 'Type::Tiny'); should_pass([1], $type); should_pass([1, "extra"], $type); $allow_extras = 0; should_pass([1], $type); should_fail([1, "extra"], $type); }; # this is mostly for better coverage { my $type = Any->where('1'); # needs to be inlineable but not a standard type my $dict = Dict[foo => Int, slurpy $type]; should_fail([foo=>123 ], $dict); should_pass({foo=>123 }, $dict); should_pass({foo=>123,bar=>456}, $dict); should_fail({ bar=>456}, $dict); } subtest my_dict_is_slurpy => sub { ok(!$struct5->my_dict_is_slurpy, 'On a non-slurpy Dict'); ok($gazetteer->my_dict_is_slurpy, 'On a slurpy Dict'); ok(!$struct5->create_child_type->my_dict_is_slurpy, 'On a child of a non-slurpy Dict'); ok($gazetteer->create_child_type->my_dict_is_slurpy, 'On a child of a slurpy Dict'); }; subtest my_hashref_allows_key => sub { ok(HashRef->my_hashref_allows_key('foo'), 'HashRef allows key "foo"'); ok(!HashRef->my_hashref_allows_key(undef), 'HashRef disallows key undef'); ok(!HashRef->my_hashref_allows_key([]), 'HashRef disallows key []'); ok((HashRef[Int])->my_hashref_allows_key('foo'), 'HashRef[Int] allows key "foo"'); ok(!(HashRef[Int])->my_hashref_allows_key(undef), 'HashRef[Int] disallows key undef'); ok(!(HashRef[Int])->my_hashref_allows_key([]), 'HashRef[Int] disallows key []'); ok(Map->my_hashref_allows_key('foo'), 'Map allows key "foo"'); ok(!Map->my_hashref_allows_key(undef), 'Map disallows key undef'); ok(!Map->my_hashref_allows_key([]), 'Map disallows key []'); ok(!(Map[Int,Int])->my_hashref_allows_key('foo'), 'Map[Int,Int] disallows key "foo"'); ok(!(Map[Int,Int])->my_hashref_allows_key(undef), 'Map[Int,Int] disallows key undef'); ok(!(Map[Int,Int])->my_hashref_allows_key([]), 'Map[Int,Int] disallows key []'); ok((Map[Int,Int])->my_hashref_allows_key('42'), 'Map[Int,Int] allows key "42"'); ok(Dict->my_hashref_allows_key('foo'), 'Dict allows key "foo"'); ok(!Dict->my_hashref_allows_key(undef), 'Dict disallows key undef'); ok(!Dict->my_hashref_allows_key([]), 'Dict disallows key []'); ok(!(Dict[])->my_hashref_allows_key('foo'), 'Dict[] disallows key "foo"'); ok(!(Dict[])->my_hashref_allows_key(undef), 'Dict[] disallows key undef'); ok(!(Dict[])->my_hashref_allows_key([]), 'Dict[] disallows key []'); ok(!(Dict[bar=>Int])->my_hashref_allows_key('foo'), 'Dict[bar=>Int] disallows key "foo"'); ok((Dict[bar=>Int])->my_hashref_allows_key('bar'), 'Dict[bar=>Int] allows key "bar"'); ok(!(Dict[bar=>Int])->my_hashref_allows_key(undef), 'Dict[bar=>Int] disallows key undef'); ok(!(Dict[bar=>Int])->my_hashref_allows_key([]), 'Dict[bar=>Int] disallows key []'); ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Any] allows key "foo"'); ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Any] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Any] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Any] disallows key []'); ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Ref] allows key "foo"'); ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Ref] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Ref] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Ref] disallows key []'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "foo"'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('bar'), 'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key([]), 'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('42'), 'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"'); ok(HashRef->create_child_type->my_hashref_allows_key('foo'), 'A child of HashRef allows key "foo"'); ok(!HashRef->create_child_type->my_hashref_allows_key(undef), 'A child of HashRef disallows key undef'); ok(!HashRef->create_child_type->my_hashref_allows_key([]), 'A child of HashRef disallows key []'); ok((HashRef[Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of HashRef[Int] allows key "foo"'); ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key(undef), 'A child of HashRef[Int] disallows key undef'); ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key([]), 'A child of HashRef[Int] disallows key []'); ok(Map->create_child_type->my_hashref_allows_key('foo'), 'A child of Map allows key "foo"'); ok(!Map->create_child_type->my_hashref_allows_key(undef), 'A child of Map disallows key undef'); ok(!Map->create_child_type->my_hashref_allows_key([]), 'A child of Map disallows key []'); ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of Map[Int,Int] disallows key "foo"'); ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key(undef), 'A child of Map[Int,Int] disallows key undef'); ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key([]), 'A child of Map[Int,Int] disallows key []'); ok((Map[Int,Int])->create_child_type->my_hashref_allows_key('42'), 'A child of Map[Int,Int] allows key "42"'); ok(Dict->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict allows key "foo"'); ok(!Dict->create_child_type->my_hashref_allows_key(undef), 'A child of Dict disallows key undef'); ok(!Dict->create_child_type->my_hashref_allows_key([]), 'A child of Dict disallows key []'); ok(!(Dict[])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[] disallows key "foo"'); ok(!(Dict[])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[] disallows key undef'); ok(!(Dict[])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[] disallows key []'); ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int] disallows key "foo"'); ok((Dict[bar=>Int])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int] allows key "bar"'); ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int] disallows key undef'); ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int] disallows key []'); ok((Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Any] allows key "foo"'); ok((Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Any] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Any] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Any])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Any] disallows key []'); ok((Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Ref] allows key "foo"'); ok((Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Ref] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Ref] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Ref])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Ref] disallows key []'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('foo'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "foo"'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('bar'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key(undef), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key undef'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key([]), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_key('42'), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"'); ok(!(Dict[slurpy Int])->my_hashref_allows_key('foo'), 'Dict[slurpy Int] disallows key "foo"'); }; # This could probably be expanded... subtest my_hashref_allows_value => sub { ok(HashRef->my_hashref_allows_value(foo => "bar"), 'HashRef allows key "foo" with value "bar"'); ok(HashRef->my_hashref_allows_value(foo => undef), 'HashRef allows key "foo" with value undef'); ok(!HashRef->my_hashref_allows_value(undef, "bar"), 'HashRef disallows key undef with value "bar"'); ok(!(HashRef[Int])->my_hashref_allows_value(foo => "bar"), 'HashRef[Int] disallows key "foo" with value "bar"'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(bar => 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar" with value 42'); ok((Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(21, 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "21" with value 42'); ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->create_child_type->my_hashref_allows_value(baz => 42), 'A child of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "baz" with value 42'); ok(!(Dict[slurpy Int])->my_hashref_allows_value(foo => 42), 'Dict[slurpy Int] disallows key "foo" with value 42'); }; subtest "Invalid parameters" => sub { my $e; $e = exception { ScalarRef[1] }; like($e, qr/Parameter to ScalarRef\[\`a\] expected to be a type constraint/, 'ScalarRef[INVALID]'); $e = exception { ArrayRef[1] }; like($e, qr/Parameter to ArrayRef\[\`a\] expected to be a type constraint/, 'ArrayRef[INVALID]'); $e = exception { HashRef[1] }; like($e, qr/Parameter to HashRef\[\`a\] expected to be a type constraint/, 'HashRef[INVALID]'); $e = exception { Map[1, Str] }; like($e, qr/First parameter to Map\[\`k,\`v\] expected to be a type constraint/, 'Map[INVALID, Str]'); $e = exception { Map[Str, 1] }; like($e, qr/Second parameter to Map\[\`k,\`v\] expected to be a type constraint/, 'Map[Str, INVALID]'); $e = exception { Tuple[1] }; like($e, qr/Parameters to Tuple\[\.\.\.] expected to be type constraints/, 'Tuple[INVALID]'); $e = exception { Tuple[Str, slurpy 42] }; like($e, qr/^Parameter to Slurpy.... expected to be a type constraint/, 'Tuple[Str, slurpy INVALID]'); $e = exception { Tuple[Optional[Str], Str] }; like($e, qr/Optional parameters to Tuple\[\.\.\.] cannot precede required parameters/, 'Tuple[Optional[Str], Str]'); $e = exception { CycleTuple[1] }; like($e, qr/Parameters to CycleTuple\[\.\.\.] expected to be type constraints/, 'CycleTuple[INVALID]'); $e = exception { CycleTuple[Optional[Str]] }; like($e, qr/Parameters to CycleTuple\[\.\.\.] cannot be optional/, 'CycleTuple[Optional[Str]]'); $e = exception { CycleTuple[slurpy Str] }; like($e, qr/Parameters to CycleTuple\[\.\.\.] cannot be slurpy/, 'CycleTuple[slurpy Str]'); $e = exception { Dict[1] }; like($e, qr/Expected even-sized list/, 'Dict[INVALID]'); $e = exception { Dict[[], Str] }; like($e, qr/Key for Dict\[\.\.\.\] expected to be string/, 'Dict[INVALID => Str]'); $e = exception { Dict[foo => 1] }; like($e, qr/Parameter for Dict\[\.\.\.\] with key 'foo' expected to be a type constraint/, 'Dict[foo => INVALID]'); $e = exception { Dict[foo => Str, slurpy 42] }; like($e, qr/^Parameter to Slurpy.... expected to be a type constraint/, 'Dict[foo => Str, slurpy INVALID]'); }; done_testing; tied.t000664001750001750 461615111656240 20530 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard=pod =encoding utf-8 =head1 PURPOSE Checks various values against C from Types::Standard. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::TypeTiny; use Types::Standard qw( Tied HashRef ); use Type::Utils qw( class_type ); my $a = do { package MyTie::Array; require Tie::Array; our @ISA = qw(Tie::StdArray); tie my(@A), __PACKAGE__; \@A; }; my $h = do { package MyTie::Hash; require Tie::Hash; our @ISA = qw(Tie::StdHash); tie my(%H), __PACKAGE__; \%H }; my $S; my $s = do { package MyTie::Scalar; require Tie::Scalar; our @ISA = qw(Tie::StdScalar); tie $S, __PACKAGE__; \$S; }; should_pass($a, Tied); should_pass($h, Tied); should_pass($s, Tied); should_fail($S, Tied); should_pass($a, Tied["MyTie::Array"]); should_fail($h, Tied["MyTie::Array"]); should_fail($s, Tied["MyTie::Array"]); should_fail($a, Tied["MyTie::Hash"]); should_pass($h, Tied["MyTie::Hash"]); should_fail($s, Tied["MyTie::Hash"]); should_fail($a, Tied["MyTie::Scalar"]); should_fail($h, Tied["MyTie::Scalar"]); should_pass($s, Tied["MyTie::Scalar"]); should_pass($a, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($h, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($s, Tied[ class_type MyTieArray => { class => "MyTie::Array" } ]); should_fail($a, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_pass($h, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_fail($s, Tied[ class_type MyTieHash => { class => "MyTie::Hash" } ]); should_fail($a, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); should_fail($h, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); should_pass($s, Tied[ class_type MyTieScalar => { class => "MyTie::Scalar" } ]); my $intersection = (Tied) & (HashRef); should_pass($h, $intersection); should_fail($a, $intersection); should_fail($s, $intersection); should_fail({foo=>2}, $intersection); my $e = exception { Tied[{}] }; like($e, qr/^Parameter to Tied\[.a\] expected to be a class name/, 'weird exception'); done_testing; exporter.t000664001750001750 173515111656240 23163 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-ArrayRef=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::ArrayRef can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::ArrayRef ( Ints => { type => Int }, Nums => { of => 'Num' }, ); is Ints->name, "Ints"; is Nums->name, "Nums"; ok is_Ints [ 1 .. 5 ]; ok is_Nums [ 1 .. 5 ]; ok !is_Ints [ undef ]; ok !is_Nums [ undef ]; require Type::Registry; is( 'Type::Registry'->for_me->{'Ints'}, Ints ); is( 'Type::Registry'->for_me->{'Nums'}, Nums ); use Types::Standard::ArrayRef TwoInts => { of => Int->where( q{ $_ > 0 } ), where => q{ @$_ == 2 }, }; ok is_TwoInts [ 1, 5 ]; ok !is_TwoInts [ 1 .. 5 ]; ok !is_TwoInts [ -1, 0 ]; done_testing; exporter.t000664001750001750 166215111656240 23520 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-CycleTuple=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::CycleTuple can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::CycleTuple ( IntAndStr1 => { of => [ Int, Str ] }, IntAndStr2 => { of => [ 'Int', 'Str' ] }, ); is IntAndStr1->name, "IntAndStr1"; is IntAndStr2->name, "IntAndStr2"; ok is_IntAndStr1 [ 1 => 'one', 2 => 'two' ]; ok is_IntAndStr2 [ 1 => 'one', 2 => 'two' ]; ok !is_IntAndStr1 [ one => 1 ]; ok !is_IntAndStr2 [ two => 2 ]; require Type::Registry; is( 'Type::Registry'->for_me->{'IntAndStr1'}, IntAndStr1 ); is( 'Type::Registry'->for_me->{'IntAndStr2'}, IntAndStr2 ); done_testing; exporter.t000664001750001750 214015111656240 22322 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-Dict=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::Dict can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::Dict ( Credentials => { of => [ username => Str, password => Str, ] }, Headers => { of => [ 'Content-Type' => Optional[Str], 'Accept' => Optional[Str], 'User-Agent' => Optional[Str], ] }, ); use Types::Standard::Dict ( HttpRequestData => { of => [ credentials => Credentials, headers => Headers, url => Str, method => Enum[ qw( OPTIONS HEAD GET POST PUT DELETE PATCH ) ], ] }, ); ok is_HttpRequestData( { credentials => { username => 'bob', password => 's3cr3t' }, headers => { 'Accept' => 'application/json' }, url => 'http://example.net/api/v1/stuff', method => 'GET', } ); done_testing; exporter.t000664001750001750 152015111656240 22760 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-HashRef=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::HashRef can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::HashRef ( IntHash => { type => Int }, NumHash => { of => 'Num' }, ); is IntHash->name, "IntHash"; is NumHash->name, "NumHash"; ok is_IntHash { one => 1 }; ok is_NumHash { one => 1.1 }; ok !is_IntHash [ undef ]; ok !is_NumHash [ undef ]; require Type::Registry; is( 'Type::Registry'->for_me->{'IntHash'}, IntHash ); is( 'Type::Registry'->for_me->{'NumHash'}, NumHash ); done_testing; exporter.t000664001750001750 155215111656240 22162 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-Map=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::Map can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::Map ( IntMap1 => { keys => Int, values => Str }, IntMap2 => { of => [ 'Int', 'Str' ] }, ); is IntMap1->name, "IntMap1"; is IntMap2->name, "IntMap2"; ok is_IntMap1 { 1 => 'one' }; ok is_IntMap2 { 2 => 'two' }; ok !is_IntMap1 { one => 1 }; ok !is_IntMap2 { two => 2 }; require Type::Registry; is( 'Type::Registry'->for_me->{'IntMap1'}, IntMap1 ); is( 'Type::Registry'->for_me->{'IntMap2'}, IntMap2 ); done_testing; exporter.t000664001750001750 145215111656240 23306 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-ScalarRef=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::ScalarRef can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::ScalarRef ( IntRef => { type => Int }, NumRef => { of => 'Num' }, ); is IntRef->name, "IntRef"; is NumRef->name, "NumRef"; ok is_IntRef \1; ok is_NumRef \1.1; ok !is_IntRef \1.1; ok !is_NumRef \"foo"; require Type::Registry; is( 'Type::Registry'->for_me->{'IntRef'}, IntRef ); is( 'Type::Registry'->for_me->{'NumRef'}, NumRef ); done_testing; exporter.t000664001750001750 146215111656240 23172 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-StrMatch=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::StrMatch can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::StrMatch ( Aaa => { of => qr/\A[Aa]+\z/ }, Bbb => { re => qr/\A[Bb]+\z/ }, ); is Aaa->name, "Aaa"; is Bbb->name, "Bbb"; ok is_Aaa 'AaaaaaaAAAAaaAaAAAaaaA'; ok is_Bbb 'BbbbBbbBbBbBBBbBBBB'; ok !is_Aaa \1.1; ok !is_Bbb "a"; require Type::Registry; is( 'Type::Registry'->for_me->{'Aaa'}, Aaa ); is( 'Type::Registry'->for_me->{'Bbb'}, Bbb ); done_testing; exporter.t000664001750001750 162015111656240 22532 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-Standard-Tuple=pod =encoding utf-8 =head1 PURPOSE Checks Types::Standard::Tuple can export. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Types::Standard -types; use Types::Standard::Tuple ( IntAndStr1 => { of => [ Int, Str ] }, IntAndStr2 => { of => [ 'Int', 'Str' ] }, ); is IntAndStr1->name, "IntAndStr1"; is IntAndStr2->name, "IntAndStr2"; ok is_IntAndStr1 [ 1 => 'one' ]; ok is_IntAndStr2 [ 2 => 'two' ]; ok !is_IntAndStr1 [ one => 1 ]; ok !is_IntAndStr2 [ two => 2 ]; require Type::Registry; is( 'Type::Registry'->for_me->{'IntAndStr1'}, IntAndStr1 ); is( 'Type::Registry'->for_me->{'IntAndStr2'}, IntAndStr2 ); done_testing; basic.t000664001750001750 447115111656240 20710 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Test the L bootstrap library. (That is, type constraints used by Type::Tiny internally.) =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny -all; use Types::TypeTiny -all; my $stringy = do { package Overloaded::String; use overload q[""] => sub { "Hello world" }, fallback => 1; bless {}; }; my $hashy = do { package Overloaded::HashRef; use overload q[%{}] => sub { +{} }, fallback => 1; bless []; }; my $arrayey = do { package Overloaded::ArrayRef; use overload q[@{}] => sub { [] }, fallback => 1; bless {}; }; my $codey = do { package Overloaded::CodeRef; use overload q[&{}] => sub { sub { 42 } }, fallback => 1; bless []; }; subtest "StringLike" => sub { my $type = StringLike; should_pass( "Hello", $type ); should_pass( "", $type ); should_pass( CodeLike, $type, 'Type::Tiny constraint object passes type constraint StringLike' ); should_pass( $stringy, $type ); should_fail( {}, $type ); should_fail( undef, $type ); }; subtest "ArrayLike" => sub { my $type = ArrayLike; should_pass( [], $type ); should_pass( $arrayey, $type ); should_fail( {}, $type ); should_fail( bless([], 'XXX'), $type ); should_fail( undef, $type ); }; subtest "HashLike" => sub { my $type = HashLike; should_pass( {}, $type ); should_pass( $hashy, $type ); should_fail( [], $type ); should_fail( bless({}, 'XXX'), $type ); should_fail( undef, $type ); }; subtest "CodeLike" => sub { my $type = CodeLike; should_pass( sub { 42 }, $type ); should_pass( CodeLike, $type, 'Type::Tiny constraint object passes type constraint CodeLike' ); should_pass( $codey, $type ); should_fail( {}, $type ); should_fail( bless(sub {42}, 'XXX'), $type ); should_fail( undef, $type ); }; subtest "TypeTiny" => sub { my $type = TypeTiny; should_pass( ArrayLike, $type, 'Type::Tiny constraint object passes type constraint TypeTiny' ); should_fail( {}, $type ); should_fail( sub { 42 }, $type ); should_fail( undef, $type ); }; done_testing; coercion.t000664001750001750 2630315111656240 21446 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Test L pseudo-coercion and the L type. =head1 DEPENDENCIES This test requires L 2.0000, L 1.00, and L 1.000000. Otherwise, it is skipped. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); # Test::Requires calls ->import on Moose/Mouse, so be sure # to import them into dummy packages. { package XXX; use Test::Requires { Moose => '2.0000' } }; { package YYY; use Test::Requires { Mouse => '1.00' } }; { package ZZZ; use Test::Requires { Moo => '1.000000' } }; use Test::More; use Test::TypeTiny -all; use Types::TypeTiny -all; use Types::Standard qw(Int); use Moose::Util::TypeConstraints qw(find_type_constraint); ok(TypeTiny->has_coercion, "TypeTiny->has_coercion"); subtest "Coercion from built-in Moose type constraint object" => sub { my $orig = find_type_constraint("Int"); my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted a Moose type constraint to a Type::Tiny one'); is($type->name, 'Int', '... which has the correct name'); ok($type->can_be_inlined, '... and which can be inlined'); note $type->inline_check('$X'); subtest "... and it works" => sub { should_pass(123, $type); should_fail(3.3, $type); }; # This doesn't provide the same message because Type::Tiny isn't # really coercing a Moose type constraint, it's just grabbing `Int` # from Types::Standard. # # is( # $type->get_message(3.3), # $orig->get_message(3.3), # '... and provides proper message', # ); }; subtest "Coercion from custom Moose type constraint object" => sub { my $orig = 'Moose::Meta::TypeConstraint'->new( name => 'EvenInt', parent => find_type_constraint("Int"), constraint => sub { my ( $value ) = @_; $value % 2 == 0; }, inlined => sub { my ( $self, $var ) = @_; return sprintf( 'do { %s } && !( %s %% 2 )', $self->parent->_inline_check( $var ), $var, ); }, message => sub { my ( $value ) = @_; return find_type_constraint("Int")->check( $value ) ? "$value isn't an integer at all" : "$value is odd"; }, ); my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted a Moose type constraint to a Type::Tiny one'); is($type->display_name, 'EvenInt', '... which has the correct display_name'); ok($type->can_be_inlined, '... and which can be inlined'); note $type->inline_check('$X'); subtest "... and it works" => sub { should_fail(3.3, $type); should_fail(123, $type); should_pass(124, $type); }; is( $type->get_message(3.3), $orig->get_message(3.3), '... and provides proper message', ); }; my %moose_ptype_opts = ( name => 'ArrayOrHashRef', parent => find_type_constraint('Ref'), constraint => sub { my $value = @_ ? pop : $_; ref($value) eq 'HASH' or ref($value) eq 'ARRAY'; }, constraint_generator => sub { my $param = shift; return sub { my $value = @_ ? pop : $_; if (ref($value) eq 'ARRAY') { ($param->check($_) or return) for @$value; return 1; } elsif (ref($value) eq 'HASH') { ($param->check($_) or return) for values %$value; return 1; } return; }; }, ); my $ptype_tests = sub { my $moose = Moose::Meta::TypeConstraint::Parameterizable->new(%moose_ptype_opts); # wow, the Moose API is stupid; need to do this Moose::Util::TypeConstraints::register_type_constraint($moose); Moose::Util::TypeConstraints::add_parameterizable_type($moose); note "Moose native type, no parameters"; ok( $moose->check([]) ); ok( $moose->check({}) ); ok( $moose->check([1..10]) ); ok( $moose->check({foo => 1, bar => 2}) ); ok( $moose->check(['hello world']) ); ok( ! $moose->check(\1) ); ok( ! $moose->check(42) ); note "Moose native type, parameterized with Moose type"; my $moose_with_moose = $moose->parameterize( find_type_constraint('Int') ); ok( $moose_with_moose->check([]) ); ok( $moose_with_moose->check({}) ); ok( $moose_with_moose->check([1..10]) ); ok( $moose_with_moose->check({foo => 1, bar => 2}) ); ok( ! $moose_with_moose->check(['hello world']) ); ok( ! $moose_with_moose->check(\1) ); ok( ! $moose_with_moose->check(42) ); note "Moose native type, parameterized with TT type"; my $moose_with_tt = $moose->parameterize( Int ); ok( $moose_with_tt->check([]) ); ok( $moose_with_tt->check({}) ); ok( $moose_with_tt->check([1..10]) ); ok( $moose_with_tt->check({foo => 1, bar => 2}) ); ok( ! $moose_with_tt->check(['hello world']) ); ok( ! $moose_with_tt->check(\1) ); ok( ! $moose_with_tt->check(42) ); note 'TT type, no parameters'; my $tt = Types::TypeTiny::to_TypeTiny($moose); isa_ok($tt, 'Type::Tiny'); is($tt->display_name, $moose_ptype_opts{name}); should_pass([], $tt); should_pass({}, $tt); should_pass([1..10], $tt); should_pass({foo => 1, bar => 2}, $tt); should_pass(['hello world'], $tt); should_fail(\1, $tt); should_fail(42, $tt); note 'TT type, parameterized with Moose type'; my $tt_with_moose = $tt->of( find_type_constraint('Int') ); should_pass([], $tt_with_moose); should_pass({}, $tt_with_moose); should_pass([1..10], $tt_with_moose); should_pass({foo => 1, bar => 2}, $tt_with_moose); should_fail(['hello world'], $tt_with_moose); should_fail(\1, $tt_with_moose); should_fail(42, $tt_with_moose); note 'TT type, parameterized with TT type'; my $tt_with_tt = $tt->of( Int ); should_pass([], $tt_with_tt); should_pass({}, $tt_with_tt); should_pass([1..10], $tt_with_tt); should_pass({foo => 1, bar => 2}, $tt_with_tt); should_fail(['hello world'], $tt_with_tt); should_fail(\1, $tt_with_tt); should_fail(42, $tt_with_tt); return ( $moose, $moose_with_moose, $moose_with_tt, $tt, $tt_with_moose, $tt_with_tt, ); }; subtest "Coercion from Moose parameterizable type constraint object" => sub { $ptype_tests->(); }; # Moose cannot handle two parameterizable types sharing a name $moose_ptype_opts{name} .= '2'; $moose_ptype_opts{inlined} = sub { my $var = pop; sprintf('ref(%s) =~ /^(HASH|ARRAY)$/', $var); }; $moose_ptype_opts{inline_generator} = sub { my ($base, $param, $var) = @_; my $code = sprintf qq{do{ if (ref($var) eq 'ARRAY') { my \$okay = 1; (%s or ((\$okay=0), last)) for \@{$var}; \$okay; } elsif (ref($var) eq 'HASH') { my \$okay = 1; (%s or ((\$okay=0), last)) for values %%{$var}; \$okay; } else { 0; } }}, ($param->_inline_check('$_')) x 2; $code; }; subtest "Coercion from Moose parameterizable type constraint object with inlining" => sub { my @types = $ptype_tests->(); note 'check everything can be inlined'; for my $type (@types) { ok( $type->can_be_inlined ); ok( length($type->_inline_check('$xxx')) ); } note( $types[-1]->inline_check('$VALUE') ); }; subtest "Coercion from Moose enum type constraint" => sub { my $moose = Moose::Util::TypeConstraints::enum(Foo => [qw/ foo bar baz /]); ok( $moose->check("foo") ); ok( ! $moose->check("quux") ); ok( ! $moose->check(\1) ); ok( ! $moose->check(undef) ); my $tt = Types::TypeTiny::to_TypeTiny($moose); ok( $tt->check("foo") ); ok( ! $tt->check("quux") ); ok( ! $tt->check(\1) ); ok( ! $tt->check(undef) ); isa_ok($tt, 'Type::Tiny::Enum'); is_deeply($tt->values, $moose->values); ok $tt->can_be_inlined; note( $tt->inline_check('$STR') ); }; subtest "Coercion from Moose class type constraint" => sub { my $moose = Moose::Util::TypeConstraints::class_type(FooObj => { class => 'MyApp::Foo' }); my $tt = Types::TypeTiny::to_TypeTiny($moose); isa_ok($tt, 'Type::Tiny::Class'); is($tt->class, $moose->class); ok $tt->can_be_inlined; note( $tt->inline_check('$OBJECT') ); }; subtest "Coercion from Moose role type constraint" => sub { my $moose = Moose::Util::TypeConstraints::role_type(DoesFoo => { role => 'MyApp::Foo' }); my $tt = Types::TypeTiny::to_TypeTiny($moose); isa_ok($tt, 'Type::Tiny::Role'); is($tt->role, $moose->role); ok $tt->can_be_inlined; note( $tt->inline_check('$OBJECT') ); }; subtest "Coercion from Moose duck type constraint" => sub { my $moose = Moose::Util::TypeConstraints::duck_type(FooInterface => [qw/foo bar baz/]); my $tt = Types::TypeTiny::to_TypeTiny($moose); isa_ok($tt, 'Type::Tiny::Duck'); is_deeply([ sort @{$tt->methods} ], [ sort @{$moose->methods} ]); ok $tt->can_be_inlined; note( $tt->inline_check('$OBJECT') ); }; subtest "Coercion from Moose union type constraint" => sub { my $moose = Moose::Util::TypeConstraints::union( 'ContainerThang', [ find_type_constraint('ArrayRef'), find_type_constraint('HashRef'), ] ); my $tt = Types::TypeTiny::to_TypeTiny($moose); is($tt->display_name, 'ContainerThang'); isa_ok($tt, 'Type::Tiny::Union'); ok($tt->[0] == Types::Standard::ArrayRef); ok($tt->[1] == Types::Standard::HashRef); ok $tt->can_be_inlined; note( $tt->inline_check('$REF') ); }; subtest "Coercion from Mouse type constraint object" => sub { my $orig = Mouse::Util::TypeConstraints::find_type_constraint("Int"); my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted a Mouse type constraint to a Type::Tiny one'); subtest "... and it works" => sub { should_pass(123, $type); should_fail(3.3, $type); }; is( $type->get_message(3.3), $orig->get_message(3.3), '... and provides proper message', ); }; subtest "Coercion from predicate-like coderef" => sub { my $orig = sub { $_[0] =~ /\A-?[0-9]+\z/ }; my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted the coderef to a Type::Tiny object'); subtest "... and it works" => sub { should_pass(123, $type); should_fail(3.3, $type); }; }; subtest "Coercion from assertion-like coderef" => sub { my $orig = sub { $_[0] =~ /\A-?[0-9]+\z/ or die("not an integer") }; my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted the coderef to a Type::Tiny object'); subtest "... and it works" => sub { should_pass(123, $type); should_fail(3.3, $type); }; like( $type->validate(3.3), qr/\Anot an integer/, '... and provides proper message', ); }; subtest "Coercion from Sub::Quote coderef" => sub { require Sub::Quote; my $orig = Sub::Quote::quote_sub(q{ $_[0] =~ /\A-?[0-9]+\z/ }); my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); should_pass($type, TypeTiny, 'to_TypeTiny converted the coderef to a Type::Tiny object'); ok($type->can_be_inlined, '... which can be inlined'); note $type->inline_check('$X'); subtest "... and it works" => sub { should_pass(123, $type); should_fail(3.3, $type); }; }; done_testing; meta.t000664001750001750 261415111656240 20552 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Test the L introspection methods. Types::TypeTiny doesn't inherit from L (because bootstrapping), so provides independent re-implementations of the most important introspection stuff. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny -all; use Types::TypeTiny; my $meta = Types::TypeTiny->meta; is_deeply( [ sort $meta->type_names ], [ sort qw( BoolLike CodeLike ArrayLike StringLike HashLike TypeTiny _ForeignTypeConstraint ) ], 'type_names', ); ok( $meta->has_type('HashLike'), 'has_type(HashLike)', ); ok( $meta->get_type('HashLike')->equals(Types::TypeTiny::HashLike()), 'get_type(HashLike)', ); ok( !$meta->has_type('MonkeyNuts'), 'has_type(MonkeyNuts)', ); ok( !defined( $meta->get_type('MonkeyNuts') ), 'get_type(MonkeyNuts)', ); is_deeply( [ sort $meta->coercion_names ], [], 'coercion_names', ); ok( !$meta->has_coercion('MonkeyNuts'), 'has_coercion(MonkeyNuts)', ); ok( !defined( $meta->get_coercion('MonkeyNuts') ), 'get_coercion(MonkeyNuts)', ); done_testing; moosemouse.t000664001750001750 265515111656240 22024 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Stuff that was originally in basic.t but was split out to avoid basic.t requiring Moose and Mouse. =head1 DEPENDENCIES This test requires L 2.0000 and L 1.00. Otherwise, it is skipped. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); # Test::Requires calls ->import on Moose/Mouse, so be sure # to import them into dummy packages. { package XXX; use Test::Requires { Moose => '2.0000' } }; { package YYY; use Test::Requires { Mouse => '1.00' } }; use Test::More; use Test::TypeTiny -all; use Types::TypeTiny -all; use Moose::Util::TypeConstraints qw(find_type_constraint); subtest "TypeTiny" => sub { my $type = TypeTiny; should_pass( ArrayLike, $type, 'Type::Tiny constraint object passes type constraint TypeTiny' ); should_fail( {}, $type ); should_fail( sub { 42 }, $type ); should_fail( find_type_constraint("Int"), $type, 'Moose constraint object fails type constraint TypeTiny' ); should_fail( Mouse::Util::TypeConstraints::find_type_constraint("Int"), $type, 'Mouse constraint object fails type constraint TypeTiny' ); should_fail( undef, $type ); }; done_testing; progressiveexporter.t000664001750001750 130115111656240 23755 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny# HARNESS-NO-PRELOAD =pod =encoding utf-8 =head1 PURPOSE Checks that Types::TypeTiny avoids loading Exporter::Tiny. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; require Types::TypeTiny; ok !Exporter::Tiny->can('mkopt'); Types::TypeTiny->import(); ok !Exporter::Tiny->can('mkopt'); Types::TypeTiny->import('HashLike'); ok Exporter::Tiny->can('mkopt'); done_testing; type-puny.t000664001750001750 302115111656240 21567 0ustar00taitai000000000000Type-Tiny-2.008006/t/20-modules/Types-TypeTiny=pod =encoding utf-8 =head1 PURPOSE Test that Type::Tiny works okay with Type::Puny, a clone of Type::Nano. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use lib qw( ./lib ./t/lib ./inc ); use strict; use warnings; use Test::More; use Test::Requires 'Type::Puny'; use Types::Standard; use Types::TypeTiny 'to_TypeTiny'; use Test::Fatal; use Test::TypeTiny; my $conv = to_TypeTiny( Type::Puny::ArrayRef ); should_pass( [ 1 .. 3 ], $conv, ); should_fail( 'Hello world', $conv, ); like( exception { $conv->(undef) }, qr/ArrayRef/, 'get_message worked', ); my $t1 = Types::Standard::ArrayRef->of( Type::Puny::Int ); should_pass( [ 1 .. 3 ], $t1, ); should_fail( {}, $t1, ); should_fail( [ 1 .. 3, undef ], $t1, ); { package Type::Puny::PlusCoerce; our @ISA = 'Type::Puny'; sub has_coercion { exists shift->{coercion} } sub coercion { shift->{coercion} } sub coerce { local $_ = pop; shift->coercion->($_) } } my $Rounded = 'Type::Puny::PlusCoerce'->new( name => 'Rounded', parent => Type::Puny::Int, constraint => sub { 1 }, coercion => sub { int $_ }, ); my $RoundedTT = to_TypeTiny( $Rounded ); ok $RoundedTT->has_coercion, 'Type::Puny::PlusCoerce->has_coercion'; is $RoundedTT->coerce(4.1), 4, 'Type::Puny::PlusCoerce->coerce'; done_testing;basic.t000664001750001750 1044315111656240 21156 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Class-InsideOut=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Class::InsideOut 1.13 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. Based on C<< t/14_accessor_hooks.t >> from the Class::InsideOut test suite, by David Golden. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by David Golden, Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Class::InsideOut" => 1.13 }; use Test::More; BEGIN { package Object::HookedTT; use Class::InsideOut ':std'; use Types::Standard -types; # $_ has the first argument in it for convenience public integer => my %integer, { set_hook => Int }; # first argument is also available directly public word => my %word, { set_hook => StrMatch[qr/\A\w+\z/] }; # Changing $_ changes what gets stored my $UC = (StrMatch[qr/\A[A-Z]+\z/])->plus_coercions(Str, q{uc $_}); public uppercase => my %uppercase, { set_hook => sub { $_ = $UC->coercion->($_) }, }; # Full @_ is available, but only first gets stored public list => my %list, { set_hook => sub { $_ = ArrayRef->check($_) ? $_ : [ @_ ] }, get_hook => sub { @$_ }, }; public reverser => my %reverser, { set_hook => sub { $_ = ArrayRef->check($_) ? $_ : [ @_ ] }, get_hook => sub { reverse @$_ } }; public write_only => my %only_only, { get_hook => sub { die "is write-only\n" } }; sub new { register( bless {}, shift ); } }; #--------------------------------------------------------------------------# my $class = "Object::HookedTT"; my $properties = { $class => { integer => "public", uppercase => "public", word => "public", list => "public", reverser => "public", write_only => "public", }, }; my ($o, @got, $got); #--------------------------------------------------------------------------# is_deeply( Class::InsideOut::_properties( $class ), $properties, "$class has/inherited its expected properties", ); ok( ($o = $class->new()) && $o->isa($class), "Creating a $class object", ); #--------------------------------------------------------------------------# eval { $o->integer(3.14) }; my $err = $@; like( $err, '/integer\(\) Value "3.14" did not pass type constraint "Int"/i', "integer(3.14) dies", ); eval { $o->integer(42) }; is( $@, q{}, "integer(42) lives", ); is( $o->integer, 42, "integer() == 42", ); #--------------------------------------------------------------------------# eval { $o->word("^^^^") }; like( $@, '/word\(\) value "\^\^\^\^" did not pass type constraint/i', "word(^^^^) dies", ); eval { $o->word("apple") }; is( $@, q{}, "word(apple) lives", ); is( $o->word, 'apple', "word() eq 'apple'", ); #--------------------------------------------------------------------------# eval { $o->uppercase("banana") }; is( $@, q{}, "uppercase(banana) lives", ); is( $o->uppercase, 'BANANA', "uppercase() eq 'BANANA'", ); #--------------------------------------------------------------------------# # list(@array) eval { $o->list(qw(foo bar bam)) }; is( $@, q{}, "list(qw(foo bar bam)) lives", ); is_deeply( [ $o->list ], [qw(foo bar bam)], "list() gives qw(foo bar bam)", ); # list(\@array) eval { $o->list( [qw(foo bar bam)] ) }; is( $@, q{}, "list( [qw(foo bar bam)] ) lives", ); is_deeply( [ $o->list ], [qw(foo bar bam)], "list() gives qw(foo bar bam)", ); #--------------------------------------------------------------------------# eval { $o->reverser(qw(foo bar bam)) }; is( $@, q{}, "reverser(qw(foo bar bam)) lives", ); # reverser in list context @got = $o->reverser; is_deeply( \@got, [qw(bam bar foo)], "reverser() in list context gives qw(bam bar foo)", ); # reverser in scalar context $got = $o->reverser; is( $got, 'mabraboof', "reverser() in scalar context gives mabraboof", ); #--------------------------------------------------------------------------# eval { $o->write_only( 23 ) }; is( $@, q{}, "write_only lives on write", ); eval { $got = $o->write_only() }; like( $@, '/write_only\(\) is write-only at/i', "write only dies on write (and was caught)", ); done_testing; basic.t000664001750001750 212415111656240 20273 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Class-Plain=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Class::Plain 0.02 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires '5.026'; use Test::Requires { "Class::Plain" => 0.02 }; use experimental 'signatures'; use Class::Plain; class Point { use Types::Common -types, -sigs; field x :reader; field y :reader; signature_for new => ( method => 1, bless => 0, named => [ x => Int, y => Int, ], ); method as_arrayref () { return [ $self->x, $self->y ]; } } my $point = Point->new( x => 42, y => 666 ); is_deeply( $point->as_arrayref, [ 42, 666 ], ); like( exception { Point->new( x => 42, y => [] ) }, qr/did not pass type constraint "Int"/, ); done_testing; multisig.t000664001750001750 255515111656240 21057 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Class-Plain=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Class::Plain 0.02 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires '5.026'; use Test::Requires { "Class::Plain" => 0.02 }; use experimental 'signatures'; use Class::Plain; class Point { use Types::Common -types, -sigs; field x :reader; field y :reader; signature_for new => ( method => !!1, multiple => [ { named => [ x => Int, y => Int, ], bless => !!0, }, { positional => [ Int, Int ], goto_next => sub { my ( $class, $x, $y ) = @_; return ( $class, { x => $x, y => $y } ), }, }, ], ); method as_arrayref () { return [ $self->x, $self->y ]; } } my $point = Point->new( x => 42, y => 666 ); is_deeply( $point->as_arrayref, [ 42, 666 ], ); like( exception { Point->new( x => 42, y => [] ) }, qr/Parameter validation failed/, ); my $point2 = Point->new( 42, 999 ); is_deeply( $point2->as_arrayref, [ 42, 999 ], ); done_testing; basic.t000664001750001750 206615111656240 21165 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Data-Constraint=pod =encoding utf-8 =head1 PURPOSE Tests integration with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2020-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Test::Fatal; use Test::Requires 'Data::Constraint'; use Types::TypeTiny qw( to_TypeTiny ); 'Data::Constraint'->add_constraint( 'FortyTwo', 'run' => sub { defined $_[1] and not ref $_[1] and $_[1] eq 42 }, 'description' => 'True if the value reveals the answer to life, the universe, and everything', ); my $type = to_TypeTiny( 'Data::Constraint'->get_by_name( 'FortyTwo' ) ); should_pass( 42, $type ); should_fail( "42.0", $type ); should_fail( [ 42 ], $type ); should_fail( undef, $type ); my $e = exception { $type->(43) }; like $e, qr/Value "43" did not pass type constraint "FortyTwo"/, 'error message'; done_testing; basic.t000664001750001750 425515111656240 20725 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Exporter-Tiny=pod =encoding utf-8 =head1 PURPOSE Tests L has the features Type::Tiny needs. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; require Types::Standard; is( exception { "Types::Standard"->import("Any") }, undef, q {No exception exporting a legitimate function}, ); can_ok(main => "Any"); isnt( exception { "Types::Standard"->import("kghffubbtfui") }, undef, q {Attempt to export a function which does not exist}, ); isnt( exception { "Types::Standard"->import("declare") }, undef, q {Attempt to export a function which exists but not in @EXPORT_OK}, ); { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(-types)); is_deeply( [ sort keys %$hash ], [ sort "Types::Standard"->meta->type_names ], '"-types" shortcut works', ); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(-coercions)); is_deeply( [ sort keys %$hash ], [ sort "Types::Standard"->meta->coercion_names ], '"-coercions" shortcut works', ); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, Str => { }); "Types::Standard"->import({ into => $hash }, Str => { -as => "String" }); "Types::Standard"->import({ into => $hash }, -types => { -prefix => "X_" }); "Types::Standard"->import({ into => $hash }, -types => { -suffix => "_Z" }); is($hash->{Str}, $hash->{String}, 'renaming works'); is($hash->{Str}, $hash->{X_Str}, 'prefixes work'); is($hash->{Str}, $hash->{Str_Z}, 'suffixes work'); }; { my $hash = {}; "Types::Standard"->import({ into => $hash }, qw(+Str)); is_deeply( [sort keys %$hash], [sort qw/ assert_Str to_Str is_Str Str /], 'plus notation works for Type::Library', ); }; my $opthash = Exporter::Tiny::mkopt_hash([ foo => [], "bar" ]); is_deeply( $opthash, { foo => [], bar => undef }, 'mkopt_hash', ) or diag explain($opthash); done_testing; installer.t000664001750001750 157215111656240 21640 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Exporter-Tiny=pod =encoding utf-8 =head1 PURPOSE Tests L libraries work with Sub::Exporter plugins. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Sub::Exporter::Lexical" => "0.092291" }; use Test::More; use Test::Fatal; { use Sub::Exporter::Lexical qw( lexical_installer ); use Types::Standard { installer => lexical_installer }, qw( ArrayRef ); ArrayRef->( [] ); } ok(!eval q{ ArrayRef->( [] ) }, 'the ArrayRef function was cleaned away'); ok(!__PACKAGE__->can("ArrayRef"), 'ArrayRef does not appear to be a method'); done_testing; role-conflict.t000664001750001750 233015111656240 22374 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Exporter-Tiny=pod =encoding utf-8 =head1 PURPOSE Tests exporting to two roles; tries to avoid reporting conflicts. =head1 DEPENDENCIES Requires L 5.59 and L 1.000000; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 THANKS This test case is based on a script provided by Kevin Dawson. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires { "Exporter" => 5.59 }; use Test::Requires { "Role::Tiny" => 1.000000 }; use Test::More; use Test::Fatal; { package Local::Role1; use Role::Tiny; use Types::Standard "Str"; } { package Local::Role2; use Role::Tiny; use Types::Standard "Str"; } my $e = exception { package Local::Class1; use Role::Tiny::With; with qw( Local::Role1 Local::Role2 ); }; is($e, undef, 'no exception when trying to compose two roles that use type constraints'); use Scalar::Util "refaddr"; note refaddr(\&Local::Role1::Str); note refaddr(\&Local::Role2::Str); done_testing; basic.t000664001750001750 235615111656240 22062 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Function-Parameters=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Requires Function::Parameters 1.0103, and either Moo 1.000000 or Moose 2.0000; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Function::Parameters" => "1.0103" }; use Test::Fatal; BEGIN { eval 'use Moo 1.000000; 1' or eval 'use Moose 2.0000; 1' or plan skip_all => "this test requires Moo 1.000000 or Moose 2.0000"; }; BEGIN { plan skip_all => 'Devel::Cover' if $INC{'Devel/Cover.pm'} }; use Types::Standard -types; use Function::Parameters qw(:strict); fun foo ((Int) $x) { return $x; } is( foo(4), 4, 'foo(4) works', ); isnt( exception { foo(4.1) }, undef, 'foo(4.1) throws', ); my $info = Function::Parameters::info(\&foo); my ($x) = $info->positional_required; is($x->name, '$x', '$x->name'); ok($x->type == Int, '$x->type'); done_testing; basic.t000664001750001750 175115111656240 17260 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/JSON-PP=pod =encoding utf-8 =head1 PURPOSE Check B and B type constraints against JSON::PP's bools. =head1 DEPENDENCIES Requires JSON::PP. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2023-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "JSON::PP" => "4.00" }; use Test::TypeTiny; use Types::Common qw( Bool BoolLike ); should_pass( $_, Bool ) for 0, 1, "", undef; should_fail( $_, Bool ) for $JSON::PP::true, $JSON::PP::false, \0, \1; is( Bool->coerce($JSON::PP::true), !!1, 'Bool coercion of JSON::PP::true' ); is( Bool->coerce($JSON::PP::false), !!0, 'Bool coercion of JSON::PP::false' ); should_pass( $_, BoolLike ) for 0, 1, "", undef, $JSON::PP::true, $JSON::PP::false; should_fail( $_, Bool ) for \0, \1; done_testing; 80returntype.t000664001750001750 361015111656240 21074 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Kavorka=pod =encoding utf-8 =head1 PURPOSE Adopted test from Kavorka test suite. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use utf8; use warnings; use Test::More; use Test::Fatal; BEGIN { $ENV{AUTOMATED_TESTING} or $ENV{EXTENDED_TESTING} or $ENV{AUTHOR_TESTING} or $ENV{RELEASE_TESTING} or plan skip_all => 'EXTENDED_TESTING'; eval { local $SIG{__WARN__} = sub {}; require Kavorka; 'Kavorka'->import; 1; } or plan skip_all => 'requires Kavorka'; }; note "simple type constraint"; fun add1 ($a, $b → Int) { return $a + $b; } is( add1(4,5), 9 ); is( add1(4.1,4.9), 9 ); like(exception { my $r = add1(4.1, 5) }, qr{did not pass type constraint "Int" at \S+ line 48}); is_deeply( [add1(4,5)], [9] ); like(exception { my @r = add1(4.1, 5) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 51}); note "type constraint expression"; use Types::Standard (); use constant Rounded => Types::Standard::Int()->plus_coercions(Types::Standard::Num(), q[int($_)]); fun add2 ($a, $b --> (Rounded) does coerce) { return $a + $b; } is( add2(4,5), 9 ); is( add2(4.1,4.9), 9 ); is( add2(4.1,5), 9 ); note "type constraints for list and scalar contexts"; fun add3 ($a, $b → Int, ArrayRef[Int] is list) { wantarray ? ($a,$b) : ($a+$b); } is( add3(4,5), 9 ); is( add3(4.1,4.9), 9 ); like(exception { my $r = add3(4.1, 5) }, qr{did not pass type constraint "Int" at \S+ line 74}); is_deeply( [add3(4,5)], [4,5] ); like(exception { my @r = add3(4.1,4.9) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 77}); like(exception { my @r = add3(4.1,5) }, qr{did not pass type constraint "ArrayRef.Int." at \S+ line 78}); done_testing; basic.t000664001750001750 202015111656240 17556 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Kavorka=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'Kavorka'; use Test::Fatal; use Kavorka; use Types::Standard qw(Int Num); fun xyz ( Int $x, (Int) $y, (Int->plus_coercions(Num, 'int($_)')) $z does coerce ) { $x * $y * $z; } is( exception { is( xyz(2,3,4), 24, 'easy sub call; all type constraints should pass', ); is( xyz(2,3,4.2), 24, 'easy sub call; all type constraints should pass or coerce', ); }, undef, '... neither raise an exception', ); isnt( exception { xyz(2.1,3,4) }, undef, 'failed type constraint with no coercion raises an exception', ); done_testing; basic.t000664001750001750 270515111656240 16724 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.000000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.000000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib ":all"; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); isnt( exception { "Local::Class"->new(small => 100) }, undef, "direct violation of type constraint", ); isnt( exception { "Local::Class"->new(small => 5.5) }, undef, "violation of parent type constraint", ); isnt( exception { "Local::Class"->new(small => "five point five") }, undef, "violation of grandparent type constraint", ); isnt( exception { "Local::Class"->new(small => []) }, undef, "violation of great-grandparent type constraint", ); done_testing; coercion-inlining-avoidance.t000664001750001750 545115111656240 23201 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE A rather complex case of defining an attribute with a type coercion in Moo; and only then adding coercion definitions to it. Does Moo pick up on the changes? It should. =head1 DEPENDENCIES Test is skipped if Moo 1.004000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { 'Moo' => '1.004000' }; use Test::Fatal; use Types::Standard -types; my $e; my $type = Int->create_child_type( name => 'MyInt', coercion => [ Num, q[int($_)] ], ); ok( !$type->coercion->frozen, 'created a type constraint without a frozen coercion', ); ok( !$type->coercion->can_be_inlined, '... it reports that it cannot be inlined', ); { package Foo; use Moo; has foo => (is => 'ro', isa => $type, coerce => $type->coercion); } # We need to do some quick checks before adding the coercions, # partly because this is interesting to check, and partly because # we need to ensure that the is( Foo->new(foo => 3.2)->foo, 3, 'initial use of type in a Moo constructor', ); $e = exception { Foo->new(foo => [3..4])->foo }; like( $e->message, qr/did not pass type constraint/, '... and it cannot coerce from an arrayref', ); $e = exception { Foo->new(foo => { value => 42 })->foo }; like( $e->message, qr/did not pass type constraint/, '... and it cannot coerce from an hashref', ); is( exception { $type->coercion->add_type_coercions( ArrayRef, q[scalar(@$_)], HashRef, q[$_->{value}], ScalarRef, q["this is just a talisman"], ); }, undef, 'can add coercions from ArrayRef and HashRef to the type', ); ok( !$type->coercion->frozen, '... it is still not frozen', ); ok( !$type->coercion->can_be_inlined, '... it reports that it still cannot be inlined', ); is( Foo->new(foo => 3.2)->foo, 3, 'again use of type in a Moo constructor', ); is( Foo->new(foo => [3..4])->foo, 2, '... but can coerce from ArrayRef', ); is( Foo->new(foo => { value => 42 })->foo, 42, '... and can coerce from HashRef', ); is( exception { $type->coercion->freeze }, undef, 'can freeze the coercion', ); ok( $type->coercion->frozen, '... it reports that it is frozen', ); ok( $type->coercion->can_be_inlined, '... it reports that it can be inlined', ); { package Goo; use Moo; has foo => (is => 'ro', isa => $type, coerce => $type->coercion); } Goo->new; if ( $ENV{AUTHOR_TESTING} ) { require B::Deparse; my $deparsed = B::Deparse->new->coderef2text(\&Goo::new); like($deparsed, qr/talisman/i, 'Moo inlining for coercions') or diag($deparsed); } done_testing; coercion.t000664001750001750 415115111656240 17441 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.000000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.000000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib -all; ::isa_ok(BigInteger, "Type::Tiny"); has small => (is => "rw", isa => SmallInteger, coerce => SmallInteger->coercion); has big => (is => "rw", isa => BigInteger, coerce => BigInteger->coercion); } my ($e, $o); my $suffix = "mutable class"; for (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; ok($e, "'big' attribute throws when it cannot coerce in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; ok($e, "'small' attribute throws when it cannot coerce in constructor - $suffix"); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; ok($e, "'big' attribute throws when it cannot coerce in accessor - $suffix"); $e = exception { $o->small({}) }; ok($e, "'small' attribute throws when it cannot coerce in accessor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; exceptions.t000664001750001750 413315111656240 20021 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE Tests L interaction with L. =head1 DEPENDENCIES Requires Moo 1.002001 or above; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Fatal; use Test::Requires { "Moo" => "1.004000" }; BEGIN { require Method::Generate::Accessor; "Method::Generate::Accessor"->can("_SIGDIE") or "Moo"->VERSION ge '1.006' or plan skip_all => "Method::Generate::Accessor exception support seems missing!!!"; }; { package Goo; use Moo; use Types::Standard qw(Int); has number => (is => "rw", isa => Int); } my $e_constructor = exception { Goo->new(number => "too") }; isa_ok($e_constructor, 'Error::TypeTiny::Assertion', '$e_constructor'); ok($e_constructor->has_attribute_name, '$e_constructor->has_attribute_name'); is($e_constructor->attribute_name, 'number', '$e_constructor->attribute_name'); ok($e_constructor->has_attribute_step, '$e_constructor->has_attribute_step'); is($e_constructor->attribute_step, 'isa check', '$e_constructor->attribute_step'); is($e_constructor->varname, '$args->{"number"}', '$e_constructor->varname'); is($e_constructor->value, "too", '$e_constructor->value'); is($e_constructor->type, Types::Standard::Int, '$e_constructor->type'); my $e_accessor = exception { Goo->new->number("too") }; isa_ok($e_accessor, 'Error::TypeTiny::Assertion', '$e_accessor'); ok($e_accessor->has_attribute_name, '$e_accessor->has_attribute_name'); is($e_accessor->attribute_name, 'number', '$e_accessor->attribute_name'); ok($e_accessor->has_attribute_step, '$e_accessor->has_attribute_step'); is($e_accessor->attribute_step, 'isa check', '$e_accessor->attribute_step'); is($e_accessor->value, "too", '$e_accessor->value'); is($e_accessor->type, Types::Standard::Int, '$e_accessor->type'); done_testing; inflation.t000664001750001750 412115111656240 17620 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE Checks that type constraints continue to work when a L class is inflated to a L class. Checks that Moo::HandleMoose correctly calls back to Type::Tiny to build Moose type constraints. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moo 1.000000 is not available. Test is redundant if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moo => 1.000000 }; use Test::Fatal; { package Local::Class; use Moo; use BiggerLib ":all"; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } note explain(\%Moo::HandleMoose::TYPE_MAP); my $state = "Moose is not loaded"; for (0..1) { is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint - $state", ); ok( exception { "Local::Class"->new(small => 100) }, "direct violation of type constraint - $state", ); ok( exception { "Local::Class"->new(small => 5.5) }, "violation of parent type constraint - $state", ); ok( exception { "Local::Class"->new(small => "five point five") }, "violation of grandparent type constraint - $state", ); ok( exception { "Local::Class"->new(small => []) }, "violation of great-grandparent type constraint - $state", ); eval q{ require Moose; Moose->VERSION(2.0000); "Local::Class"->meta->get_attribute("small"); "Local::Class"->meta->get_attribute("big"); $state = "Moose is loaded"; }; } $state eq 'Moose is loaded' ? is( "Local::Class"->meta->get_attribute("small")->type_constraint->name, "SmallInteger", "type constraint metaobject inflates from Moo to Moose", ) : pass("redundant test"); done_testing; inflation2.t000664001750001750 171015111656240 17703 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moo=pod =encoding utf-8 =head1 PURPOSE A test for type constraint inflation from L to L. =head1 DEPENDENCIES Requires Moo 1.003000 and Moose 2.0800; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { 'Moo' => '1.003000' }; use Test::Requires { 'Moose' => '2.0800' }; use Types::Standard qw/Str HashRef/; my $type = HashRef[Str]; { package AAA; BEGIN { $INC{'AAA.pm'} = __FILE__ }; use Moo::Role; has foo => ( is => 'ro', isa => $type, traits => ['Hash'], ); } { package BBB; use Moose; with 'AAA'; } ok not exception { 'BBB'->new( foo => { a => 'b' } ); }; done_testing; basic.t000664001750001750 177115111656240 17271 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moops=pod =encoding utf-8 =head1 PURPOSE Check that type constraints work in L. This file is borrowed from the Moops test suite, where it is called C<< 31types.t >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Moops'; use Test::Fatal; use Moops; class Foo { has num => (is => 'rw', isa => Num); method add ( Num $addition ) { $self->num( $self->num + $addition ); } } my $foo = 'Foo'->new(num => 20); is($foo->num, 20); is($foo->num(40), 40); is($foo->num, 40); is($foo->add(2), 42); is($foo->num, 42); isnt( exception { $foo->num("Hello") }, undef, ); isnt( exception { $foo->add("Hello") }, undef, ); isnt( exception { 'Foo'->new(num => "Hello") }, undef, ); done_testing; library-keyword.t000664001750001750 212315111656240 21326 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moops=pod =encoding utf-8 =head1 PURPOSE Check that type libraries can be declared with L. This file is borrowed from the Moops test suite, where it is called C<< 71library.t >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { 'Moops' => '0.018' }; use Test::Fatal; use Test::TypeTiny; use Moops; library MyTypes extends Types::Standard declares RainbowColour { declare RainbowColour, as Enum[qw/ red orange yellow green blue indigo violet /]; } should_pass('indigo', MyTypes::RainbowColour); should_fail('magenta', MyTypes::RainbowColour); class MyClass types MyTypes { method capitalize_colour ( $class: RainbowColour $r ) { return uc($r); } } is('MyClass'->capitalize_colour('indigo'), 'INDIGO'); ok exception { 'MyClass'->capitalize_colour('magenta') }; done_testing; accept-moose-types.t000664001750001750 316315111656240 21713 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check that Moose type constraints can be passed into the Type::Tiny API where a Type::Tiny constraint might usually be expected. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => 2.0000 }; use Test::Fatal; # Example from the manual { package Person; use Moose; use Types::Standard qw( Str Int ); use Type::Utils qw( declare as where inline_as coerce from ); ::isa_ok( Int, 'Moose::Meta::TypeConstraint', 'Int', ); ::isa_ok( Str, 'Moose::Meta::TypeConstraint', 'Str', ); has name => ( is => "ro", isa => Str, ); my $PositiveInt = declare as Int, where { $_ > 0 }, inline_as { "$_ =~ /^0-9]\$/ and $_ > 0" }; coerce $PositiveInt, from Int, q{ abs $_ }; ::isa_ok( $PositiveInt, 'Type::Tiny', '$PositiveInt', ); ::isa_ok( $PositiveInt->parent, 'Type::Tiny', '$PositiveInt->parent', ); has age => ( is => "ro", isa => $PositiveInt, coerce => 1, writer => "_set_age", ); sub get_older { my $self = shift; my ($years) = @_; $PositiveInt->assert_valid($years); $self->_set_age($self->age + $years); } } done_testing; basic.t000664001750001750 2025315111656240 17272 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; no warnings qw(once); use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => 2.0000 }; use Test::Fatal; use Test::TypeTiny qw( matchfor ); note "The basics"; { package Local::Class; use Moose; use BiggerLib -all; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); is( exception { "Local::Class"->new(small => 100) }, matchfor( 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(small\) does not pass the type constraint} ), "direct violation of type constraint", ); is( exception { "Local::Class"->new(small => 5.5) }, matchfor( 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(small\) does not pass the type constraint} ), "violation of parent type constraint", ); is( exception { "Local::Class"->new(small => "five point five") }, matchfor( 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(small\) does not pass the type constraint} ), "violation of grandparent type constraint", ); is( exception { "Local::Class"->new(small => []) }, matchfor( 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(small\) does not pass the type constraint} ), "violation of great-grandparent type constraint", ); note "Coercion..."; my $coercion; { package TmpNS1; use Moose::Util::TypeConstraints; use Scalar::Util qw(refaddr); subtype 'MyInt', as 'Int'; coerce 'MyInt', from 'ArrayRef', via { scalar(@$_) }; my $orig = find_type_constraint('MyInt'); my $type = Types::TypeTiny::to_TypeTiny($orig); ::ok($type->has_coercion, 'types converted from Moose retain coercions'); ::is($type->coerce([qw/a b c/]), 3, '... which work'); ::is(refaddr($type->moose_type), refaddr($orig), '... refaddr matches'); ::is(refaddr($type->coercion->moose_coercion), refaddr($orig->coercion), '... coercion refaddr matches'); $coercion = $type->coercion; } note "Introspection, comparisons, conversions..."; require Types::Standard; isa_ok( Types::Standard::Int(), 'Class::MOP::Object', 'Int', ); isa_ok( Types::Standard::ArrayRef(), 'Moose::Meta::TypeConstraint', 'ArrayRef', ); isa_ok( Types::Standard::ArrayRef(), 'Moose::Meta::TypeConstraint::Parameterizable', 'ArrayRef', ); isa_ok( Types::Standard::ArrayRef()->of(Types::Standard::Int()), 'Moose::Meta::TypeConstraint', 'ArrayRef[Int]', ); isa_ok( Types::Standard::ArrayRef()->of(Types::Standard::Int()), 'Moose::Meta::TypeConstraint::Parameterized', 'ArrayRef[Int]', ); isa_ok( Types::Standard::ArrayRef() | Types::Standard::Int(), 'Moose::Meta::TypeConstraint', 'ArrayRef|Int', ); isa_ok( Types::Standard::ArrayRef() | Types::Standard::Int(), 'Moose::Meta::TypeConstraint::Union', 'ArrayRef|Int', ); isa_ok( $coercion, 'Moose::Meta::TypeCoercion', 'MyInt->coercion', ); $coercion = do { my $arrayref = Types::Standard::ArrayRef()->plus_coercions( Types::Standard::ScalarRef(), sub { [$$_] }, ); my $int = Types::Standard::Int()->plus_coercions( Types::Standard::Num(), sub { int($_) }, ); my $array_or_int = $arrayref | $int; $array_or_int->coercion; }; isa_ok( $coercion, 'Moose::Meta::TypeCoercion', '(ArrayRef|Int)->coercion', ); isa_ok( $coercion, 'Moose::Meta::TypeCoercion::Union', '(ArrayRef|Int)->coercion', ); ok( Types::Standard::ArrayRef->moose_type->equals( Moose::Util::TypeConstraints::find_type_constraint("ArrayRef") ), "equivalence between Types::Standard types and core Moose types", ); require Type::Utils; my $classtype = Type::Utils::class_type(LocalClass => { class => "Local::Class" })->moose_type; isa_ok( $classtype, "Moose::Meta::TypeConstraint::Class", '$classtype', ); is( $classtype->class, "Local::Class", "Type::Tiny::Class provides meta information to Moose::Meta::TypeConstraint::Class", ); isa_ok( $classtype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Class', '$classtype->Types::TypeTiny::to_TypeTiny', ); my $roletype = Type::Utils::role_type(LocalRole => { class => "Local::Role" })->moose_type; isa_ok( $roletype, "Moose::Meta::TypeConstraint", '$roletype', ); ok( !$roletype->isa("Moose::Meta::TypeConstraint::Role"), "NB! Type::Tiny::Role does not inflate to Moose::Meta::TypeConstraint::Role because of differing notions as to what constitutes a role.", ); isa_ok( $roletype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Role', '$roletype->Types::TypeTiny::to_TypeTiny', ); my $ducktype = Type::Utils::duck_type(Darkwing => [qw/ foo bar baz /])->moose_type; isa_ok( $ducktype, "Moose::Meta::TypeConstraint::DuckType", '$ducktype', ); is_deeply( [sort @{$ducktype->methods}], [sort qw/ foo bar baz /], "Type::Tiny::Duck provides meta information to Moose::Meta::TypeConstraint::DuckType", ); isa_ok( $ducktype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Duck', '$ducktype->Types::TypeTiny::to_TypeTiny', ); my $enumtype = Type::Utils::enum(MyEnum => [qw/ foo bar baz /])->moose_type; isa_ok( $enumtype, "Moose::Meta::TypeConstraint::Enum", '$classtype', ); is_deeply( [sort @{$enumtype->values}], [sort qw/ foo bar baz /], "Type::Tiny::Enum provides meta information to Moose::Meta::TypeConstraint::Enum", ); isa_ok( $enumtype->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Enum', '$enumtype->Types::TypeTiny::to_TypeTiny', ); my $union = Type::Utils::union(ICU => [$classtype->Types::TypeTiny::to_TypeTiny, $roletype->Types::TypeTiny::to_TypeTiny])->moose_type; isa_ok( $union, "Moose::Meta::TypeConstraint::Union", '$union', ); is_deeply( [sort @{$union->type_constraints}], [sort $classtype, $roletype], "Type::Tiny::Union provides meta information to Moose::Meta::TypeConstraint::Union", ); isa_ok( $union->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Union', '$union->Types::TypeTiny::to_TypeTiny', ); is( [sort @{$union->type_constraints}]->[0]->Types::TypeTiny::to_TypeTiny->{uniq}, $classtype->Types::TypeTiny::to_TypeTiny->{uniq}, '$union->type_constraints->[$i]->Types::TypeTiny::to_TypeTiny provides access to underlying Type::Tiny objects' ); my $intersect = Type::Utils::intersection(Chuck => [$classtype->Types::TypeTiny::to_TypeTiny, $roletype->Types::TypeTiny::to_TypeTiny])->moose_type; isa_ok( $intersect, "Moose::Meta::TypeConstraint", '$intersect', ); isa_ok( $intersect->Types::TypeTiny::to_TypeTiny, 'Type::Tiny::Intersection', '$intersect->Types::TypeTiny::to_TypeTiny', ); is( Scalar::Util::refaddr( $intersect->Types::TypeTiny::to_TypeTiny ), Scalar::Util::refaddr( $intersect->Types::TypeTiny::to_TypeTiny->moose_type->Types::TypeTiny::to_TypeTiny->moose_type->Types::TypeTiny::to_TypeTiny ), 'round-tripping between ->moose_type and ->Types::TypeTiny::to_TypeTiny preserves reference address' ); note "Method pass-through"; { local *Moose::Meta::TypeConstraint::dummy_1 = sub { 42; }; local *Moose::Meta::TypeCoercion::dummy_3 = sub { 666; }; is(Types::Standard::Int()->dummy_1, 42, 'method pass-through'); like( exception { Types::Standard::Int()->dummy_2 }, qr/^Can't locate object method "dummy_2"/, '... but not non-existant method', ); ok( Types::Standard::Int()->can('dummy_1') && !Types::Standard::Int()->can('dummy_2'), '... and `can` works ok', ); my $int = Types::Standard::Int()->plus_coercions(Types::Standard::Any(),q[999]); is($int->coercion->dummy_3, 666, 'method pass-through for coercions'); like( exception { $int->coercion->dummy_4 }, qr/^Can't locate object method "dummy_4"/, '... but not non-existant method', ); ok( $int->coercion->can('dummy_3') && !$int->coercion->can('dummy_4'), '... and `can` works ok', ); } done_testing; coercion-more.t000664001750001750 237115111656240 20733 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Test for the good old "You cannot coerce an attribute unless its type has a coercion" error. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.1200 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => '2.1200' }; use Test::Fatal; use Test::TypeTiny qw( matchfor ); my $e; { package Local::Class; use Moose; use BiggerLib -all; ::isa_ok(BigInteger, "Moose::Meta::TypeConstraint"); has small => (is => "rw", isa => SmallInteger, coerce => 1); has big => (is => "rw", isa => BigInteger, coerce => 1); $e = ::exception { has big_nc => (is => "rw", isa => BigInteger->no_coercions, coerce => 1); }; } like( $e, qr{^You cannot coerce an attribute .?big_nc.? unless its type .?\w+.? has a coercion}, "no_coercions and friends available on Moose type constraint objects", ); done_testing; coercion.t000664001750001750 573115111656240 17776 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L; both mutable and immutable classes. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Moose 2.0000 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Moose => '2.0000' }; use Test::Fatal; use Test::TypeTiny qw( matchfor ); my $e; my $o; { package Local::Class; use Moose; use BiggerLib -all; ::isa_ok(BigInteger, "Moose::Meta::TypeConstraint"); has small => (is => "rw", isa => SmallInteger, coerce => 1); has big => (is => "rw", isa => BigInteger, coerce => 1); has big_nc => (is => "rw", isa => BigInteger->no_coercions, coerce => 0); } my $suffix = "mutable class"; for my $i (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; is( $e, matchfor( $i # exception class thrown by constructor is dependent on immutability ? 'Moose::Exception::ValidationFailedForInlineTypeConstraint' : 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(big\)} ), "'big' attribute throws when it cannot coerce in constructor - $suffix", ); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; is( $e, matchfor( $i # exception class thrown by constructor is dependent on immutability ? 'Moose::Exception::ValidationFailedForInlineTypeConstraint' : 'Moose::Exception::ValidationFailedForTypeConstraint', qr{^Attribute \(small\)} ), "'small' attribute throws when it cannot coerce in constructor - $suffix", ); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; is( $e, matchfor( 'Moose::Exception::ValidationFailedForInlineTypeConstraint', qr{^Attribute \(big\)} ), "'big' attribute throws when it cannot coerce in accessor - $suffix", ); $e = exception { $o->small({}) }; is( $e, matchfor( 'Moose::Exception::ValidationFailedForInlineTypeConstraint', qr{^Attribute \(small\)} ), "'small' attribute throws when it cannot coerce in accessor - $suffix", ); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; inflate-then-inline.t000664001750001750 212515111656240 22021 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check type constraint inlining works with L in strange edge cases where we need to inflate Type::Tiny constraints into full L objects. =head1 DEPENDENCIES Test is skipped if Moose 2.1210 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More 0.96; use Test::Requires { 'Moose' => '2.1005' }; use Type::Tiny; my $type1 = Type::Tiny->new; my $type2 = $type1->create_child_type( constraint => sub { !!2 }, inlined => sub { my ($self, $var) = @_; $self->parent->inline_check($var) . " && !!2"; }, ); like( $type2->inline_check('$XXX'), qr/\(\(?!!1\)? && !!2\)/, '$type2->inline_check' ); like( $type2->moose_type->_inline_check('$XXX'), qr/\(\(?!!1\)? && !!2\)/, '$type2->moose_type->_inline_check' ); done_testing; native-attribute-traits.t000664001750001750 1570215111656240 23007 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check type constraints and coercions work with L native attribute traits. =head1 DEPENDENCIES Test is skipped if Moose 2.1210 is not available. (The feature should work in older versions of Moose, but older versions of Test::Moose conflict with newer versions of Test::Builder.) =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use Test::More; use Test::Requires { Moose => '2.1210' }; use Test::Requires { 'Test::Moose' => '2.1210' }; use Test::Fatal; use Test::TypeTiny qw( matchfor ); use Test::Moose qw( with_immutable ); use Types::Standard -types; # For testing Array trait { package MyCollection; use Moose; use Types::Standard qw( ArrayRef Object ); has things => ( is => 'ro', isa => ArrayRef[ Object ], traits => [ 'Array' ], handles => { add => 'push' }, ); } # for testing Hash trait my %attributes = ( hashref => HashRef, hashref_int => HashRef[Int], map => Map, map_strint => Map[Str, Int], ); { package MyHashes; use Moose; while (my ($attr, $type) = each %attributes) { has $attr => ( traits => ['Hash'], is => 'ro', isa => $type, handles => { "$attr\_get" => 'get', "$attr\_set" => 'set', "$attr\_has" => 'exists', }, default => sub { +{} }, ); } } # For testing coercions { package Mini::Milk; use Moose; use Types::Standard qw( Int InstanceOf ); has i => (is => 'ro', isa => Int); around BUILDARGS => sub { my $next = shift; my $class = shift; return { i => $_[0] } if @_==1 and not ref $_[0]; $class->$next(@_); } } my $minimilk = InstanceOf->of('Mini::Milk')->plus_constructors(Num, "new"); { package MyCollection2; use Moose; use Types::Standard qw( ArrayRef ); has things => ( is => 'ro', isa => ArrayRef[ $minimilk ], traits => [ 'Array' ], handles => { add => 'push' }, coerce => 1, ); } { package MyCollection3; use Moose; use Types::Standard qw( ArrayRef ); has things => ( is => 'ro', isa => (ArrayRef[ $minimilk ])->create_child_type(coercion => 1), traits => [ 'Array' ], handles => { add => 'push' }, coerce => 1, ); } { package MyHashes2; use Moose; use Types::Standard qw( HashRef Map Int ); has hash => ( traits => ['Hash'], is => 'ro', isa => HashRef[ $minimilk ], coerce => 1, handles => { "hash_get" => 'get', "hash_set" => 'set', }, default => sub { +{} }, ); has 'map' => ( traits => ['Hash'], is => 'ro', isa => Map[ Int, $minimilk ], coerce => 1, handles => { "map_get" => 'get', "map_set" => 'set', }, default => sub { +{} }, ); } { package MyHashes3; use Moose; use Types::Standard qw( HashRef Map Int ); has hash => ( traits => ['Hash'], is => 'ro', isa => (HashRef[ $minimilk ])->create_child_type(coercion => 1), coerce => 1, handles => { "hash_get" => 'get', "hash_set" => 'set', }, default => sub { +{} }, ); has 'map' => ( traits => ['Hash'], is => 'ro', isa => (Map[ Int, $minimilk ])->create_child_type(coercion => 1), coerce => 1, handles => { "map_get" => 'get', "map_set" => 'set', }, default => sub { +{} }, ); } WEIRD_ERROR: { my $c = MyCollection3 ->meta ->get_attribute('things') ->type_constraint ->coercion ->compiled_coercion; my $input = [ Mini::Milk->new(0), 1, 2, 3 ]; my $output = $c->($input); my $expected = [ map Mini::Milk->new($_), 0..3 ]; is_deeply($output, $expected) or diag( B::Deparse->new->coderef2text($c) ); } my $i = 0; with_immutable { note($i++ ? "MUTABLE" : "IMMUTABLE"); subtest "Array trait with type ArrayRef[Object]" => sub { my $coll = MyCollection->new(things => []); ok( !exception { $coll->add(bless {}, "Monkey") }, 'pushing ok value', ); is( exception { $coll->add({})}, matchfor( 'Moose::Exception::ValidationFailedForInlineTypeConstraint', qr{^A new member value for things does not pass its type constraint because:}, ), 'pushing not ok value', ); }; my %subtests = ( MyCollection2 => "Array trait with type ArrayRef[InstanceOf] and coercion", MyCollection3 => "Array trait with type ArrayRef[InstanceOf] and coercion and subtyping", ); for my $class (sort keys %subtests) { subtest $subtests{$class} => sub { my $coll = $class->new(things => []); is( exception { $coll->add( 'Mini::Milk'->new(i => 0) ); $coll->add(1); $coll->add(2); $coll->add(3); }, undef, 'pushing ok values', ); my $things = $coll->things; for my $i (0 .. 3) { isa_ok($things->[$i], 'Mini::Milk', "\$things->[$i]"); is($things->[$i]->i, $i, "\$things->[$i]->i == $i"); } }; } for my $attr (sort keys %attributes) { my $type = $attributes{$attr}; my $getter = "$attr\_get"; my $setter = "$attr\_set"; my $predicate = "$attr\_has"; subtest "Hash trait with type $type" => sub { my $obj = MyHashes->new; is_deeply($obj->$attr, {}, 'default empty hash'); $obj->$setter(foo => 666); $obj->$setter(bar => 999); is($obj->$getter('foo'), 666, 'getter'); is($obj->$getter('bar'), 999, 'getter'); $obj->$setter(bar => 42); is($obj->$getter('bar'), 42, 'setter'); ok($obj->$predicate('foo'), 'predicate'); ok($obj->$predicate('bar'), 'predicate'); ok(!$obj->$predicate('baz'), 'predicate - negatory'); is_deeply($obj->$attr, { foo => 666, bar => 42 }, 'correct hash'); like( exception { $obj->$setter(baz => 3.141592) }, qr/type constraint/, 'cannot add non-Int value', ) if $attr =~ /int$/; done_testing; }; } %subtests = ( MyHashes2 => "Hash trait with types HashRef[InstanceOf] and Map[Int,InstanceOf]; and coercion", MyHashes3 => "Hash trait with types HashRef[InstanceOf] and Map[Int,InstanceOf]; and coercion and subtyping", ); for my $class (sort keys %subtests) { subtest $subtests{$class} => sub { my $H = $class->new(); is( exception { $H->hash_set( 0, 'Mini::Milk'->new(i => 0) ); $H->hash_set( 1, 1 ); $H->hash_set( 2, 2 ); $H->hash_set( 3, 3 ); }, undef, 'adding ok values to HashRef', ); is( exception { $H->map_set( 4, 'Mini::Milk'->new(i => 4) ); $H->map_set( 5, 5 ); $H->map_set( 6, 6 ); $H->map_set( 7, 7 ); }, undef, 'adding ok values to Map', ); my $h = $H->hash; for my $i (0 .. 3) { isa_ok($h->{$i}, 'Mini::Milk', "\$h->{$i}"); is($h->{$i}->i, $i, "\$h->{$i}->i == .$i"); } my $m = $H->map; for my $i (4 .. 7) { isa_ok($m->{$i}, 'Mini::Milk', "\$m->{$i}"); is($m->{$i}->i, $i, "\$m->{$i}->i == .$i"); } }; } } qw( MyCollection MyCollection2 MyCollection3 MyHashes Mini::Milk ); done_testing; parameterized.t000664001750001750 250115111656240 21021 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Test that parameterizable Moose types are still parameterizable when they are converted to Type::Tiny. =head1 DEPENDENCIES Test is skipped if Moose is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Moose::Util::TypeConstraints'; use Types::TypeTiny 'to_TypeTiny'; use Test::TypeTiny; ## We want to prevent Types::TypeTiny from noticing we've loaded a ## core type, because then it will just steal from Types::Standard. ## and bypass making a new type constraint. ## sub Types::Standard::get_type { return() } $INC{'Types/Standard.pm'} = 1; my $mt_ArrayRef = Moose::Util::TypeConstraints::find_type_constraint('ArrayRef'); my $mt_Int = Moose::Util::TypeConstraints::find_type_constraint('Int'); my $tt_ArrayRef = to_TypeTiny($mt_ArrayRef); my $tt_Int = to_TypeTiny($mt_Int); ok $tt_ArrayRef->is_parameterizable; my $tt_ArrayRef_of_Int = $tt_ArrayRef->of($tt_Int); should_pass [qw/1 2 3/], $tt_ArrayRef_of_Int; should_fail [qw/a b c/], $tt_ArrayRef_of_Int; done_testing; coercion.t000664001750001750 322015111656240 21355 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MooseX-Getopt=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L; both mutable and immutable classes. =head1 DEPENDENCIES Test is skipped if Moose 2.0000, MooseX::Getopt 0.63, and Types::Path::Tiny are not available. =head1 AUTHOR Alexander Hartmaier Eabraxxa@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Alexander Hartmaier. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { 'Moose' => '2.0000' }; use Test::Requires { 'MooseX::Getopt' => '0.63' }; use Test::Requires { 'Types::Path::Tiny' => '0' }; use Test::Fatal; use Test::TypeTiny qw( matchfor ); my @warnings; BEGIN { package Local::Types; use Type::Library -base, -declare => qw( Files ); use Type::Utils -all; use Types::Standard -types; use Types::Path::Tiny qw( Path to_Path ); declare Files, as ArrayRef[ Path ], coercion => 1; coerce Files, from Str, via { [ to_Path($_) ] }; $INC{'Local/Types.pm'} = __FILE__; }; # note explain( Local::Types::Files->moose_type ); { package Local::Class; use Moose; use Local::Types -all; with 'MooseX::Getopt'; has files => (is => "rw", isa => Files, coerce => 1); } my ($e, $o); my $suffix = "mutable class"; for my $i (0..1) { $e = exception { $o = "Local::Class"->new_with_options( files => 'foo.bar', ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; basic.t000664001750001750 335415111656240 20507 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MooseX-Types=pod =encoding utf-8 =head1 PURPOSE Complex checks between Type::Tiny and L. =head1 DEPENDENCIES MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Types::Moose" => "0.35" }; use Test::TypeTiny; use MooseX::Types::Moose -all; use Types::Standard -all => { -prefix => "My" }; my $union1 = Int | MyArrayRef; my $union2 = MyArrayRef | Int; isa_ok($union1, "Moose::Meta::TypeConstraint"); isa_ok($union2, "Moose::Meta::TypeConstraint"); isa_ok($union2, "Type::Tiny"); should_pass([], $union1); should_pass(2, $union1); should_fail({}, $union1); should_pass([], $union2); should_pass(2, $union2); should_fail({}, $union2); my $param1 = MyArrayRef[Int]; my $param2 = ArrayRef[MyInt]; should_pass([1,2,3], $param1); should_pass([], $param1); should_fail({}, $param1); should_fail(["x"], $param1); should_pass([1,2,3], $param2); should_pass([], $param2); should_fail({}, $param2); should_fail(["x"], $param2); my $param_union = MyArrayRef[Int | ArrayRef]; should_pass([], $param_union); should_pass([1,2,3], $param_union); should_pass([[],[]], $param_union); should_pass([11,[]], $param_union); should_pass([[],11], $param_union); should_fail([1.111], $param_union); use Types::TypeTiny 'to_TypeTiny'; my $moosey = ArrayRef[HashRef[Int]]; my $tt1 = to_TypeTiny($moosey); my $tt2 = to_TypeTiny($moosey); is($tt1->{uniq}, $tt2->{uniq}, "to_TypeTiny caches results"); done_testing; extending.t000664001750001750 376615111656240 21422 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MooseX-Types=pod =encoding utf-8 =head1 PURPOSE Check that L can extend an existing L type constraint library. =head1 DEPENDENCIES MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Types::Moose" => "0.35" }; use Test::TypeTiny; use Test::Fatal; BEGIN { package MyTypes; use Type::Library -base, -declare => qw(NonEmptyStr); use Type::Utils -all; BEGIN { extends 'MooseX::Types::Moose', 'Types::TypeTiny' }; declare NonEmptyStr, as Str, where { length($_) }; $INC{'MyTypes.pm'} = __FILE__; }; use MyTypes -types; should_pass("foo", Str); should_pass("", Str); should_pass("foo", NonEmptyStr); should_fail("", NonEmptyStr); should_pass({}, HashLike); should_fail([], HashLike); { package MyDummy; use Moose; $INC{'MyDummy.pm'} = __FILE__; package MoreTypes; use Type::Library -base; ::like( ::exception { Type::Utils::extends 'MyDummy' }, qr/not a type constraint library/, 'cannot extend non-type-library', ); } BEGIN { package MyMooseTypes; use MooseX::Types -declare => ['RoundedInt']; use MooseX::Types::Moose qw(Int Num); subtype RoundedInt, as Int; coerce RoundedInt, from Num, via { int($_) }; $INC{'MyMooseTypes.pm'} = __FILE__; }; { package Local::XYZ1234; use MyMooseTypes qw(RoundedInt); ::is( RoundedInt->coerce(3.1), 3, 'MooseX::Types coercion works as expected' ); } BEGIN { package MyTinyTypes; use Type::Library -base; use Type::Utils 'extends'; extends 'MyMooseTypes'; $INC{'MyTinyTypes.pm'} = __FILE__; }; { package Local::XYZ12345678; use MyTinyTypes qw(RoundedInt); ::is( RoundedInt->coerce(3.1), 3, 'Type::Tiny coercion works built from MooseX::Types extension' ); } done_testing; more.t000664001750001750 330515111656240 20364 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MooseX-Types=pod =encoding utf-8 =head1 PURPOSE More checks between Type::Tiny and L. This started out as an example of making a parameterized C<< Not[] >> type constraint, but worked out as a nice test case. =head1 DEPENDENCIES MooseX::Types 0.35; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Types::Moose" => "0.35" }; use Test::TypeTiny; BEGIN { package MooseX::Types::Not; use Type::Library -base; use Types::TypeTiny; __PACKAGE__->add_type({ name => "Not", constraint => sub { !!0 }, inlined => sub { "!!0" }, constraint_generator => sub { Types::TypeTiny::to_TypeTiny(shift)->complementary_type }, }); $INC{"MooseX/Types/Not.pm"} = __FILE__; }; use MooseX::Types::Not qw(Not); use MooseX::Types::Moose qw(Int); isa_ok($_, "Moose::Meta::TypeConstraint", "$_") for Not, Int, Not[Int], Not[Not[Int]]; should_fail(1.1, Int); should_fail(undef, Int); should_fail([], Int); should_pass(2, Int); should_pass(1.1, Not[Int]); should_pass(undef, Not[Int]); should_pass([], Not[Int]); should_fail(2, Not[Int]); should_fail(1.1, Not[Not[Int]]); should_fail(undef, Not[Not[Int]]); should_fail([], Not[Not[Int]]); should_pass(2, Not[Not[Int]]); # 'Not' alone behaves as 'Not[Any]' should_fail(1.1, Not); should_fail(undef, Not); should_fail([], Not); should_fail(2, Not); done_testing; basic.t000664001750001750 372515111656240 17265 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Mouse=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. Checks values that should pass and should fail; checks error messages. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Mouse 1.00 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Mouse => 1.00 }; use Test::Fatal; { package Local::Class; use Mouse; use BiggerLib -all; has small => (is => "ro", isa => SmallInteger); has big => (is => "ro", isa => BigInteger); } is( exception { "Local::Class"->new(small => 9, big => 12) }, undef, "some values that should pass their type constraint", ); isnt( exception { "Local::Class"->new(small => 100) }, undef, "direct violation of type constraint", ); isnt( exception { "Local::Class"->new(small => 5.5) }, undef, "violation of parent type constraint", ); isnt( exception { "Local::Class"->new(small => "five point five") }, undef, "violation of grandparent type constraint", ); isnt( exception { "Local::Class"->new(small => []) }, undef, "violation of great-grandparent type constraint", ); use Mouse::Util; ok( Mouse::Util::is_a_type_constraint(BiggerLib::SmallInteger), "Mouse::Util::is_a_type_constraint accepts Type::Tiny type constraints", ); note "Coercion..."; { package TmpNS1; use Mouse::Util::TypeConstraints; subtype 'MyInt', as 'Int'; coerce 'MyInt', from 'ArrayRef', via { scalar(@$_) }; my $type = Types::TypeTiny::to_TypeTiny(find_type_constraint('MyInt')); ::ok($type->has_coercion, 'types converted from Mouse retain coercions'); ::is($type->coerce([qw/a b c/]), 3, '... which work'); } done_testing; coercion.t000664001750001750 423215111656240 17777 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Mouse=pod =encoding utf-8 =head1 PURPOSE Check coercions work with L; both mutable and immutable classes. =head1 DEPENDENCIES Uses the bundled BiggerLib.pm type library. Test is skipped if Mouse 1.00 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { Mouse => 1.00 }; use Test::Fatal; { package Local::Class; use Mouse; use BiggerLib -all; ::isa_ok(BigInteger, "Mouse::Meta::TypeConstraint"); has small => (is => "rw", isa => SmallInteger, coerce => 1); has big => (is => "rw", isa => BigInteger, coerce => 1); } my ($e, $o); my $suffix = "mutable class"; for (0..1) { $e = exception { $o = "Local::Class"->new( small => 104, big => 9, ); }; is($e, undef, "no exception on coercion in constructor - $suffix"); is($o && $o->big, 19, "'big' attribute coerces in constructor - $suffix"); is($o && $o->small, 4, "'small' attribute coerces in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => [], big => {}, ); }; isnt($e, undef, "'big' attribute throws when it cannot coerce in constructor - $suffix"); $e = exception { $o = "Local::Class"->new( small => {}, big => [], ); }; isnt($e, undef, "'small' attribute throws when it cannot coerce in constructor - $suffix"); $o = "Local::Class"->new; $e = exception { $o->big([]); $o->small([]); }; is($o && $o->big, 100, "'big' attribute coerces in accessor - $suffix"); is($o && $o->small, 1, "'small' attribute coerces in accessor - $suffix"); $e = exception { $o->big({}) }; isnt($e, undef, "'big' attribute throws when it cannot coerce in accessor - $suffix"); $e = exception { $o->small({}) }; isnt($e, undef, "'small' attribute throws when it cannot coerce in accessor - $suffix"); "Local::Class"->meta->make_immutable; $suffix = "im$suffix"; } done_testing; parameterized.t000664001750001750 250115111656240 21027 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Mouse=pod =encoding utf-8 =head1 PURPOSE Test that parameterizable Mouse types are still parameterizable when they are converted to Type::Tiny. =head1 DEPENDENCIES Test is skipped if Mouse is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Mouse::Util::TypeConstraints'; use Types::TypeTiny 'to_TypeTiny'; use Test::TypeTiny; ## We want to prevent Types::TypeTiny from noticing we've loaded a ## core type, because then it will just steal from Types::Standard. ## and bypass making a new type constraint. ## sub Types::Standard::get_type { return() } $INC{'Types/Standard.pm'} = 1; my $mt_ArrayRef = Mouse::Util::TypeConstraints::find_type_constraint('ArrayRef'); my $mt_Int = Mouse::Util::TypeConstraints::find_type_constraint('Int'); my $tt_ArrayRef = to_TypeTiny($mt_ArrayRef); my $tt_Int = to_TypeTiny($mt_Int); ok $tt_ArrayRef->is_parameterizable; my $tt_ArrayRef_of_Int = $tt_ArrayRef->of($tt_Int); should_pass [qw/1 2 3/], $tt_ArrayRef_of_Int; should_fail [qw/a b c/], $tt_ArrayRef_of_Int; done_testing; basic.t000664001750001750 307215111656240 20512 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MouseX-Types=pod =encoding utf-8 =head1 PURPOSE Complex checks between Type::Tiny and L. =head1 DEPENDENCIES MouseX::Types 0.06; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MouseX::Types" => "0.06" }; use Test::TypeTiny; use MouseX::Types::Moose qw(Int ArrayRef); use Types::Standard -all => { -prefix => "My" }; my $union1 = Int | MyArrayRef; my $union2 = MyArrayRef | Int; isa_ok($union1, "Mouse::Meta::TypeConstraint"); isa_ok($union1, "Mouse::Meta::TypeConstraint"); isa_ok($union2, "Type::Tiny"); should_pass([], $union1); should_pass(2, $union1); should_fail({}, $union1); should_pass([], $union2); should_pass(2, $union2); should_fail({}, $union2); note explain($union2); my $param1 = MyArrayRef[Int]; my $param2 = ArrayRef[MyInt]; should_pass([1,2,3], $param1); should_pass([], $param1); should_fail({}, $param1); should_fail(["x"], $param1); should_pass([1,2,3], $param2); should_pass([], $param2); should_fail({}, $param2); should_fail(["x"], $param2); my $param_union = MyArrayRef[Int | ArrayRef]; should_pass([], $param_union); should_pass([1,2,3], $param_union); should_pass([[],[]], $param_union); should_pass([11,[]], $param_union); should_pass([[],11], $param_union); should_fail([1.111], $param_union); done_testing; extending.t000664001750001750 246715111656240 21425 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/MouseX-Types=pod =encoding utf-8 =head1 PURPOSE Check that L can extend an existing L type constraint library. =head1 DEPENDENCIES MouseX::Types 0.06; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MouseX::Types" => "0.06" }; use Test::TypeTiny; use Test::Fatal; BEGIN { package MyTypes; use Type::Library -base, -declare => qw(NonEmptyStr); use Type::Utils -all; BEGIN { extends 'MouseX::Types::Moose', 'Types::TypeTiny' }; declare NonEmptyStr, as Str, where { length($_) }; $INC{'MyTypes.pm'} = __FILE__; }; use MyTypes -types; should_pass("foo", Str); should_pass("", Str); should_pass("foo", NonEmptyStr); should_fail("", NonEmptyStr); should_pass({}, HashLike); should_fail([], HashLike); { package MyDummy; use Mouse; $INC{'MyDummy.pm'} = __FILE__; package MoreTypes; use Type::Library -base; ::like( ::exception { Type::Utils::extends 'MyDummy' }, qr/not a type constraint library/, 'cannot extend non-type-library', ); } done_testing; basic.t000664001750001750 245515111656240 21142 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Object-Accessor=pod =encoding utf-8 =head1 PURPOSE Check type constraints work with L. =head1 DEPENDENCIES Test is skipped if Object::Accessor 0.30 is not available. =head1 CAVEATS As of Perl 5.17.x, the Object::Accessor module is being de-cored, so will issue deprecation warnings. These can safely be ignored for the purposes of this test case. Object::Accessor from CPAN does not have these warnings. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); # Avoid warnings about core version of Object::Accessor in Perl 5.18 no warnings qw(deprecated); use Test::More; use Test::Requires { "Object::Accessor" => 0.30 }; use Test::Fatal; use Types::Standard "Int"; use Object::Accessor; my $obj = Object::Accessor->new; $obj->mk_accessors( { foo => Int->compiled_check }, ); $obj->foo(12); is($obj->foo, 12, 'write then read on accessor works'); my $e = exception { local $Object::Accessor::FATAL = 1; $obj->foo("Hello"); }; isnt($e, undef, 'exception thrown for bad value'); done_testing; basic.t000664001750001750 414415111656240 20367 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Return-Type=pod =encoding utf-8 =head1 PURPOSE Test that this sort of thing works: sub foo :ReturnType(Int) { ...; } =head1 DEPENDENCIES Requires L 0.004; skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; BEGIN { plan skip_all => "Test case fails with App::ForkProve" if exists $INC{"App/ForkProve.pm"}; }; use Test::Requires { 'Return::Type' => '0.007' }; use Types::Standard qw( HashRef Int ); use Test::Fatal; if (0) { require JSON; diag("\%ENV ".JSON->new->pretty(1)->canonical(1)->encode({%ENV})); diag("\%INC ".JSON->new->pretty(1)->canonical(1)->encode({%INC})); } sub foo :ReturnType(Int) { wantarray ? @_ : $_[0]; } subtest "simple return type constraint" => sub { subtest "scalar context" => sub { is( scalar(foo(42)), 42, ); isnt( exception { scalar(foo(4.2)) }, undef, ); done_testing; }; subtest "list context" => sub { is_deeply( [ foo(4, 2) ], [ 4, 2 ], ); isnt( exception { [ foo(4, 2, 4.2) ] }, undef, ); done_testing; }; done_testing; }; my $Even; BEGIN { $Even = Int->create_child_type( name => 'Even', constraint => sub { not($_[0] % 2) }, ); }; sub bar :ReturnType(scalar => $Even, list => HashRef[Int]) { wantarray ? @_ : scalar(@_); } subtest "more complex return type constraint" => sub { subtest "scalar context" => sub { is( scalar(bar(xxx => 1, yyy => 2)), 4, ); TODO: { local $TODO = 'this seems to fail: error in Return::Type??'; isnt( exception { scalar(bar(xxx => 1, 2)) }, undef, ); } done_testing; }; subtest "list context" => sub { is_deeply( { bar(xxx => 1, yyy => 2) }, { xxx => 1, yyy => 2 }, ); isnt( exception { [ bar(xxx => 1, 2) ] }, undef, ); done_testing; }; done_testing; }; done_testing; basic.t000664001750001750 154115111656240 17411 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Specio=pod =encoding utf-8 =head1 PURPOSE Check that Specio type constraints can be converted to Type::Tiny with inlining support. =head1 DEPENDENCIES Test is skipped if Specio is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires 'Specio'; use Specio::Library::Builtins; use Types::TypeTiny 'to_TypeTiny'; my $Int = to_TypeTiny t('Int'); ok $Int->check('4'); ok !$Int->check('4.1'); ok $Int->can_be_inlined; my $check_x = $Int->inline_check('$x'); ok do { my $x = '4'; eval $check_x }; ok do { my $x = '4.1'; !eval $check_x }; done_testing; library.t000664001750001750 151415111656240 17774 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Specio=pod =encoding utf-8 =head1 PURPOSE Check that Specio type libraries can be extended by Type::Library. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::TypeTiny; use Test::Requires 'Specio::Library::Builtins'; BEGIN { package Local::MyTypes; use Type::Library -base; use Type::Utils; Type::Utils::extends 'Specio::Library::Builtins'; $INC{'Local/MyTypes.pm'} = __FILE__; # allow `use` to work }; use Local::MyTypes qw(Int ArrayRef); should_pass 1, Int; should_pass [], ArrayRef; should_fail 1, ArrayRef; should_fail [], Int; done_testing; basic.t000664001750001750 575315111656240 20024 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Sub-Quote=pod =encoding utf-8 =head1 PURPOSE Check type constraints can be made inlinable using L. =head1 DEPENDENCIES Test is skipped if Sub::Quote is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires "Sub::Quote"; use Test::TypeTiny; use Sub::Quote; use Type::Tiny; use Types::Standard qw( ArrayRef Int ); my $Type1 = "Type::Tiny"->new( name => "Type1", constraint => quote_sub q{ $_[0] eq q(42) }, ); should_fail(41, $Type1); should_pass(42, $Type1); ok($Type1->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined') and note $Type1->inline_check('$value'); my $Type2 = "Type::Tiny"->new( name => "Type2", constraint => quote_sub q{ $_ eq q(42) }, ); should_fail(41, $Type2); should_pass(42, $Type2); ok($Type2->can_be_inlined, 'constraint built using quote_sub and $_[0] can be inlined') and note $Type2->inline_check('$value'); my $Type3 = "Type::Tiny"->new( name => "Type3", constraint => quote_sub q{ my ($n) = @_; $n eq q(42) }, ); should_fail(41, $Type3); should_pass(42, $Type3); ok($Type3->can_be_inlined, 'constraint built using quote_sub and @_ can be inlined') and note $Type3->inline_check('$value'); my $Type4 = "Type::Tiny"->new( name => "Type4", parent => Int, constraint => quote_sub q{ $_[0] >= 42 }, ); should_fail(41, $Type4); should_pass(42, $Type4); should_pass(43, $Type4); should_fail(44.4, $Type4); ok($Type4->can_be_inlined, 'constraint built using quote_sub and parent type can be inlined') and note $Type4->inline_check('$value'); my $Type5 = "Type::Tiny"->new( name => "Type5", parent => Int, constraint => quote_sub q{ $_[0] >= $x }, { '$x' => \42 }, ); should_fail(41, $Type5); should_pass(42, $Type5); should_pass(43, $Type5); should_fail(44.4, $Type5); TODO: { local $TODO = "captures not supported yet"; ok($Type5->can_be_inlined, 'constraint built using quote_sub and captures can be inlined'); }; my $Type6 = "Type::Tiny"->new( name => "Type6", parent => Int->create_child_type(constraint => sub { 999 }), constraint => quote_sub q{ $_[0] >= 42 }, ); should_fail(41, $Type6); should_pass(42, $Type6); should_pass(43, $Type6); should_fail(44.4, $Type6); ok(!$Type6->can_be_inlined, 'constraint built using quote_sub and non-inlinable parent cannot be inlined'); my $Type7 = ArrayRef([Int]) & quote_sub q{ @$_ > 1 and @$_ < 4 }; should_pass([1,2,3], $Type7); should_fail([1,2.1,3], $Type7); should_fail([1], $Type7); should_fail([1,2,3,4], $Type7); ok($Type7->can_be_inlined, 'constraint built as an intersection of an inlinable type constraint and a quoted sub can be inlined'); note($Type7->inline_check('$VAR')); done_testing; delayed-quoting.t000664001750001750 232715111656240 22030 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Sub-Quote=pod =encoding utf-8 =head1 PURPOSE Check type constraints can be made inlinable using L even if Sub::Quote is loaded late. =head1 DEPENDENCIES Some parts are skipped if Sub::Quote is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2018-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::TypeTiny; use Types::Standard qw( ArrayRef Int ); my $type = ArrayRef[Int]; my $coderef1 = $type->_overload_coderef; my $coderef2 = $type->_overload_coderef; is($coderef1, $coderef2, 'overload coderef gets cached instead of being rebuilt'); eval { require Sub::Quote } or do { note "Sub::Quote required for further testing"; done_testing; exit(0); }; my $coderef3 = $type->_overload_coderef; isnt($coderef3, $coderef1, 'loading Sub::Quote triggers rebuilding overload coderef'); my $coderef4 = $type->_overload_coderef; is($coderef3, $coderef4, 'overload coderef gets cached again instead of being rebuilt'); done_testing; unquote-coercions.t000664001750001750 304415111656240 22414 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Sub-Quote=pod =encoding utf-8 =head1 PURPOSE Check type coercions can be unquoted L. =head1 DEPENDENCIES Test is skipped if Sub::Quote is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires "Sub::Quote"; use Test::TypeTiny; use Sub::Quote; use Type::Tiny; use Types::Standard qw( ArrayRef Int ); use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires "Sub::Quote"; use Test::Fatal; use Sub::Quote; use Type::Tiny; use Types::Standard qw( Int Num ArrayRef ); my $type = Int->plus_coercions( Num, q[ int($_) ], ArrayRef, q[ scalar(@$_) ], ); my $coercion = $type->coercion; my ($name, $code, $captures, $compiled_sub) = @{ Sub::Quote::quoted_from_sub( \&$coercion ); }; ok(defined($code), 'Got back code from Sub::Quote'); my $coderef = eval "sub { $code }"; is(ref($coderef), 'CODE', '... which compiles OK'); is( $coderef->(42), 42, "... which passes through values that don't need to be coerced", ); ok( $coderef->(3.1)==3 && $coderef->([qw/foo bar/])==2, "... coerces values that can be coerced", ); is_deeply( $coderef->({foo => 666}), {foo => 666}, "... and passes through any values it can't handle", ); done_testing; unquote-constraints.t000664001750001750 212715111656240 23000 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Sub-Quote=pod =encoding utf-8 =head1 PURPOSE Check type constraints can be unquoted L. =head1 DEPENDENCIES Test is skipped if Sub::Quote is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires "Sub::Quote"; use Test::Fatal; use Sub::Quote; use Type::Tiny; use Types::Standard qw( Int ); my $type = Int; my ($name, $code, $captures, $compiled_sub) = @{ Sub::Quote::quoted_from_sub( \&$type ); }; ok(defined($code), 'Got back code from Sub::Quote'); my $coderef = eval "sub { $code }"; is(ref($coderef), 'CODE', '... which compiles OK'); ok($coderef->(42), '... and seems to work'); like( exception { $coderef->([]) }, qr/\AReference \[\] did not pass type constraint "Int"/, '... and throws exceptions properly', ); done_testing; basic.t000664001750001750 147315111656240 20321 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Switcheroo=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'Switcheroo'; use Test::Fatal; use Types::Standard -all; use Switcheroo; sub what_is { my $var = shift; switch ($var) { case ArrayRef: 'ARRAY'; case HashRef: 'HASH'; default: undef; } } is( what_is([]), 'ARRAY', ); is( what_is({}), 'HASH', ); is( what_is(42), undef, ); is( what_is(\(42)), undef, ); done_testing; basic.t000664001750001750 266715111656240 22274 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Type-Library-Compiler=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny interacts nicely with Type::Library::Compiled-generated libraries. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::Requires '5.008001'; use Test::More; use Test::Fatal; use Test::TypeTiny; use CompiledLib qw( Int ); use Types::Standard qw( ArrayRef ); use Type::Params qw( compile ); use Type::Registry (); my $ArrayOfInt = ArrayRef[ Int ]; isa_ok( $ArrayOfInt->type_parameter, 'Type::Tiny' ); ok $ArrayOfInt->check( [ 1, 2, 3 ] ); ok ! $ArrayOfInt->check( [ "Nope!" ] ); { my $check; sub add_counts { $check ||= compile( Int, Int ); my ( $x, $y ) = &$check; return $x + $y; } } is add_counts( 5, 6 ), 11; my $e = exception { my $z = add_counts( 1.1, 2.2 ); }; like $e, qr/Value "1.1" did not pass type constraint "Int"/; { local $@; my $r = eval q{ package My::Lib; use Type::Library -extends => [ 'CompiledLib' ]; 1; }; ok $r or diag explain( $@ ); } isa_ok( My::Lib::Str(), 'Type::Tiny' ); my $reg = 'Type::Registry'->new; $reg->add_types( 'CompiledLib' ); ok ! $reg->simple_lookup( 'InstanceOf' ); ok $reg->simple_lookup( 'Int' ); done_testing; basic.t000664001750001750 216715111656240 21013 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Types-ReadOnly=pod =encoding utf-8 =head1 PURPOSE L does some frickin weird stuff with parameterization. Check it all works! =head1 DEPENDENCIES Test is skipped if Types::ReadOnly 0.003 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2019-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Types::ReadOnly" => '0.003' }; use Test::Fatal; use Types::Standard -types; use Types::ReadOnly -types; my $UnitHash = Dict->of( magnitude => Num, unit => Optional[Str], )->plus_coercions( Str ,=> q{ do { my($m,$u) = split / /; { magnitude => $m, unit => $u } } }, ); my $LockedUnitHash = Locked[$UnitHash]; my $thirtymetres = $LockedUnitHash->coerce('30 m'); is($thirtymetres->{magnitude}, 30); is($thirtymetres->{unit}, 'm'); my $e = exception { $thirtymetres->{shizzle}++ }; like($e, qr/disallowed key/); done_testing; archaic.t000664001750001750 451615111656240 23071 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Validation-Class-Simple=pod =encoding utf-8 =head1 PURPOSE Fake L 7.900017 by overriding C<< $VERSION >> variable. (There is a reason for this... C follows two different code paths depending on the version of the Validation::Class::Simple object passed to it.) =head1 DEPENDENCIES Test is skipped if Validation::Class 7.900017 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Validation::Class" => "7.900017" }; use Test::TypeTiny; use Types::TypeTiny qw( to_TypeTiny ); use Validation::Class::Simple; BEGIN { $Validation::Class::Simple::VERSION = '7.900017' }; my $type = to_TypeTiny "Validation::Class::Simple"->new( fields => { name => { required => 1, pattern => qr{^\w+(\s\w+)*$}, filters => [qw/trim/] }, email => { required => 1 }, pass => { required => 1 }, pass2 => { required => 1, matches => 'pass' }, }, ); isa_ok($type, "Type::Tiny", 'can create a child type constraint from Validation::Class::Simple'); should_fail('Hello', $type); should_fail({}, $type); should_fail({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }, $type); should_pass({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); should_fail({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); my $msg = $type->get_message({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }); like($msg, qr{pass2 does not match pass}, 'correct error message (A)'); my $msg2 = $type->get_message({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }); like($msg2, qr{name is not formatted properly}, 'correct error message (B)'); ok($type->has_coercion, 'the type has a coercion'); is_deeply( $type->coerce( { name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo', monkey => 'nuts' }, ), { name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, "... which works", ); done_testing; basic.t000664001750001750 435515111656240 22561 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/Validation-Class-Simple=pod =encoding utf-8 =head1 PURPOSE Check type constraints L objects can be used as type constraints. =head1 DEPENDENCIES Test is skipped if Validation::Class 7.900017 is not available. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires { "Validation::Class" => "7.900017" }; use Test::TypeTiny; use Types::TypeTiny qw( to_TypeTiny _ForeignTypeConstraint ); use Validation::Class::Simple; my $orig = "Validation::Class::Simple"->new( fields => { name => { required => 1, pattern => qr{^\w+(\s\w+)*$}, filters => [qw/trim/] }, email => { required => 1 }, pass => { required => 1 }, pass2 => { required => 1, matches => 'pass' }, }, ); my $type = to_TypeTiny $orig; should_pass($orig, _ForeignTypeConstraint); should_fail($type, _ForeignTypeConstraint); isa_ok($type, "Type::Tiny", 'can create a child type constraint from Validation::Class::Simple'); should_fail('Hello', $type); should_fail({}, $type); should_fail({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }, $type); should_pass({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); should_fail({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, $type); my $msg = $type->get_message({ name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'bar' }); like($msg, qr{pass2 does not match pass}, 'correct error message (A)'); my $msg2 = $type->get_message({ name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }); like($msg2, qr{name is not formatted properly}, 'correct error message (B)'); ok($type->has_coercion, 'the type has a coercion'); is_deeply( $type->coerce( { name => 'Toby ', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo', monkey => 'nuts' }, ), { name => 'Toby', email => 'tobyink@cpan.org', pass => 'foo', pass2 => 'foo' }, "... which works", ); done_testing; basic.t000664001750001750 131515111656240 20551 0ustar00taitai000000000000Type-Tiny-2.008006/t/30-external/match-simple=pod =encoding utf-8 =head1 PURPOSE Checks Type::Tiny works with L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use lib qw( ./lib ./t/lib ../inc ./inc ); use Test::More; use Test::Requires 'match::simple'; use Test::Fatal; use Types::Standard -all; use match::simple { replace => 1 }; ok( 42 |M| Int ); ok( 42 |M| Num ); ok not( 42 |M| ArrayRef ); ok( 42 |M| \&is_Int ); ok not( 42 |M| \&is_ArrayRef ); done_testing; Puny.pm000664001750001750 1372415111656240 15665 0ustar00taitai000000000000Type-Tiny-2.008006/t/lib/Type# This is just a copy of Type::Nano. # use 5.008001; use strict; use warnings; use Scalar::Util (); package Type::Puny; use Exporter::Shiny qw( Any Defined Undef Ref ArrayRef HashRef CodeRef Object Str Bool Num Int Object class_type role_type duck_type union intersection enum type ); # Built-in type constraints # our %TYPES; sub Any () { $TYPES{Any} ||= __PACKAGE__->new( name => 'Any', constraint => sub { !!1 }, ); } sub Defined () { $TYPES{Defined} ||= __PACKAGE__->new( name => 'Defined', parent => Any, constraint => sub { defined $_ }, ); } sub Undef () { $TYPES{Undef} ||= __PACKAGE__->new( name => 'Undef', parent => Any, constraint => sub { !defined $_ }, ); } sub Ref () { $TYPES{Ref} ||= __PACKAGE__->new( name => 'Ref', parent => Defined, constraint => sub { ref $_ }, ); } sub ArrayRef () { $TYPES{ArrayRef} ||= __PACKAGE__->new( name => 'ArrayRef', parent => Ref, constraint => sub { ref $_ eq 'ARRAY' }, ); } sub HashRef () { $TYPES{HashRef} ||= __PACKAGE__->new( name => 'HashRef', parent => Ref, constraint => sub { ref $_ eq 'HASH' }, ); } sub CodeRef () { $TYPES{CodeRef} ||= __PACKAGE__->new( name => 'CodeRef', parent => Ref, constraint => sub { ref $_ eq 'CODE' }, ); } sub Object () { $TYPES{Object} ||= __PACKAGE__->new( name => 'Object', parent => Ref, constraint => sub { Scalar::Util::blessed($_) }, ); } sub Bool () { $TYPES{Bool} ||= __PACKAGE__->new( name => 'Bool', parent => Any, constraint => sub { !defined($_) or (!ref($_) and { 1 => 1, 0 => 1, '' => 1 }->{$_}) }, ); } sub Str () { $TYPES{Str} ||= __PACKAGE__->new( name => 'Str', parent => Defined, constraint => sub { !ref $_ }, ); } sub Num () { $TYPES{Num} ||= __PACKAGE__->new( name => 'Num', parent => Str, constraint => sub { Scalar::Util::looks_like_number($_) }, ); } sub Int () { $TYPES{Int} ||= __PACKAGE__->new( name => 'Int', parent => Num, constraint => sub { /\A-?[0-9]+\z/ }, ); } sub class_type ($) { my $class = shift; $TYPES{CLASS}{$class} ||= __PACKAGE__->new( name => $class, parent => Object, constraint => sub { $_->isa($class) }, class => $class, ); } sub role_type ($) { my $role = shift; $TYPES{ROLE}{$role} ||= __PACKAGE__->new( name => $role, parent => Object, constraint => sub { my $meth = $_->can('DOES') || $_->can('isa'); $_->$meth($role) }, role => $role, ); } sub duck_type { my $name = ref($_[0]) ? '__ANON__' : shift; my @methods = sort( ref($_[0]) ? @{+shift} : @_ ); my $methods = join "|", @methods; $TYPES{DUCK}{$methods} ||= __PACKAGE__->new( name => $name, parent => Object, constraint => sub { my $obj = $_; $obj->can($_)||return !!0 for @methods; !!1 }, methods => \@methods, ); } sub enum { my $name = ref($_[0]) ? '__ANON__' : shift; my @values = sort( ref($_[0]) ? @{+shift} : @_ ); my $values = join "|", map quotemeta, @values; my $regexp = qr/\A(?:$values)\z/; $TYPES{ENUM}{$values} ||= __PACKAGE__->new( name => $name, parent => Str, constraint => sub { $_ =~ $regexp }, values => \@values, ); } sub union { my $name = ref($_[0]) ? '__ANON__' : shift; my @types = ref($_[0]) ? @{+shift} : @_; __PACKAGE__->new( name => $name, constraint => sub { my $val = $_; $_->check($val) && return !!1 for @types; !!0 }, types => \@types, ); } sub intersection { my $name = ref($_[0]) ? '__ANON__' : shift; my @types = ref($_[0]) ? @{+shift} : @_; __PACKAGE__->new( name => $name, constraint => sub { my $val = $_; $_->check($val) || return !!0 for @types; !!1 }, types => \@types, ); } sub type { my $name = ref($_[0]) ? '__ANON__' : shift; my $coderef = shift; __PACKAGE__->new( name => $name, constraint => $coderef, ); } # OO interface # sub DOES { my $proto = shift; my ($role) = @_; return !!1 if { 'Type::API::Constraint' => 1, 'Type::API::Constraint::Constructor' => 1, }->{$role}; "UNIVERSAL"->can("DOES") ? $proto->SUPER::DOES(@_) : $proto->isa(@_); } sub new { # Type::API::Constraint::Constructor my $class = ref($_[0]) ? ref(shift) : shift; my $self = bless { @_ == 1 ? %{+shift} : @_ } => $class; $self->{constraint} ||= sub { !!1 }; unless ($self->{name}) { require Carp; Carp::croak("Requires both `name` and `constraint`"); } $self; } sub check { # Type::API::Constraint my $self = shift; my ($value) = @_; if ($self->{parent}) { return unless $self->{parent}->check($value); } local $_ = $value; $self->{constraint}->($value); } sub get_message { # Type::API::Constraint my $self = shift; my ($value) = @_; require B; !defined($value) ? sprintf("Undef did not pass type constraint %s", $self->{name}) : ref($value) ? sprintf("Reference %s did not pass type constraint %s", $value, $self->{name}) : sprintf("Value %s did not pass type constraint %s", B::perlstring($value), $self->{name}); } # Overloading # { my $nil = sub {}; sub _install_overloads { no strict 'refs'; no warnings 'redefine', 'once'; if ($] < 5.010) { require overload; push @_, fallback => 1; goto \&overload::OVERLOAD; }; my $class = shift; *{$class . '::(('} = sub {}; *{$class . '::()'} = sub {}; *{$class . '::()'} = do { my $x = 1; \$x }; while (@_) { my $f = shift; #*{$class . '::(' . $f} = $nil; # cargo culting overload.pm #*{$class . '::(' . $f} = shift; *{$class . '::(' . $f} = ref $_[0] ? shift : do { my $m = shift; sub { shift->$m(@_) } }; } } } __PACKAGE__ ->_install_overloads( 'bool' => sub { 1 }, '""' => sub { shift->{name} }, '&{}' => sub { my $self = shift; sub { my ($value) = @_; $self->check($value) or do { require Carp; Carp::croak($self->get_message($value)); }; }; }, ); 1; Module.pm000664001750001750 735015111656240 20653 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Test/Builderpackage Test::Builder::Module; use strict; use Test::Builder; require Exporter; our @ISA = qw(Exporter); our $VERSION = '0.98'; $VERSION = eval $VERSION; ## no critic (BuiltinFunctions::ProhibitStringyEval) =head1 NAME Test::Builder::Module - Base class for test modules =head1 SYNOPSIS # Emulates Test::Simple package Your::Module; my $CLASS = __PACKAGE__; use base 'Test::Builder::Module'; @EXPORT = qw(ok); sub ok ($;$) { my $tb = $CLASS->builder; return $tb->ok(@_); } 1; =head1 DESCRIPTION This is a superclass for Test::Builder-based modules. It provides a handful of common functionality and a method of getting at the underlying Test::Builder object. =head2 Importing Test::Builder::Module is a subclass of Exporter which means your module is also a subclass of Exporter. @EXPORT, @EXPORT_OK, etc... all act normally. A few methods are provided to do the C 23> part for you. =head3 import Test::Builder::Module provides an import() method which acts in the same basic way as Test::More's, setting the plan and controlling exporting of functions and variables. This allows your module to set the plan independent of Test::More. All arguments passed to import() are passed onto C<< Your::Module->builder->plan() >> with the exception of C<< import =>[qw(things to import)] >>. use Your::Module import => [qw(this that)], tests => 23; says to import the functions this() and that() as well as set the plan to be 23 tests. import() also sets the exported_to() attribute of your builder to be the caller of the import() function. Additional behaviors can be added to your import() method by overriding import_extra(). =cut sub import { my($class) = shift; # Don't run all this when loading ourself. return 1 if $class eq 'Test::Builder::Module'; my $test = $class->builder; my $caller = caller; $test->exported_to($caller); $class->import_extra( \@_ ); my(@imports) = $class->_strip_imports( \@_ ); $test->plan(@_); $class->export_to_level( 1, $class, @imports ); } sub _strip_imports { my $class = shift; my $list = shift; my @imports = (); my @other = (); my $idx = 0; while( $idx <= $#{$list} ) { my $item = $list->[$idx]; if( defined $item and $item eq 'import' ) { push @imports, @{ $list->[ $idx + 1 ] }; $idx++; } else { push @other, $item; } $idx++; } @$list = @other; return @imports; } =head3 import_extra Your::Module->import_extra(\@import_args); import_extra() is called by import(). It provides an opportunity for you to add behaviors to your module based on its import list. Any extra arguments which shouldn't be passed on to plan() should be stripped off by this method. See Test::More for an example of its use. B This mechanism is I as it feels like a bit of an ugly hack in its current form. =cut sub import_extra { } =head2 Builder Test::Builder::Module provides some methods of getting at the underlying Test::Builder object. =head3 builder my $builder = Your::Class->builder; This method returns the Test::Builder object associated with Your::Class. It is not a constructor so you can call it as often as you like. This is the preferred way to get the Test::Builder object. You should I get it via C<< Test::Builder->new >> as was previously recommended. The object returned by builder() may change at runtime so you should call builder() inside each function rather than store it in a global. sub ok { my $builder = Your::Class->builder; return $builder->ok(@_); } =cut sub builder { return Test::Builder->new; } 1; Tester.pm000664001750001750 3625715111656240 20724 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Test/Builderpackage Test::Builder::Tester; use strict; our $VERSION = "1.22"; use Test::Builder; use Symbol; use Carp; =head1 NAME Test::Builder::Tester - test testsuites that have been built with Test::Builder =head1 SYNOPSIS use Test::Builder::Tester tests => 1; use Test::More; test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =head1 DESCRIPTION A module that helps you test testing modules that are built with B. The testing system is designed to be used by performing a three step process for each test you wish to test. This process starts with using C and C in advance to declare what the testsuite you are testing will output with B to stdout and stderr. You then can run the test(s) from your test suite that call B. At this point the output of B is safely captured by B rather than being interpreted as real test output. The final stage is to call C that will simply compare what you predeclared to what B actually outputted, and report the results back with a "ok" or "not ok" (with debugging) to the normal output. =cut #### # set up testing #### my $t = Test::Builder->new; ### # make us an exporter ### use Exporter; our @ISA = qw(Exporter); our @EXPORT = qw(test_out test_err test_fail test_diag test_test line_num); sub import { my $class = shift; my(@plan) = @_; my $caller = caller; $t->exported_to($caller); $t->plan(@plan); my @imports = (); foreach my $idx ( 0 .. $#plan ) { if( $plan[$idx] eq 'import' ) { @imports = @{ $plan[ $idx + 1 ] }; last; } } __PACKAGE__->export_to_level( 1, __PACKAGE__, @imports ); } ### # set up file handles ### # create some private file handles my $output_handle = gensym; my $error_handle = gensym; # and tie them to this package my $out = tie *$output_handle, "Test::Builder::Tester::Tie", "STDOUT"; my $err = tie *$error_handle, "Test::Builder::Tester::Tie", "STDERR"; #### # exported functions #### # for remembering that we're testing and where we're testing at my $testing = 0; my $testing_num; # remembering where the file handles were originally connected my $original_output_handle; my $original_failure_handle; my $original_todo_handle; my $original_test_number; my $original_harness_state; my $original_harness_env; # function that starts testing and redirects the filehandles for now sub _start_testing { # even if we're running under Test::Harness pretend we're not # for now. This needed so Test::Builder doesn't add extra spaces $original_harness_env = $ENV{HARNESS_ACTIVE} || 0; $ENV{HARNESS_ACTIVE} = 0; # remember what the handles were set to $original_output_handle = $t->output(); $original_failure_handle = $t->failure_output(); $original_todo_handle = $t->todo_output(); # switch out to our own handles $t->output($output_handle); $t->failure_output($error_handle); $t->todo_output($output_handle); # clear the expected list $out->reset(); $err->reset(); # remember that we're testing $testing = 1; $testing_num = $t->current_test; $t->current_test(0); # look, we shouldn't do the ending stuff $t->no_ending(1); } =head2 Functions These are the six methods that are exported as default. =over 4 =item test_out =item test_err Procedures for predeclaring the output that your test suite is expected to produce until C is called. These procedures automatically assume that each line terminates with "\n". So test_out("ok 1","ok 2"); is the same as test_out("ok 1\nok 2"); which is even the same as test_out("ok 1"); test_out("ok 2"); Once C or C (or C or C) have been called, all further output from B will be captured by B. This means that you will not be able perform further tests to the normal output in the normal way until you call C (well, unless you manually meddle with the output filehandles) =cut sub test_out { # do we need to do any setup? _start_testing() unless $testing; $out->expect(@_); } sub test_err { # do we need to do any setup? _start_testing() unless $testing; $err->expect(@_); } =item test_fail Because the standard failure message that B produces whenever a test fails will be a common occurrence in your test error output, and because it has changed between Test::Builder versions, rather than forcing you to call C with the string all the time like so test_err("# Failed test ($0 at line ".line_num(+1).")"); C exists as a convenience function that can be called instead. It takes one argument, the offset from the current line that the line that causes the fail is on. test_fail(+1); This means that the example in the synopsis could be rewritten more simply as: test_out("not ok 1 - foo"); test_fail(+1); fail("foo"); test_test("fail works"); =cut sub test_fail { # do we need to do any setup? _start_testing() unless $testing; # work out what line we should be on my( $package, $filename, $line ) = caller; $line = $line + ( shift() || 0 ); # prevent warnings # expect that on stderr $err->expect("# Failed test ($0 at line $line)"); } =item test_diag As most of the remaining expected output to the error stream will be created by Test::Builder's C function, B provides a convenience function C that you can use instead of C. The C function prepends comment hashes and spacing to the start and newlines to the end of the expected output passed to it and adds it to the list of expected error output. So, instead of writing test_err("# Couldn't open file"); you can write test_diag("Couldn't open file"); Remember that B's diag function will not add newlines to the end of output and test_diag will. So to check Test::Builder->new->diag("foo\n","bar\n"); You would do test_diag("foo","bar") without the newlines. =cut sub test_diag { # do we need to do any setup? _start_testing() unless $testing; # expect the same thing, but prepended with "# " local $_; $err->expect( map { "# $_" } @_ ); } =item test_test Actually performs the output check testing the tests, comparing the data (with C) that we have captured from B against that that was declared with C and C. This takes name/value pairs that effect how the test is run. =over =item title (synonym 'name', 'label') The name of the test that will be displayed after the C or C. =item skip_out Setting this to a true value will cause the test to ignore if the output sent by the test to the output stream does not match that declared with C. =item skip_err Setting this to a true value will cause the test to ignore if the output sent by the test to the error stream does not match that declared with C. =back As a convenience, if only one argument is passed then this argument is assumed to be the name of the test (as in the above examples.) Once C has been run test output will be redirected back to the original filehandles that B was connected to (probably STDOUT and STDERR,) meaning any further tests you run will function normally and cause success/errors for B. =cut sub test_test { # decode the arguments as described in the pod my $mess; my %args; if( @_ == 1 ) { $mess = shift } else { %args = @_; $mess = $args{name} if exists( $args{name} ); $mess = $args{title} if exists( $args{title} ); $mess = $args{label} if exists( $args{label} ); } # er, are we testing? croak "Not testing. You must declare output with a test function first." unless $testing; # okay, reconnect the test suite back to the saved handles $t->output($original_output_handle); $t->failure_output($original_failure_handle); $t->todo_output($original_todo_handle); # restore the test no, etc, back to the original point $t->current_test($testing_num); $testing = 0; # re-enable the original setting of the harness $ENV{HARNESS_ACTIVE} = $original_harness_env; # check the output we've stashed unless( $t->ok( ( $args{skip_out} || $out->check ) && ( $args{skip_err} || $err->check ), $mess ) ) { # print out the diagnostic information about why this # test failed local $_; $t->diag( map { "$_\n" } $out->complaint ) unless $args{skip_out} || $out->check; $t->diag( map { "$_\n" } $err->complaint ) unless $args{skip_err} || $err->check; } } =item line_num A utility function that returns the line number that the function was called on. You can pass it an offset which will be added to the result. This is very useful for working out the correct text of diagnostic functions that contain line numbers. Essentially this is the same as the C<__LINE__> macro, but the C idiom is arguably nicer. =cut sub line_num { my( $package, $filename, $line ) = caller; return $line + ( shift() || 0 ); # prevent warnings } =back In addition to the six exported functions there exists one function that can only be accessed with a fully qualified function call. =over 4 =item color When C is called and the output that your tests generate does not match that which you declared, C will print out debug information showing the two conflicting versions. As this output itself is debug information it can be confusing which part of the output is from C and which was the original output from your original tests. Also, it may be hard to spot things like extraneous whitespace at the end of lines that may cause your test to fail even though the output looks similar. To assist you C can colour the background of the debug information to disambiguate the different types of output. The debug output will have its background coloured green and red. The green part represents the text which is the same between the executed and actual output, the red shows which part differs. The C function determines if colouring should occur or not. Passing it a true or false value will enable or disable colouring respectively, and the function called with no argument will return the current setting. To enable colouring from the command line, you can use the B module like so: perl -Mlib=Text::Builder::Tester::Color test.t Or by including the B module directly in the PERL5LIB. =cut my $color; sub color { $color = shift if @_; $color; } =back =head1 BUGS Calls C<no_ending>> turning off the ending tests. This is needed as otherwise it will trip out because we've run more tests than we strictly should have and it'll register any failures we had that we were testing for as real failures. The color function doesn't work unless B is compatible with your terminal. Bugs (and requests for new features) can be reported to the author though the CPAN RT system: L =head1 AUTHOR Copyright Mark Fowler Emark@twoshortplanks.comE 2002, 2004. Some code taken from B and B, written by by Michael G Schwern Eschwern@pobox.comE. Hence, those parts Copyright Micheal G Schwern 2001. Used and distributed with permission. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 NOTES Thanks to Richard Clamp Erichardc@unixbeard.netE for letting me use his testing system to try this module out on. =head1 SEE ALSO L, L, L. =cut 1; #################################################################### # Helper class that is used to remember expected and received data package Test::Builder::Tester::Tie; ## # add line(s) to be expected sub expect { my $self = shift; my @checks = @_; foreach my $check (@checks) { $check = $self->_translate_Failed_check($check); push @{ $self->{wanted} }, ref $check ? $check : "$check\n"; } } sub _translate_Failed_check { my( $self, $check ) = @_; if( $check =~ /\A(.*)# (Failed .*test) \((.*?) at line (\d+)\)\Z(?!\n)/ ) { $check = "/\Q$1\E#\\s+\Q$2\E.*?\\n?.*?\Qat $3\E line \Q$4\E.*\\n?/"; } return $check; } ## # return true iff the expected data matches the got data sub check { my $self = shift; # turn off warnings as these might be undef local $^W = 0; my @checks = @{ $self->{wanted} }; my $got = $self->{got}; foreach my $check (@checks) { $check = "\Q$check\E" unless( $check =~ s,^/(.*)/$,$1, or ref $check ); return 0 unless $got =~ s/^$check//; } return length $got == 0; } ## # a complaint message about the inputs not matching (to be # used for debugging messages) sub complaint { my $self = shift; my $type = $self->type; my $got = $self->got; my $wanted = join "\n", @{ $self->wanted }; # are we running in colour mode? if(Test::Builder::Tester::color) { # get color eval { require Term::ANSIColor }; unless($@) { # colours my $green = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_green"); my $red = Term::ANSIColor::color("black") . Term::ANSIColor::color("on_red"); my $reset = Term::ANSIColor::color("reset"); # work out where the two strings start to differ my $char = 0; $char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 ); # get the start string and the two end strings my $start = $green . substr( $wanted, 0, $char ); my $gotend = $red . substr( $got, $char ) . $reset; my $wantedend = $red . substr( $wanted, $char ) . $reset; # make the start turn green on and off $start =~ s/\n/$reset\n$green/g; # make the ends turn red on and off $gotend =~ s/\n/$reset\n$red/g; $wantedend =~ s/\n/$reset\n$red/g; # rebuild the strings $got = $start . $gotend; $wanted = $start . $wantedend; } } return "$type is:\n" . "$got\nnot:\n$wanted\nas expected"; } ## # forget all expected and got data sub reset { my $self = shift; %$self = ( type => $self->{type}, got => '', wanted => [], ); } sub got { my $self = shift; return $self->{got}; } sub wanted { my $self = shift; return $self->{wanted}; } sub type { my $self = shift; return $self->{type}; } ### # tie interface ### sub PRINT { my $self = shift; $self->{got} .= join '', @_; } sub TIEHANDLE { my( $class, $type ) = @_; my $self = bless { type => $type }, $class; $self->reset; return $self; } sub READ { } sub READLINE { } sub GETC { } sub FILENO { } 1; AllTypes.pod000664001750001750 2042415111656240 20525 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::AllTypes - alphabetical list of all type constraints bundled with Type::Tiny =head1 MANUAL The following is a list of type constraints bundled with Type::Tiny, with very brief descriptions. For more information, see the type library's documentation, and the test cases in C<< t/21-types/ >>. GitHub link: L. =over =item * B<< Any >> in L Anything. Absolutely anything. =item * B<< ArrayLike >> I<< [parameterizable] >> in L Arrayrefs and objects overloading arrayfication. =item * B<< ArrayRef >> I<< [parameterizable] >> in L Arrayrefs. =item * B<< Bool >> I<< [has coercion] >> in L Booleans; the numbers or strings "0" and "1", the empty string, or undef. =item * B<< BoolLike >> in L Similar to B<< Bool >>, but without coercions, and accepts objects overloading "bool". =item * B<< ClassName >> in L Any loaded package name. =item * B<< CodeLike >> in L Coderefs and objects overloading coderefification. =item * B<< CodeRef >> in L Coderefs. =item * B<< ConsumerOf >> I<< [parameterizable] >> in L An object that DOES a particular role. =item * B<< CycleTuple >> I<< [parameterizable] >> in L An arrayref with a repeating pattern of constraints on its values. =item * B<< Defined >> in L Any value other than undef. =item * B<< DelimitedStr >> I<< [parameterizable] >> in L A comma-delimited or other delimited string. =item * B<< Dict >> I<< [parameterizable] >> in L A hashref with constraints on each of its values. =item * B<< Enum >> I<< [parameterizable] >> in L A string from an allowed set of strings. =item * B<< _ForeignTypeConstraint >> in L A coderef or an object which Type::Tiny knows how to convert into a Type::Tiny instance. (Yes, the name of this type starts with an underscore.) =item * B<< FileHandle >> in L A reference where Scalar::Util::openhandle returns true, or a blessed object in the IO::Handle class. =item * B<< GlobRef >> in L Globrefs =item * B<< HashLike >> I<< [parameterizable] >> in L Hashrefs and objects overloading hashrefification. =item * B<< HashRef >> I<< [parameterizable] >> in L Hashrefs. =item * B<< HasMethods >> I<< [parameterizable] >> in L An object that can do particular methods. =item * B<< InstanceOf >> I<< [parameterizable] >> in L An object that isa particular class. =item * B<< Int >> in L A whole number, either positive, negative, or zero. =item * B<< IntRange >> I<< [parameterizable] >> in L An integer within a particular numeric range. =item * B<< Item >> in L Any single item; effectively the same as B. =item * B<< LaxNum >> in L A number; relaxed constraint that allows "inf". =item * B<< LowerCaseSimpleStr >> I<< [has coercion] >> in L A string less than 256 characters long with no line breaks or uppercase letters. =item * B<< LowerCaseStr >> I<< [has coercion] >> in L A string with no uppercase letters. =item * B<< Map >> I<< [parameterizable] >> in L A hashref with a constraint for the values and keys. =item * B<< Maybe >> I<< [parameterizable] >> in L When parameterized, the same as its parameter, but also allows undef. =item * B<< NegativeInt >> in L An integer below 0. =item * B<< NegativeNum >> in L A number below 0. =item * B<< NegativeOrZeroInt >> in L An integer below 0, or 0. =item * B<< NegativeOrZeroNum >> in L A number below 0, or 0. =item * B<< NonEmptySimpleStr >> in L A string with more than 0 but less than 256 characters with no line breaks. =item * B<< NonEmptyStr >> in L A string with more than 0 characters. =item * B<< Num >> in L The same as B or B depending on environment. =item * B<< NumericCode >> I<< [has coercion] >> in L A string containing only digits. =item * B<< NumRange >> I<< [parameterizable] >> in L A number within a particular numeric range. =item * B<< Object >> in L A blessed object. =item * B<< Optional >> I<< [parameterizable] >> in L Used in conjunction with B, B, or B. =item * B<< OptList >> in L An arrayref of arrayrefs, where each of the inner arrayrefs are two values, the first value being a string. =item * B<< Overload >> I<< [parameterizable] >> in L An overloaded object. =item * B<< Password >> in L A string at least 4 characters long and less than 256 characters long with no line breaks. =item * B<< PositiveInt >> in L An integer above 0. =item * B<< PositiveNum >> in L A number above 0. =item * B<< PositiveOrZeroInt >> in L An integer above 0, or 0. =item * B<< PositiveOrZeroNum >> in L An number above 0, or 0. =item * B<< Ref >> I<< [parameterizable] >> in L Any reference. =item * B<< RegexpRef >> in L A regular expression. =item * B<< RoleName >> in L Any loaded package name where there is no `new` method. =item * B<< ScalarRef >> I<< [parameterizable] >> in L Scalarrefs. =item * B<< SimpleStr >> in L A string with less than 256 characters with no line breaks. =item * B<< SingleDigit >> in L A single digit number. This includes single digit negative numbers! =item * B<< Slurpy >> I<< [parameterizable] >> in L Used in conjunction with Dict or Tuple. =item * B<< Str >> in L A string. =item * B<< StrictNum >> in L A number; strict constraint. =item * B<< StringLike >> in L Strings and objects overloading stringification. =item * B<< StrLength >> I<< [parameterizable] >> in L A string with length in a particular range. =item * B<< StrMatch >> I<< [parameterizable] >> in L A string matching a particular regular expression. =item * B<< StrongPassword >> in L A string at least 4 characters long and less than 256 characters long with no line breaks and at least one non-alphabetic character. =item * B<< Tied >> I<< [parameterizable] >> in L A reference to a tied variable. =item * B<< Tuple >> I<< [parameterizable] >> in L An arrayref with constraints on its values. =item * B<< TypeTiny >> I<< [has coercion] >> in L Blessed objects in the Type::Tiny class. =item * B<< Undef >> in L undef. =item * B<< UpperCaseSimpleStr >> I<< [has coercion] >> in L A string less than 256 characters long with no line breaks or lowercase letters. =item * B<< UpperCaseStr >> I<< [has coercion] >> in L A string with no lowercase letters. =item * B<< Value >> in L Any non-reference value, including undef. =back The module L incorporates all of the above. =head1 NEXT STEPS Here's your next step: =over =item * L Policies related to Type::Tiny development. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Coercions.pod000664001750001750 3153215111656240 20716 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Coercions - advanced information on coercions =head1 MANUAL This section of the manual assumes you've already read L. Type::Tiny takes a slightly different approach to type constraints from Moose. In Moose, there is a single flat namespace for type constraints. Moose defines a type constraint called B for strings and a type constraint called B for arrayrefs. If you want to define strings differently (maybe you think that the empty string doesn't really count as a string, or maybe you think objects overloading C<< q[""] >> should count as strings) then you can't call it B; you need to choose a different name. With Type::Tiny, two type libraries can each offer a string type constraint with their own definitions for what counts as a string, and you can choose which one to import, or import them both with different names: use Some::Types qw( Str ); use Other::Types "Str" => { -as => "Str2" }; This might seem to be a small advantage of Type::Tiny, but where this global-versus-local philosophy really makes a difference is coercions. Let's imagine for a part of your application that deals with reading username and password data you need to have a "username:password" string. You may wish to accept a C<< [$username, $password] >> arrayref and coerce it to a string using C<< join ":", @$arrayref >>. But another part of your application deals with slurping log files, and wants to coerce a string from an arrayref using C<< join "\n", @$arrayref >>. These are both perfectly sensible ways to coerce an arrayref. In Moose, a typical way to do this would be: package My::UserManager { use Moose; use Moose::Util::TypeConstraints; coerce 'Str', from 'ArrayRef', via { join ":", @$_ }; ...; } package My::LogReader { use Moose; use Moose::Util::TypeConstraints; coerce 'Str', from 'ArrayRef', via { join "\n", @$_ }; ...; } However, because in Moose all types and coercions are global, if both these classes are loaded, only one of them will work. One class will overrule the other's coercion. Which one "wins" will depend on load order. It is possible to solve this with Moose native types, but it requires extra work. (The solution is for My::UserManager and My::LogReader to each create a subtype of B and define the coercion on that subtype instead of on B directly.) Type::Tiny solves this in two ways: =over =item 1. Type::Tiny makes it possible for type libraries to "protect" their type constraints to prevent external code from adding new coercions to them. $type->coercion->freeze(); You can freeze coercions for your entire type library using: __PACKAGE__->make_immutable; If you try to add coercions to a type constraint that has frozen coercions, it will throw an error. use Types::Standard qw( Str ArrayRef ); Str->coercion->add_type_coercions( ArrayRef, sub { join "\n", @$_ }, ); =item 2. Type::Tiny makes the above-mentioned pattern of adding coercions to a subtype much easier. use Types::Standard ( Str ArrayRef ); my $subtype = Str->plus_coercions( ArrayRef, sub { join "\n", @$_ }, ); The C method creates a new child type, adds new coercions to it, copies any existing coercions from the parent type, and then freezes coercions for the new child type. The end result is you now have a "copy" of B that can coerce from B but other copies of B won't be affected by your coercion. =back =head2 Defining Coercions within Type Libraries Some coercions like joining an arrayref to make a string are not going to be coercions that everybody will agree on. Join with a line break in between them as above? Or with a colon, a tab, a space, some other chanaracter? It depends a lot on your application. Others, like coercing a L object from a string, are likely to be very obvious. It is this kind of coercion that it makes sense to define within the library itself so it's available to any packages that use the library. my $pt = __PACKAGE__->add_type( Type::Tiny::Class->new( name => 'Path', class => 'Path::Tiny', ), ); $pt->coercion->add_type_coercions( Str, q{ Path::Tiny::path($_) }, ); $pt->coercion->freeze; =head2 Tweak Coercions Outside Type Libraries The C method creates a new type constraint with additional coercions. If the original type already had coercions, the new coercions have a higher priority. There's also a C method which does the same as C but adds the new coercions with a lower priority than any existing ones. L provides a C method as a shortcut for coercing via a constructor method. The following two are the same: Path->plus_constructors( Str, "new" ) Path->plus_coercions( Str, q{ Path::Tiny->new($_) } ) To create a type constraint without particular existing coercions, you can use C. The following uses the B type defined in L, removing the coercion from B but keeping the coercions from B and B. use Types::Standard qw( Int ); use Example::Types qw( Datetime ); has start_date => ( is => 'ro', isa => Datetime->minus_coercions( Int ), coerce => 1, ); There's also a C method that creates a subtype with no coercions at all. This is most useful either to create a "blank slate" for C: my $Path = Path->no_coercions->plus_coercions( Str, sub { ... } ); Or to disable coercions for L. Type::Params will always automatically coerce a parameter if there is a coercion for that type. use Types::Standard qw( Object ); use Types::Common::String qw( UpperCaseStr ); use Type::Params qw( signature_for ); signature_for set_account_name => ( method => Object, positional => [ UpperCaseStr->no_coercions ], ); sub set_account_name ( $self, $name ) { $self->_account_name( $name ); $self->db->update( $self ); return $self; } # This will die instead of coercing from lowercase $robert->set_account_name( 'bob' ); =head2 Named Coercions A compromise between defining a coercion in the type library or defining them in the package that uses the type library is for a type library to define a named collection of coercions which can be optionally added to a type constraint. { package MyApp::Types; use Type::Library -extends => [ 'Types::Standard' ]; __PACKAGE__->add_coercion( name => "FromLines", type_constraint => ArrayRef, type_coercion_map => [ Str, q{ [split /\n/] }, Undef, q{ [] }, ], ); } This set of coercions has a name and can be imported and used: use MyApp::Types qw( ArrayRef FromLines ); has lines => ( is => 'ro', isa => ArrayRef->plus_coercions( FromLines ), coerce => 1, ); L defines a named coercion B designed to be used for B. use Types::Standard qw( OptList MkOpt ); my $OptList = OptList->plus_coercions( MkOpt ); =head2 Parameterized Coercions Named coercions can also be parameterizable. my $ArrayOfLines = ArrayRef->plus_coercions( Split[ qr{\n} ] ); L defines B and B parameterizable coercions. Viewing the source code for L should give you hints as to how they are implemented. =head2 "Deep" Coercions Certain parameterized type constraints can automatically acquire coercions if their parameters have coercions. For example: ArrayRef[ Int->plus_coercions( Num, q{int($_)} ) ] ... does what you mean! The parameterized type constraints that do this magic include the following ones from L: =over =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =item * B =back Imagine we're defining a type B in a type library: __PACKAGE__->add_type( name => 'Paths', parent => ArrayRef[Path], ); The B type has a coercion from B, so B should be able to coerce from an arrayref of strings, right? I<< Wrong! >> Although B<< ArrayRef[Path] >> could coerce from an arrayref of strings, B is a separate type constraint which, although it inherits from B<< ArrayRef[Path] >> has its own (currently empty) set of coercions. Because that is often not what you want, Type::Tiny provides a shortcut when declaring a subtype to copy the parent type constraint's coercions: __PACKAGE__->add_type( name => 'Paths', parent => ArrayRef[Path], coercion => 1, # inherit ); Now B can coerce from an arrayref of strings. =head3 Deep Caveat Currently there exists ill-defined behaviour resulting from mixing deep coercions and mutable (non-frozen) coercions. Consider the following: class_type Path, { class => "Path::Tiny" }; coerce Path, from Str, via { "Path::Tiny"->new($_) }; declare Paths, as ArrayRef[Path], coercion => 1; coerce Path, from InstanceOf["My::File"], via { $_->get_path }; An arrayref of strings can now be coerced to an arrayref of Path::Tiny objects, but is it also now possible to coerce an arrayref of My::File objects to an arrayref of Path::Tiny objects? Currently the answer is "no", but this is mostly down to implementation details. It's not clear what the best way to behave in this situation is, and it could start working at some point in the future. This is why you should freeze coercions. =head2 Chained Coercions Consider the following type library: package Types::Geometric { use Type::Library -base, -declare => qw( VectorArray VectorArray3D Point Point3D ); use Type::Utils; use Types::Standard qw( Num Tuple InstanceOf ); declare VectorArray, as Tuple[Num, Num]; declare VectorArray3D, as Tuple[Num, Num, Num]; coerce VectorArray3D, from VectorArray, via { [ @$_, 0 ]; }; class_type Point, { class => "Point" }; coerce Point, from VectorArray, via { Point->new(x => $_->[0], y => $_->[1]); }; class_type Point3D, { class => "Point3D" }; coerce Point3D, from VectorArray3D, via { Point3D->new(x => $_->[0], y => $_->[1], z => $_->[2]); }, from Point, via { Point3D->new(x => $_->x, y => $_->y, z => 0); }; } Given an arrayref C<< [1, 1] >> you might reasonably expect it to be coercible to a B object; it matches the type constraint B so can be coerced to B and thus to B. However, L does not automatically chain coercions like this. Firstly, it would be incompatible with Moose's type coercion system which does not chain coercions. Secondly, it's ambiguous; in our example, the arrayref could be coerced along two different paths (via B or via B); in this case the end result would be the same, but in other cases it might not. Thirdly, it runs the risk of accidentally creating loops. Doing the chaining manually though is pretty simple. Firstly, we'll take note of the C method in L. This method called as C<< VectorArray3D->coercibles >> returns a type constraint meaning "anything that can be coerced to a B". So we can define the coercions for B as: coerce Point3D, from VectorArray3D->coercibles, via { my $tmp = to_VectorArray3D($_); Point3D->new(x => $tmp->[0], y => $tmp->[1], z => $tmp->[2]); }, from Point, via { Point3D->new(x => $_->x, y => $_->y, z => 0); }; ... and now coercing from C<< [1, 1] >> will work. =head1 SEE ALSO L, L, L. =head1 NEXT STEPS After that last example, probably have a little lie down. Once you're recovered, here's your next step: =over =item * L An alphabetical list of all type constraints bundled with Type::Tiny. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Contributing.pod000664001750001750 555515111656240 21427 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Contributing - contributing to Type::Tiny development. =head1 MANUAL =head2 Reporting bugs Bug reports (including wishlist items) can be submitted to GitHub. L. Test cases written using L are always appreciated. =head2 Fixing bugs If something doesn't work as documented, or causes unexpected crashes, and you know how to fix it, then either attach a patch to the bug report (see above) or as a pull request to the project on GitHub. L. Please try to follow the coding style used in the rest of the project. (Tab indents, spaces for alignment, British English spellings, pod at the end of code but the start of test cases, etc.) L =head2 Adding Test Cases New test cases for the Type::Tiny test suite are always welcome. The coveralls page for Type::Tiny should reveal what parts of the code are most needing good test cases. Any files with below 95% coverage are highest priority. L. Type::Tiny is now also on Codecov which does coverage accounting slightly differently, giving some stricter targets to aim for. L =head2 Type::Tiny::XS I'm not really a C programmer, nor am I that familiar with Perl's internals, so help with L is always appreciated. There are some type constraints in L, L, and L which don't have XS implementations. =head2 Writing Type Libraries Though I'm unlikely to bundle many more type libraries in this distribution, uploading your own type libraries to CPAN will strengthen the Type::Tiny ecosystem. =head2 Donate If you or your organization uses Type::Tiny and you wish to contribute financially, you should be able to find links to donate on the Type::Tiny website at L. Please note that I am not suggesting that you must do this in order for me to continue working on Type::Tiny and related modules. =head1 NEXT STEPS You've reached the end of the manual! But each class, type library, and other package includes more detailed documentation. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Installation.pod000664001750001750 1070115111656240 21426 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =for highlighter language=ChangeLog =head1 NAME Type::Tiny::Manual::Installation - how to install Type::Tiny =head1 MANUAL Installing Type-Tiny should be straightforward. =head2 Installation with cpanminus If you have cpanm, you only need one line: % cpanm Type::Tiny If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S Type::Tiny =head2 Installation with the CPAN Shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Type::Tiny =head2 Manual Installation As a last resort, you can manually install it. Download the tarball and unpack it. Consult the file META.json for a list of pre-requisites. Install these first. To build Type-Tiny: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install =head2 Dependencies Type::Tiny requires at least Perl 5.8.1, though certain Unicode-related features (e.g. non-ASCII type constraint names) may work better in newer versions of Perl. Type::Tiny requires L, a module that was previously bundled in this distribution, but has since been spun off as a separate distribution. Don't worry - it's quick and easy to install. At run-time, Type::Tiny also requires the following Perl modules: L, L, L, L, L, L, L, L, and L. All of these come bundled with Perl itself. Certain features require additional modules. Stack traces on exceptions require L. The L plugin for L requires L (obviously). L is not required, but if available provides a speed boost for some type checks. (Setting the environment variable C to false, or setting C to true will suppress the use of Type::Tiny::XS, even if it is available.) The test suite additionally requires L, L and L. Test::More comes bundled with Perl, but if you are using a version of Perl older than 5.14, you will need to upgrade to at least Test::More version 0.96. Test::Requires and Test::Fatal (plus Try::Tiny which Test::Fatal depends on) are bundled with Type::Tiny in the C directory, so you do not need to install them separately. If using Type::Tiny in conjunction with L, then at least Moo 1.006000 is recommended. If using Type::Tiny with L, then at least Moose 2.0000 is recommended. If using Type::Tiny with L, then at least Mouse 1.00 is recommended. Type::Tiny is mostly untested against older versions of these packages. =head3 Type::Tiny and cperl L is an extended version of Perl with various incompatible changes from the official Perl 5 releases. As of Type::Tiny 1.010001, cperl is a supported platform for Type::Tiny with some caveats. At the time of writing, Moose will not install on the latest cperl releases, so using Type::Tiny with Moose on cperl is untested. Moo can be forced to install, and Type::Tiny is verified to work with Moo on cperl. cperl not only enables a new warnings category called "shadow" (which is good; they're potentially useful) but switches on shadow warnings by default (which is annoying). Type::Tiny does not (and likely will never) attempt to work around these warnings. If the warnings bother you, you should be able to catch them using C<< $SIG{__WARN__} >>. Certain features of L are broken under cperl, but they're not thought to have any practical effect on Type::Tiny or its other bundled modules. =head1 NEXT STEPS Here's your next step: =over =item * L Basic use of Type::Tiny with Moo, including attribute type constraints, parameterized type constraints, coercions, and method parameter checking. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Libraries.pod000664001750001750 3402315111656240 20704 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Libraries - defining your own type libraries =head1 MANUAL =head2 Defining a Type A type is an object and you can create a new one using the constructor: use Type::Tiny; my $type = Type::Tiny->new(%args); A full list of the available arguments can be found in the L documentation, but the most important ones to begin with are: =over =item C The name of your new type. Type::Tiny uses a convention of UpperCamelCase names for type constraints. The type name may also begin with one or two leading underscores to indicate a type intended for internal use only. Types using non-ASCII characters may cause problems on older versions of Perl (pre-5.8). Although this is optional and types may be anonymous, a name is required for a type constraint to added to a type library. =item C A code reference checking C<< $_ >> and returning a boolean. Alternatively, a string of Perl code may be provided. If you've been paying attention, you can probably guess that the string of Perl code may result in more efficient type checks. =item C An existing type constraint to inherit from. A value will need to pass the parent constraint before its own constraint would be called. my $Even = Type::Tiny->new( name => 'EvenNumber', parent => Types::Standard::Int, constraint => sub { # in this sub we don't need to check that $_ is an Int # because the parent will take care of that! $_ % 2 == 0 }, ); Although the C is optional, it makes sense whenever possible to inherit from an existing type constraint to benefit from any optimizations or XS implementations they may provide. =back =head2 Defining a Library A library is a Perl module that exports type constraints as subs. L, L, and L are type libraries that are bundled with Type::Tiny. To create a type library, create a package that inherits from L. package MyTypes { use Type::Library -base; ...; # your type definitions go here } The C<< -base >> flag is just a shortcut for: package MyTypes { use Type::Library; our @ISA = 'Type::Library'; } You can add types like this: package MyTypes { use Type::Library -base; my $Even = Type::Tiny->new( name => 'EvenNumber', parent => Types::Standard::Int, constraint => sub { # in this sub we don't need to check that $_ is an Int # because the parent will take care of that! $_ % 2 == 0 }, ); __PACKAGE__->add_type($Even); } There is a shortcut for adding types if they're going to be blessed L objects and not, for example, a subclass of Type::Tiny. You can just pass C<< %args >> directly to C. package MyTypes { use Type::Library -base; __PACKAGE__->add_type( name => 'EvenNumber', parent => Types::Standard::Int, constraint => sub { # in this sub we don't need to check that $_ is an Int # because the parent will take care of that! $_ % 2 == 0 }, ); } The C method returns the type it just added, so it can be stored in a variable. my $Even = __PACKAGE__->add_type(...); This can be useful if you wish to use C<< $Even >> as the parent type to some other type you're going to define later. Here's a bigger worked example: package Example::Types { use Type::Library -base; use Types::Standard -types; use DateTime; # Type::Tiny::Class is a subclass of Type::Tiny for creating # InstanceOf-like types. It's kind of better though because # it does cool stuff like pass through $type->new(%args) to # the class's constructor. # my $dt = __PACKAGE__->add_type( Type::Tiny::Class->new( name => 'Datetime', class => 'DateTime', ) ); my $dth = __PACKAGE__->add_type( name => 'DatetimeHash', parent => Dict[ year => Int, month => Optional[ Int ], day => Optional[ Int ], hour => Optional[ Int ], minute => Optional[ Int ], second => Optional[ Int ], nanosecond => Optional[ Int ], time_zone => Optional[ Str ], ], ); my $eph = __PACKAGE__->add_type( name => 'EpochHash', parent => Dict[ epoch => Int ], ); # Can't just use "plus_coercions" method because that creates # a new anonymous child type to add the coercions to. We want # to add them to the type which exists in this library. # $dt->coercion->add_type_coercions( Int, q{ DateTime->from_epoch(epoch => $_) }, Undef, q{ DateTime->now() }, $dth, q{ DateTime->new(%$_) }, $eph, q{ DateTime->from_epoch(%$_) }, ); __PACKAGE__->make_immutable; } C freezes to coercions of all the types in the package, so no outside code can tamper with the coercions, and allows Type::Tiny to make optimizations to the coercions, knowing they won't later be altered. You should always do this at the end. The library will export types B, B, and B. The B type will have coercions from B, B, B, and B. =head2 Extending Libraries L provides a helpful function C<< extends >>. package My::Types { use Type::Library -base; use Type::Utils qw( extends ); BEGIN { extends("Types::Standard") }; # define your own types here } The C function (which you should usually use in a C<< BEGIN { } >> block not only loads another type library, but it also adds all the types from it to your library. This means code using the above My::Types doesn't need to do: use Types::Standard qw( Str ); use My::Types qw( Something ); It can just do: use My::Types qw( Str Something ); Because all the types from Types::Standard have been copied across into My::Types and are also available there. C can be passed a list of libraries; you can inherit from multiple existing libraries. It can also recognize and import types from L, L, and L libraries. Since Type::Library 1.012, there has been a shortcut for C<< extends >>. package My::Types { use Type::Library -extends => [ 'Types::Standard' ]; # define your own types here } The C<< -extends >> flag takes an arrayref of type libraries to extend. It automatically implies C<< -base >> so you don't need to use both. =head2 Custom Error Messages A type constraint can have custom error messages. It's pretty simple: Type::Tiny->new( name => 'EvenNumber', parent => Types::Standard::Int, constraint => sub { # in this sub we don't need to check that $_ is an Int # because the parent will take care of that! $_ % 2 == 0 }, message => sub { sprintf '%s is not an even number', Type::Tiny::_dd($_); }, ); The message coderef just takes a value in C<< $_ >> and returns a string. It may use C<< Type::Tiny::_dd() >> as a way of pretty-printing a value. (Don't be put off by the underscore in the function name. C<< _dd() >> is an officially supported part of Type::Tiny's API now.) You don't have to use C<< _dd() >>. You can generate any error string you like. But C<< _dd() >> will help you make undef and the empty string look different, and will pretty-print references, and so on. There's no need to supply an error message coderef unless you really want custom error messages. The default sub should be reasonable. =head2 Inlining In Perl, sub calls are relatively expensive in terms of memory and CPU use. The B type inherits from B which inherits from B which inherits from B which inherits from B which inherits from B which inherits from B. So you might think that to check of C<< $value >> is a B, it needs to be checked all the way up the inheritance chain. But this is where one of Type::Tiny's big optimizations happens. Type::Tiny can glue together a bunch of checks with a stringy eval, and get a single coderef that can do all the checks in one go. This is why when Type::Tiny gives you a choice of using a coderef or a string of Perl code, you should usually choose the string of Perl code. A single coderef can "break the chain". But these automatically generated strings of Perl code are not always as efficient as they could be. For example, imagine that B is defined as: my $Defined = Type::Tiny->new( name => 'Defined', constraint => 'defined($_)', ); my $Ref = Type::Tiny->new( name => 'Ref', parent => $Defined, constraint => 'ref($_)', ); my $HashRef = Type::Tiny->new( name => 'HashRef', parent => $Ref, constraint => 'ref($_) eq "HASH"', ); Then the combined check is: defined($_) and ref($_) and ref($_) eq "HASH" Actually in practice it's even more complicated, because Type::Tiny needs to localize and set C<< $_ >> first. But in practice, the following should be a sufficient check: ref($_) eq "HASH" It is possible for the B type to have more control over the string of code generated. my $HashRef = Type::Tiny->new( name => 'HashRef', parent => $Ref, constraint => 'ref($_) eq "HASH"', inlined => sub { my $varname = pop; sprintf 'ref(%s) eq "HASH"', $varname; }, ); The inlined coderef gets passed the name of a variable to check. This could be C<< '$_' >> or C<< '$var' >> or C<< $some{deep}{thing}[0] >>. Because it is passed the name of a variable to check, instead of always checking C<< $_ >>, this enables very efficient checking for parameterized types. Although in this case, the inlining coderef is just returning a string, technically it returns a list of strings. If there's multiple strings, Type::Tiny will join them together in a big "&&" statement. As a special case, if the first item in the returned list of strings is undef, then Type::Tiny will substitute the parent type constraint's inlined string in its place. So an inlieing coderef for even numbers might be: Type::Tiny->new( name => 'EvenNumber', parent => Types::Standard::Int, constraint => sub { $_ % 2 == 0 }, inlined => sub { my $varname = pop; return (undef, "$varname % 2 == 0"); }, ); Even if you provide a coderef as a string, an inlining coderef has the potential to generate more efficient code, so you should consider providing one. =head2 Pre-Declaring Types use Type::Library -base, -declare => qw( Foo Bar Baz ); This declares types B, B, and B at compile time so they can safely be used as barewords in your type library. This also allows recursively defined types to (mostly) work! use Type::Library -base, -declare => qw( NumericArrayRef ); use Types::Standard qw( Num ArrayRef ); __PACKAGE__->add_type( name => NumericArrayRef, parent => ArrayRef->of( Num | NumericArrayRef ), ); (Support for recursive type definitions added in Type::Library 1.009_000.) =head2 Parameterizable Types This is probably the most "meta" concept that is going to be covered. Building your own type constraint that can be parameterized like B or B. The type constraint we'll build will be B<< MultipleOf[$i] >> which checks that an integer is a multiple of $i. __PACKAGE__->add_type( name => 'MultipleOf', parent => Int, # This coderef gets passed the contents of the square brackets. constraint_generator => sub ( $i ) { assert_Int $i; # needs to return a coderef to use as a constraint for the # parameterized type return sub { $_ % $i == 0 }; }, # optional but recommended inline_generator => sub ( $i ) { return sub { my $varname = pop; return (undef, "$varname % $i == 0"); }; }, # probably the most complex bit coercion_generator => sub ( $parent_type, $child_type, $i ) { require Type::Coercion; return Type::Coercion->new( type_coercion_map => [ Num, qq{ int($i * int(\$_/$i)) } ], ); }, ); Now we can define an even number like this: __PACKAGE__->add_type( name => 'EvenNumber', parent => __PACKAGE__->get_type('MultipleOf')->of(2), coercion => 1, # inherit from parent ); Note that it is possible for a type constraint to have a C I a C. BaseType # uses the constraint BaseType[] # constraint_generator with no arguments BaseType[$x] # constraint_generator with an argument In the B example above, B<< MultipleOf[] >> with no number would throw an error because of C<< assert_Int(shift) >> not finding an integer. But it is certainly possible for B<< BaseType[] >> to be meaningful and distinct from C<< BaseType >>. For example, B is just the same as B and accepts any arrayref as being valid. But B<< Tuple[] >> will only accept arrayrefs with zero elements in them. (Just like B<< Tuple[Any,Any] >> will only accept arrayrefs with two elements.) =head1 NEXT STEPS After that last example, probably have a little lie down. Once you're recovered, here's your next step: =over =item * L How to use Type::Tiny with Moose, including the advantages of Type::Tiny over built-in type constraints, and Moose-specific features. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut NonOO.pod000664001750001750 647415111656240 17751 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::NonOO - Type::Tiny in non-object-oriented code =head1 MANUAL Although Type::Tiny was designed with object-oriented programming in mind, especially Moose-style classes and roles, it can be used in procedural and imperative programming. If you have read L, you should understand how L can be used to validate method parameters. This same technique can be applied to regular subs too. More information about checking parameters can be found in L. The C<< is_* >> and C<< assert_* >> functions exported by type libraries may be useful in non-OO code too. See L. =head2 Type::Tiny and Smart Match Perl 5.10 introduced the smart match operator C<< ~~ >>, which has since been deprecated because though the general idea is fairly sound, the details were a bit messy. Nevertheless, Type::Tiny has support for smart match and I'm documenting it here because there's nowhere better to put it. The following can be used as to check if a value passes a type constraint: $value ~~ SomeType Where it gets weird is if C<< $value >> is an object and overloads C<< ~~ >>. Which overload of C<< ~~ >> wins? I don't know. Better to use: SomeType->check( $value ) # more reliable, probably faster is_SomeType($value) # more reliable, definitely faster It's also possible to do: $value ~~ SomeType->coercion This checks to see if C<< $value >> matches any type that can be coerced to B. But better to use: SomeType->coercion->has_coercion_for_value( $value ) =head2 C and C Related to the smart match operator is the C/C syntax. This will not do what you want it to do: use Types::Standard qw( Str Int ); given ( $value ) { when ( Int ) { ... } when ( Str ) { ... } } This will do what you wanted: use Types::Standard qw( is_Str is_Int ); given ( $value ) { when ( \&is_Int ) { ... } when ( \&is_Str ) { ... } } Sorry, that's just how Perl be. Better though: use Types::Standard qw( Str Int ); use Type::Utils qw( match_on_type ); match_on_type $value => ( Str, sub { ... }, Int, sub { ... }, ); If this is part of a loop or other frequently called bit of code, you can compile the checks once and use them many times: use Types::Standard qw( Str Int ); use Type::Utils qw( compile_match_on_type ); my $dispatch_table = compile_match_on_type( Str, sub { ... }, Int, sub { ... }, ); $dispatch_table->($_) for @lots_of_values; As with most things in Type::Tiny, those coderefs can be replaced by strings of Perl code. =head1 NEXT STEPS Here's your next step: =over =item * L Squeeze the most out of your CPU. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Optimization.pod000664001750001750 2403315111656240 21456 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Optimization - squeeze the most out of your CPU =head1 MANUAL Type::Tiny is written with efficiency in mind, but there are techniques you can use to get the best performance out of it. =head2 XS The simplest thing you can do to increase performance of many of the built-in type constraints is to install L, a set of ultra-fast type constraint checks implemented in C. L will attempt to load L and use its type checks. If L is not available, it will then try to use L I<< if it is already loaded >>, but Type::Tiny won't attempt to load Mouse for you. Certain type constraints can also be accelerated if you have L installed. =head3 Types that can be accelerated by Type::Tiny::XS The following simple type constraints from L will be accelerated by Type::Tiny::XS: B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, B, and B. (Note that B and B are I on that list.) The parameterized form of B cannot be accelerated. The parameterized forms of B, B, and B can be accelerated only if their parameters are. The parameterized form of B can be accelerated if its parameters are, it has no B components, and it does not use B. Certain type constraints may benefit partially from Type::Tiny::XS. For example, B inherits from B, so part of the type check will be conducted by Type::Tiny::XS. The parameterized B, B, and B type constraints will be accelerated. So will L, L, and L objects. The B and B type constraints from L will be accelerated, as will the B type constraint from L. The B, B, B, and B types from L will be accelerated, including the parameterized versions of B and B. L and L will also be accelerated if their constituent type constraints are. =head3 Types that can be accelerated by Mouse The following simple type constraints from L will be accelerated by Type::Tiny::XS: B, B, B, B, B, B, B, B, B, B, B, B, B, and B. (Note that B, B, B, B, and B are I on that list.) The parameterized form of B cannot be accelerated. The parameterized forms of B and B can be accelerated only if their parameters are. Certain type constraints may benefit partially from Mouse. For example, B inherits from B, so part of the type check will be conducted by Mouse. The parameterized B and B type constraints will be accelerated. So will L and L objects. =head2 Inlining Type Constraints In the case of a type constraint like this: my $type = Int->where( sub { $_ >= 0 } ); Type::Tiny will need to call one sub to verify a value meets the B type constraint, and your coderef to check that the value is above zero. Sub calls in Perl are relatively expensive in terms of memory and CPU usage, so it would be good if it could be done all in one sub call. The B type constraint knows how to create a string of Perl code that checks an integer. It's something like the following. (It's actually more complicated, but this is close enough as an example.) $_ =~ /^-?[0-9]+$/ If you provide your check as a string instead of a coderef, like this: my $type = Int->where( q{ $_ >= 0 } ); Then Type::Tiny will be able to combine them into one string: ( $_ =~ /^-?[0-9]+$/ ) && ( $_ >= 0 ) So Type::Tiny will be able to check values in one sub call. Providing constraints as strings is a really simple and easy way of optimizing type checks. But it can be made even more efficient. Type::Tiny needs to localize C<< $_ >> and copy the value into it for the above check. If you're checking B<< ArrayRef[$type] >> this will be done for each element of the array. Things could be made more efficient if Type::Tiny were able to directly check: ( $arrayref->[$i] =~ /^-?[0-9]+$/ ) && ( $arrayref->[$i] >= 0 ) This can be done by providing an inlining sub. The sub is given a variable name and can use that in the string of code it generates. my $type = Type::Tiny->new( parent => Int, inlined => sub ( $self, $varname ) { return sprintf( '(%s) && ( %s >= 0 )', $self->parent->inline_check( $varname ), $varname, ); } ); Because it's pretty common to want to call your parent's inline check and C<< && >> your own string with it, Type::Tiny provides a shortcut for this. Just return a list of strings to smush together with C<< && >>, and if the first one is C, Type::Tiny will fill in the blank with the parent type check. my $type = Type::Tiny->new( parent => Int, inlined => sub ( $self, $varname ) { return ( undef, sprintf( '%s >= 0', $varname ) ); }, ); There is one further optimization which can be applied to this particular case. You'll note that we're checking the string matches C<< /^-?[0-9+]$/ >> and then checking it's greater than or equal to zero. But a non-negative integer won't ever start with a minus sign, so we could inline the check to something like: $_ =~ /^[0-9]+$/ While an inlined check I call its parent type check, it is not required to. my $type = Type::Tiny->new( parent => Int, inlined => sub ( $self, $varname ) { return sprintf( '%s =~ /^[0-9]+$/', $varname ); } ); If you opt not to call the parent type check, then you need to ensure your own check is at least as rigorous. =head2 Inlining Coercions Moo is the only object-oriented programming toolkit that fully supports coercions being inlined, but even for Moose and Mouse, providing coercions as strings can help Type::Tiny optimize its coercion features. For Moo, if you want your coercion to be inlinable, all the types you're coercing from and to need to be inlinable, plus the coercion needs to be given as a string of Perl code. =head2 Common Sense The B<< HashRef[ArrayRef] >> type constraint can probably be checked faster than B<< HashRef[ArrayRef[Num]] >>. If you find yourself using very complex and slow type constraints, you should consider switching to simpler and faster ones. (Though this means you have to place a little more trust in your caller to not supply you with bad data.) (A counter-intuitive exception to this: even though B is more restrictive than B, in most circumstances B checks will run faster.) =head2 Devel::StrictMode One possibility is to use strict type checks when you're running your release tests, and faster, more permissive type checks at other times. L can make this easier. This provides a C constant that indicates whether your code is operating in "strict mode" based on certain environment variables. =head3 Attributes use Types::Standard qw( ArrayRef Num ); use Devel::StrictMode qw( STRICT ); has numbers => ( is => 'ro', isa => STRICT ? ArrayRef[Num] : ArrayRef, default => sub { [] }, ); It is inadvisible to do this on attributes that have coercions because it can lead to inconsistent and unpredictable behaviour. =head3 Type::Params Very efficient way which avoids compiling the signature at all if C is false: use Types::Standard qw( Num Object ); use Type::Params qw( signature ); use Devel::StrictMode qw( STRICT ); sub add_number { state $check; STRICT and $check //= signature( method => 1, positional => [ Num ], ); my ( $self, $num ) = STRICT ? &$check : @_; push @{ $self->numbers }, $num; return $self; } Again, you need to be careful to ensure consistent behaviour if you're using coercions, defaults, slurpies, etc. Less efficient way, but more declarative and smart enough to just disable checks which are safe(ish) to disable, while coercions, defaults, and slurpies will continue to work: use Types::Standard qw( Num Object ); use Type::Params qw( signature_for ); use Devel::StrictMode qw( STRICT ); signature_for add_number => ( strictness => STRICT, method => 1, positional => [ Num ], ); sub add_number ( $self, $num ) { push @{ $self->numbers }, $num; return $self; } =head3 Ad-Hoc Type Checks ...; my $x = get_some_number(); assert_Int $x if STRICT; return $x + 1; ...; =head2 The Slash Operator Type::Tiny has some of the same logic as Devel::StrictMode built in. In particular, it overloads the slash (division) operator so that B<< TypeA/TypeB >> evaluates to B normally, but to B in strict mode. An example using this feature: use Types::Standard -types; has numbers => ( is => 'ro', isa => ArrayRef[ Num / Any ], default => sub { [] }, ); In strict mode, this attribute would check that its value is an arrayref of numbers (which may be slow if it contains a lot of numbers). Normally though, it will just check that the value is an arrayref. =head1 NEXT STEPS Here's your next step: =over =item * L Advanced information on coercions. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Params.pod000664001750001750 2323415111656240 20215 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Params - advanced information on Type::Params =head1 MANUAL To get started with Type::Params, please read L which will cover a lot of the basics, even if you're not using Moo. =head2 C The C option allows you to specify multiple ways of calling a sub. signature_for repeat_string => ( multiple => [ { positional => [ Str, Int ] }, { named => [ string => Str, count => Int ], named_to_list => true }, ], ); sub repeat_string ( $string, $count ) { return $string x $count; } repeat_string( "Hello", 42 ); # works repeat_string( string => "Hello", count => 42 ); # works repeat_string({ string => "Hello", count => 42 }); # works repeat_string( qr/hiya/ ); # dies It combines multiple checks and tries each until one works. =head2 C In many cases, the multiple call conventions offered by C can be implemented more easily using C. signature_for repeat_string => ( list_to_named => true, named => [ string => Str, count => Int ], named_to_list => true, ); sub repeat_string ( $string, $count ) { return $string x $count; } # Standard ways to call the function: repeat_string( string => "Hello", count => 42 ); repeat_string({ string => "Hello", count => 42 }); # These should also work: repeat_string( "Hello", count => 42 ); repeat_string( "Hello", { count => 42 } ); repeat_string( 42, string => "Hello" ); repeat_string( 42, { string => "Hello" } ); repeat_string( "Hello", 42 ); # This currently won't work though, because "42" appears first so is taken # to be the string, but "Hello" isn't a valid integer! repeat_string( 42, "Hello" ); The C option works in three stages. When looking for the hash or hashref of named parameters, if there are other parameters first, these are kept to one side in a list of "sneaky" positional parameters. Later when validating the named parameters, if any of them seem to be missing, the list of sneaky positional parameters is examined and if possible the parameter is taken from there. Finally after all the named parameters have been processed, if there are still any positional parameters which weren't needed, an error is thrown. =head2 C C allows the signature to be defined within the sub itself, potentially on-the-fly, which is occasionally useful. Instead of this: signature_for foobar => ( positional => [ Int, Str ], ); sub foobar ( $foo, $bar ) { ...; } You do this: sub foobar { my $check = signature( positional => [ Int, Str ] ); my ( $foo, $bar ) = $check->( @_ ); ...; } Or use C<< state $check >> if you know the check will be the same every time. =head2 Functions versus Methods For subs which are intended to be called as functions: signature_for my_sub => ( method => false, ... ); signature_for my_sub => ( ... ); # this is the default anyway For subs which are intended to be called as methods on a blessed object: signature_for my_method => ( method => Object, ... ); And for subs which are intended to be called as methods on a class: signature_for my_method => ( method => ClassName, ... ); signature_for my_method => ( method => Str, ... ); # faster, less readable The following are also allowed, which indicates that the sub is intended to be called as a method, but you don't want to do type checks on the invocant: signature_for my_method => ( method => builtin::true, ... ); signature_for my_method => ( method => 1, ... ); Shortcuts are available: use Type::Params qw( signature_for_func signature_for_method ); signature_for_func my_function => ( ... ); signature_for_method my_method => ( ... ); =head2 Mixed Named and Positional Parameters The C and C options allow required positional parameters at the start or end of a named parameter list: signature_for my_func => ( head => [ Int ], named => [ foo => Int, bar => Optional[Int], baz => Optional[Int], ], ); my_func( 42, foo => 21 ); # ok my_func( 42, foo => 21, bar => 84 ); # ok my_func( 42, foo => 21, bar => 10.5 ); # not ok my_func( 42, foo => 21, quux => 84 ); # not ok Alternatively, C (see above) may be of use. =head2 Proper Signatures Don't you wish your subs could look like this? sub set_name ( Object $self, Str $name ) { $self->{name} = $name; } Well; here are a few solutions for sub signatures that work with L... =head3 Zydeco L is a Perl OO syntax toolkit with Type::Tiny support baked in throughout. package MyApp { use Zydeco; class Person { has name ( type => Str ); method rename ( Str $new_name ) { printf( "%s will now be called %s\n", $self->name, $new_name ); $self->name( $new_name ); } coerce from Str via { $class->new( name => $_ ) } } class Company { has owner ( type => 'Person' ); } } my $acme = MyApp->new_company( owner => "Robert" ); $acme->owner->rename( "Bob" ); =head3 Kavorka L is a sub signatures implementation written to natively use L' C for type constraints, and take advantage of Type::Tiny's features such as inlining, and coercions. method set_name ( Str $name ) { $self->{name} = $name; } Kavorka's signatures provide a lot more flexibility, and slightly more speed than Type::Params. (The speed comes from inlining almost all type checks into the body of the sub being declared.) Kavorka also includes support for type checking of the returned value. Kavorka can also be used as part of L, a larger framework for object oriented programming in Perl. =head3 Function::Parameters Function::Parameters offers support for Type::Tiny and MooseX::Types. use Types::Standard qw( Str ); use Function::Parameters; method set_name ( Str $name ) { $self->{name} = $name; } =head3 Attribute::Contract Both Kavorka and Function::Parameters require a relatively recent version of Perl. L supports older versions by using a lot less magic. You want Attribute::Contract 0.03 or above. use Attribute::Contract -types => [qw/Object Str/]; sub set_name :ContractRequires(Object, Str) { my ($self, $name) = @_; $self->{name} = $name; } Attribute::Contract also includes support for type checking of the returned value. =head2 Type::Params versus X =head3 Params::Validate L is not really a drop-in replacement for L; the API differs far too much to claim that. Yet it performs a similar task, so it makes sense to compare them. =over =item * Type::Params will tend to be faster if you've got a sub which is called repeatedly, but may be a little slower than Params::Validate for subs that are only called a few times. This is because it does a bunch of work the first time your sub is called to make subsequent calls a lot faster. =item * Params::Validate doesn't appear to have a particularly natural way of validating a mix of positional and named parameters. =item * Type::Utils allows you to coerce parameters. For example, if you expect a L object, you could coerce it from a string. =item * If you are primarily writing object-oriented code, using Moose or similar, and you are using Type::Tiny type constraints for your attributes, then using Type::Params allows you to use the same constraints for method calls. =item * Type::Params comes bundled with Types::Standard, which provides a much richer vocabulary of types than the type validation constants that come with Params::Validate. For example, Types::Standard provides constraints like C<< ArrayRef[Int] >> (an arrayref of integers), while the closest from Params::Validate is C<< ARRAYREF >>, which you'd need to supplement with additional callbacks if you wanted to check that the arrayref contained integers. Whatsmore, Type::Params doesn't just work with Types::Standard, but also any other Type::Tiny type constraints. =back =head3 Params::ValidationCompiler L does basically the same thing as L. =over =item * Params::ValidationCompiler and Type::Params are likely to perform fairly similarly. In most cases, recent versions of Type::Params seem to be I faster, but except in very trivial cases, you're unlikely to notice the speed difference. Speed probably shouldn't be a factor when choosing between them. =item * Type::Params's syntax is more compact: state $check = signature( pos => [ Object, Optional[Int], Slurpy[ArrayRef], ], ); Versus: state $check = validation_for( params => [ { type => Object }, { type => Int, optional => 1 }, { type => ArrayRef, slurpy => 1 }, ], ); =item * L probably has slightly better exceptions. =back =head1 NEXT STEPS Here's your next step: =over =item * L Type::Tiny in non-object-oriented code. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Policies.pod000664001750001750 1155415111656240 20543 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::Policies - Type::Tiny policies =head1 MANUAL =head2 Type::Tiny Stability Policy Type::Tiny 1.000000+ is considered stable. Any changes to the API that are big enough to I changes to the test suite will be preceded by a I<< six month >> notice period, with the following exceptions: =over =item * Any changes which are necessary to maintain compatibility with new releases of L, L, and other software that Type::Tiny needs to integrate with. =item * Changes to maintain compatibility with future versions of Perl itself. =item * Where a change fixes a contradiction between the implementation and documentation of Type::Tiny. =item * Where a feature is explicitly documented as being "experimental" or "unstable". =item * Improvements to the text of error messages. =back =head2 Experimental and Unstable Type::Tiny Features The following list is currently non-exhaustive. =over =item * The following type checks result may vary based on your version of Perl and whether Type::Tiny::XS is installed. Their outcome is currently considered undefined, and may change in future versions. =over =item * Using B and similar type checks on unblessed regular expression references, the outcome is undefined. =item * On all current versions of Perl, false (C<< !!0 >>) stringifies to the empty string (but using Devel::Peek you can tell the difference between this value and a normal empty string), so B and subtypes of B do not consider it to be an integer. If Perl's behaviour ever changes, you might not be able to rely on this outcome. True (C<< !!1 >>) stringifies as "1", so is considered an integer. =item * A glob (not a globref but an actual glob) currently passes the B type constraint but not the B type constraint. =item * The B type is intended to extend B to cover overloaded boolean objects, but the exact mechanism it uses may change. =back =item * L's C attribute and the functionality it provides is experimental. =item * The L is subject to change. =item * The interaction of deep coercions and mutable coercions currently results in ill-defined behaviour. This could change at any time. =item * L's ability to import L and L type libraries is experimental. =item * The C and C keywords provided by L may change their behaviour slightly in the future. Once stable, they are expected to be added to L's exports. =item * The C function. =item * These modules are considered part of Type::Tiny's internals, and not covered by the stability policy: L, L, L, L, L, L, L, L, L, L, L, L, L, L, and L. =item * The use of some of the modules in the previous list item as exporters of shortcuts for parameterized types is not stable yet. =item * L is not covered by the stability policy. =back =head2 Type::Tiny Versioning Policy As of 1.000000, this distribution follows a versioning scheme similar to L, which is based on a L-like three component version number, but with the last two components each represented by three decimal digits in the fractional part of the version number. That is, version 1.003002 of the software represents "1.3.2". Additionally, releases where the second component is an odd number will be considered unstable/trial releases. (These will also include an underscore in the version number as per the usual CPAN convention.) =head2 Perl Version Support Type::Tiny 0.000_01 to Type::Tiny 0.015_04 required Perl 5.8.1. Type::Tiny 0.015_05+ and Type::Tiny 1.000000+ requires Perl 5.6.1. Type::Tiny 2.000000+ will require Perl 5.8.1. =head1 NEXT STEPS Here's your next step: =over =item * L Contributing to Type::Tiny development. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithClassTiny.pod000664001750001750 1053515111656240 22545 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithClassTiny - use of Type::Tiny with Class::Tiny =head1 MANUAL L is an even-smaller-than-Moo class builder. Let's translate the classic Horse class from Moo to Class::Tiny. Moo: package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, required => 1 ); has gender => ( is => 'ro', isa => Str ); has age => ( is => 'rw', isa => Num ); has children => ( is => 'ro', isa => ArrayRef, default => sub { return [] }, ); } Class::Tiny: package Horse { use Class::Tiny qw( gender age ), { name => sub { die "name is required"; }, children => sub { return [] }, }; use Types::Standard qw( Str Num ArrayRef Dict Optional Slurpy Any Object ); use Type::Params qw( signature_for ); use namespace::autoclean; # type checks signature_for BUILD => ( method => Object, named => [ name => Str, gender => Optional[Str], age => Optional[Num], children => Optional[ArrayRef], () => Slurpy[Any], ], fallback => 1, ); signature_for [ 'name', 'gender', 'children' ] => ( method => Object, positional => [], ); signature_for age => ( method => Object, positional => [ Optional[Num] ], ); } What's going on here? Well, Class::Tiny, after it has built a new object, will do this: $self->BUILD($args); (Technically, it calls C not just for the current class, but for all parent classes too.) We can hook onto this in order to check type constraints for the constructor. We use C from L to wrap the original C method (which doesn't exist, so C<< fallback => 1 >> will just assume an empty sub) with a type check for its arguments. The type check is just a B that checks the class's required and optional attributes and includes B<< Slurpy[Any] >> at the end to be flexible for subclasses adding new attributes. Then we wrap the C, C, and C methods with checks to make sure they're only being called as getters, and we wrap C, allowing it to be called as a setter with a B. There are also a couple of CPAN modules that can help you out. =head2 Class::Tiny::ConstrainedAccessor L creates a C and accessors that enforce Type::Tiny constraints. Attribute types are passed to Class::Tiny::ConstrainedAccessor; attribute defaults are passed to Class::Tiny. package Horse { use Types::Standard qw( Str Num ArrayRef ); use Class::Tiny::ConstrainedAccessor { name => Str, gender => Str, age => Num, children => ArrayRef, }; use Class::Tiny qw( gender age ), { name => sub { die "name is required"; }, children => sub { return [] }, }; } =head2 Class::Tiny::Antlers L provides Moose-like syntax for Class::Tiny, including support for C. You do not also need to use Class::Tiny itself. package Horse { use Class::Tiny::Antlers qw(has); use Types::Standard qw( Str Num ArrayRef ); use namespace::autoclean; has name => ( is => 'ro', isa => Str, default => sub { die "name is required" }, ); has gender => ( is => 'ro', isa => Str ); has age => ( is => 'rw', isa => Num ); has children => ( is => 'ro', isa => ArrayRef, default => sub { return [] }, ); } =head1 NEXT STEPS Here's your next step: =over =item * L Using Type::Tiny with Class::InsideOut, Params::Check, and Object::Accessor. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMite.pod000664001750001750 1150615111656240 21531 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMite - how to use Type::Tiny with Mite =head1 MANUAL L takes an unorthodox approach to object-oriented code. When you first start a project with Mite (which we'll assume is called Your::Project), Mite will create a module called Your::Project::Mite for you. Then all your classes use code like: package Your::Project::Widget; use Your::Project::Mite -all; has name => ( is => ro, isa => 'Str', ); has id => ( is => ro, isa => 'PositiveInt', ); signature_for warble => ( named => [ foo => 'Int', bar => 'ArrayRef', ], ); sub warble { my ( $self, $arg ) = @_; printf( "%s: %d\n", $self->name, $arg->foo ); return; } 1; After writing or editing each class or role, you run the command C<< mite compile >> and Mite will output a collection of compiled Perl classes which have no non-core dependencies (on Perl 5.14+. There are a couple of non-core dependencies on older versions of Perl.) Attribute C options are Type::Tiny type constraints expressed as strings. Mite looks them up during compilation using C from L, and pre-loads L, L, and L for you. The C keyword is similar to the corresponding function in L. Again, note that types are expressed as strings and looked up using C. Any types which are inlineable should work. If using coercion, any coercions which are inlineable should work. =head2 Custom Types in Mite You can define your own type library (say, Your::Project::Types) using L as normal: package Your::Project::Types; use Type::Library -extends => [ 'Types::Standard', 'Types::Common::Numeric' ]; __PACKAGE__->add_type( name => 'Widget', parent => InstanceOf['Your::Project::Widget'], )->coercion->add_type_coercions( HashRef, q{Your::Project::Widget->new($_)}, ); __PACKAGE__->make_immutable; 1; Now if your classes load Your::Project::Types they'll suddenly have a dependency on Type::Library, so you don't get that nice zero-dependency feeling. But you can add this to your C<< .mite/config >> file: types: Your::Project::Types Now Mite will know to load that type library at compile time, and will make those types available as stringy types everywhere. =head2 Compiled Type Libraries It does look really pretty to not have to quote your type constraints: has name => ( is => ro, isa => Str, ); One solution for that is L. Say you've created the custom type library above, you can use L to compile it into a module called Your::Project::Types::Compiled, which just uses L and doesn't rely on L or any other part of L. Then your Widget class can use that: package Your::Project::Widget; use Your::Project::Mite -all; use Your::Project::Types::Compiled -types; has name => ( is => ro, isa => Str, ); has id => ( is => ro, isa => PositiveInt, ); signature_for warble => ( named => [ foo => Int, bar => ArrayRef, ], ); sub warble { my ( $self, $arg ) = @_; printf( "%s: %d\n", $self->name, $arg->foo ); return; } 1; The compiled type libraries are more limited than real type libraries. You can't, for example, do parameterized types with them. However, they still offer some cool features like: Foo->check( $value ) # a few basic methods like this is_Foo( $value ) # boolean checks assert_Foo( $value ) # assertions which die Foo | Bar # unions! This way you can write a project with object orientation, roles, method modifiers, type-checked attributes, type-checked signatures, and even coercion, with no non-core dependencies! (The tools like L and L are only needed by the developer, not the end user.) =head1 NEXT STEPS Here's your next step: =over =item * L Including how to Type::Tiny in your object's C method, and third-party shims between Type::Tiny and Class::Tiny. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2022-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMoo.pod000664001750001750 6134115111656240 21367 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoo - basic use of Type::Tiny with Moo =head1 MANUAL =head2 Type Constraints Consider the following basic Moo class: package Horse { use Moo; use namespace::autoclean; has name => ( is => 'ro' ); has gender => ( is => 'ro' ); has age => ( is => 'rw' ); has children => ( is => 'ro', default => sub { [] } ); } Code like this seems simple enough: my $br = Horse->new(name => "Bold Ruler", gender => 'm', age => 16); push @{ $br->children }, Horse->new(name => 'Secretariat', gender => 'm', age => 0); However, once you step away from very simple use of the class, things can start to go wrong. When we push a new horse onto C<< @{ $br->children } >>, we are assuming that C<< $br->children >> returned an arrayref. What if the code that created the C<< $br >> horse had instantiated it like this? my $br = Horse->new(name => "Bold Ruler", children => 'no'); It is for this reason that it's useful for the Horse class to perform some basic sanity-checking on its own attributes. package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef ); use namespace::autoclean; has name => ( is => 'ro', isa => Str ); has gender => ( is => 'ro', isa => Str ); has age => ( is => 'rw', isa => Num ); has children => ( is => 'ro', isa => ArrayRef, default => sub { return [] }, ); } Now, if you instantiate a horse like this, it will throw an error: my $br = Horse->new(name => "Bold Ruler", children => 'no'); The first type constraint we used here was B. This is type constraint that requires values to be strings. Note that although C is not a string, the empty string is still a string and you will often want to check that a string is non-empty. We could have done this: use Types::Common::String qw( NonEmptyStr ); has name => ( is => 'ro', isa => NonEmptyStr ); While most of the type constraints we will use in this manual are defined in L, the L type library also defines many useful type constraints. We have required the horse's age to be a number. This is also a common, useful type constraint. If we want to make sure it's a whole number, we could use: use Types::Standard qw( Int ); has age => ( is => 'rw', isa => Int ); Or because negative numbers make little sense as an age: use Types::Common::Numeric qw( PositiveOrZeroInt ); has age => ( is => 'rw', isa => PositiveOrZeroInt ); The L library defines many useful subtypes of B and B, such as B and B. The last type constraint we've used in this example is B. This requires the value to be a reference to an array. Types::Standard also provides B and B type constraints. An example of using the latter: package Task { use Moo; use Types::Standard qw( CodeRef Bool ); has on_success => ( is => 'ro', isa => CodeRef ); has on_failure => ( is => 'ro', isa => CodeRef ); has finished => ( is => 'ro', isa => Bool, default => 0 ); ...; } my $task = Task->new( on_success => sub { ... }, on_failure => sub { ... }, ..., ); The B<< Bool >> type constraint accepts "1" as a true value, and "0", "", or undef as false values. No other values are accepted. There exists an B type constraint that accepts any blessed object. package Horse { use Moo; use Types::Standard qw( Object ); use namespace::autoclean; ...; # name, gender, age, children has father => ( is => 'ro', isa => Object ); has mother => ( is => 'ro', isa => Object ); } Finally, another useful type constraint to know about is B: use Types::Standard qw( Any ); has stuff => ( is => 'rw', isa => Any ); This type constraint allows any value; it is essentially the same as not doing any type check, but makes your intent clearer. Where possible, Type::Tiny will optimize away this type check, so it should have little (if any) impact on performance. =head2 Parameterized Types Let's imagine we want to keep track of our horse's race wins: package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef ); use namespace::autoclean; ...; # name, gender, age, children has wins => ( is => 'ro', isa => ArrayRef, default => sub { return [] }, ); } We can create a horse like this: my $br = Horse->new( name => "Bold Ruler", gender => 'm', age => 4, wins => ["Futurity Stakes 1956", "Juvenile Stakes 1956"], ); The list of wins is an arrayref of strings. The B type constraint prevents it from being set to a hashref, for example, but it doesn't ensure that everything in the arrayref is a string. To do that, we need to parameterize the type constraint: has wins => ( is => 'ro', isa => ArrayRef[Str], default => sub { return [] }, ); Thanks to the B<< ArrayRef[Str] >> parameterized type, the constructor will throw an error if the arrayref you pass to it contains anything non-string. An alternative way of writing this is: has wins => ( is => 'ro', isa => ArrayRef->of(Str), default => sub { return [] }, ); Which way you choose is largely a style preference. TIMTOWTDI! Note that although the constructor and any setter/accessor method will perform type checks, it is possible to bypass them using: push @{ $br->wins }, $not_a_string; The constructor isn't being called here, and although the accessor I being called, it's being called as a reader, not a writer, so never gets an opportunity to inspect the value being added. (It is possible to use C to solve this, but that will be covered later.) And of course, if you directly poke at the underlying hashref of the object, all bets are off: $br->{wins} = $not_an_arrayref; So type constraints do have limitations. Careful API design (and not circumventing the proper API) can help. The B type constraint can also be parameterized: package Design { use Moo; use Types::Standard qw( HashRef Str ); has colours => ( is => 'ro', isa => HashRef[Str] ); } my $eiffel65 = Design->new( colours => { house => "blue", little_window => "blue" }, ); The B<< HashRef[Str] >> type constraint ensures the I of the hashref are strings; it doesn't check the keys of the hashref because keys in Perl hashes are always strings! If you do need to constrain the keys, it is possible to use a parameterized B<< Map >> constraint: use Types::Common::String qw( NonEmptyStr ); use Types::Standard qw( Map ); has colours => ( is => 'ro', isa => Map[NonEmptyStr, NonEmptyStr] ); B takes two parameters; the first is a type to check keys against and the second is a type to check values against. Another useful type constraint is the B<< Tuple >> type constraint. use Types::Standard qw( ArrayRef Tuple ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Tuple[PositiveInt, NonEmptyStr] ], default => sub { return [] }, ); The B<< Tuple[PositiveInt, NonEmptyStr] >> type constraint checks that a value is a two-element arrayref where the first element is a positive integer and the second element is a non-empty string. For example: my $br = Horse->new( name => "Bold Ruler", wins => [ [ 1956, "Futurity Stakes" ], [ 1956, "Juvenile Stakes" ], ], ); As you can see, parameterized type constraints may be nested to arbitrary depth, though of course the more detailed your checks become, the slower they will perform. It is possible to have tuples with variable length. For example, we may wish to include the jockey name in our race wins when it is known. use Types::Standard qw( ArrayRef Tuple Optional ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Tuple[ PositiveInt, NonEmptyStr, Optional[NonEmptyStr] ] ], default => sub { return [] }, ); The third element will be checked if it is present, but forgiven if it is absent. Or we could just allow tuples to contain an arbitrary list of strings after the year and race name: use Types::Standard qw( ArrayRef Tuple Str Slurpy ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Tuple[ PositiveInt, NonEmptyStr, Slurpy[ ArrayRef[Str] ] ] ], default => sub { return [] }, ); The B<< Slurpy[ ArrayRef[Str] ] >> type will "slurp" all the remaining items in the tuple into an arrayref and check it against B<< ArrayRef[Str] >>. It's even possible to do this: use Types::Standard qw( ArrayRef Tuple Any Slurpy ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Tuple[ PositiveInt, NonEmptyStr, Slurpy[Any] ] ], default => sub { return [] }, ); With this type constraint, any elements after the first two will be slurped into an arrayref and we don't check that arrayref at all. (In fact, the implementation of the B type is smart enough to not bother creating the temporary arrayref to check.) B is the equivalent of B for checking values of hashrefs. use Types::Standard qw( ArrayRef Dict Optional ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Dict[ year => PositiveInt, race => NonEmptyStr, jockey => Optional[NonEmptyStr], ], ], default => sub { return [] }, ); An example of using it: my $br = Horse->new( name => "Bold Ruler", wins => [ { year => 1956, race => "Futurity Stakes", jockey => "Eddie" }, { year => 1956, race => "Juvenile Stakes" }, ], ); The B type does work for B too: Dict[ year => PositiveInt, race => NonEmptyStr, jockey => Optional[NonEmptyStr], () => Slurpy[ HashRef[Str] ], # other Str values allowed ] And C<< Slurpy[Any] >> means what you probably think it means: Dict[ year => PositiveInt, race => NonEmptyStr, jockey => Optional[NonEmptyStr], () => Slurpy[Any], # allow hashref to contain absolutely anything else ] Going back to our first example, there's an opportunity to refine our B constraint: package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef ); use namespace::autoclean; has name => ( is => 'ro', isa => Str ); has gender => ( is => 'ro', isa => Str ); has age => ( is => 'rw', isa => Num ); has children => ( is => 'ro', isa => ArrayRef[ InstanceOf["Horse"] ], default => sub { return [] }, ); } The B<< InstanceOf["Horse"] >> type constraint checks that a value is a blessed object in the Horse class. So the horse's children should be an arrayref of other Horse objects. Internally it just checks C<< $_->isa("Horse") >> on each item in the arrayref. It is sometimes useful to instead check C<< $_->DOES($role) >> or C<< $_->can($method) >> on an object. For example: package MyAPI::Client { use Moo; use Types::Standard qw( HasMethods ); has ua => (is => 'ro', isa => HasMethods["get", "post"] ); } The B and B parameterizable types allow you to easily check roles and methods of objects. The B parameterizable type allows you to accept a more limited set of string values. For example: use Types::Standard qw( Enum ); has gender => ( is => 'ro', isa => Enum["m","f"] ); Or if you want a little more flexibility, you can use B which allows you to test strings against a regular expression: use Types::Standard qw( StrMatch ); has gender => ( is => 'ro', isa => StrMatch[qr/^[MF]/i] ); Or B to check the maximum and minimum length of a string: use Types::Common::String qw( StrLength ); has name => ( is => 'ro', isa => StrLength[3, 100] ); The maximum can be omitted. Similarly, the maximum and minimum values for a numeric type can be expressed using B and B: use Types::Common::Numeric qw( IntRange ); # values over 200 are probably an input error has age => ( is => 'ro', isa => IntRange[0, 200] ); Parameterized type constraints are one of the most powerful features of Type::Tiny, allowing a small set of constraints to be combined in useful ways. =head2 Type Coercions It is often good practice to be liberal in what you accept. package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef Bool ); use namespace::autoclean; ...; # name, gender, age, children, wins has is_alive => ( is => 'rw', isa => Bool, coerce => 1 ); } The C option indicates that if a value is given which I<< does not >> pass the B type constraint, then it should be coerced (converted) into something that does. The definition of B says that to convert a non-boolean to a bool, you just do C<< !! $non_bool >>. So all of the following will be living horses: Horse->new(is_alive => 42) Horse->new(is_alive => []) Horse->new(is_alive => "false") # in Perl, string "false" is true! B is the only type constraint in Types::Standard that has a coercion defined for it. The B, B, B, B, and B types from Types::Common::String also have conversions defined. The other built-in constraints do not define any coercions because it would be hard to agree on what it means to coerce from, say, a B to an B. Do we keep the keys? The values? Both? But it is pretty simple to add your own coercions! use Types::Standard qw( ArrayRef HashRef Str ); has things => ( is => 'rw', isa => ArrayRef->plus_coercions( HashRef, sub { [ values %$_ ] }, Str, sub { [ split /;/, $_ ] }, ), coerce => 1, ); (Don't ever forget the C<< coerce => 1 >>!) If a hashref is provided, the values will be used, and if a string is provided, it will be split on the semicolon. Of course, if an arrayref if provided, it already passes the type constraint, so no conversion is necessary. The coercions should be pairs of "from types" and code to coerce the value. The code can be a coderef (as above) or just string of Perl code (as below). Strings of Perl code can usually be optimized better by Type::Tiny's internals, so are generally preferred. Thanks to Perl's C<< q{...} >> operator, they can look just as clean and pretty as coderefs. use Types::Standard qw( ArrayRef HashRef Str ); has things => ( is => 'rw', isa => ArrayRef->plus_coercions( HashRef, q{ [ values %$_ ] }, Str, q{ [ split /;/, $_ ] }, ), coerce => 1, ); Coercions are deeply applied automatically, so the following will do what you expect. has inputs => ( is => 'ro', isa => ArrayRef->of(Bool), coerce => 1 ); I am, of course, assuming you expect something like: my $coerced = [ map { !!$_ } @$orig ]; If you were assuming that, congratulations! We are on the same wavelength. And of course you can still add more coercions to the inherited ones... has inputs => ( is => 'ro', isa => ArrayRef->of(Bool)->plus_coercions(Str, sub {...}), coerce => 1 ); =head2 Type Defaults A previous example included: has children => ( is => 'ro', isa => ArrayRef, default => sub { return [] }, ); It's actually pretty common that you'll want an arrayref attribute to default to being an empty arrayref, a numeric attribute to default to zero, etc. Type::Tiny provides a method for that: has children => ( is => 'ro', isa => ArrayRef, default => ArrayRef->type_default, ); Many of the types in L have sensible type defaults defined. =head2 Method Parameters So far we have just concentrated on the definition of object attributes, but type constraints are also useful to validate method parameters. Let's remember our attribute for keeping track of a horse's race wins: use Types::Standard qw( ArrayRef Tuple Optional ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has wins => ( is => 'ro', isa => ArrayRef[ Tuple[ PositiveInt, NonEmptyStr, Optional[NonEmptyStr] ] ], default => sub { return [] }, ); Because we don't trust outside code to push new entries onto this array, let's define a method in our class to do it. package Horse { ...; sub add_win ( $self, $year, $race, $jockey ) { my $win = [ $year, $race, $jockey ? $jockey : (), ]; push $self->wins->@*, $win; return $self; } } This works pretty well, but we're still not actually checking the values of C<< $year >>, C<< $race >>, and C<< $jockey >>. Let's use L for that: package Horse { use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); use Type::Params qw( signature_for ); use constant { true => !!1, false => !!0 }; ...; signature_for add_win => ( method => true, # it's a method, so has $self positional => [ PositiveInt, NonEmptyStr, NonEmptyStr, { optional => true }, ], ); sub add_win ( $self, $year, $race, $jockey ) { my $win = [ $year, $race, $jockey ? $jockey : (), ]; push $self->wins->@*, $win; return $self; } } The C method will be wrapped with code that checks incoming arguments, throwing an exception if they fail to meet requirements. It will also perform coercions if types have them (and you don't even need to remember C<< coerce => 1 >>; it's automatic) and can even add in defaults: signature_for add_win => ( method => true, positional => [ PositiveInt, NonEmptyStr, NonEmptyStr, { default => sub { "Eddie" } }, ], ); The generalized syntax for positional parameters in C is: signature_for $method_name => ( %general_options, positional => [ TypeForFirstParam, \%options_for_first_param, TypeForSecondParam, \%options_for_second_param, ..., ], ); As a shortcut for the C<< { optional => true } >> option, you can just use B like in B. signature_for add_win => ( method => true, positional => [ PositiveInt, NonEmptyStr, Optional[NonEmptyStr], ], ); You can also use C<0> (or C<< builtin::false >> if your Perl is new enough) and C<1> (or C<< builtin::true >>) as shortcuts for B<< Optional[Any] >> and B<< Any >>. The following checks that the first parameter is a positive integer, the second parameter is required (but doesn't care what value it is) and a third parameter is allowed but not required. signature_for thingy => ( positional => [ PositiveInt, 1, 0 ] ); It is possible to accept a variable number of values using B: package Horse { use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); use Types::Standard qw( ArrayRef Slurpy ); use Type::Params qw( signature_for ); use constant { true => !!1, false => !!0 }; ...; signature_for add_wins_for_year => ( method => true, positional => [ PositiveInt, Slurpy[ ArrayRef[NonEmptyStr] ], ], ); sub add_wins_for_year ( $self, $year, $races ) { for my $race ( $races->@* ) { push $self->wins->@*, [ $year, $race ]; } return $self; } } It would be called like this: $bold_ruler->add_wins_for_year( 1956, "Futurity Stakes", "Juvenile Stakes", ); The additional parameters are slurped into an arrayref and checked against B<< ArrayRef[NonEmptyStr] >>. Note that with a slurpy arrayref like this, the method receives the values as an arrayref even though they were passed as a list. Optional parameters are only allowed after required parameters, and B parameters are only allowed at the end. (And there can only be a at most one B parameter!) For methods that accept more than one or two parameters, it is often a good idea to provide them as a hash. For example: $horse->add_win( year => 1956, race => "Futurity Stakes", jockey => "Eddie", ); This can make your code more readable. To accept named parameters, use the C option instead of C. package Horse { use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); use Type::Params qw( signature_for ); use constant { true => !!1, false => !!0 }; ...; signature_for add_win => ( method => true, named => [ year => PositiveInt, race => NonEmptyStr, jockey => NonEmptyStr, { optional => true }, ], ); sub add_win ( $self, $arg ) { my $win = [ $arg->year, $arg->race, $arg->has_jockey ? $arg->jockey : (), ]; push $self->wins->@*, $win; return $self; } } The C option will bundle all of your named arguments into an object C<< $arg >>. It allows your method to be called with a list of name-value pairs or a hashref: $horse->add_win( year => 1956, race => "Futurity Stakes", jockey => "Eddie", ); $horse->add_win( { year => 1956, race => "Juvenile Stakes", } ); It is also possible for your check to I named parameters but I a positional list of parameters, using C. package Horse { use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); use Type::Params qw( signature_for ); use constant { true => !!1, false => !!0 }; ...; signature_for add_win => ( method => true, named => [ year => PositiveInt, race => NonEmptyStr, jockey => NonEmptyStr, { optional => true }, ], named_to_list => true, ); sub add_win ( $self, $year, $race, $jockey ) { my $win = [ $year, $race, $jockey ? $jockey : (), ]; push $self->wins->@*, $win; return $self; } } ...; $horse->add_win( year => 1956, race => "Futurity Stakes", jockey => "Eddie", ); Optional and Slurpy named parameters are supported as you'd expect. For more information on Type::Params, and third-party alternatives, see L. =head1 NEXT STEPS Congratulations! I know this was probably a lot to take in, but you've covered all of the essentials. You can now set type constraints and coercions for attributes and method parameters in Moo! You are familiar with a lot of the most important and useful type constraints and understand parameterization and how it can be used to build more specific type constraints. (And I'll let you in on a secret. Using Type::Tiny with L or L instead of L is exactly the same. You can just replace C<< use Moo >> with C<< use Moose >> in any of these examples and they should work fine!) Here's your next step: =over =item * L Advanced use of Type::Tiny with Moo, including unions and intersections, C, C, C, and C. =back =head1 NOTES On very old versions of Moo C<< coerce => 1 >> is not supported. Instead you will need to provide a coderef or object overloading C<< &{} >> to coerce. Type::Tiny can provide you with an overloaded object. package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef Bool ); use namespace::autoclean; ...; # name, gender, age, children, wins has is_alive => ( is => 'rw', isa => Bool, coerce => Bool->coercion, # overloaded object ); } If you have a very old version of Moo, please upgrade to at least Moo 1.006000 which was the version that added support for C<< coerce => 1 >>. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMoo2.pod000664001750001750 2511615111656240 21451 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoo2 - advanced use of Type::Tiny with Moo =head1 MANUAL =head2 What is a Type? So far all the examples have shown you how to work with types, but we haven't looked at what a type actually I. use Types::Standard qw( Int ); my $type = Int; C<< Int >> in the above code is just a function called with zero arguments which returns a blessed Perl object. It is this object that defines what the B type is and is responsible for checking values meet its definition. use Types::Standard qw( HashRef Int ); my $type = HashRef[Int]; The C<< HashRef >> function, if called with no parameters returns the object defining the B type, just like the C<< Int >> function did before. But the difference here is that it's called with a parameter, an arrayref containing the B type object. It uses this to make the B<< HashRef[Int] >> type and returns that. Like any object, you can call methods on it. The most important methods to know about are: # check the value and return a boolean # $type->check($value); # return an error message about $value failing the type check # but don't actually check the value # $type->get_message($value); # coerce the value # my $coerced = $type->coerce($value); We've already seen some other methods earlier in the tutorial. # create a new type, same as the old type, but that has coercions # my $new_type = $type->plus_coercions( ... ); # different syntax for parameterized types # my $href = HashRef; my $int = Int; my $href_of_int = $href->of($int); So now you should understand this: use Types::Standard qw( ArrayRef Dict Optional ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); my $RaceInfo = Dict[ year => PositiveInt, race => NonEmptyStr, jockey => Optional[NonEmptyStr], ]; has latest_event => ( is => 'rw', isa => $RaceInfo ); has wins => ( is => 'rw', isa => ArrayRef[$RaceInfo] ); has losses => ( is => 'rw', isa => ArrayRef[$RaceInfo] ); This can help you avoid repetition if you have a complex parameterized type that you need to reuse a few times. =head2 C<< where >> One of the most useful methods you can call on a type object is C<< where >>. use Types::Standard qw( Int ); has lucky_number => ( is => 'ro', isa => Int->where(sub { $_ != 13 }), ); I think you already understand what it does. It creates a new type constraint on the fly, restricting the original type. Like with coercions, these restrictions can be expressed as a coderef or as a string of Perl code, operating on the C<< $_ >> variable. And like with coercions, using a string of code will result in better performance. use Types::Standard qw( Int ); has lucky_number => ( is => 'ro', isa => Int->where(q{ $_ != 13 }), ); Let's coerce a hashref of strings from an even-sized arrayref of strings: use Types::Standard qw( HashRef ArrayRef Str ); has stringhash => ( is => 'ro', isa => HashRef->of(Str)->plus_coercions( ArrayRef->of(Str)->where(q{ @$_ % 2 == 0 }), q{ my %h = @$_; \%h; }, ), coerce => 1, # never forget! ); If you understand that, you really are in the advanced class. Congratulations! =head2 Unions Sometimes you want to accept one thing or another thing. This is pretty easy with Type::Tiny. use Types::Standard qw( HashRef ArrayRef Str ); has strings => ( is => 'ro', isa => ArrayRef[Str] | HashRef[Str], ); Type::Tiny overloads the bitwise or operator so stuff like this should "just work". That said, now any code that calls C<< $self->strings >> will probably need to check if the value is an arrayref or a hashref before doing anything with it. So it may be simpler overall if you just choose one of the options and coerce the other one into it. =head2 Intersections Similar to a union is an intersection. package MyAPI::Client { use Moo; use Types::Standard qw( HasMethods InstanceOf ); has ua => ( is => 'ro', isa => (InstanceOf["MyUA"]) & (HasMethods["store_cookie"]), ); } Here we are checking that the UA is an instance of the MyUA class and also offers the C method. Perhaps C isn't provided by the MyUA class itself, but several subclasses of MyUA provide it. Intersections are not useful as often as unions are. This is because they often make no sense. C<< (ArrayRef) & (HashRef) >> would be a reference which was simultaneously pointing to an array and a hash, which is impossible. Note that when using intersections, it is good practice to put parentheses around each type. This is to disambiguate the meaning of C<< & >> for Perl, because Perl uses it as the bitwise and operator but also as the sigil for subs. =head2 Complements For any type B there is a complementary type B<< ~Foo >> (pronounced "not Foo"). package My::Class { use Moo; use Types::Standard qw( ArrayRef CodeRef ); has things => ( is => 'ro', isa => ArrayRef[~CodeRef] ); } C is now an arrayref of anything except coderefs. If you need a number that is I an integer: Num & ~Int L includes two types which are complements of each other: B and B. B might seem to be the complement of B but when you think about it, it is not. There are values that fall into neither category, such as non-integers, non-numeric strings, references, undef, etc. =head2 C and C The B type constraint provides C and C methods which are probably best explained by examples. C<< Object->numifies_to(Int) >> means any object where C<< 0 + $object >> is an integer. C<< Object->stringifies_to(StrMatch[$re]) >> means any object where C<< "$object" >> matches the regular expression. C<< Object->stringifies_to($re) >> also works as a shortcut. C<< Object->numifies_to($coderef) >> and C<< Object->stringifies_to($coderef) >> also work, where the coderef checks C<< $_ >> and returns a boolean. Other types which are also logically objects, such as parameterized B, B, and B should also provide C and C methods. C and C work on unions if I of the type constraints in the union offer the method. C and C work on intersections if I of the type constraints in the intersection offers the method. =head2 C Another one that is probably best explained using an example: package Horse { use Types::Standard qw( Enum Object ); has gender => ( is => 'ro', isa => Enum['m', 'f'], ); has father => ( is => 'ro', isa => Object->with_attribute_values(gender => Enum['m']), ); has mother => ( is => 'ro', isa => Object->with_attribute_values(gender => Enum['f']), ); } In this example when you set a horse's father, it will call C<< $father->gender >> and check that it matches B<< Enum['m'] >>. This method is in the same family as C and C, so like those, it only applies to B and similar type constraints, can work on unions/intersections under the same circumstances, and will also accept coderefs and regexps. has father => ( is => 'ro', isa => Object->with_attribute_values(gender => sub { $_ eq 'm' }), ); has mother => ( is => 'ro', isa => Object->with_attribute_values(gender => qr/^f/i), ); All of C, C, and C are really just wrappers around C. The following two are roughly equivalent: my $type1 = Object->with_attribute_values(foo => Int, bar => Num); my $type2 = Object->where(sub { Int->check( $_->foo ) and Num->check( $_->bar ) }); The first will result in better performing code though. =head2 Tied Variables It is possible to tie variables to a type constraint. use Types::Standard qw(Int); tie my $n, Int, 4; print "$n\n"; # says "4" $n = 5; # ok $n = "foo"; # dies You can also tie arrays: tie my @numbers, Int; push @numbers, 1 .. 10; And hashes: tie my %numbers, Int; $numbers{lucky} = 7; $numbers{unlucky} = 13; Earlier in the manual, it was mentioned that there is a problem with code like this: push $horse->children->@*, $non_horse; This can be solved using tied variables. tie $horse->children->@*, InstanceOf["Horse"]; Here is a longer example using builders and triggers. package Horse { use Moo; use Types::Standard qw( Str Num ArrayRef InstanceOf ); use Type::Params qw( signature_for ); use namespace::autoclean; my $ThisClass = InstanceOf[ __PACKAGE__ ]; has name => ( is => 'ro', isa => Str ); has gender => ( is => 'ro', isa => Str ); has age => ( is => 'rw', isa => Num ); has children => ( is => 'rw', isa => ArrayRef[$ThisClass], builder => "_build_children", trigger => sub { shift->_trigger_children(@_) }, ); # tie a default arrayref sub _build_children ( $self ) { tie my @kids, $ThisClass; \@kids; } # this method will tie an arrayref provided by the caller sub _trigger_children ( $self, $new ) { tie $new->@*, $ThisClass; } signature_for add_child => ( method => $ThisClass, positional => [ $ThisClass ], ); sub add_child ( $self, $kid ) { push $self->children->@*, $kid; return $self; } } Now it's pretty much impossible for the caller to make a mess by adding a non-horse as a child. (Note there's a L module on CPAN that will define a B type meaning B<< InstanceOf[ __PACKAGE__ ] >> for you!) =head1 NEXT STEPS Here's your next step: =over =item * L There's more than one way to do it! Alternative ways of using Type::Tiny, including type registries, exported functions, and C. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMoo3.pod000664001750001750 2720215111656240 21450 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoo3 - alternative use of Type::Tiny with Moo =head1 MANUAL =head2 Type Registries In all the examples so far, we have imported a collection of type constraints into each class: package Horse { use Moo; use Types::Standard qw( Str ArrayRef HashRef Int Any InstanceOf ); use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); has name => ( is => 'ro', isa => Str ); has father => ( is => 'ro', isa => InstanceOf["Horse"] ); ...; } This creates a bunch of subs in the Horse namespace, one for each type. We've used L to clean these up later. But it is also possible to avoid pulling all these into the Horse namespace. Instead we'll use a type registry: package Horse { use Moo; use Type::Registry qw( t ); t->add_types('-Standard'); t->add_types('-Common::String'); t->add_types('-Common::Numeric'); t->alias_type('InstanceOf["Horse"]' => 'Horsey'); has name => ( is => 'ro', isa => t('Str') ); has father => ( is => 'ro', isa => t('Horsey') ); has mother => ( is => 'ro', isa => t('Horsey') ); has children => ( is => 'ro', isa => t('ArrayRef[Horsey]') ); ...; } You don't even need to import the C<< t() >> function. Types::Registry can be used in an entirely object-oriented way. package Horse { use Moo; use Type::Registry; my $reg = Type::Registry->for_me; $reg->add_types('-Standard'); $reg->add_types('-Common::String'); $reg->add_types('-Common::Numeric'); $reg->alias_type('InstanceOf["Horse"]' => 'Horsey'); has name => ( is => 'ro', isa => $reg->lookup('Str') ); ...; } You could create two registries with entirely different definitions for the same named type. my $dracula = Aristocrat->new(name => 'Dracula'); package AristocracyTracker { use Type::Registry; my $reg1 = Type::Registry->new; $reg1->add_types('-Common::Numeric'); $reg1->alias_type('PositiveInt' => 'Count'); my $reg2 = Type::Registry->new; $reg2->add_types('-Standard'); $reg2->alias_type('InstanceOf["Aristocrat"]' => 'Count'); $reg1->lookup("Count")->assert_valid("1"); $reg2->lookup("Count")->assert_valid($dracula); } Type::Registry uses C, so things like this work: $reg->ArrayRef->of( $reg->Int ); Although you can create as many registries as you like, Type::Registry will create a default registry for each package. # Create a new empty registry. # my $reg = Type::Registry->new; # Get the default registry for my package. # It will be pre-populated with any types we imported using `use`. # my $reg = Type::Registry->for_me; # Get the default registry for some other package. # my $reg = Type::Registry->for_class("Horse"); Type registries are a convenient place to store a bunch of types without polluting your namespace. They are not the same as type libraries though. L, L, and L are type libraries; packages that export types for others to use. We will look at how to make one of those later. For now, here's the best way to think of the difference: =over =item * Type registry Curate a collection of types for me to use here in this class. This collection is an implementation detail. =item * Type library Export a collection of types to be used across multiple classes. This collection is part of your API. =back =head2 Importing Functions We've seen how, for instance, Types::Standard exports a sub called C that returns the B type object. use Types::Standard qw( Int ); my $type = Int; $type->check($value) or die $type->get_message($value); Type libraries are also capable of exporting other convenience functions. =head3 C<< is_* >> This is a shortcut for checking a value meets a type constraint: use Types::Standard qw( is_Int ); if ( is_Int $value ) { ...; } Calling C<< is_Int($value) >> will often be marginally faster than calling C<< Int->check($value) >> because it avoids a method call. (Method calls in Perl end up slower than normal function calls.) Using things like C in your code might be preferable to C<< ref($value) eq "ARRAY" >> because it's neater, leads to more consistent type checking, and might even be faster. (Type::Tiny can be pretty fast; it is sometimes able to export these functions as XS subs.) If checking type constraints like C or C, there's no way to give a parameter. C<< is_ArrayRef[Int]($value) >> doesn't work, and neither does C<< is_ArrayRef(Int, $value) >> nor C<< is_ArrayRef($value, Int) >>. For some types like C, this makes them fairly useless; without being able to give a class name, it just acts the same as C<< is_Object >>. See L for a solution. Also, check out L. There also exists a generic C function. use Types::Standard qw( ArrayRef Int ); use Type::Utils qw( is ); if ( is ArrayRef[Int], \@numbers ) { ...; } =head3 C<< assert_* >> While C<< is_Int($value) >> returns a boolean, C<< assert_Int($value) >> will throw an error if the value does not meet the constraint, and return the value otherwise. So you can do: my $sum = assert_Int($x) + assert_Int($y); And you will get the sum of integers C<< $x >> and C<< $y >>, and an explosion if either of them is not an integer! Assert is useful for quick parameter checks if you are avoiding L for some strange reason: sub add_numbers { my $x = assert_Num(shift); my $y = assert_Num(shift); return $x + $y; } You can also use a generic C function. use Type::Utils qw( assert ); sub add_numbers { my $x = assert Num, shift; my $y = assert Num, shift; return $x + $y; } =head3 C<< to_* >> This is a shortcut for coercion: my $truthy = to_Bool($value); It trusts that the coercion has worked okay. You can combine it with an assertion if you want to make sure. my $truthy = assert_Bool(to_Bool($value)); =head3 Shortcuts for exporting functions This is a little verbose: use Types::Standard qw( Bool is_Bool assert_Bool to_Bool ); Isn't this a little bit nicer? use Types::Standard qw( +Bool ); The plus sign tells a type library to export not only the type itself, but all of the convenience functions too. You can also use: use Types::Standard -types; # export Int, Bool, etc use Types::Standard -is; # export is_Int, is_Bool, etc use Types::Standard -assert; # export assert_Int, assert_Bool, etc use Types::Standard -to; # export to_Bool, etc use Types::Standard -all; # just export everything!!! So if you imagine the functions exported by Types::Standard are like this: qw( Str is_Str assert_Str Num is_Num assert_Num Int is_Int assert_Int Bool is_Bool assert_Bool to_Bool ArrayRef is_ArrayRef assert_ArrayRef ); # ... and more Then "+" exports a horizontal group of those, and "-" exports a vertical group. =head2 Exporting Parameterized Types It's possible to export parameterizable types like B, but it is also possible to export I types. use Types::Standard qw( ArrayRef Int ); use Types::Standard ( '+ArrayRef' => { of => Int, -as => 'IntList' }, ); has numbers => (is => 'ro', isa => IntList); Using C<< is_IntList($value) >> should be significantly faster than C<< ArrayRef->of(Int)->check($value) >>. This trick only works for parameterized types that have a single parameter, like B, B, B, etc. (Sorry, C and C!) Since Type::Tiny 2.8.0 there has been experimental support for a different way of exporting parameterized versions of certain parameterizable type constraints. use Types::Standard -types; use Types::Standard::ArrayRef ( IntList => { of => Int }, StrList => { of => Str }, NonEmptyStrList => { of => Str->where( sub { length($_) > 0 } ) }, StrNonEmptyList => { of => Str, where => sub { @$_ > 0 } }, NEStrNEList => { of => Str->where( sub { length($_) > 0 } ), where => sub { @$_ > 0 }, }, ); assert_IntList [ 1.. 5 ]; # doesn't die is_NonEmptyStrList [ "foo", "bar" ]; # ==> true is_NonEmptyStrList [ "foo", "" ]; # ==> false is_NonEmptyStrList []; # ==> true is_StrNonEmptyList [ "foo", "bar" ]; # ==> true is_StrNonEmptyList [ "foo", "" ]; # ==> true is_StrNonEmptyList []; # ==> false is_NEStrNEList [ "foo", "bar" ]; # ==> true is_NEStrNEList [ "foo", "" ]; # ==> false is_NEStrNEList []; # ==> false And of course C also accepts a string of Perl code. =head2 Lexical imports Type::Tiny 2.0 combined with Perl 5.37.2+ allows lexically scoped imports. So: my $is_ok = do { use Types::Standard -lexical, qw( Str ArrayRef ); ArrayRef->of( Str )->check( \@things ); }; # The Str and ArrayRef types aren't defined here. =head2 Do What I Mean! use Type::Utils qw( dwim_type ); my $type = dwim_type("ArrayRef[Int]"); C will look up a type constraint from a string and attempt to guess what you meant. If it's a type constraint that you seem to have imported with C, then it should find it. Otherwise, if you're using Moose or Mouse, it'll try asking those. Or if it's in Types::Standard, it'll look there. And if it still has no idea, then it will assume dwim_type("Foo") means dwim_type("InstanceOf['Foo']"). It just does a big old bunch of guessing. The C function will use C if you pass it a string as a type. use Type::Utils qw( is ); if ( is "ArrayRef[Int]", \@numbers ) { ...; } =head2 Types::Common Notice that in a lot of examples we're importing one or two functions each from a few different modules: use Types::Common::Numeric qw( PositiveInt ); use Types::Common::String qw( NonEmptyStr ); use Types::Standard qw( ArrayRef Slurpy ); use Type::Params qw( signature_for ); A module called L exists which acts as a single place you can use for importing most of Type::Tiny's commonly used types and functions. use Types::Common qw( PositiveInt NonEmptyStr ArrayRef Slurpy signature_for ); Types::Common provides: =over =item * All the types from L. =item * All the types from L and L. =item * All the types from L. =item * The C<< -sigs >> tag from L. =item * The C<< t() >> function from L. =back =head1 NEXT STEPS You now know pretty much everything there is to know about how to use type libraries. Here's your next step: =over =item * L Defining your own type libraries, including extending existing libraries, defining new types, adding coercions, defining parameterizable types, and the declarative style. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMoose.pod000664001750001750 1421715111656240 21717 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMoose - how to use Type::Tiny with Moose =head1 MANUAL First read L, L, and L. Everything in those parts of the manual should work exactly the same in Moose. This part of the manual will focus on Moose-specifics. =head2 Why Use Type::Tiny At All? Moose does have a built-in type constraint system which is fairly convenient to use, but there are several reasons you should consider using Type::Tiny instead. =over =item * Type::Tiny type constraints will usually be faster than Moose built-ins. Even without Type::Tiny::XS installed, Type::Tiny usually produces more efficient inline code than Moose. Coercions will usually be a lot faster. =item * Type::Tiny provides helpful methods like C and C that allow type constraints and coercions to be easily tweaked on a per-attribute basis. Something like this is much harder to do with plain Moose types: has name => ( is => "ro", isa => Str->plus_coercions( ArrayRef[Str], sub { join " ", @$_ }, ), coerce => 1, ); Moose tends to encourage defining coercions globally, so if you wanted one B attribute to be able to coerce from B<< ArrayRef[Str] >>, then I B attributes would coerce from B<< ArrayRef[Str] >>, and they'd all do that coercion in the same way. (Even if it might make sense to join by a space in some places, a comma in others, and a line break in others!) =item * Type::Tiny provides automatic deep coercions, so if type B has a coercion, the following should "just work": has xyzlist => ( is => 'ro', isa => ArrayRef[Xyz], coerce => 1 ); =item * Type::Tiny offers a wider selection of built-in types. =item * By using Type::Tiny, you can use the same type constraints and coercions for attributes and method parameters, in Moose and non-Moose code. =back =head2 Type::Utils If you've used L, you may be accustomed to using a DSL for declaring type constraints: use Moose::Util::TypeConstraints; subtype 'Natural', as 'Int', where { $_ > 0 }; There's a module called L that provides a very similar DSL for declaring types in Type::Library-based type libraries. package My::Types { use Type::Library -base; use Type::Utils; use Types::Standard qw( Int ); declare 'Natural', as Int, where { $_ > 0 }; } Personally I prefer the more object-oriented way to declare types though. Since Type::Library 1.012, a shortcut has been available for importing Type::Library and Type::Utils at the same time: package MyType { use Type::Library -base, -utils; ...; } In Moose you might also declare types like this within classes and roles too. Unlike Moose, Type::Tiny doesn't keep types in a single global flat namespace, so this doesn't work quite the same with Type::Utils. It still creates the type, but it doesn't store it in any type library; the type is returned. package My::Class { use Moose; use Type::Utils; use Types::Standard qw( Int ); my $Natural = # store type in a variable declare 'Natural', as Int, where { $_ > 0 }; has number => ( is => 'ro', isa => $Natural ); } But really, isn't the object-oriented way cleaner? package My::Class { use Moose; use Types::Standard qw( Int ); has number => ( is => 'ro', isa => Int->where('$_ > 0'), ); } =head2 Type::Tiny and MooseX::Types L should be a drop-in replacement for L. And L and L should easily replace L and L. That said, if you do with to use a mixture of Type::Tiny and MooseX::Types, they should fit together pretty seamlessly. use Types::Standard qw( ArrayRef ); use MooseX::Types::Common::Numeric qw( PositiveInt ); # this should just work my $list_of_nums = ArrayRef[PositiveInt]; # and this my $list_or_num = ArrayRef | PositiveInt; =head2 C<< -moose >> Import Parameter If you have read this far in the manual, you will know that this is the usual way to import type constraints: use Types::Standard qw( Int ); And the C which is imported is a function that takes no arguments and returns the B type constraint, which is a blessed object in the L class. Type::Tiny mocks the L API so well that most Moose and MooseX code will not be able to tell the difference. But what if you need a real Moose::Meta::TypeConstraint object? use Types::Standard -moose, qw( Int ); Now the C function imported will return a genuine native Moose type constraint. This flag is mostly a throwback from when Type::Tiny native objects I<< didn't >> directly work in Moose. In 99.9% of cases, there is no reason to use it and plenty of reasons not to. (Moose native type constraints don't offer helpful methods like C and C.) =head2 C<< moose_type >> Method Another quick way to get a native Moose type constraint object from a Type::Tiny object is to call the C method: use Types::Standard qw( Int ); my $tiny_type = Int; my $moose_type = $tiny_type->moose_type; Internally, this is what the C<< -moose >> flag makes imported functions do. =head1 NEXT STEPS Here's your next step: =over =item * L How to use Type::Tiny with Mouse, including the advantages of Type::Tiny over built-in type constraints, and Mouse-specific features. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithMouse.pod000664001750001750 1517115111656240 21725 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithMouse - how to use Type::Tiny with Mouse =head1 MANUAL First read L, L, and L. Everything in those parts of the manual should work exactly the same in Mouse. This part of the manual will focus on Mouse-specifics. Overall, Type::Tiny is less well-tested with Mouse than it is with Moose and Moo, but there are still a good number of test cases for using Type::Tiny with Mouse, and there are no known major issues with Type::Tiny's Mouse support. =head2 Why Use Type::Tiny At All? Mouse does have a built-in type constraint system which is fairly convenient to use, but there are several reasons you should consider using Type::Tiny instead. =over =item * Type::Tiny provides helpful methods like C and C that allow type constraints and coercions to be easily tweaked on a per-attribute basis. Something like this is much harder to do with plain Mouse types: has name => ( is => "ro", isa => Str->plus_coercions( ArrayRef[Str], sub { join " ", @$_ }, ), coerce => 1, ); Mouse tends to encourage defining coercions globally, so if you wanted one B attribute to be able to coerce from B<< ArrayRef[Str] >>, then I B attributes would coerce from B<< ArrayRef[Str] >>, and they'd all do that coercion in the same way. (Even if it might make sense to join by a space in some places, a comma in others, and a line break in others!) =item * Type::Tiny provides automatic deep coercions, so if type B has a coercion, the following should "just work": has xyzlist => ( is => 'ro', isa => ArrayRef[Xyz], coerce => 1 ); =item * Type::Tiny offers a wider selection of built-in types. =item * By using Type::Tiny, you can use the same type constraints and coercions for attributes and method parameters, in Mouse and non-Mouse code. =back =head2 Type::Utils If you've used L, you may be accustomed to using a DSL for declaring type constraints: use Mouse::Util::TypeConstraints; subtype 'Natural', as 'Int', where { $_ > 0 }; There's a module called L that provides a very similar DSL for declaring types in Type::Library-based type libraries. package My::Types { use Type::Library -base; use Type::Utils; use Types::Standard qw( Int ); declare 'Natural', as Int, where { $_ > 0 }; } Personally I prefer the more object-oriented way to declare types though. In Mouse you might also declare types like this within classes and roles too. Unlike Mouse, Type::Tiny doesn't keep types in a single global flat namespace, so this doesn't work quite the same with Type::Utils. It still creates the type, but it doesn't store it in any type library; the type is returned. package My::Class { use Mouse; use Type::Utils; use Types::Standard qw( Int ); my $Natural = # store type in a variable declare 'Natural', as Int, where { $_ > 0 }; has number => ( is => 'ro', isa => $Natural ); } But really, isn't the object-oriented way cleaner? package My::Class { use Mouse; use Types::Standard qw( Int ); has number => ( is => 'ro', isa => Int->where('$_ > 0'), ); } =head2 Type::Tiny and MouseX::Types L should be a drop-in replacement for L. And L and L should easily replace L and L. That said, if you do with to use a mixture of Type::Tiny and MouseX::Types, they should fit together pretty seamlessly. use Types::Standard qw( ArrayRef ); use MouseX::Types::Mouse qw( Int ); # this should just work my $list_of_nums = ArrayRef[Int]; # and this my $list_or_num = ArrayRef | Int; =head2 C<< -mouse >> Import Parameter If you have read this far in the manual, you will know that this is the usual way to import type constraints: use Types::Standard qw( Int ); And the C which is imported is a function that takes no arguments and returns the B type constraint, which is a blessed object in the L class. Type::Tiny mocks the L API so well that most Mouse and MouseX code will not be able to tell the difference. But what if you need a real Mouse::Meta::TypeConstraint object? use Types::Standard -mouse, qw( Int ); Now the C function imported will return a genuine native Mouse type constraint. This flag is mostly a throwback from when Type::Tiny native objects I<< didn't >> directly work in Mouse. In 99.9% of cases, there is no reason to use it and plenty of reasons not to. (Mouse native type constraints don't offer helpful methods like C and C.) =head2 C<< mouse_type >> Method Another quick way to get a native Mouse type constraint object from a Type::Tiny object is to call the C method: use Types::Standard qw( Int ); my $tiny_type = Int; my $mouse_type = $tiny_type->mouse_type; Internally, this is what the C<< -mouse >> flag makes imported functions do. =head2 Type::Tiny Performance Type::Tiny should run pretty much as fast as Mouse types do. This is because, when possible, it will use Mouse's XS implementations of type checks to do the heavy lifting. There are a few type constraints where Type::Tiny prefers to do things without Mouse's help though, for consistency and correctness. For example, the Mouse XS implementation of B is... strange... it accepts blessed objects that overload C, but only if they return false. If they return true, it's a type constraint error. Using Type::Tiny instead of Mouse's type constraints shouldn't make a significant difference to the performance of your code. =head1 NEXT STEPS Here's your next step: =over =item * L How to use Type::Tiny with Mite, including how to write an entire Perl project using clean Moose-like code and no non-core dependencies. (Not even dependencies on Mite or Type::Tiny!) =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithOther.pod000664001750001750 1302315111656240 21710 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithOther - using Type::Tiny with Class::InsideOut, Params::Check, and Object::Accessor. =head1 MANUAL The antlers crew aren't the only object-oriented programming toolkits in Perl town. Although Type::Tiny might have been built with Moose, Mouse, and Moo in mind, it can be used with other toolkits. These toolkits are... well... hmm... okay... they exist. If you are starting a new project, there's very little reason not to use Class::Tiny, Moo, or Moose. So you're probably okay to skip this part of the fine manual and go straight to L. =head2 Class::InsideOut You want L 1.13 or above, which has support for blessed and overloaded objects (including Type::Tiny type constraints) for the C and C options. package Person { use Class::InsideOut qw( public ); use Types::Standard qw( Str Int ); use Types::Common::Numeric qw( PositiveInt ); use Type::Params qw( signature_for ); # Type checks are really easy. # Just supply the type as a set hook. public name => my %_name, { set_hook => Str, }; # Define a type that silently coerces negative values # to positive. It's silly, but it works as an example! my $Years = PositiveInt->plus_coercions(Int, q{ abs($_) }); # Coercions are more annoying, but possible. public age => my %_age, { set_hook => sub { $_ = $Years->assert_coerce($_) }, }; # Parameter checking for methods is as expected. signature_for get_older => ( method => 1, positional => [ $Years ] ); sub get_older ( $self, $years ) { $self->_set_age( $self->age + $years ); } } =head2 Params::Check and Object::Accessor The Params::Check C<< allow() >> function, the C option for the Params::Check C<< check() >> function, and the input validation mechanism for Object::Accessor all work in the same way, which is basically a limited pure-Perl implementation of the smart match operator. While this doesn't directly support Type::Tiny constraints, it does support coderefs. You can use Type::Tiny's C method to obtain a suitable coderef. L example: my $tmpl = { name => { allow => Str->compiled_check }, age => { allow => Int->compiled_check }, }; check($tmpl, { name => "Bob", age => 32 }) or die Params::Check::last_error(); L example: my $obj = Object::Accessor->new; $obj->mk_accessors( { name => Str->compiled_check }, { age => Int->compiled_check }, ); I<< Caveat: >> Object::Accessor doesn't die when a value fails to meet its type constraint; instead it outputs a warning to STDERR. This behaviour can be changed by setting C<< $Object::Accessor::FATAL = 1 >>. =head2 Class::Struct This is proof-of-concept of how Type::Tiny can be used to constrain attributes for Class::Struct. It's probably not a good idea to use this in production as it slows down C globally. use Types::Standard -types; use Class::Struct; { my %MAP; my $orig_isa = \&UNIVERSAL::isa; *UNIVERSAL::isa = sub { return $MAP{$1}->check($_[0]) if $_[1] =~ /^CLASSSTRUCT::TYPETINY::(.+)$/ && exists $MAP{$1}; goto $orig; }; my $orig_dn = \&Type::Tiny::display_name; *Type::Tiny::display_name = sub { if (caller(1) eq 'Class::Struct') { $MAP{$_[0]{uniq}} = $_[0]; return "CLASSSTRUCT::TYPETINY::".$_[0]{uniq}; } goto $orig_dn; }; } struct Person => [ name => Str, age => Int ]; my $bob = Person->new( name => "Bob", age => 21, ); $bob->name("Robert"); # okay $bob->name([]); # dies =head2 Class::Plain There is not currently a high level of integration, but here's a quick example of type checking attributes in the constructor. If any of your accessors are C<< :rw >> then you would also need to add type checks to those. use Class::Plain; class Point { use Types::Common -types, -sigs; field x :reader; field y :reader; signature_for new => ( method => !!1, bless => !!0, named => [ x => Int, y => Int, ], ); method as_arrayref () { return [ $self->x, $self->y ]; } } The following signature may also be of interest: signature_for new => ( method => !!1, multiple => [ { named => [ x => Int, y => Int, ], bless => !!0, }, { positional => [ Int, Int ], goto_next => sub { my ( $class, $x, $y ) = @_; return ( $class, { x => $x, y => $y } ), }, }, ], ); This would allow your class to be instantiated using any of the following: my $point11 = Point->new( { x => 1, y => 1 } ); my $point22 = Point->new( x => 2, y => 2 ); my $point33 = Point->new( 3, 3 ); =head1 NEXT STEPS Here's your next step: =over =item * L Type::Tiny for test suites. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut UsingWithTestMore.pod000664001750001750 511515111656240 22354 0ustar00taitai000000000000Type-Tiny-2.008006/lib/Type/Tiny/Manual=pod =encoding utf-8 =head1 NAME Type::Tiny::Manual::UsingWithTestMore - Type::Tiny for test suites =head1 MANUAL =head2 Test::TypeTiny This is a module for testing that types you've defined accept and reject the values you think they should. should_pass($value, $type); should_fail($othervalue, $type); Easy. (But yeah, I always forget whether the type goes first or second!) There's also a function to test that subtype/supertype relationships are working okay. ok_subtype($type, @subtypes); Of course you can just check a type like this: ok( $type->check($value) ); But the advantage of C is that if the C environment variable is set to true, C will also perform a strict check on the value, which involves climbing up the type's inheritance tree (its parent, its parent's parent, etc) to make sure the value passes all their constraints. If a normal check and strict check differ, this is usually a problem in the inlining code somewhere. See L for more information. =head2 Type::Tiny as a Replacement for Test::Deep Here's one of the examples from the Test::Deep documentation: my $name_re = re('^(Mr|Mrs|Miss) \w+ \w+$'); cmp_deeply( $person, { Name => $name_re, Phone => re('^0d{6}$'), ChildNames => array_each($name_re) }, "person ok" ); It's pretty easy to rewrite this to use Types::Standard: my $name = StrMatch[ qr/^(Mr|Mrs|Miss) \w+ \w+$/ ]; should_pass( $person, Dict[ Name => $name, Phone => StrMatch[ qr/^0d{6}$/ ], ChildNames => ArrayRef[$name] ] ); There's nothing especially wrong with L, but if you're already familiar with Type::Tiny's built-in types and you've maybe written your own type libraries too, it will save you having to switch between using two separate systems of checks. =head1 NEXT STEPS Here's your next step: =over =item * L Advanced information on Type::Params, and using Type::Tiny with other signature modules like Function::Parameters and Kavorka. =back =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013-2014, 2017-2025 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut Scalar.pm000664001750001750 3245415111656240 21165 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Test/Builder/IOpackage Test::Builder::IO::Scalar; =head1 NAME Test::Builder::IO::Scalar - A copy of IO::Scalar for Test::Builder =head1 DESCRIPTION This is a copy of IO::Scalar which ships with Test::Builder to support scalar references as filehandles on Perl 5.6. Newer versions of Perl simply use C<>'s built in support. Test::Builder can not have dependencies on other modules without careful consideration, so its simply been copied into the distribution. =head1 COPYRIGHT and LICENSE This file came from the "IO-stringy" Perl5 toolkit. Copyright (c) 1996 by Eryq. All rights reserved. Copyright (c) 1999,2001 by ZeeGee Software Inc. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut # This is copied code, I don't care. ##no critic use Carp; use strict; use vars qw($VERSION @ISA); use IO::Handle; use 5.005; ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = "2.110"; ### Inheritance: @ISA = qw(IO::Handle); #============================== =head2 Construction =over 4 =cut #------------------------------ =item new [ARGS...] I Return a new, unattached scalar handle. If any arguments are given, they're sent to open(). =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = bless \do { local *FH }, $class; tie *$self, $class, $self; $self->open(@_); ### open on anonymous by default $self; } sub DESTROY { shift->close; } #------------------------------ =item open [SCALARREF] I Open the scalar handle on a new scalar, pointed to by SCALARREF. If no SCALARREF is given, a "private" scalar is created to hold the file data. Returns the self object on success, undefined on error. =cut sub open { my ($self, $sref) = @_; ### Sanity: defined($sref) or do {my $s = ''; $sref = \$s}; (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; ### Setup: *$self->{Pos} = 0; ### seek position *$self->{SR} = $sref; ### scalar reference $self; } #------------------------------ =item opened I Is the scalar handle opened on something? =cut sub opened { *{shift()}->{SR}; } #------------------------------ =item close I Disassociate the scalar handle from its underlying scalar. Done automatically on destroy. =cut sub close { my $self = shift; %{*$self} = (); 1; } =back =cut #============================== =head2 Input and output =over 4 =cut #------------------------------ =item flush I No-op, provided for OO compatibility. =cut sub flush { "0 but true" } #------------------------------ =item getc I Return the next character, or undef if none remain. =cut sub getc { my $self = shift; ### Return undef right away if at EOF; else, move pos forward: return undef if $self->eof; substr(${*$self->{SR}}, *$self->{Pos}++, 1); } #------------------------------ =item getline I Return the next line, or undef on end of string. Can safely be called in an array context. Currently, lines are delimited by "\n". =cut sub getline { my $self = shift; ### Return undef right away if at EOF: return undef if $self->eof; ### Get next line: my $sr = *$self->{SR}; my $i = *$self->{Pos}; ### Start matching at this point. ### Minimal impact implementation! ### We do the fast fast thing (no regexps) if using the ### classic input record separator. ### Case 1: $/ is undef: slurp all... if (!defined($/)) { *$self->{Pos} = length $$sr; return substr($$sr, $i); } ### Case 2: $/ is "\n": zoom zoom zoom... elsif ($/ eq "\012") { ### Seek ahead for "\n"... yes, this really is faster than regexps. my $len = length($$sr); for (; $i < $len; ++$i) { last if ord (substr ($$sr, $i, 1)) == 10; } ### Extract the line: my $line; if ($i < $len) { ### We found a "\n": $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos} + 1); *$self->{Pos} = $i+1; ### Remember where we finished up. } else { ### No "\n"; slurp the remainder: $line = substr ($$sr, *$self->{Pos}, $i - *$self->{Pos}); *$self->{Pos} = $len; } return $line; } ### Case 3: $/ is ref to int. Do fixed-size records. ### (Thanks to Dominique Quatravaux.) elsif (ref($/)) { my $len = length($$sr); my $i = ${$/} + 0; my $line = substr ($$sr, *$self->{Pos}, $i); *$self->{Pos} += $i; *$self->{Pos} = $len if (*$self->{Pos} > $len); return $line; } ### Case 4: $/ is either "" (paragraphs) or something weird... ### This is Graham's general-purpose stuff, which might be ### a tad slower than Case 2 for typical data, because ### of the regexps. else { pos($$sr) = $i; ### If in paragraph mode, skip leading lines (and update i!): length($/) or (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); ### If we see the separator in the buffer ahead... if (length($/) ? $$sr =~ m,\Q$/\E,g ### (ordinary sep) TBD: precomp! : $$sr =~ m,\n\n,g ### (a paragraph) ) { *$self->{Pos} = pos $$sr; return substr($$sr, $i, *$self->{Pos}-$i); } ### Else if no separator remains, just slurp the rest: else { *$self->{Pos} = length $$sr; return substr($$sr, $i); } } } #------------------------------ =item getlines I Get all remaining lines. It will croak() if accidentally called in a scalar context. =cut sub getlines { my $self = shift; wantarray or croak("can't call getlines in scalar context!"); my ($line, @lines); push @lines, $line while (defined($line = $self->getline)); @lines; } #------------------------------ =item print ARGS... I Print ARGS to the underlying scalar. B this continues to always cause a seek to the end of the string, but if you perform seek()s and tell()s, it is still safer to explicitly seek-to-end before subsequent print()s. =cut sub print { my $self = shift; *$self->{Pos} = length(${*$self->{SR}} .= join('', @_) . (defined($\) ? $\ : "")); 1; } sub _unsafe_print { my $self = shift; my $append = join('', @_) . $\; ${*$self->{SR}} .= $append; *$self->{Pos} += length($append); 1; } sub _old_print { my $self = shift; ${*$self->{SR}} .= join('', @_) . $\; *$self->{Pos} = length(${*$self->{SR}}); 1; } #------------------------------ =item read BUF, NBYTES, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub read { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $read = substr(${*$self->{SR}}, *$self->{Pos}, $n); $n = length($read); *$self->{Pos} += $n; ($off ? substr($_[1], $off) : $_[1]) = $read; return $n; } #------------------------------ =item write BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub write { my $self = $_[0]; my $n = $_[2]; my $off = $_[3] || 0; my $data = substr($_[1], $off, $n); $n = length($data); $self->print($data); return $n; } #------------------------------ =item sysread BUF, LEN, [OFFSET] I Read some bytes from the scalar. Returns the number of bytes actually read, 0 on end-of-file, undef on error. =cut sub sysread { my $self = shift; $self->read(@_); } #------------------------------ =item syswrite BUF, NBYTES, [OFFSET] I Write some bytes to the scalar. =cut sub syswrite { my $self = shift; $self->write(@_); } =back =cut #============================== =head2 Seeking/telling and other attributes =over 4 =cut #------------------------------ =item autoflush I No-op, provided for OO compatibility. =cut sub autoflush {} #------------------------------ =item binmode I No-op, provided for OO compatibility. =cut sub binmode {} #------------------------------ =item clearerr I Clear the error and EOF flags. A no-op. =cut sub clearerr { 1 } #------------------------------ =item eof I Are we at end of file? =cut sub eof { my $self = shift; (*$self->{Pos} >= length(${*$self->{SR}})); } #------------------------------ =item seek OFFSET, WHENCE I Seek to a given position in the stream. =cut sub seek { my ($self, $pos, $whence) = @_; my $eofpos = length(${*$self->{SR}}); ### Seek: if ($whence == 0) { *$self->{Pos} = $pos } ### SEEK_SET elsif ($whence == 1) { *$self->{Pos} += $pos } ### SEEK_CUR elsif ($whence == 2) { *$self->{Pos} = $eofpos + $pos} ### SEEK_END else { croak "bad seek whence ($whence)" } ### Fixup: if (*$self->{Pos} < 0) { *$self->{Pos} = 0 } if (*$self->{Pos} > $eofpos) { *$self->{Pos} = $eofpos } return 1; } #------------------------------ =item sysseek OFFSET, WHENCE I Identical to C, I =cut sub sysseek { my $self = shift; $self->seek (@_); } #------------------------------ =item tell I Return the current position in the stream, as a numeric offset. =cut sub tell { *{shift()}->{Pos} } #------------------------------ =item use_RS [YESNO] I B Obey the current setting of $/, like IO::Handle does? Default is false in 1.x, but cold-welded true in 2.x and later. =cut sub use_RS { my ($self, $yesno) = @_; carp "use_RS is deprecated and ignored; \$/ is always consulted\n"; } #------------------------------ =item setpos POS I Set the current position, using the opaque value returned by C. =cut sub setpos { shift->seek($_[0],0) } #------------------------------ =item getpos I Return the current position in the string, as an opaque object. =cut *getpos = \&tell; #------------------------------ =item sref I Return a reference to the underlying scalar. =cut sub sref { *{shift()}->{SR} } #------------------------------ # Tied handle methods... #------------------------------ # Conventional tiehandle interface: sub TIEHANDLE { ((defined($_[1]) && UNIVERSAL::isa($_[1], __PACKAGE__)) ? $_[1] : shift->new(@_)); } sub GETC { shift->getc(@_) } sub PRINT { shift->print(@_) } sub PRINTF { shift->print(sprintf(shift, @_)) } sub READ { shift->read(@_) } sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } sub WRITE { shift->write(@_); } sub CLOSE { shift->close(@_); } sub SEEK { shift->seek(@_); } sub TELL { shift->tell(@_); } sub EOF { shift->eof(@_); } #------------------------------------------------------------ 1; __END__ =back =cut =head1 WARNINGS Perl's TIEHANDLE spec was incomplete prior to 5.005_57; it was missing support for C, C, and C. Attempting to use these functions with an IO::Scalar will not work prior to 5.005_57. IO::Scalar will not have the relevant methods invoked; and even worse, this kind of bug can lie dormant for a while. If you turn warnings on (via C<$^W> or C), and you see something like this... attempt to seek on unopened filehandle ...then you are probably trying to use one of these functions on an IO::Scalar with an old Perl. The remedy is to simply use the OO version; e.g.: $SH->seek(0,0); ### GOOD: will work on any 5.005 seek($SH,0,0); ### WARNING: will only work on 5.005_57 and beyond =head1 VERSION $Id: Scalar.pm,v 1.6 2005/02/10 21:21:53 dfs Exp $ =head1 AUTHORS =head2 Primary Maintainer David F. Skoll (F). =head2 Principal author Eryq (F). President, ZeeGee Software Inc (F). =head2 Other contributors The full set of contributors always includes the folks mentioned in L. But just the same, special thanks to the following individuals for their invaluable contributions (if I've forgotten or misspelled your name, please email me!): I for contributing C. I for suggesting C. I for finding and fixing the bug in C. I for his offset-using read() and write() implementations. I for his patches to massively improve the performance of C and add C and C. I for stringification and inheritance improvements, and sundry good ideas. I for the IO::Handle inheritance and automatic tie-ing. =head1 SEE ALSO L, which is quite similar but which was designed more-recently and with an IO::Handle-like interface in mind, so you could mix OO- and native-filehandle usage without using tied(). I as of version 2.x, these classes all work like their IO::Handle counterparts, so we have comparable functionality to IO::String. =cut Color.pm000664001750001750 171115111656240 21745 0ustar00taitai000000000000Type-Tiny-2.008006/inc/archaic/Test/Builder/Testerpackage Test::Builder::Tester::Color; use strict; our $VERSION = "1.22"; require Test::Builder::Tester; =head1 NAME Test::Builder::Tester::Color - turn on colour in Test::Builder::Tester =head1 SYNOPSIS When running a test script perl -MTest::Builder::Tester::Color test.t =head1 DESCRIPTION Importing this module causes the subroutine color in Test::Builder::Tester to be called with a true value causing colour highlighting to be turned on in debug output. The sole purpose of this module is to enable colour highlighting from the command line. =cut sub import { Test::Builder::Tester::color(1); } =head1 AUTHOR Copyright Mark Fowler Emark@twoshortplanks.comE 2002. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 BUGS This module will have no effect unless Term::ANSIColor is installed. =head1 SEE ALSO L, L =cut 1;