CONTRIBUTING000664001750001750 5214413237246 14175 0ustar00taitai000000000000Type-Tiny-2.004000See lib/Type/Tiny/Manual/Contributing.pod COPYRIGHT000664001750001750 5030014413237246 13717 0ustar00taitai000000000000Type-Tiny-2.004000Format: 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-2023 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/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/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-2023 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-2023 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-2023 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/Type/Params/Alternatives.pm lib/Type/Params/Parameter.pm lib/Type/Params/Signature.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 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 2023 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-2023 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-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: CONTRIBUTING dist.ini 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 2022 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: 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 by 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-2023 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-2023 by Toby Inkster. 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-2023 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-2023 by Graham Knop. 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-2023 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-2023 by Diab Jerius. License: GPL-1.0+ or Artistic-1.0 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/40-bugs/rt86233.t t/40-bugs/rt86239.t Copyright: This software is copyright (c) 2013-2014, 2017-2023 by Vyacheslav Matyukhin. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT SIGNATURE Copyright: None License: public-domain Files: inc/Test/Requires.pm Copyright: Copyright 2022 MATSUNO Tokuhiro. License: GPL-1.0+ or Artistic-1.0 Files: examples/benchmarking/benchmark-coercions.pl Copyright: This software is copyright (c) 2013-2014, 2017-2022 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/ttxs-gh1.t Copyright: This software is copyright (c) 2014, 2017-2023 by Jed Lund. 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/30-external/Class-InsideOut/basic.t Copyright: This software is copyright (c) 2013-2014, 2017-2023 by David Golden, Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Tester/Color.pm Copyright: Copyright 2022 Mark Fowler. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh80.t Copyright: This software is copyright (c) 2021-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt90096.t Copyright: This software is copyright (c) 2013-2014, 2017-2023 by Samuel Kaufman. 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-2023 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-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/Type/Tiny/_DeclaredType.pm Copyright: This software is copyright (c) 2013-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: inc/Try/Tiny.pm Copyright: Copyright 2022 Yuval Kogman. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Tester.pm Copyright: Copyright 2022 Richard Clamp. 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/20-modules/Type-Tie/03prototypicalweirdness.t Copyright: This software is copyright (c) 2014, 2018-2019, 2022-2023 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt125765.t Copyright: This software is copyright (c) 2018-2023 by KB Jørgensen. License: GPL-1.0+ or Artistic-1.0 Files: t/30-external/MooseX-Getopt/coercion.t Copyright: This software is copyright (c) 2014, 2017-2023 by Alexander Hartmaier. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/gh1.t Copyright: This software is copyright (c) 2013-2014, 2017-2023 by Richard Simões. 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-2023 by Benct Philip Jonsson. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt133141.t Copyright: This software is copyright (c) 2020-2023 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-2023 by Graham Knop. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt98113.t Copyright: This software is copyright (c) 2014, 2017-2023 by Dagfinn Ilmari MannsÃ¥ker. License: GPL-1.0+ or Artistic-1.0 Files: inc/archaic/Test/Builder/Module.pm Copyright: Copyright 2022 Chromatic. License: GPL-1.0+ or Artistic-1.0 Files: inc/Test/Fatal.pm Copyright: Copyright 2022 Ricardo Signes. License: GPL-1.0+ or Artistic-1.0 Files: t/40-bugs/rt125132.t Copyright: This software is copyright (c) 2018-2023 by Marc Ballarin. License: GPL-1.0+ or Artistic-1.0 License: Artistic-1.0 This software is Copyright (c) 2023 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) 2023 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 22414413237246 13404 0ustar00taitai000000000000Type-Tiny-2.004000Maintainer: - Toby Inkster (TOBYINK) Thanks: - Diab Jerius (DJERIUS) - Jon Portnoy (AVENJ) Changes000664001750001750 2724414413237246 13732 0ustar00taitai000000000000Type-Tiny-2.004000Type-Tiny ========= Created: 2013-03-23 Home page: Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 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 165314413237246 13444 0ustar00taitai000000000000Type-Tiny-2.004000 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 4365014413237246 13443 0ustar00taitai000000000000Type-Tiny-2.004000This software is copyright (c) 2023 by Toby Inkster. 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) 2023 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 Artistic License 1.0 --- This software is Copyright (c) 2023 by Toby Inkster. This is free software, licensed under: The 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. - "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 ftp.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) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting 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. 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 whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. 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 3467314413237246 13574 0ustar00taitai000000000000Type-Tiny-2.004000CONTRIBUTING 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 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-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-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-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/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/gh80.t t/40-bugs/gh96.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 2200014413237246 14041 0ustar00taitai000000000000Type-Tiny-2.004000{ "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.004000" }, "Error::TypeTiny" : { "file" : "lib/Error/TypeTiny.pm", "version" : "2.004000" }, "Error::TypeTiny::Assertion" : { "file" : "lib/Error/TypeTiny/Assertion.pm", "version" : "2.004000" }, "Error::TypeTiny::Compilation" : { "file" : "lib/Error/TypeTiny/Compilation.pm", "version" : "2.004000" }, "Error::TypeTiny::WrongNumberOfParameters" : { "file" : "lib/Error/TypeTiny/WrongNumberOfParameters.pm", "version" : "2.004000" }, "Eval::TypeTiny" : { "file" : "lib/Eval/TypeTiny.pm", "version" : "2.004000" }, "Eval::TypeTiny::CodeAccumulator" : { "file" : "lib/Eval/TypeTiny/CodeAccumulator.pm", "version" : "2.004000" }, "Reply::Plugin::TypeTiny" : { "file" : "lib/Reply/Plugin/TypeTiny.pm", "version" : "2.004000" }, "Test::TypeTiny" : { "file" : "lib/Test/TypeTiny.pm", "version" : "2.004000" }, "Type::Coercion" : { "file" : "lib/Type/Coercion.pm", "version" : "2.004000" }, "Type::Coercion::FromMoose" : { "file" : "lib/Type/Coercion/FromMoose.pm", "version" : "2.004000" }, "Type::Coercion::Union" : { "file" : "lib/Type/Coercion/Union.pm", "version" : "2.004000" }, "Type::Library" : { "file" : "lib/Type/Library.pm", "version" : "2.004000" }, "Type::Params" : { "file" : "lib/Type/Params.pm", "version" : "2.004000" }, "Type::Params::Alternatives" : { "file" : "lib/Type/Params/Alternatives.pm", "version" : "2.004000" }, "Type::Params::Parameter" : { "file" : "lib/Type/Params/Parameter.pm", "version" : "2.004000" }, "Type::Params::Signature" : { "file" : "lib/Type/Params/Signature.pm", "version" : "2.004000" }, "Type::Parser" : { "file" : "lib/Type/Parser.pm", "version" : "2.004000" }, "Type::Parser::AstBuilder" : { "file" : "lib/Type/Parser.pm", "version" : "2.004000" }, "Type::Parser::Token" : { "file" : "lib/Type/Parser.pm", "version" : "2.004000" }, "Type::Parser::TokenStream" : { "file" : "lib/Type/Parser.pm", "version" : "2.004000" }, "Type::Registry" : { "file" : "lib/Type/Registry.pm", "version" : "2.004000" }, "Type::Tie" : { "file" : "lib/Type/Tie.pm", "version" : "2.004000" }, "Type::Tie::ARRAY" : { "file" : "lib/Type/Tie.pm", "version" : "2.004000" }, "Type::Tie::BASE" : { "file" : "lib/Type/Tie.pm", "version" : "2.004000" }, "Type::Tie::HASH" : { "file" : "lib/Type/Tie.pm", "version" : "2.004000" }, "Type::Tie::SCALAR" : { "file" : "lib/Type/Tie.pm", "version" : "2.004000" }, "Type::Tiny" : { "file" : "lib/Type/Tiny.pm", "version" : "2.004000" }, "Type::Tiny::Bitfield" : { "file" : "lib/Type/Tiny/Bitfield.pm", "version" : "2.004000" }, "Type::Tiny::Class" : { "file" : "lib/Type/Tiny/Class.pm", "version" : "2.004000" }, "Type::Tiny::ConstrainedObject" : { "file" : "lib/Type/Tiny/ConstrainedObject.pm", "version" : "2.004000" }, "Type::Tiny::Duck" : { "file" : "lib/Type/Tiny/Duck.pm", "version" : "2.004000" }, "Type::Tiny::Enum" : { "file" : "lib/Type/Tiny/Enum.pm", "version" : "2.004000" }, "Type::Tiny::Intersection" : { "file" : "lib/Type/Tiny/Intersection.pm", "version" : "2.004000" }, "Type::Tiny::Role" : { "file" : "lib/Type/Tiny/Role.pm", "version" : "2.004000" }, "Type::Tiny::Union" : { "file" : "lib/Type/Tiny/Union.pm", "version" : "2.004000" }, "Type::Utils" : { "file" : "lib/Type/Utils.pm", "version" : "2.004000" }, "Types::Common" : { "file" : "lib/Types/Common.pm", "version" : "2.004000" }, "Types::Common::Numeric" : { "file" : "lib/Types/Common/Numeric.pm", "version" : "2.004000" }, "Types::Common::String" : { "file" : "lib/Types/Common/String.pm", "version" : "2.004000" }, "Types::Standard" : { "file" : "lib/Types/Standard.pm", "version" : "2.004000" }, "Types::Standard::ArrayRef" : { "file" : "lib/Types/Standard/ArrayRef.pm", "version" : "2.004000" }, "Types::Standard::CycleTuple" : { "file" : "lib/Types/Standard/CycleTuple.pm", "version" : "2.004000" }, "Types::Standard::Dict" : { "file" : "lib/Types/Standard/Dict.pm", "version" : "2.004000" }, "Types::Standard::HashRef" : { "file" : "lib/Types/Standard/HashRef.pm", "version" : "2.004000" }, "Types::Standard::Map" : { "file" : "lib/Types/Standard/Map.pm", "version" : "2.004000" }, "Types::Standard::ScalarRef" : { "file" : "lib/Types/Standard/ScalarRef.pm", "version" : "2.004000" }, "Types::Standard::StrMatch" : { "file" : "lib/Types/Standard/StrMatch.pm", "version" : "2.004000" }, "Types::Standard::Tied" : { "file" : "lib/Types/Standard/Tied.pm", "version" : "2.004000" }, "Types::Standard::Tuple" : { "file" : "lib/Types/Standard/Tuple.pm", "version" : "2.004000" }, "Types::TypeTiny" : { "file" : "lib/Types/TypeTiny.pm", "version" : "2.004000" } }, "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.004000", "x_breaks" : { "Kavorka" : "<= 0.013", "Types::ReadOnly" : "<= 0.001" }, "x_serialization_backend" : "JSON::PP version 4.09" } META.yml000664001750001750 1316614413237246 13706 0ustar00taitai000000000000Type-Tiny-2.004000--- 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.004000' Error::TypeTiny: file: lib/Error/TypeTiny.pm version: '2.004000' Error::TypeTiny::Assertion: file: lib/Error/TypeTiny/Assertion.pm version: '2.004000' Error::TypeTiny::Compilation: file: lib/Error/TypeTiny/Compilation.pm version: '2.004000' Error::TypeTiny::WrongNumberOfParameters: file: lib/Error/TypeTiny/WrongNumberOfParameters.pm version: '2.004000' Eval::TypeTiny: file: lib/Eval/TypeTiny.pm version: '2.004000' Eval::TypeTiny::CodeAccumulator: file: lib/Eval/TypeTiny/CodeAccumulator.pm version: '2.004000' Reply::Plugin::TypeTiny: file: lib/Reply/Plugin/TypeTiny.pm version: '2.004000' Test::TypeTiny: file: lib/Test/TypeTiny.pm version: '2.004000' Type::Coercion: file: lib/Type/Coercion.pm version: '2.004000' Type::Coercion::FromMoose: file: lib/Type/Coercion/FromMoose.pm version: '2.004000' Type::Coercion::Union: file: lib/Type/Coercion/Union.pm version: '2.004000' Type::Library: file: lib/Type/Library.pm version: '2.004000' Type::Params: file: lib/Type/Params.pm version: '2.004000' Type::Params::Alternatives: file: lib/Type/Params/Alternatives.pm version: '2.004000' Type::Params::Parameter: file: lib/Type/Params/Parameter.pm version: '2.004000' Type::Params::Signature: file: lib/Type/Params/Signature.pm version: '2.004000' Type::Parser: file: lib/Type/Parser.pm version: '2.004000' Type::Parser::AstBuilder: file: lib/Type/Parser.pm version: '2.004000' Type::Parser::Token: file: lib/Type/Parser.pm version: '2.004000' Type::Parser::TokenStream: file: lib/Type/Parser.pm version: '2.004000' Type::Registry: file: lib/Type/Registry.pm version: '2.004000' Type::Tie: file: lib/Type/Tie.pm version: '2.004000' Type::Tie::ARRAY: file: lib/Type/Tie.pm version: '2.004000' Type::Tie::BASE: file: lib/Type/Tie.pm version: '2.004000' Type::Tie::HASH: file: lib/Type/Tie.pm version: '2.004000' Type::Tie::SCALAR: file: lib/Type/Tie.pm version: '2.004000' Type::Tiny: file: lib/Type/Tiny.pm version: '2.004000' Type::Tiny::Bitfield: file: lib/Type/Tiny/Bitfield.pm version: '2.004000' Type::Tiny::Class: file: lib/Type/Tiny/Class.pm version: '2.004000' Type::Tiny::ConstrainedObject: file: lib/Type/Tiny/ConstrainedObject.pm version: '2.004000' Type::Tiny::Duck: file: lib/Type/Tiny/Duck.pm version: '2.004000' Type::Tiny::Enum: file: lib/Type/Tiny/Enum.pm version: '2.004000' Type::Tiny::Intersection: file: lib/Type/Tiny/Intersection.pm version: '2.004000' Type::Tiny::Role: file: lib/Type/Tiny/Role.pm version: '2.004000' Type::Tiny::Union: file: lib/Type/Tiny/Union.pm version: '2.004000' Type::Utils: file: lib/Type/Utils.pm version: '2.004000' Types::Common: file: lib/Types/Common.pm version: '2.004000' Types::Common::Numeric: file: lib/Types/Common/Numeric.pm version: '2.004000' Types::Common::String: file: lib/Types/Common/String.pm version: '2.004000' Types::Standard: file: lib/Types/Standard.pm version: '2.004000' Types::Standard::ArrayRef: file: lib/Types/Standard/ArrayRef.pm version: '2.004000' Types::Standard::CycleTuple: file: lib/Types/Standard/CycleTuple.pm version: '2.004000' Types::Standard::Dict: file: lib/Types/Standard/Dict.pm version: '2.004000' Types::Standard::HashRef: file: lib/Types/Standard/HashRef.pm version: '2.004000' Types::Standard::Map: file: lib/Types/Standard/Map.pm version: '2.004000' Types::Standard::ScalarRef: file: lib/Types/Standard/ScalarRef.pm version: '2.004000' Types::Standard::StrMatch: file: lib/Types/Standard/StrMatch.pm version: '2.004000' Types::Standard::Tied: file: lib/Types/Standard/Tied.pm version: '2.004000' Types::Standard::Tuple: file: lib/Types/Standard/Tuple.pm version: '2.004000' Types::TypeTiny: file: lib/Types/TypeTiny.pm version: '2.004000' 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.004000' x_breaks: Kavorka: '<= 0.013' Types::ReadOnly: '<= 0.001' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Makefile.PL000664001750001750 4403114413237246 14402 0ustar00taitai000000000000Type-Tiny-2.004000use 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.004000" }, "Error::TypeTiny" => { file => "lib/Error/TypeTiny.pm", version => "2.004000" }, "Error::TypeTiny::Assertion" => { file => "lib/Error/TypeTiny/Assertion.pm", version => "2.004000" }, "Error::TypeTiny::Compilation" => { file => "lib/Error/TypeTiny/Compilation.pm", version => "2.004000" }, "Error::TypeTiny::WrongNumberOfParameters" => { file => "lib/Error/TypeTiny/WrongNumberOfParameters.pm", version => "2.004000", }, "Eval::TypeTiny" => { file => "lib/Eval/TypeTiny.pm", version => "2.004000" }, "Eval::TypeTiny::CodeAccumulator" => { file => "lib/Eval/TypeTiny/CodeAccumulator.pm", version => "2.004000", }, "Reply::Plugin::TypeTiny" => { file => "lib/Reply/Plugin/TypeTiny.pm", version => "2.004000" }, "Test::TypeTiny" => { file => "lib/Test/TypeTiny.pm", version => "2.004000" }, "Type::Coercion" => { file => "lib/Type/Coercion.pm", version => "2.004000" }, "Type::Coercion::FromMoose" => { file => "lib/Type/Coercion/FromMoose.pm", version => "2.004000" }, "Type::Coercion::Union" => { file => "lib/Type/Coercion/Union.pm", version => "2.004000" }, "Type::Library" => { file => "lib/Type/Library.pm", version => "2.004000" }, "Type::Params" => { file => "lib/Type/Params.pm", version => "2.004000" }, "Type::Params::Alternatives" => { file => "lib/Type/Params/Alternatives.pm", version => "2.004000" }, "Type::Params::Parameter" => { file => "lib/Type/Params/Parameter.pm", version => "2.004000" }, "Type::Params::Signature" => { file => "lib/Type/Params/Signature.pm", version => "2.004000" }, "Type::Parser" => { file => "lib/Type/Parser.pm", version => "2.004000" }, "Type::Parser::AstBuilder" => { file => "lib/Type/Parser.pm", version => "2.004000" }, "Type::Parser::Token" => { file => "lib/Type/Parser.pm", version => "2.004000" }, "Type::Parser::TokenStream" => { file => "lib/Type/Parser.pm", version => "2.004000" }, "Type::Registry" => { file => "lib/Type/Registry.pm", version => "2.004000" }, "Type::Tie" => { file => "lib/Type/Tie.pm", version => "2.004000" }, "Type::Tie::ARRAY" => { file => "lib/Type/Tie.pm", version => "2.004000" }, "Type::Tie::BASE" => { file => "lib/Type/Tie.pm", version => "2.004000" }, "Type::Tie::HASH" => { file => "lib/Type/Tie.pm", version => "2.004000" }, "Type::Tie::SCALAR" => { file => "lib/Type/Tie.pm", version => "2.004000" }, "Type::Tiny" => { file => "lib/Type/Tiny.pm", version => "2.004000" }, "Type::Tiny::Bitfield" => { file => "lib/Type/Tiny/Bitfield.pm", version => "2.004000" }, "Type::Tiny::Class" => { file => "lib/Type/Tiny/Class.pm", version => "2.004000" }, "Type::Tiny::ConstrainedObject" => { file => "lib/Type/Tiny/ConstrainedObject.pm", version => "2.004000" }, "Type::Tiny::Duck" => { file => "lib/Type/Tiny/Duck.pm", version => "2.004000" }, "Type::Tiny::Enum" => { file => "lib/Type/Tiny/Enum.pm", version => "2.004000" }, "Type::Tiny::Intersection" => { file => "lib/Type/Tiny/Intersection.pm", version => "2.004000" }, "Type::Tiny::Role" => { file => "lib/Type/Tiny/Role.pm", version => "2.004000" }, "Type::Tiny::Union" => { file => "lib/Type/Tiny/Union.pm", version => "2.004000" }, "Type::Utils" => { file => "lib/Type/Utils.pm", version => "2.004000" }, "Types::Common" => { file => "lib/Types/Common.pm", version => "2.004000" }, "Types::Common::Numeric" => { file => "lib/Types/Common/Numeric.pm", version => "2.004000" }, "Types::Common::String" => { file => "lib/Types/Common/String.pm", version => "2.004000" }, "Types::Standard" => { file => "lib/Types/Standard.pm", version => "2.004000" }, "Types::Standard::ArrayRef" => { file => "lib/Types/Standard/ArrayRef.pm", version => "2.004000" }, "Types::Standard::CycleTuple" => { file => "lib/Types/Standard/CycleTuple.pm", version => "2.004000" }, "Types::Standard::Dict" => { file => "lib/Types/Standard/Dict.pm", version => "2.004000" }, "Types::Standard::HashRef" => { file => "lib/Types/Standard/HashRef.pm", version => "2.004000" }, "Types::Standard::Map" => { file => "lib/Types/Standard/Map.pm", version => "2.004000" }, "Types::Standard::ScalarRef" => { file => "lib/Types/Standard/ScalarRef.pm", version => "2.004000" }, "Types::Standard::StrMatch" => { file => "lib/Types/Standard/StrMatch.pm", version => "2.004000" }, "Types::Standard::Tied" => { file => "lib/Types/Standard/Tied.pm", version => "2.004000" }, "Types::Standard::Tuple" => { file => "lib/Types/Standard/Tuple.pm", version => "2.004000" }, "Types::TypeTiny" => { file => "lib/Types/TypeTiny.pm", version => "2.004000" }, }, "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.004000", "x_breaks" => { "Kavorka" => "<= 0.013", "Types::ReadOnly" => "<= 0.001" }, }; 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/*.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 334014413237246 13105 0ustar00taitai000000000000Type-Tiny-2.004000======================================================================= 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. ======================================================================= 2023-04-XX 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 1574614413237246 13323 0ustar00taitai000000000000Type-Tiny-2.004000NAME 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 800 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.12; use strict; use warnings; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef InstanceOf ); use Type::Params qw( signature ); 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 [] }, ); sub add_child { state $check = signature( method => Object, positional => [ InstanceOf['Horse'] ] ); my ( $self, $child ) = $check->(@_); # unpack @_ 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.12 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, 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-2023 by Toby Inkster. 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 13576714413237246 13755 0ustar00taitai000000000000Type-Tiny-2.004000This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.87. 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 3f7a641f2393fdd37658c5ce02877bf5d987cdddedbc01e3cb73cb6d4a0988bc COPYRIGHT SHA256 aa78c487292c1cdbc5e787a4b8787d5ffcda50f2f0b4cb407ee5157236238f84 CREDITS SHA256 199dd138c30b108b17bc38778088e9e65f035923cada598a99dd8990be0acbd0 Changes SHA256 6a5ab06a68802a98172274d878229173c11a5229cdf14feaa4b88498cb3c05d7 INSTALL SHA256 1a2929dacaef239beca27a85f7f97b793628dfb22f07fdfb406cb6f3f0d22a6b LICENSE SHA256 439940b3be0dbb2f84ff1f61e443ffc03c4957eebb4031bb13ee2749d99b96ac MANIFEST SHA256 72f907f65909fe90069951ef64e8ea074810e31240f3befb89cf3739509ab4b4 META.json SHA256 bec5f53677f9f362e55105b2577b8fe103ff384d13f8d68e951b9693426abe68 META.yml SHA256 528da48d7c139d5c7ed5896a74e3f991edc93c74285de02b23e985ca2577b902 Makefile.PL SHA256 335403357c42af0ece3d061bf7675ababbadfbc10ed756e0098ec9b9ea4d3b60 NEWS SHA256 753001b71ba22a394f0f4beb3e473d7e237835d52e60952b5497acb64e4a8532 README SHA256 cd8759458860e09c13d2be9509cef61689d8ee9738ef9d38ee1ca8add64312ba dist.ini SHA256 2ea04eeaa861eac3e8eabdb709a99938a89d3d2f3431a5aec983db5e9f485a51 doap.ttl SHA256 16785ec5a64f0b45eca9ce7b0b2d0aba043eb3553c02f9ef3f59bcc5f1d8956f examples/benchmarking/benchmark-coercions.pl SHA256 c8f798b50a85897e5f239970b4995bfdd79edea9c2e474d2b4e8d14693920409 examples/benchmarking/benchmark-constraints.pl SHA256 a0b9dd7a8aedcc522f3c059874b4a03bdba1fbedcd670ee446443526681e327c examples/benchmarking/benchmark-named-param-validation.pl SHA256 a93b946514d09a42cd061c915e520eadc4c22074b85c133fd30aa862de3172c2 examples/benchmarking/benchmark-param-validation.pl SHA256 734e61080079b084143d6305d0f5dc8c56a1acddcf4a777ab42b79637adb9df0 examples/benchmarking/versus-scalar-validation.pl SHA256 064d245fa2999162a82267daeddbe1ec9637537d1747f6a830d7e632dc13d8e3 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 f8e583cb48ebf97dba0e0bd2cd61f27bb0f1f2f96337cd1993b10523dd37bbdb lib/Devel/TypeTiny/Perl58Compat.pm SHA256 33f9a32426ab6682883b7e2d76ccc5b3bcafb9951c2c4f3b275790f9d7e29c8a lib/Error/TypeTiny.pm SHA256 7b92c13b2ac92097bc18ca91d1167cb40d8411372e62ba46af34bb745910d9fb lib/Error/TypeTiny/Assertion.pm SHA256 4fd71496dad60a16ac59f3b45b8fd13c526db9ce490f17ee8f2ef88ec5820f81 lib/Error/TypeTiny/Compilation.pm SHA256 d17f3837c941903eb5d63e5d499ee41e8d398f2085a6f143e5e3e2f0ae74f703 lib/Error/TypeTiny/WrongNumberOfParameters.pm SHA256 c76d91a0ac3bc85027239ba0db71557dc785501ef4154f9bcb4c531b7ae408f0 lib/Eval/TypeTiny.pm SHA256 aedf2897d141641f1b20363dd05356d8d181fa8f018a1ca61d5908bd27777317 lib/Eval/TypeTiny/CodeAccumulator.pm SHA256 35131a1c50fd48d0b09dce2c923f60e49425fc364d99f5e245a97933ee90a62c lib/Reply/Plugin/TypeTiny.pm SHA256 9257caa0de923d0f2875de58d242a7ab65cc6ba33b6948af5a23796415995726 lib/Test/TypeTiny.pm SHA256 623881ca2dd2978d11305f75583b13c63a3e1dd5a0ef8b7fe3574832285176a1 lib/Type/Coercion.pm SHA256 9c4d6b5c35965be93d5b7bc899661ea516e8adb3cf90cf197c8a381da2f1cf26 lib/Type/Coercion/FromMoose.pm SHA256 c2c8e66b5717ca87422c8388baf71ae5921712629ea014784a8b95dd0a1368c8 lib/Type/Coercion/Union.pm SHA256 b55dc79bf59280c5345c6651cd1257b2075abe3c0d9eb8d11d8f5ca9efe8e025 lib/Type/Library.pm SHA256 9d5e3886f09d57f14e9a5a0b355b360cc2c7d702e83d4b479124b1cf57111a28 lib/Type/Params.pm SHA256 4012aa068a3499b3a7769853b2eadf0dd90f6f8db83e1a4dd9d0fd830340cb09 lib/Type/Params/Alternatives.pm SHA256 b3d4588f3b1646bd7fc1e28a10816250b9053ff0f4e155188ac8513d71aa13a9 lib/Type/Params/Parameter.pm SHA256 a95f5f6abf57e87b4ea22df5f73a27bb88540630adc8a5c019281677741afeda lib/Type/Params/Signature.pm SHA256 be9b576254801e38f867c184d00f55c7467b54f07fcdcba5ce90e839105d0197 lib/Type/Parser.pm SHA256 4367e72e54e952a96f9965c9d0c44a3ff2d0b894e0791c3b530598b92b34f6f8 lib/Type/Registry.pm SHA256 fce464a6bf5019bc6a528078d6907d0c44b276056bb20a294bdb152aa4e84a59 lib/Type/Tie.pm SHA256 ff534cc88ffa2096073cab6ff6592eef0dcfe94dba9817e1ccef4c19051851fa lib/Type/Tiny.pm SHA256 8fc201d099a3d54371a5e8fd8735f062c67291f7845e6539182526e813ba2a53 lib/Type/Tiny/Bitfield.pm SHA256 de96f5a1277f90ada502b0ae097aa200177ce7b9d9ae77db3e21627df6733eca lib/Type/Tiny/Class.pm SHA256 7b126a730e6920bfc5e07e9c026b1da087069cf30d0054d2ac13926b406881e9 lib/Type/Tiny/ConstrainedObject.pm SHA256 b41b57aff8692ac63fad41edc49bdeaaeb582c313f5b70ec6fb247264f2b43ae lib/Type/Tiny/Duck.pm SHA256 5e80ffebb2777ec9dd0a3f527aaf6b8a9366e11ed6b4b76de09889a1f4f863a2 lib/Type/Tiny/Enum.pm SHA256 fdc8738f2f9f82508f7ddbcb3445c2992be82d324b31a16fc777eb9e55048584 lib/Type/Tiny/Intersection.pm SHA256 869dea71b28f5ff08068c7d129d7c46ce738f4e084d54178d9cc9025ce27ac62 lib/Type/Tiny/Manual.pod SHA256 24a2be8c8111f0a0728731140f1fd99432d68cb614026039417d68c3a7e79f83 lib/Type/Tiny/Manual/AllTypes.pod SHA256 4ab0fdc6e240204d50cb6565ab568ea5697e1c7608ea1437b950bc9b167a82c4 lib/Type/Tiny/Manual/Coercions.pod SHA256 017d18eb946d1d0ff41634b0f4cfcd6f035caef320f96089b645b414c3faa9e5 lib/Type/Tiny/Manual/Contributing.pod SHA256 45a80c9939d115a5f7516dff0d5b10aa2476f2815feee2f6a48435524ec39a76 lib/Type/Tiny/Manual/Installation.pod SHA256 35e4d52309771306f1cedabdd629f7517d13e225dadfb1fe3bb2744e1eeb9785 lib/Type/Tiny/Manual/Libraries.pod SHA256 305cd88bfe2bb6e39c995dde94f2b7085daea24333e82eddf9f99791fa53fb1f lib/Type/Tiny/Manual/NonOO.pod SHA256 8b414500d1402538829eb5e0547edbc4f7931b207c3dc8eed1377cf32c402e00 lib/Type/Tiny/Manual/Optimization.pod SHA256 92470e4054588830dca99c7e8fd5dc362003f5702db711bb40a586e0410b8cb1 lib/Type/Tiny/Manual/Params.pod SHA256 c0761ab04b045c3a35eb2282038158559c7e000868595960bd63bce54b5e7c75 lib/Type/Tiny/Manual/Policies.pod SHA256 94c634213d3a52e37e041614b584a5bfee64f80fa7382a638dc7b6e36b4b4981 lib/Type/Tiny/Manual/UsingWithClassTiny.pod SHA256 fcd264e4cb05a60a0dce59c8e842553a0937f6d9de406403ccbef5ff7359ae73 lib/Type/Tiny/Manual/UsingWithMite.pod SHA256 002cd5f4848319dc3133ae2c41f11241024d38ed7f6ece11f9ca892d1279db7b lib/Type/Tiny/Manual/UsingWithMoo.pod SHA256 f54df479478aa3bcfac010e51a8dd06801c2a132a567507657d1048947c7cb1e lib/Type/Tiny/Manual/UsingWithMoo2.pod SHA256 664bd20013a569602e16bef7c0738f05614a2a99c5209d631583288a38ad236a lib/Type/Tiny/Manual/UsingWithMoo3.pod SHA256 2ab52e8fb318abb81edd2d42cbead177a7b1a2d675fc0ef0eb2815de67a9c134 lib/Type/Tiny/Manual/UsingWithMoose.pod SHA256 b0211e71c2c361b3ce287dae3b087ee40bde634a352f3d6b6f6d7296dacf92e8 lib/Type/Tiny/Manual/UsingWithMouse.pod SHA256 f06dbbdf22b96e34513bbc31accb3cd88346e54f46583b0b72334fe1de275330 lib/Type/Tiny/Manual/UsingWithOther.pod SHA256 fe94d2720534178e1d37903409f6da4c3c7a7df7a2585d14da113e86111ddafa lib/Type/Tiny/Manual/UsingWithTestMore.pod SHA256 7ba7f1b12f34caf26763e3e934450765584ed2f40783e83ffbdc1cff0063eb97 lib/Type/Tiny/Role.pm SHA256 63c0394f8eead4b45b72b4395fbe8d73b4e9c44bdbeddde61bfff939c609fdbd lib/Type/Tiny/Union.pm SHA256 c3712a4058808f0e05c0a92cb7f12a3b8fddf11d5ded8cfe168522c852c25a92 lib/Type/Tiny/_DeclaredType.pm SHA256 ea57a48232799e5ad1b239eee17ea82125723c29806953981bd85b2082c1a2c7 lib/Type/Tiny/_HalfOp.pm SHA256 959c258e84b57ab5f04618899a68d3fca551f6401d6605c249968cfe38b9bafe lib/Type/Utils.pm SHA256 843f96f229013c5300559a3b72baccc2d150126f4d89fcb051f494e881a09e67 lib/Types/Common.pm SHA256 8e4f211a89c483c82ad402130c9fd869116a85b3e1ef6306ea746db92265167a lib/Types/Common/Numeric.pm SHA256 d85d1d53d6f7bfc5a39d34d7d17147d62b7eefa74406236e8d0e31a263f557c7 lib/Types/Common/String.pm SHA256 29642bd6a4517b3c82a81198aa48eacd82bd22ccbaccfa52cb3108e42bfb0e25 lib/Types/Standard.pm SHA256 cadd4ccdec4cce32e26951c806a80a4404890744086b4e7daf50ffa52888c28b lib/Types/Standard/ArrayRef.pm SHA256 26cb603fe035b11890fe6fd01aa77023f9679b971d888532af9d7def43626292 lib/Types/Standard/CycleTuple.pm SHA256 5e936edc6129b3e480d43500b6c3d058675e644c6a9ee56783d1f553714d5ca1 lib/Types/Standard/Dict.pm SHA256 9b0ee1f99172a2d5b4767233878ea31d81e6665399419ae13e6a10376553a626 lib/Types/Standard/HashRef.pm SHA256 08d50fd59fd0629b3bcf4e7e49160407e0fda93f6adf7ea1b6b151669e59ba30 lib/Types/Standard/Map.pm SHA256 e5a47f14f8949e01dc299267540718a1e07d308eb28008bec39199384745a98a lib/Types/Standard/ScalarRef.pm SHA256 00ef241e493b389b422dd4af6368455b4ba57f2421e0082f17eb439962e12417 lib/Types/Standard/StrMatch.pm SHA256 56be657bc01efafcaa568a43aff126a1a02869e17576892a6a8ae4a0373ffa4e lib/Types/Standard/Tied.pm SHA256 e48336e3c5db74c457091d0d577d330d8a4349f14b2d1c4d3cc752ddbf628ec0 lib/Types/Standard/Tuple.pm SHA256 747f35f376ac93257a9612cb2ffb2cc4c4599c79f4115f46aab6e7999780fc19 lib/Types/TypeTiny.pm SHA256 275ab2b80b4955d0cbd36637691d3fcc7daaefa7243cfde2c576d56762d9803f t/00-begin.t SHA256 2e02e23495541d9b6e4f6250988a3e2227c2e7bbcda2d4bbfd20a480a2b3c2d2 t/01-compile.t SHA256 13fb97d11a6b5f7fe8a171c2217736b76b20bbc839ca0cc7444e8be4bd8be00b t/02-api.t SHA256 0286128d43e0b3759def05cefb531a957b534833316e53d690ceeff32c4e1e09 t/03-leak.t SHA256 c822dc1f1adecb76b6e28084f9c2ed04f32c73ae8644591ebf22b3b6ccbc36e0 t/20-modules/Devel-TypeTiny-Perl58Compat/basic.t SHA256 bd4909c50439d19b269faec895dac6c7fecd5b976cb73249319caec6f36cc0c2 t/20-modules/Error-TypeTiny-Assertion/basic.t SHA256 527a818ff7cc807b12b9f0484aaa8c7aad782d3c15c3ce120735de21796e8535 t/20-modules/Error-TypeTiny-Compilation/basic.t SHA256 52a61d867705c27ec373aec2d3ea4eb9e3a32fd3e6b5ed3b115b4e3c516825aa t/20-modules/Error-TypeTiny-WrongNumberOfParameters/basic.t SHA256 8fd79cb7642d6ff4b2472f29ba9aa225305e51b749071055bddb54c7262f4da7 t/20-modules/Error-TypeTiny/basic.t SHA256 5687e7a680d3832a4b74ad53c94647ecab289409c3b8277d07f41258468dd807 t/20-modules/Error-TypeTiny/stacktrace.t SHA256 02eca58543c8d2778639e724b435b508253ebcd79d62498ee32390130eef8be8 t/20-modules/Eval-TypeTiny-CodeAccumulator/basic.t SHA256 2c6df3ecb24037f968fdcc78bd6db33cda27de786793fb9e5dc1134fd1bd635f t/20-modules/Eval-TypeTiny-CodeAccumulator/callback.t SHA256 0cfe0608d295b1e9ed8283e0f1459bb02bc2854318e1d5ad085a64bbcda6c78a t/20-modules/Eval-TypeTiny/aliases-devel-lexalias.t SHA256 33f4e66ea76117192061c0cbdb3bc2fcfa87dca4d1169035b7c01b8a98e1f43c t/20-modules/Eval-TypeTiny/aliases-native.t SHA256 6ea6e90b9003cff6b36e0a545632c39e563abff3ac10f91798df495de56af1d7 t/20-modules/Eval-TypeTiny/aliases-padwalker.t SHA256 e0eb29e92171f5d362d6b43429e5af414cb953af3ba7438683faf2721e2f653e t/20-modules/Eval-TypeTiny/aliases-tie.t SHA256 3929e7de7591f87998a55c1c0a7fe1896e223059c963637b19b977d9785f9945 t/20-modules/Eval-TypeTiny/basic.t SHA256 109cbf5eaeff6fc5031d97fbbdb68ec6f6df37d1937c59c482e05f0fb4c8cebb t/20-modules/Eval-TypeTiny/lexical-subs.t SHA256 6f5a2c798edc6e516ca9e6a8dd75d460ab724e7301670ad1b76db5addf4a2fed t/20-modules/Test-TypeTiny/basic.t SHA256 4c4b5ad13cd3e5eb0c23138d3526c5addba1082745c0c528216b89f9274564bc t/20-modules/Test-TypeTiny/extended.t SHA256 b3d287adf152be4d00015479f04bae55ce6833b5f290ef3b539ed9a71f0d9971 t/20-modules/Test-TypeTiny/matchfor.t SHA256 a0a6014f9ac05bbdce9ea503484649bdfc78668d9722ca48b5d60561c883a11f t/20-modules/Type-Coercion-FromMoose/basic.t SHA256 46a441de351306d8417278ababe87f1c2c8948ef592927e2d223b94bb2bd6720 t/20-modules/Type-Coercion-FromMoose/errors.t SHA256 3f211d08fc015ca32a2deff8fb723294ea2f125ff5ae9d5687cc72da55a2fd83 t/20-modules/Type-Coercion-Union/basic.t SHA256 fd78514139bf16e7845665a758e0ec96928d7196447b67c446fd0df5ed666d08 t/20-modules/Type-Coercion/basic.t SHA256 d63941896342c7ec68df87a53c72de671924aa0f23ccb60f3f19472df2921c89 t/20-modules/Type-Coercion/esoteric.t SHA256 498f7ec324ed626142ec9554e1d38111d3c2f903b430fd11b62a604994f2826d t/20-modules/Type-Coercion/frozen.t SHA256 1f3fe9bf38c415b287dd7b02bc9dde4efa540f9a5299492da4c72ac0a286b705 t/20-modules/Type-Coercion/inlining.t SHA256 9248750deecf265f228efcfba9ca9b91297a0d02c2276f290bb3b4f00d3feb66 t/20-modules/Type-Coercion/parameterized.t SHA256 8b69c06669c3ab8d3fcc08cc1a983b837929dc1e23d6a1919d20d11727eed9ca t/20-modules/Type-Coercion/smartmatch.t SHA256 7dce84b2f858d5b2ea29635a7f54c416d286201ee3d24040761e933b1c66cbc4 t/20-modules/Type-Coercion/typetiny-constructor.t SHA256 3662e8b040ab3231f4d2e2a6ffbd8ff15a8fec0dd44b3f03f54f18fa7a99f0ad t/20-modules/Type-Library/assert.t SHA256 848e5c85ca76a34aad8c15117ab2e5b1ddc9b73325856336038554f43c312a0e t/20-modules/Type-Library/declared-types.t SHA256 99eb8b00f51808709f853aa9c6bd060e338ed2669976151d32b1f665edd3041d t/20-modules/Type-Library/deprecation.t SHA256 c564b327766cdf006fa79075116df16119782f0e90120220be76bf974ce2942e t/20-modules/Type-Library/errors.t SHA256 07fc02a48e5ec44431fa0b06e6139e8cd688584f418ddae57e21d75d74c3f506 t/20-modules/Type-Library/exportables-duplicated.t SHA256 00974070f3b5ae17f596504f622c27737675e7c17d3c3762192a29067576cd01 t/20-modules/Type-Library/exportables.t SHA256 9a6f45d72d33a6097f590ddf8b06f5062bc8a7999db0e03c4d0247c426dad213 t/20-modules/Type-Library/import-params.t SHA256 cefd1c3bb9e3d355be67fb1ddb6f36dbb04c51a3d92d3cddce5d370424212d55 t/20-modules/Type-Library/inheritance.t SHA256 fc67727fdafcbb4a314413bc3d889b71108f6ff68951738f7e959bf30c270114 t/20-modules/Type-Library/is.t SHA256 22cafad535b2b3fe98559e32e2d17afa51ab24db5de309f8f532eaac058227a6 t/20-modules/Type-Library/own-registry.t SHA256 56018996009dee158f8ac332d037b081874c7c340644ac8fc47b485a53138c38 t/20-modules/Type-Library/recursive-type-definitions.t SHA256 81e86c9979cc1fe8db363f8fa4e278f511e001483adc06a7c238cc0a0f9f2587 t/20-modules/Type-Library/remove-type.t SHA256 f4f4c013d1c4ef372dc16fed214ad0aa7665ef167361a09a7c90dcf1636e903e t/20-modules/Type-Library/to.t SHA256 cfe654689174bec5101054f60e69e01e00d7234a37f37d0c847c9b84af73acae t/20-modules/Type-Library/types.t SHA256 e17187c376a6bfff20eb57d894038c0e8d1bce5a3ba87ceeb9647f14876aa11d t/20-modules/Type-Params-Signature/basic.t SHA256 906f2878e0b9c4d069a74dc369b252083e06575acaab2d4db55206d5b67f7261 t/20-modules/Type-Params/alias.t SHA256 6ff6fa97167c081d707e6b626dcb91604f1aefb27535b48726210425bcee8faf t/20-modules/Type-Params/badsigs.t SHA256 4c0ba222078f3ddec569b5bb49176e464530e7679a33cb2fd66d36b5fca4807c t/20-modules/Type-Params/carping.t SHA256 1807cb2736c8067e485296445033ff99b0e96566f3df9bbc03344c6a4ca27017 t/20-modules/Type-Params/clone.t SHA256 e713638b88c85c9d990d3e599cec920ef92dca6c1f0853a21d91a7dae36ce1af t/20-modules/Type-Params/coerce.t SHA256 c8f954fc5f146e25f32aa394f731600decb2780988e2e238cd1bf8c40a69a984 t/20-modules/Type-Params/compile-named-avoidcallbacks.t SHA256 510f155b8aeef551e9d9bba0d8cb3d1e79523a9c26cacb7dc2c286a58ccd25c3 t/20-modules/Type-Params/compile-named-bless.t SHA256 161e905b75bba9ed01f43b346f7c72b40e061bf0f23fd523d924710335da56a1 t/20-modules/Type-Params/compile-named-oo-pp.t SHA256 63e7cd955422da82fce8d7434defe277474913ac97a285d06f71895bb72a72b4 t/20-modules/Type-Params/compile-named-oo.t SHA256 baf93280faf4c894b203a20f4d41ef906150bfc94c789fc67682182f6a6b0edd t/20-modules/Type-Params/compile-named.t SHA256 d4990e154bd4bf933226203e8d98b49805ab99849905cf2d2ef2e61741bbca7e t/20-modules/Type-Params/defaults.t SHA256 9f5deb7318b82db0fd6366886185ffa4f9428606deb29e6e681429ee7cc9d6f6 t/20-modules/Type-Params/goto_next.t SHA256 d9fb12628671d098dcec9adf74f9e34adaad995753e4f2f8f58fc6f84812eecf t/20-modules/Type-Params/hashorder.t SHA256 74513544f4d3d5750a6f473c700d0dab1d3c1e939ff6a65784178587b4093c7c t/20-modules/Type-Params/methods.t SHA256 04aad7ad9d5c74399a2b6c06d45ad271517766d2e9e5e912944babfe9e08988c t/20-modules/Type-Params/mixednamed.t SHA256 20d224a1e4b74a7c0c5433d55e3f758cf7ce676eb97135464855f5ec403d24c2 t/20-modules/Type-Params/multisig-custom-message.t SHA256 b537e8f1080adec543b96a06233338b7bb7e7e1ab4499db975abfc1f3dece9c9 t/20-modules/Type-Params/multisig-gotonext.t SHA256 d8a67b9f860b3cddbc93bbf4803159c2eecebd3b6d7de088ac0d4ded6210fb7a t/20-modules/Type-Params/multisig.t SHA256 9d64b693e7d4f1dcbe433f6558a4ab8b2343ac75a0b9fb66e2d5fa6f37a84e2f t/20-modules/Type-Params/named-to-list.t SHA256 2fd0303bb2302af4c82c2ac49f320b6e41bf6513656a7e73a27c29c07b4c56a4 t/20-modules/Type-Params/named.t SHA256 be7eac28fd9209a363e8d618958d8b35d16d4f30dba0c51c48dc4696fb452914 t/20-modules/Type-Params/noninline.t SHA256 21a42755f822f48b814e1b66e5b46d75f53d441d3f22db7f31a1359ca286e7d9 t/20-modules/Type-Params/on-die.t SHA256 3eef1167dbc2dc605b881466d42ac972061ec3ca6630f327fce5aa7df865b48a t/20-modules/Type-Params/optional.t SHA256 0f8d4d571107d136efc743d1063422b3cedb8dd13b899ffc835c7b60bc0d420a t/20-modules/Type-Params/positional.t SHA256 225e1c01eb82e7ab2829ef2764c2c7403a85631d24cc58f876aa472f00e592cd t/20-modules/Type-Params/slurpy.t SHA256 4c748a50938722f4a97d29ef5d065b3de18d9221fff192f31f09c85f8abe4123 t/20-modules/Type-Params/strictness.t SHA256 0269608f7ee722ecacb381343bde3b2b243ab2d761bbe745c58b50444c0aeb5a t/20-modules/Type-Params/v2-defaults.t SHA256 00ef51a0b79259d98aa72505d2b2bb12eca293d02f67a99c959953afadb4a3bb t/20-modules/Type-Params/v2-delayed-compilation.t SHA256 4042438e7c455aa13e831c29efcca31c6c424ab359b19d60ac1866694aedc485 t/20-modules/Type-Params/v2-exceptions.t SHA256 dcf5fc436a5895f4ee34eed8061e019b259e77e78fd1b10153d1d52288dedd0a t/20-modules/Type-Params/v2-fallback.t SHA256 02662c2d5b83203dcd4d824bf85230ff8a3d2b429d84307571dd1cf8239421da t/20-modules/Type-Params/v2-multi.t SHA256 96d3a59ded4b547ac1a70bbee5284f1239131cd7142c662fd4671f2240f8005d t/20-modules/Type-Params/v2-named-backcompat.t SHA256 23b57ca4aeb1fb9665159e2d47a71fd9053b76f4804a4a4d1b3954b92bb02cf3 t/20-modules/Type-Params/v2-named-plus-slurpy.t SHA256 edef4f578acd208337cc25838144fffa5b33746dd655793a6af9e637b98444d9 t/20-modules/Type-Params/v2-named.t SHA256 a4e026a39105cdaa06729e9d690077db4fee58afe14eb9654ee6ae4b82de30b5 t/20-modules/Type-Params/v2-positional-backcompat.t SHA256 afe33695e094cb8158e6b639589a07be3a6cb1835d9e363d5756b36c4747de57 t/20-modules/Type-Params/v2-positional-plus-slurpy.t SHA256 a98adf24f0892e684f80e64667b6f172e97b934dde4d808167c612127a18bcb4 t/20-modules/Type-Params/v2-positional.t SHA256 acf38929f464e6e7ffa2bf610bc138be324b73221413a5fbc7b9a405ec16c821 t/20-modules/Type-Params/v2-warnings.t SHA256 26d65c97775e64e034d98c0e55aa48417dc3800eef1c75546ee156bb507fcfd4 t/20-modules/Type-Params/v2-wrap-inherited-method.t SHA256 b89b39c175e3f09b71baba0d7c57af3d9e3baf7e064dbc4ec7158c3255b3b0b7 t/20-modules/Type-Params/wrap.t SHA256 a2a8baf3d1d44ff20cc722aaf02d252edb9b23c69814c2b94e44e9e842b963e7 t/20-modules/Type-Parser/basic.t SHA256 953c88d1d531786157d497c6a8e264ba67ba6b0acc8257423ac12c78879dc567 t/20-modules/Type-Parser/moosextypes.t SHA256 b5cfdb157f5361eb8bda28c3fc9a49e594b65a2f718ad60ab0210366f59a07dc t/20-modules/Type-Registry/automagic.t SHA256 ecd79f060a362f6ff995cb0d3ea12efc36598c4e1a33629fa93774d1e463c4a0 t/20-modules/Type-Registry/basic.t SHA256 9e432289bbd89bde9a03f21ee97a96da185163330410b568d9ea32224831814e t/20-modules/Type-Registry/methods.t SHA256 439afafb05c84e00c8c1b5cc1804ba56f9c43af6e3e9d4c78387fa7ec32210af t/20-modules/Type-Registry/moosextypes.t SHA256 1186f3ec408b9e7430f988f63f1f51dee3df2b2377f0052b4a69f5ecfc1beee4 t/20-modules/Type-Registry/mousextypes.t SHA256 8ac0090e6c481a50732cc416d170402bfdc7d2f66c098064c213fb7870e228b8 t/20-modules/Type-Registry/parent.t SHA256 daa90b6ac23d8a31345f09022a5aaa6c56944c0bce6822f53b8da04e22e082d5 t/20-modules/Type-Registry/refcount.t SHA256 21ce289fd2e32a6c5732f6f659c01e4f99bee982b6f970fe5e059783aab36ae2 t/20-modules/Type-Tie/01basic.t SHA256 850d9ee889634e0f1fbd9806f599f62380497719e3fac733c19ab9374ef1d5b7 t/20-modules/Type-Tie/02moosextypes.t SHA256 ca0d5340efa5a3c9e0921331f8d8cc317c5381fc5f16f5e3ecf8ddf5327e69c8 t/20-modules/Type-Tie/03prototypicalweirdness.t SHA256 048a0f89f70cf39957ffa15901668d151335122455b004c3b15e78144c0c1f21 t/20-modules/Type-Tie/04nots.t SHA256 67408cad869d1473acbb9f1df61f276060d0585c77fad9230e3342592af9e7a3 t/20-modules/Type-Tie/05typetiny.t SHA256 65218c19b2f82080492569af9b9f35662f58761661391af7c508a5c989c4c6b3 t/20-modules/Type-Tie/06clone.t SHA256 4d82fc519e774ebd07e0dfef90c09d15d53077470176a34751ba17a4df6d4f92 t/20-modules/Type-Tie/06storable.t SHA256 cd33a79cc640e62d9ebc80e85c0daf7753532a7fbcbbff778d57aac6bb7aceb5 t/20-modules/Type-Tie/basic.t SHA256 4d5c352502b49c20158362d9e775d66f829149a6d31685acd1228724af4ad7ea 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 4d33d43a7d55a80038c94b7d16cc66684a333c750ad3e7a51cecbc96463f16e6 t/20-modules/Type-Tiny-Class/basic.t SHA256 bab44e8a8788fdd6c26272a66970af44eabc36bdb152723d59983142a8ecf935 t/20-modules/Type-Tiny-Class/errors.t SHA256 77ad6e239093e957ed7de34ac9e476d1b67ba55b43783ebc76b8c4b5879534f0 t/20-modules/Type-Tiny-Class/exporter.t SHA256 4d6ecfc7c8629a90afb7e6fd086a774dffde58ed3c591ce9ef5b66392b77ab0d t/20-modules/Type-Tiny-Class/exporter_with_options.t SHA256 8c53a3251d43d19452752097483cf414a020ff30d973b1aa06d69c2492af48bd t/20-modules/Type-Tiny-Class/plus-constructors.t SHA256 14fd9ab99816da2317b556479088e26871545038930da54f524db8b90f77aa07 t/20-modules/Type-Tiny-ConstrainedObject/basic.t SHA256 829ac2594a4725c9c1ee68ae972f8d6b5976c339a83f37a194e812fcbbe1cc9b t/20-modules/Type-Tiny-Duck/basic.t SHA256 fb4a8ab0b1df1225fbc3fa7c1d4e8b9a10860f189198dc81a6caa4dff47b5cb9 t/20-modules/Type-Tiny-Duck/cmp.t SHA256 bd1ba2d2d7e8bdbdfd77e462ce59b5c05fde0fd8f05d05660c25d6e9c4750433 t/20-modules/Type-Tiny-Duck/errors.t SHA256 66ca8c6896f767e6261d090c32b20d826e8370ec2f397a14276ec75ebda57742 t/20-modules/Type-Tiny-Duck/exporter.t SHA256 88d5ae1a24f80403b9fa48fe04f0c98479ea62e4db72c78676a301de8a36ce83 t/20-modules/Type-Tiny-Enum/basic.t SHA256 ee5aa30086248de655efd8ec0ba84ede7fadf989472cfa977d890881ecd22699 t/20-modules/Type-Tiny-Enum/cmp.t SHA256 1d6353633911a41962f58f8617c2fb45e415d93216c76773b3e7f6ecf0e2639b t/20-modules/Type-Tiny-Enum/errors.t SHA256 4d6c7d4c1ca5586688e9e34a7c6e8a61a1cd28520d1492c79bb193ac3ae45905 t/20-modules/Type-Tiny-Enum/exporter.t SHA256 4e52c1b33b72cf26ae3a097ed86af85d401e39017faa58bae5a4c94d7c60dce4 t/20-modules/Type-Tiny-Enum/exporter_lexical.t SHA256 97bd680145a845f921c2ae56dd0a8382491b38438fd61f2af45ebda8d7f45fa7 t/20-modules/Type-Tiny-Enum/sorter.t SHA256 962cd478485810296b641ac4b1b2427a6a70b96f618313a47ce1949acde9112f t/20-modules/Type-Tiny-Enum/union_intersection.t SHA256 6d62c843727f3a48db904b9a64ef6da294063bd7769bc14b8a7b790a8ea9f64a t/20-modules/Type-Tiny-Intersection/basic.t SHA256 4cc30f0192370175efdae09e6fd65ee340de39ba142b854854547769b14cda7c t/20-modules/Type-Tiny-Intersection/cmp.t SHA256 547e09f3161f83e8438c5f43b765797f3b65d8a5491403fdd02ab87213ecfcc3 t/20-modules/Type-Tiny-Intersection/constrainedobject.t SHA256 7987fedf76afce54bf052730034629944f584ae778ed9fb49539990ade09ac43 t/20-modules/Type-Tiny-Intersection/errors.t SHA256 4571d104e9952747ca0266ca585c50c477816a7ff73335b5af4072cf925051e1 t/20-modules/Type-Tiny-Role/basic.t SHA256 6dd542007fe0792de5a38cbfeb93d7f30ae872fdcf1209411e55b3a1a5280f9e t/20-modules/Type-Tiny-Role/errors.t SHA256 2eccf3f6179b0215b7fa17bdf5216576b4034d29ba5393e617131228b8c5cfaf t/20-modules/Type-Tiny-Role/exporter.t SHA256 51041ea9f09ca6568a095db3adcef2676b0eae342a123a6043d29a783a5f0f40 t/20-modules/Type-Tiny-Union/basic.t SHA256 9724e9455f373ffdfcd61dc224f823788d0266be1b2088ad3eebf68e995d9b03 t/20-modules/Type-Tiny-Union/constrainedobject.t SHA256 5712511195167772378281bebce434cfe1364cbce5a0a9f06b78e1db5af66aa0 t/20-modules/Type-Tiny-Union/errors.t SHA256 289fd9f2ff7fafcb5e62e7224ad7c8ba17acb121b70538f0a56199332713a1f0 t/20-modules/Type-Tiny-Union/relationships.t SHA256 064b8fabbd166a6514725a5d033f0f8228f718772e37fa88d1982a20c154d3b7 t/20-modules/Type-Tiny-_HalfOp/double-union.t SHA256 eca25f31de9118b2dcb2e2009c69e655d5edde93de3e8f0c13de5b7bb3bf6263 t/20-modules/Type-Tiny-_HalfOp/extra-params.t SHA256 6619c55a4e6de62b44735619d8e3f4216fc682e7d042e6913af8f8c5fc48bb99 t/20-modules/Type-Tiny-_HalfOp/overload-precedence.t SHA256 86a56e97a64d6d44208711339a7b3224b4ada43dc081f3a381850c7bfe469aaf t/20-modules/Type-Tiny/arithmetic.t SHA256 ce7b4cc41fc0616c6e97d5af81ad994032898775077e31ab9f85f8ef52d21caf t/20-modules/Type-Tiny/basic.t SHA256 e3658ba8f0a0dc9f920ff2de0d1bb3ed0a3c4a1a61a82007c08cacc213b52ab3 t/20-modules/Type-Tiny/cmp.t SHA256 ae5527360f62bff4767551845015f876a27aaefffacadd3689f689b3a9cb90e6 t/20-modules/Type-Tiny/coercion-modifiers.t SHA256 15da3a8f711e2c587033cb53ecd37322264a1c569c4354a7e0a45f48a81aed55 t/20-modules/Type-Tiny/constraint-strings.t SHA256 689973e8247acb1068e094fd70a4f2e9a66c50083ff1ea225d35d070ab95039f t/20-modules/Type-Tiny/custom-exception-classes.t SHA256 16b126d5651c824b4eeab9da694ed58aaf6fb075e45c950391f8f375beb25693 t/20-modules/Type-Tiny/definition-context.t SHA256 b693d80b47fe0f90d82f4682738309196400c748fa7a3978ecd90bc23a5396c7 t/20-modules/Type-Tiny/deprecation.t SHA256 13c413fa48de7834dc7806a9f4bee88ff52f7aa95bba90d6007308d7cdd0cd0f t/20-modules/Type-Tiny/esoteric.t SHA256 36b596ad06d35752f7346e7a74bb378f9ca5a2db4a825a8e24fcafab082ec382 t/20-modules/Type-Tiny/inline-assert.t SHA256 829c9202b6c1c007376ee47d83b53830736b59bf70e1db4f60a9b836e9ca33ba t/20-modules/Type-Tiny/list-methods.t SHA256 316a36a62ee39da81d408ce6a869dfd57d4c0138f493ae6bd6d388122c2bace3 t/20-modules/Type-Tiny/my-methods.t SHA256 33c4964cabddd40ef2c5c36ac6997426c6f35727d6ce00fc40ab94ecd93b5446 t/20-modules/Type-Tiny/parameterization.t SHA256 7cecea60694abd226ba0f85d9aa652f70ac31272daa517b0391419040536ef62 t/20-modules/Type-Tiny/refcount.t SHA256 14299dff172a5af12c2f6b5641fe6097b5653c29c6c4295ed9d1ad285a5baf45 t/20-modules/Type-Tiny/shortcuts.t SHA256 c96c80db149e887a8c7fad18a08885c66df54b387268ca7eeb18da32961385c0 t/20-modules/Type-Tiny/smartmatch.t SHA256 8496a912aef327156925a629f44dc53798447eb0df0177ee456d32c1ef17c386 t/20-modules/Type-Tiny/strictmode-off.t SHA256 eb074817d2d2a3fc1eefaacf59dcb5307a7bc685b021675674a76ffa2efd146a t/20-modules/Type-Tiny/strictmode-on.t SHA256 6415abb076d6bd6d9f0934931f5b8202dcedaa61aa2041bc9a11e0d3b287a007 t/20-modules/Type-Tiny/syntax.t SHA256 31daa92c7ba96c2d1ac4fe30a75440553bbe5f53405239880c9a9ec301e340a6 t/20-modules/Type-Tiny/to-moose.t SHA256 9db4e95fb46cc7b03de5925694270d74a9f0433b5c1adef7c81f67a58e1070fb t/20-modules/Type-Tiny/to-mouse.t SHA256 ed77f877e9b0f335d331b56a568a26e5280cb510e8e9a840e7c5ddaf654907e9 t/20-modules/Type-Tiny/type_default.t SHA256 8a7a087acbb434f62a41ee1e69daa41f97a224f44740abb8a480f94d93b6804d t/20-modules/Type-Utils/auto-registry.t SHA256 b77770a52663f7f3d96f97b8717dd7c44fcca27c69a21e5eea519adf3fabd0cc t/20-modules/Type-Utils/classifier.t SHA256 46fc750f48481a793c9e56baab9ec15ecf593133543d0c8ee9858b92a851c80f t/20-modules/Type-Utils/dwim-both.t SHA256 cdb0a607e819b6b7db7519ab735a2b88ee22da5049a435900f54f18e9fb42ea3 t/20-modules/Type-Utils/dwim-moose.t SHA256 dedf0103c6dc40398cad428d8204735566aa62f7aad4db7bb96e8eb44e40f40f t/20-modules/Type-Utils/dwim-mouse.t SHA256 db180a28913be533dbec52e985dea31a8480af8fbfe7453dbfa2f897a2eba50b t/20-modules/Type-Utils/is.t SHA256 5de87522458d07f8887d0be7551d6f61fdacab1f605c119ab9a78ba5b1f12e6b t/20-modules/Type-Utils/match-on-type.t SHA256 a835a803cbf52037a312074fc4a0cef89a58aec93b7a33ba5c71cf33f3db8f15 t/20-modules/Type-Utils/warnings.t SHA256 6f44de7e2ada78400a0702ccc64a54691f900cde796280059309b6560c84661e t/20-modules/Types-Common-Numeric/basic.t SHA256 e0d705fe1776234d00ff32614628e1ec6c276be8a09ec41a4a5be6306abbb2f2 t/20-modules/Types-Common-Numeric/immutable.t SHA256 a23792ce541d12d3d36a4575a7fd47a14a57f6f53c03fc4ebba7e3d75f5ebbbb t/20-modules/Types-Common-Numeric/ranges.t SHA256 04eb1645608be65efbf1c23dd856c095ce01e5be78e0f612bd939b61f430d0a8 t/20-modules/Types-Common-String/basic.t SHA256 771efb1fb5698470d6eeb0a995456b817206a91a0081cc000c2d4c96982963db t/20-modules/Types-Common-String/coerce.t SHA256 6a21f591b85b6624ff887fd0073ba31f5ebf3b81a279a3d6e1c334ddfd097b5e t/20-modules/Types-Common-String/immutable.t SHA256 99eee3345d21ec475826f2042c004b70688adca13bf2ab05f129626450be8baa t/20-modules/Types-Common-String/strlength.t SHA256 1400f06d1a61da833c709c4cacc19b011b961099336aec45b45e90760f3e470d t/20-modules/Types-Common-String/unicode.t SHA256 d2f23ef4e168f318f0950567526a077e904f5027df018d4452697ae9b7a1259f t/20-modules/Types-Common/basic.t SHA256 1a558ad6f2e7e6c856db4f7fac911253eb4af5cdc98598f2aba91758ef337cb9 t/20-modules/Types-Common/immutable.t SHA256 36713f211a3023b517033a1586efd665341869254ddbaee2e44b7697132962be t/20-modules/Types-Standard/arrayreflength.t SHA256 ea0de9976c652b4f83610ddfb6d09fc0aa4f03cc5aa42ab710ff9a1437d04d83 t/20-modules/Types-Standard/basic.t SHA256 855da8ae3eaf0417a1bab77050dfccbc3734beba287e69b40f7bc8533e31d86c t/20-modules/Types-Standard/cycletuple.t SHA256 c444c3b9994a238679fc1e309e99f6e487672813b586d7187ebdb693e95a1b79 t/20-modules/Types-Standard/deep-coercions.t SHA256 c65eb774ddc49d3ef3e056bb9e2f233f2eadd824884b7df13fa5e66819ea7576 t/20-modules/Types-Standard/filehandle.t SHA256 22c0713becfe371d43af6931d00c16f9eadaf1a8a28a30ff8f122ba1066206cc t/20-modules/Types-Standard/immutable.t SHA256 818b9fc99e2c50b45fa13ef6359f8f7e175d9916e5173aef672da8e2977d4f14 t/20-modules/Types-Standard/lockdown.t SHA256 191fbbc17d419ede3c40dfc9df9326d7a27fa27eb98373d16a3c3ecd201de6b0 t/20-modules/Types-Standard/mxtmlb-alike.t SHA256 398681b5b9b49326b93ae55a46a4b48c34c8c529a4d91df2796a48d68f7997f1 t/20-modules/Types-Standard/optlist.t SHA256 4c86314f345b5139e658015bd437d1d515a656fcf1a88393dc66e28ed0af6f10 t/20-modules/Types-Standard/overload.t SHA256 334038af7a50f344ba6061a9ac80c61281c6ab6a8e57f3ca3e290b77347da906 t/20-modules/Types-Standard/strmatch-allow-callbacks.t SHA256 f48f917e040c0d346f8295ae02540fe33c3a4b8340f97990f1ec4901454e07be t/20-modules/Types-Standard/strmatch-avoid-callbacks.t SHA256 c2b7fd88ecb21a1fae028c7d36f904aa1b3b589c017d7e00d4c1dcbefb371ddb t/20-modules/Types-Standard/strmatch.t SHA256 99492f6965b85e61c2171045999d581531a8deb5bc3944de089a9e64557b7f20 t/20-modules/Types-Standard/structured.t SHA256 16067edbe6f081346f52d741e4cb9d91915f23fc02792a8c20c34c14bacc0312 t/20-modules/Types-Standard/tied.t SHA256 ffb89b0f1c47046796e7f543fd5adcc387ba51e7a462be9c1b74e1d0d1825f91 t/20-modules/Types-TypeTiny/basic.t SHA256 15a06c7221ccf62ed499579046bd66060aae59803f8593a3913f08689739a7f4 t/20-modules/Types-TypeTiny/coercion.t SHA256 2654796ce6c4a90fadfb46c27dcd8b0eaa5a6591d5ef6747094824b89a68bc28 t/20-modules/Types-TypeTiny/meta.t SHA256 09284594b473ca91f08bb17af87664e36a41a93d06cff55b22696d667a8a3e0c t/20-modules/Types-TypeTiny/moosemouse.t SHA256 a370cd0cc9c85ba501bd9f33a472f04987e438dc791d92b0f9faa9362aae42e8 t/20-modules/Types-TypeTiny/progressiveexporter.t SHA256 af074e5e5a945246e6216ddb4630c703dfac725301616f3267bd0b8a73ce0503 t/20-modules/Types-TypeTiny/type-puny.t SHA256 3432e350a7361e961796d1b307d36c113f2fa114dce7d9c496b469e5acbfc6fe t/21-types/Any.t SHA256 3de30671b93b87a1f05622b9a04728f6579e87bc945936f7863dd6f913599d3a t/21-types/ArrayLike.t SHA256 d8709118584ccb2427e500d4eee23b1bc2026bba8263dd934b697f65e8b10c4c t/21-types/ArrayRef.t SHA256 e4eeb3c31cb1f84824301fc819e0383a5aa24e851c18d96dd93b4cb1b42792a1 t/21-types/Bool.t SHA256 4d6baff851923c58a3deb01765695fbcfbbc9f5660a3a8cfbabd31d3307e6076 t/21-types/BoolLike.t SHA256 acf353c5e7bae238139d7bd179afd7a872674f077255fe0b50fd46c67fe29d86 t/21-types/ClassName.t SHA256 f0170e80edab3f61efa03aa70b4d29812657afe16fbff904e18e034f42be66cf t/21-types/CodeLike.t SHA256 7845f4139392480637aee0d193d7a809cba069f8e2edb8ef08342a9c46f41d8e t/21-types/CodeRef.t SHA256 63d95a1a0aadac387d7e568f1a857d0c5e8180844a94a4b24d01fe1d257e82f5 t/21-types/ConsumerOf.t SHA256 1d81945f21bfc3df578b74834cd266e2e35db8649b352b6871282bf1bcebbd9b t/21-types/CycleTuple.t SHA256 a2445b2bf58dcab8d4c075bac0c32b377e5906ef56dff4243c3b93a4c0702f10 t/21-types/Defined.t SHA256 267ff20786573262759c2f819d07dff727cdb7fddfaf840e740ed3736534cd6a t/21-types/DelimitedStr.t SHA256 1e0ed1a9a8ac50a3af9cbdfb4b6c003622c7e7e6184cb32ca89a45dea749b3c3 t/21-types/Dict.t SHA256 838b228f718d4cadd3e66c646e3ec4ce8daa577a5b77ea14a334c1ac9ac9f12e t/21-types/Enum.t SHA256 0fbbb2dec49267d587d4e7a25539ccfac57b349a95cd7ecf9eb24c9072b1df97 t/21-types/FileHandle.t SHA256 531496d70133d67693911051b379548ed630a4b62049b6bd298a67b806613ce3 t/21-types/GlobRef.t SHA256 78f08eb6bd3d174480c945bb942b4337dd3ff0a6e869881d11cb66f7abdaeb5d t/21-types/HasMethods.t SHA256 e8eb49ffce37709155bc4d619f7040c8409f105f459bff61c35448f45a7adea7 t/21-types/HashLike.t SHA256 30cc92dc6f3ae60ca56199a9ded77997ff995d732dd0a2daf6525a8bf546c9f6 t/21-types/HashRef.t SHA256 eada91481c34c469bfbaf7837a06f11a4dc1a66d92e556b5eb3879dcb10734fd t/21-types/InstanceOf.t SHA256 ae4225025e5d8aece798fb9ec2ac1bca86ec8f7587b204513877c72fb139edf6 t/21-types/Int.t SHA256 5bad4b79c91fc45f0810729b436985d5eeabc8896bc6d90d96f72e87e24ab0a8 t/21-types/IntRange.t SHA256 020ad5dc24d7b495c0f1a73c796eddab8a714b0233ce886fb8aad715ab7dd006 t/21-types/Item.t SHA256 27a114f36100c7cf9b4fb6b46b12718b3aba0c0affedbc75453de776e0df212b t/21-types/LaxNum.t SHA256 36740ea60ca4697cbcae4ebf48db04be720339dccdfdabf384fd05420382d411 t/21-types/LowerCaseSimpleStr.t SHA256 90257230f3f59a3a4085be241c9c71bbfabc7c1d72a01f76d61f9179844708e6 t/21-types/LowerCaseStr.t SHA256 3dd865e34dc6dfb5ca7e7181832700e376b727fe5613d157bd14b6ca8f86551b t/21-types/Map.t SHA256 a6babd167ae5635d4f759dc4e50dec6919462c3e24cbdc32e6cf2db724dc55cf t/21-types/Maybe.t SHA256 6fdc3958d238d90852c1a43120c559c2bed1f3fbe2395001e77551771570b9e6 t/21-types/NegativeInt.t SHA256 4d9d63f1aaf11a5e83c09bc73fc67cd4deeba7bea0edc15ba0bda6ee0cb13882 t/21-types/NegativeNum.t SHA256 97ae47b7d24ff9297dd996a29e17bf7916fa5925c425faecd69210cce67f89e4 t/21-types/NegativeOrZeroInt.t SHA256 fa51f3aa6503205284413d597cce11e55ec8ab712283116b7b9378f197b65c75 t/21-types/NegativeOrZeroNum.t SHA256 d6c0f4ae83fe6a5a5d01b03c40d664d62d0d021f53e2e07cfaba79678be2479e t/21-types/NonEmptySimpleStr.t SHA256 9a3f801dc784ed64fb34aecd5d9297cafc9d2c784b359d4e103c9b84740336dc t/21-types/NonEmptyStr.t SHA256 0fffd4e7b2a823ee2e68b4cfc4ef0b9c8ae5797e0f141fa2018b550bbbd79ca5 t/21-types/Num.t SHA256 8011b71fce4dc9fb3df57b69bb516ea7b587a68a27232f93f697edc72c2a10e8 t/21-types/NumRange.t SHA256 9b22638ea27a2e74cbc148e6bc8774ec15553bd919090b041e45b94815cdfa92 t/21-types/NumericCode.t SHA256 7f20acc91878c012d39c9411cfb03d833ece93d17add718c1961726ba35a2892 t/21-types/Object.t SHA256 b114b51886278de43bba9b983d61d7ffc3fab9e8666ac200a9c49a12ece30285 t/21-types/OptList.t SHA256 7209027cde737c81d66a99f3b2d06a25f58c458856636174bb6a2cef0c87d574 t/21-types/Optional.t SHA256 17f7b994d4777e7734d8ccafc41f7df9407f6e3b026ef40d49c03ee161e26869 t/21-types/Overload.t SHA256 a8bc9b04879130aed306541783c813f5c95dd19c0b5d20bf61359b8cdd9bd1ba t/21-types/Password.t SHA256 2d56eee5de419f86e2dc1da7a8348046963ba4ae6e558e4d49049711ac016d0c t/21-types/PositiveInt.t SHA256 d439243b4167725915c9e8a0a217ee4ee895d20a2166db412c315b37ddbe9ed8 t/21-types/PositiveNum.t SHA256 bc3221fddb04fab6130ae68e6e3e48d88107c87ae6fbb0ab276e2c3fccb8d372 t/21-types/PositiveOrZeroInt.t SHA256 8ccbeec03c95a86cecce9f324f9626a13769c576af115ba7b572629f0fbf65b6 t/21-types/PositiveOrZeroNum.t SHA256 6ac53b2fd9cfb1948186dc27c06bc5234565abc25665a8f7217efac4837cbc64 t/21-types/Ref.t SHA256 9ba47466d8ca14df5c8ce21cb626d5ee8866f26f5bb6bc1fe1ee10d7b8c66516 t/21-types/RegexpRef.t SHA256 ccb365fbdc85cd9dcfaa074b3e3332bc9e2d3f0fb16db7cdbe7a5bfe37177f45 t/21-types/RoleName.t SHA256 0b0971704ad80c3c424b2aac7e18581fdb33251e8efbe8b4a868559bbf72c312 t/21-types/ScalarRef.t SHA256 4567fe5184f2a495fc8157a29a4b5400708ac565fa31393083ff2296d99a9774 t/21-types/SimpleStr.t SHA256 ea25f3297b42d675ceccc3ad0efd292427843729a193f11ae5bf9cf6f35b9445 t/21-types/SingleDigit.t SHA256 79f8bcb4553461671f7c52e156e3f62bd35c901edbfa3ea7362701346ff4c792 t/21-types/Slurpy.t SHA256 dae03c5109f14e73cb80702f31811f315aa64244d1ecb62e50f1eb7382ef0ee4 t/21-types/Str.t SHA256 4e9f54436907b1da78f9d1b2e6d2686e816ab248b97cc42297a333abcc9254af t/21-types/StrLength.t SHA256 a8a2045048d9a5e29249839f0e5b6b0efee997381d524b958616df437017910e t/21-types/StrMatch-more.t SHA256 773c681bbcb749db8f776e3c2e6da9930d91b0830ec2cff97bea26331747543b t/21-types/StrMatch.t SHA256 d5f032038c60ad735d8dd8c29ad282f035164794ea15f27f7f4711f8ac3324bf t/21-types/StrictNum.t SHA256 80fdff2559db9d10d1c327591aab529161af84f89022f92e8882e87b76c617af t/21-types/StringLike.t SHA256 be4c68f56729483f2960e96a19502c1468bec487f42653a9f4c03840bec6353f t/21-types/StrongPassword.t SHA256 92f0b2ee8ee34cbdf105ec691046b6a1eccc1ab33012faebfd207398908c1a7a t/21-types/Tied.t SHA256 66a7bc5d3e77a3ae18ed06bd42a231cf40313b98efbb2ce86bea8e61f65e180e t/21-types/Tuple.t SHA256 e8a062fbd948dab6a333b4dcd944788edbef432bf077b8e3cab11e834a2f4fd7 t/21-types/TypeTiny.t SHA256 f579fc2613b21732a0cf02fe13701a924e591ae10c89bd910f13845caf48c90e t/21-types/Undef.t SHA256 58ddc3ec449239908d51b6e753798895fde2759d7bbc6272f5069c7bf29ca3e6 t/21-types/UpperCaseSimpleStr.t SHA256 b76ca768d9578ee89a53e03b84fc7a81b95d265396b741e4cab2fa823f32790c t/21-types/UpperCaseStr.t SHA256 721666f1d2eb8e82fb4a46e899cc2f49f93571a6d632cd8421bafcf8adf9520a t/21-types/Value.t SHA256 8b85f6f57fa4875932f8e730889aaa6a2eee805cc8ebcd2e09e59778e3b99e25 t/21-types/_ForeignTypeConstraint.t SHA256 20ccd76f4e6b7522f9b44763441fd2a8e0a18caaad9cd5011b16fec05aa0ba5b t/30-external/Class-InsideOut/basic.t SHA256 3d46bcbe9b5aa5952e50264fe2a7b20dd38c0b28dca2936d2d69b518e1eb56e5 t/30-external/Class-Plain/basic.t SHA256 8de1347a8fda60cf4a6ffdbea46f4e04f49efe66a577896b708f5f5da14fc66a t/30-external/Class-Plain/multisig.t SHA256 0130d24e906a9bfe509f32f1b3b7b5eaf06d1371cdd2b38062509a28921f7681 t/30-external/Data-Constraint/basic.t SHA256 cf14f7db98bbe8a21750bd82ad5f81e471c51bd435d3176cb38a54dac5b57d4a t/30-external/Exporter-Tiny/basic.t SHA256 248582d118492969bcb875aaf2291f41da4e42778480c5071591cf889d20d28f t/30-external/Exporter-Tiny/installer.t SHA256 bd772513a95743e5beafe2ff3c2fc040c7073634e3d437cf740a90a6ee8b6f80 t/30-external/Exporter-Tiny/role-conflict.t SHA256 674ce8b4fc2b32569bfa528d2cf34c6aa8b66cc45994fc3e2fd3caa82a026eec t/30-external/Function-Parameters/basic.t SHA256 fdabea368223e3d3d2989b3d8dc9ea7988e5d056f82dafd9780786340dd28a6f t/30-external/JSON-PP/basic.t SHA256 6c8ab66b2185b5ec92fbeba09e32c05261fa2d54bb23c1b322b904ad9beba79e t/30-external/Kavorka/80returntype.t SHA256 e4fe09b829268dd48e275ee2b0a1c0d536b923afce744df9c356fe6dd8e8870e t/30-external/Kavorka/basic.t SHA256 1a14be9b6ef55ad39878b0746c2228c973a5ac36ee7ebc078302a4f998a094e4 t/30-external/Moo/basic.t SHA256 507d3ca98b50b9fa00dc0adf3ce03b69a1230f7f749f728ca3f6ed286120be4b t/30-external/Moo/coercion-inlining-avoidance.t SHA256 8c892b2d202c031aca4f06f6ac0d7fc3b32479b1d2c5ccdb917695e7596c770a t/30-external/Moo/coercion.t SHA256 e6f1591d8fbffefd7c11c5cf8f53a5c34633ec471ac4eac1fbb45e89ae0598ce t/30-external/Moo/exceptions.t SHA256 e9a3c37341cf6a9210f0c42956ad9ef5c2ff46667efd9e407d64f7e6de17b4e1 t/30-external/Moo/inflation.t SHA256 443ba9d0259927c82ec038c5e4b4fd43596ec87ef5ba62d9ff2664acdac1366d t/30-external/Moo/inflation2.t SHA256 3c4862243c7edd9b59e23cf2aeb7d65db676ad2b058716ec3f1368b03f7a6203 t/30-external/Moops/basic.t SHA256 0650818750ea2b132bd9778b1e4125cf188c0c95557e37c0be6033b1f41a9d52 t/30-external/Moops/library-keyword.t SHA256 ad2cd582c25a7421cb481233c9031f1389c689d0538e31324163f0265cb6d095 t/30-external/Moose/accept-moose-types.t SHA256 1517b51b3c1851cde4dc440b4f2094958c5ce96a3ba8309f5244598e889513d6 t/30-external/Moose/basic.t SHA256 e8c9279aa9ae74123d37eb3dd16eb837cc11c7f71d1a300ef3aa43255b63be2a t/30-external/Moose/coercion-more.t SHA256 87ee54e75789c140cd6bb03842a370b8fa0d790ece2215f1cab58690426de4cd t/30-external/Moose/coercion.t SHA256 6d622db6194b604366925614f93817c1072efdf64f8c4a254f5a3a7d4c62a577 t/30-external/Moose/inflate-then-inline.t SHA256 4845c6ba2deda2a162d7c2f6434ac5b1ab911adcf0a051bc3a445832b5517424 t/30-external/Moose/native-attribute-traits.t SHA256 535e4e1d374f573d7bb98095b3a7da0eb7bb9ae864d123a4940e7f62852fda94 t/30-external/Moose/parameterized.t SHA256 f617b3e5209faa1077e44cc6770936b1d12b825d5530934904f83c0109c4c413 t/30-external/MooseX-Getopt/coercion.t SHA256 72f45c9f6d890dbfee2ec51021ae6814a5d85caeecd7fb8f839329a49088986a t/30-external/MooseX-Types/basic.t SHA256 965c6cd2b7b49dc6c201d345900df03e70865021e2eb77d62c0dc7a980d07075 t/30-external/MooseX-Types/extending.t SHA256 a7dc17410b6df1f7ea61e5725255e70a1befe2a0bb6bf7aa0f66e4009517d01a t/30-external/MooseX-Types/more.t SHA256 e841412d398cd5afb560707b911beabb1d62e546b5030a33ab8a3e8d5e519c24 t/30-external/Mouse/basic.t SHA256 676c9077ceb1495047ff14597a4e06314153194ac4d4a7a3fd7cab965e250b29 t/30-external/Mouse/coercion.t SHA256 9f212455084f58d189e541552f4d3af950292bfcf354b4b1a12173512ad180f1 t/30-external/Mouse/parameterized.t SHA256 76dd77e6e7d7c0ff3ea5f7a04d2d43fd53cd35889eb89641a5909f0fee469cdd t/30-external/MouseX-Types/basic.t SHA256 60c8d3343ae4b3735b4c73be59aad52eb3d76ba83f0bcbde503bb3a5357559fb t/30-external/MouseX-Types/extending.t SHA256 69c8413f33e0899835c1d2533d83f71ba5b3cbffa0778aae18d992742edcb0cc t/30-external/Object-Accessor/basic.t SHA256 faf01412b68246ec3a135a61936b348d0e0290f078e2be4e63bd71ec7a0bfe86 t/30-external/Return-Type/basic.t SHA256 5a39214515c296ea75f13f1ecdf8c3029561337c7c3c5dec4615e12e7bffbb82 t/30-external/Specio/basic.t SHA256 3d1ee11e3f5955856e6e98b4764ab6029b1759371ded39b8d38eefaa034b2d07 t/30-external/Specio/library.t SHA256 1f3a7c0f700631df4693833ac47b2e240a0e2b61c7d5d313780f407a462dbb4c t/30-external/Sub-Quote/basic.t SHA256 d7666e09f5591488babc1ce74559c1dc55e138b8a61c933148bb507bf9a00fea t/30-external/Sub-Quote/delayed-quoting.t SHA256 ac6f98503e6fbd7d0436f1d02d7d06a5236e3dabd7ca855a752300e9893eeb9b t/30-external/Sub-Quote/unquote-coercions.t SHA256 17d49ea0e9c1552e47d740db6ea00450e9bd755b0ab61d40b88cd8806b5b98ea t/30-external/Sub-Quote/unquote-constraints.t SHA256 07e064a8e9046089cc11fd6dbae51843ab404185bba10e6e864a5e4522f49ef6 t/30-external/Switcheroo/basic.t SHA256 9cc26118e3f8064f1f30f0f682204719b25c2039aa8ae3c2eed9fbc5129dc2d6 t/30-external/Type-Library-Compiler/basic.t SHA256 e55c02f9411358020fe2637745c32328f2beb52c548312f96fc034e13cfc26a1 t/30-external/Types-ReadOnly/basic.t SHA256 d12020237830fee6ad0e4f2e9a57d308d2919523f73ab721ca98fd85ee28f611 t/30-external/Validation-Class-Simple/archaic.t SHA256 7e775f047565e613c7dfac84e4fe1c2f6978d8d55d0cf7fcc5268694323781df t/30-external/Validation-Class-Simple/basic.t SHA256 e5a969bc228ab0a2df0c867fdd5a969949c44c9f97999e30d0688276ad910b05 t/30-external/match-simple/basic.t SHA256 a4f5185b66a6234623cf307bae17fd925cb450a00682493baea49877f3c76c78 t/40-bugs/73f51e2d.pl SHA256 d6b799b976f63b42945fa933b39507274f43d17721fe981b2a883feb8cc85787 t/40-bugs/73f51e2d.t SHA256 0058123c6559e3537b1b6c1c9559060beb2244223c68cd7ee843384143f05112 t/40-bugs/gh1.t SHA256 a4ead54498c5b3585c32285238fdc34e20b2b29d682c22bf7732e579fa04e273 t/40-bugs/gh14.t SHA256 f3d550e68179e441f41bb1aca6aa26d2d0f6a15b6ffea0c7b9738209be9e2975 t/40-bugs/gh80.t SHA256 c6db3e84cdf13460f51c5d70f234c5c76eaaa424636bf6754f7e4575753dbaf0 t/40-bugs/gh96.t SHA256 4a07145742663ec54d18e7d071d755dc88c92496eca9c706cd6666f2dd198f0d t/40-bugs/rt102748.t SHA256 f71da82082970258df46f40b9f878fd5666d2af1e572257bf8d4a0d25aa07590 t/40-bugs/rt104154.t SHA256 7cefb6e194bd4cf3b1c73610fb0964cd502cc2d74e7135ecba5e7244fb837266 t/40-bugs/rt121763.t SHA256 c0c002532a2fe71c20acc52d608def20b35077f392481cc6b7bbeee7519f1001 t/40-bugs/rt125132.t SHA256 8f01bcf523035c60dc9a237383c183a86463f25f9b2639a3a87f0dd599ccbede t/40-bugs/rt125765.t SHA256 6d3796fd8ed0bc16f5af388b3070a5550f0f4ca6d4740711c45550d2d9008ee8 t/40-bugs/rt129729.t SHA256 bb66bfd985b214d79c72595531775cde39384847ac918a800b32172bc2d2c438 t/40-bugs/rt130823.t SHA256 1f30392367b97af1c8b6be6a56da9de6b301d2416831f660520bc3f151a6709a t/40-bugs/rt131401.t SHA256 c27e5c56b093277d388ab17dff30b338273bdf26dbbc629c7589065d9442cec7 t/40-bugs/rt131576.t SHA256 5dc6b1f507815f42f7f0f77a45115d05c4a2b1fbf4dc43074beb7007ac6fc74b t/40-bugs/rt133141.t SHA256 d7b7ee927302c52d1ec573e0b8d31be4d403a700c5d09af919025b9b89bef426 t/40-bugs/rt85911.t SHA256 f965e28ba9335cfb3d853f63f646e282c36e417cc2f5ba533ff663b446f3cecb t/40-bugs/rt86004.t SHA256 1f225e8911a70b907af63e2855aa4654c846c97085fbd5f58864fe15834605b9 t/40-bugs/rt86233.t SHA256 1f88d028410d7268d60dab5570c6997083e4bdfd3a21a24d12097c853727fec4 t/40-bugs/rt86239.t SHA256 1393700591a98a80b92270fd2aa8709e90e5ef4cf9ff27facaa4b57bc9b4466d t/40-bugs/rt90096-2.t SHA256 e625595a89274de42a93b38244183b1ce67da39492d69b351e46be30d8ed6e26 t/40-bugs/rt90096.t SHA256 7a09e35eae31abf9865ab412fb57d64a22a58149c7b4af1590272ad6afea3c3b t/40-bugs/rt92571-2.t SHA256 bce22ac09c74bd0387d5ea00d9a14f268c5ceee940f155eb559545b07fd6f562 t/40-bugs/rt92571.t SHA256 f1b272b534785ca876630bae7bd451aaa82f0839669ff14a8a2cfd752f341202 t/40-bugs/rt92591.t SHA256 31e037d52e82a73332b49b91d2aa4d500b9aa075953022fb029f843434019402 t/40-bugs/rt94196.t SHA256 0e111968cd716e4d87b597378eb746e397728bb854c60f713f0e3b0af3da636c t/40-bugs/rt97684.t SHA256 d46058308d33e6fff1995730b1d4164b43c300379066b47d18eb1a2c4cee0e00 t/40-bugs/rt98113.t SHA256 5934caca6e5c8029caa705ca42e486e7f923f4f82e532e42ba91a58d71bdedb4 t/40-bugs/ttxs-gh1.t SHA256 097ff161108fb941f972153957ad7d44f3b28dc43693ac43e79333e4ee531366 t/98-param-eg-from-docs.t SHA256 a91dfb05b1b84874beab03dcd781e09518b58c65dc7b530880452797cba9dc62 t/99-moose-std-types-test.t SHA256 7f662474dac5012f3a5414d996071602da277818fdc5782fbc79bfa70e548dae t/README SHA256 118043d0c560930ef1831126e175dc791261cfbf0b9b7fb08748bdb6d76731d0 t/lib/BiggerLib.pm SHA256 f55bd05d028bb0dd2e0d45304c3f521c85d9be1e785b2c788be3d9698660f786 t/lib/CompiledLib.pm SHA256 bb6a2b8ae6a06ff84608f91baac5ea9e17c804ad6ffeadb30da2e59349f2a693 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+s6z4WzNujOv4Eoaip9OQUCZC0+pgAKCRDOv4Eoaip9 OfqwAKCHkCgYcSM/zh3VT3KQ3GHj3c8vXACcDa3CXoa80a53R7FCpLjVHg5/oR8= =Ys68 -----END PGP SIGNATURE----- dist.ini000664001750001750 16214413237246 14031 0ustar00taitai000000000000Type-Tiny-2.004000;; class = 'Dist::Inkt::Profile::TOBYINK' ;; name = 'Type-Tiny' ;; source_for_readme = 'lib/Type/Tiny/Manual.pod' doap.ttl000664001750001750 125125614413237246 14152 0ustar00taitai000000000000Type-Tiny-2.004000@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: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 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 "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 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 "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 "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:mbox ; foaf:name "David Steinbrunner". 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 "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: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". [] 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/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". _:B11 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 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 "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' 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 '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 "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 "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 "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 "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 "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"; ]; ], [ 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"; ]; ]; 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 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"; ]; ], [ 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"; ]; ]; nfo:fileName "lib/Type/Tie.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 "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::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 directy, 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::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". _:B12 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Class-InsideOut/basic.t". _:B13 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Data-Constraint/basic.t". _:B14 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/basic.t". _:B15 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/installer.t". _:B16 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Exporter-Tiny/role-conflict.t". _:B17 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Function-Parameters/basic.t". _:B18 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Kavorka/80returntype.t". _:B19 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Kavorka/basic.t". _:B20 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/basic.t". _:B21 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/coercion-inlining-avoidance.t". _:B22 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/coercion.t". _:B23 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/exceptions.t". _:B24 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/inflation.t". _:B25 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moo/inflation2.t". _:B26 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moops/basic.t". _:B27 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moops/library-keyword.t". _:B28 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/accept-moose-types.t". _:B29 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/basic.t". _:B30 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/coercion-more.t". _:B31 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/coercion.t". _:B32 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/inflate-then-inline.t". _:B33 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/native-attribute-traits.t". _:B34 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Moose/parameterized.t". _:B35 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Getopt/coercion.t". _:B36 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/basic.t". _:B37 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/extending.t". _:B38 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MooseX-Types/more.t". _:B39 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/basic.t". _:B40 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/coercion.t". _:B41 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Mouse/parameterized.t". _:B42 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MouseX-Types/basic.t". _:B43 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/MouseX-Types/extending.t". _:B44 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Object-Accessor/basic.t". _:B45 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Return-Type/basic.t". _:B46 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Specio/basic.t". _:B47 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Specio/library.t". _:B48 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/basic.t". _:B49 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/delayed-quoting.t". _:B50 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/unquote-coercions.t". _:B51 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Sub-Quote/unquote-constraints.t". _:B52 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Switcheroo/basic.t". _:B53 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Type-Library-Compiler/basic.t". _:B54 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Types-ReadOnly/basic.t". _:B55 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Validation-Class-Simple/archaic.t". _:B56 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/Validation-Class-Simple/basic.t". _:B57 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/30-external/match-simple/basic.t". _:B58 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/73f51e2d.t". _:B59 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/40-bugs/ttxs-gh1.t". _:B60 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/00-begin.t". _:B61 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/01-compile.t". _:B62 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/02-api.t". _:B63 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/03-leak.t". _:B64 a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/98-param-eg-from-docs.t". _:B65 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 [ a nfo:FileDataObject, nfo:SourceCode; nfo:fileName "t/20-modules/Type-Coercion/smartmatch.t"; ]; ], [ a doap-tests:AutomatedTest; doap-tests:purpose "Checks proper Type::Coercion objects are automatically created by the Type::Tiny constructor."; doap-tests:test_script _:B11; ]; nfo:fileName "lib/Type/Coercion.pm"; nfo:programmingLanguage "Perl". [] a doap-tests:Test; doap-tests:purpose "Print some standard diagnostics before beginning testing."; doap-tests:test_script _:B60. [] a doap-tests:Test; doap-tests:purpose "Test that Type::Tiny, Type::Library, etc compile."; doap-tests:test_script _:B61. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Class::InsideOut."; doap-tests:test_script _:B12. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests integration with Data::Constraint."; doap-tests:test_script _:B13. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Exporter::Tiny has the features Type::Tiny needs."; doap-tests:test_script _:B14. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Type::Library libraries work with Sub::Exporter plugins."; doap-tests:test_script _:B15. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests exporting to two roles; tries to avoid reporting conflicts."; doap-tests:test_script _:B16. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Function::Parameters."; doap-tests:test_script _:B17. [] a doap-tests:AutomatedTest; doap-tests:purpose "Adopted test from Kavorka test suite."; doap-tests:test_script _:B18. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with Kavorka."; doap-tests:test_script _:B19. [] 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 _:B20. [] a doap-tests:Test; doap-tests:purpose "Test that Type::Tiny and Type::Coercion provide a Moose/Mouse-compatible API."; doap-tests:test_script _:B62. [] 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 _:B21. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Moo."; doap-tests:test_script _:B22. [] a doap-tests:AutomatedTest; doap-tests:purpose "Tests Error::TypeTiny interaction with Moo."; doap-tests:test_script _:B23. [] 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 _:B24. [] a doap-tests:AutomatedTest; doap-tests:purpose "A test for type constraint inflation from Moo to Moose."; doap-tests:test_script _:B25. [] 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 _:B26. [] 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 _:B27. [] 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 _:B28. [] 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 _:B29. [] 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 _:B30. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Moose; both mutable and immutable classes."; doap-tests:test_script _:B31. [] 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 _:B32. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints and coercions work with Moose native attibute traits."; doap-tests:test_script _:B33. [] 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 _:B34. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with MooseX::Getopt; both mutable and immutable classes."; doap-tests:test_script _:B35. [] a doap-tests:AutomatedTest; doap-tests:purpose "Complex checks between Type::Tiny and MooseX::Types."; doap-tests:test_script _:B36. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Library can extend an existing MooseX::Types type constraint library."; doap-tests:test_script _:B37. [] 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 _:B38. [] 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 _:B39. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check coercions work with Mouse; both mutable and immutable classes."; doap-tests:test_script _:B40. [] 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 _:B41. [] a doap-tests:AutomatedTest; doap-tests:purpose "Complex checks between Type::Tiny and MouseX::Types."; doap-tests:test_script _:B42. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Type::Library can extend an existing MooseX::Types type constraint library."; doap-tests:test_script _:B43. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints work with Object::Accessor."; doap-tests:test_script _:B44. [] a doap-tests:AutomatedTest; doap-tests:purpose "Test that this sort of thing works: sub foo :ReturnType(Int) { ...; }"; doap-tests:test_script _:B45. [] 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 _:B46. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check that Specio type libraries can be extended by Type::Library."; doap-tests:test_script _:B47. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints can be made inlinable using Sub::Quote."; doap-tests:test_script _:B48. [] 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 _:B49. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type coercions can be unquoted Sub::Quote."; doap-tests:test_script _:B50. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints can be unquoted Sub::Quote."; doap-tests:test_script _:B51. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with Switcheroo."; doap-tests:test_script _:B52. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny interacts nicely with Type::Library::Compiled-generated libraries."; doap-tests:test_script _:B53. [] a doap-tests:AutomatedTest; doap-tests:purpose "Types::ReadOnly does some frickin weird stuff with parameterization. Check it all works!"; doap-tests:test_script _:B54. [] 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 _:B55. [] a doap-tests:AutomatedTest; doap-tests:purpose "Check type constraints Validation::Class::Simple objects can be used as type constraints."; doap-tests:test_script _:B56. [] a doap-tests:AutomatedTest; doap-tests:purpose "Checks Type::Tiny works with match::simple."; doap-tests:test_script _:B57. [] a doap-tests:RegressionTest; doap-tests:purpose "Possible issue causing segfaults on threaded Perl 5.18.x."; doap-tests:test_script _:B58. [] a doap-tests:RegressionTest; doap-tests:purpose "Test that was failing with Type::Tiny::XS prior to 0.009."; doap-tests:test_script _:B59. [] 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 _:B63. [] 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 _:B64. [] a doap-tests:Test; doap-tests:purpose "Type constraint tests pilfered from the Moose test suite."; doap-tests:test_script _:B65. datetime-coercions.pl000664001750001750 525614413237246 20347 0ustar00taitai000000000000Type-Tiny-2.004000/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-2022 by Toby Inkster. This is free software; you can 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 66314413237246 17027 0ustar00taitai000000000000Type-Tiny-2.004000/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 205014413237246 16427 0ustar00taitai000000000000Type-Tiny-2.004000/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 342314413237246 17150 0ustar00taitai000000000000Type-Tiny-2.004000/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; 00-begin.t000664001750001750 523614413237246 14345 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 216614413237246 14711 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 540314413237246 14030 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 417514413237246 14201 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 442514413237246 16661 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 4662514413237246 17363 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 132514413237246 13532 0ustar00taitai000000000000Type-Tiny-2.004000/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 603414413237246 16401 0ustar00taitai000000000000Type-Tiny-2.004000/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 113314413237246 15431 0ustar00taitai000000000000Type-Tiny-2.004000/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 674514413237246 23141 0ustar00taitai000000000000Type-Tiny-2.004000/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-2022 by Toby Inkster. This is free software; you can 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 1145314413237246 23534 0ustar00taitai000000000000Type-Tiny-2.004000/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-2022 by Toby Inkster. This is free software; you can 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 1162714413237246 25502 0ustar00taitai000000000000Type-Tiny-2.004000/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-2022 by Toby Inkster. This is 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 1132614413237246 24414 0ustar00taitai000000000000Type-Tiny-2.004000/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-2022 by Toby Inkster. This is 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 400314413237246 24130 0ustar00taitai000000000000Type-Tiny-2.004000/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 245514413237246 15471 0ustar00taitai000000000000Type-Tiny-2.004000/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 374314413237246 16242 0ustar00taitai000000000000Type-Tiny-2.004000/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 4332514413237246 15245 0ustar00taitai000000000000Type-Tiny-2.004000/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 1345514413237246 16420 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Errorpackage Error::TypeTiny; use 5.008001; use strict; use warnings; BEGIN { $Error::TypeTiny::AUTHORITY = 'cpan:TOBYINK'; $Error::TypeTiny::VERSION = '2.004000'; } $Error::TypeTiny::VERSION =~ tr/_//d; require Type::Tiny; __PACKAGE__->Type::Tiny::_install_overloads( q[""] => sub { $_[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 || "" ); } # 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 Data::Dumper; use Try::Tiny; use Types::Standard qw(Str); try { Str->assert_valid(undef); } catch { my $exception = shift; 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-2023 by Toby Inkster. 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 3711214413237246 16212 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; 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<< IMPLEMENTAION_* >> 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-2023 by Toby Inkster. 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 1614114413237246 16241 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; 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-2023 by Toby Inkster. 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 5547314413237246 16232 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typepackage Type::Coercion; use 5.008001; use strict; use warnings; BEGIN { $Type::Coercion::AUTHORITY = 'cpan:TOBYINK'; $Type::Coercion::VERSION = '2.004000'; } $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.pm"} and blessed( $self ) and $_[0] eq 'Moose::Meta::TypeCoercion' ) { return !!1; } if ( $INC{"Moose.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.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.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-2023 by Toby Inkster. 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 4211214413237246 16057 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typepackage Type::Library; use 5.008001; use strict; use warnings; BEGIN { $Type::Library::AUTHORITY = 'cpan:TOBYINK'; $Type::Library::VERSION = '2.004000'; } $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); =begin trustme =item meta =end trustme =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-2023 by Toby Inkster. 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. Params.pm000664001750001750 12665014413237246 15730 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typepackage Type::Params; use 5.008001; use strict; use warnings; BEGIN { $Type::Params::AUTHORITY = 'cpan:TOBYINK'; $Type::Params::VERSION = '2.004000'; } $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 ); 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 ) ], 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 { 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 ) = @_; 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 ); if ( ref($function) eq 'ARRAY' ) { $opts{package} = $package; signature_for( $_, %opts ) for @$function; return; } my $fullname = ( $function =~ /::/ ) ? $function : "$package\::$function"; $opts{package} ||= $package; $opts{subname} ||= ( $function =~ /::(\w+)$/ ) ? $1 : $function; $opts{goto_next} ||= do { no strict 'refs'; exists(&$fullname) ? \&$fullname : undef; }; if ( $opts{method} ) { $opts{goto_next} ||= eval { $package->can( $opts{subname} ) }; } if ( $opts{fallback} and not $opts{goto_next} ) { $opts{goto_next} = ref( $opts{fallback} ) ? $opts{fallback} : sub {}; } if ( not $opts{goto_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; } 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, 'goto_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.20; use strict; use warnings; use experimental 'signatures'; package Horse { use Moo; use Types::Standard qw( Object ); use Type::Params -sigs; use namespace::autoclean; ...; # define attributes, etc signature_for add_child => ( method => 1, 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 you only need to do it the first time the sub is called. The second stage is fast; according to my benchmarks faster even than the XS version of L. =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 ); =head2 C<< signature( %spec ) >> The C function takes a specification for your function's signature and returns a coderef. You then call the coderef in list context, passing C<< @_ >> to it. The coderef will check, coerce, and apply other procedures to the values, and return the tidied values, or die with an error. The usual way of using it is: sub your_function { state $signature = signature( ... ); my ( $arg1, $arg2, $arg3 ) = $signature->( @_ ); ...; } 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 your_function { state $signature = signature( ... ); my ( $arg1, $arg2, $arg3 ) = &$signature; ...; } If you need to support Perl 5.8, which didn't have the C keyword: my $__your_function_sig; sub your_function { $__your_function_sig ||= signature( ... ); my ( $arg1, $arg2, $arg3 ) = $__your_function_sig->( @_ ); ...; } One important thing to note is how the signature is only compiled into a coderef the first time your function gets called, and thereafter will be reused. =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( positional => [ Int, Int ] ) However, each type constraint is optionally followed by a hashref of options which affect that parameter. For example: signature( 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( 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. signature( positional => [ Optional[Int], Int, { optional => !!1 }, 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( positional => [ Int, Slurpy[ ArrayRef[Int] ], ] ) signature( positional => [ Int, ArrayRef[Int], { slurpy => !!1 }, ] ) The C option can also be abbreviated to C. So C<< signature( pos => [...] ) >> can be used instead of the longer C<< signature( positional => [...] ) >>. If a signature uses positional parameters, the values are returned by the coderef as a list: sub add_numbers { state $sig = signature( positional => [ Num, Num ] ); my ( $num1, $num2 ) = $sig->( @_ ); 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 positional parameter. For example, a signature for a function which accepts two integers: signature( named => [ foo => Int, bar => Int ] ) However, each type constraint is optionally followed by a hashref of options which affect that parameter. For example: signature( 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( 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 returned by the coderef as an object: sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ] ); my ( $arg ) = $sig->( @_ ); 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 returned in a list instead of as an object: sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ], named_to_list => !!1, ); my ( $num1, $num2 ) = $sig->( @_ ); 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 specify the order the paramaters will be returned in. (By default they are returned in the order they were defined in.) sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ], named_to_list => [ qw( num2 num1 ) ], ); my ( $num2, $num1 ) = $sig->( @_ ); return $num1 + $num2; } =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: sub my_method { state $signature = signature( head => [ Object ], named => [ foo => Optional[Int], bar => Optional[Int] ], ); my ( $self, $arg ) = $signature->( @_ ); ...; } If C is set as a number instead of an arrayref, it is the number of additional arguments at the start: sub my_method { state $signature = signature( head => 1, named => [ foo => Optional[Int], bar => Optional[Int] ], ); my ( $self, $arg ) = $signature->( @_ ); ...; } 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<< @_ >>. sub my_method { state $signature = signature( head => [ Object ], named => [ foo => Optional[Int], bar => Optional[Int] ], tail => [ CodeRef ], ); my ( $self, $arg, $callback ) = $signature->( @_ ); ...; } $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 => 1 >>. 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.) sub my_method { state $signature = signature( method => 1, named => [ foo => Optional[Int], bar => Optional[Int] ], ); my ( $self, $arg ) = $signature->( @_ ); ...; } If C<< method >> is true (or a type constraint) then any parameter defaults which are coderefs will be called as methods. =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 caller sub name. Usually the default will be fine. =head4 C<< package >> B The package of the sub whose paramaters we're supposed to be checking. As well as showing up in stack traces, it's used by C if you provide any type constraints as strings. The default is probably fine, but if you're wrapping C so that you can check signatures on behalf of another package, you may need to provide it. =head4 C<< subname >> B The name of the sub whose paramaters we're supposed to be checking. The default is probably fine, but if you're wrapping C so that you can check signatures on behalf of another package, you may need to provide it. =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<< on_die >> B<< Maybe[CodeRef] >> Usually when your coderef 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. If the C coderef returns something, then whatever it returns will be returned as your signature's parameters. sub add_numbers { state $sig = signature( positional => [ Num, Num ], on_die => sub { my $error = shift; print "Existential crisis: $error\n"; exit( 1 ); }, ); my ( $num1, $num2 ) = $sig->( @_ ); return $num1 + $num2; } say add_numbers(); # has an existential crisis This is probably not very useful. =head4 C<< goto_next >> B<< Bool|CodeLike >> This can be used for chaining coderefs. If you understand C, it's more like an "on_live". sub add_numbers { state $sig = signature( positional => [ Num, Num ], goto_next => sub { my ( $num1, $num2 ) = @_; return $num1 + $num2; }, ); my $sum = $sig->( @_ ); return $sum; } say add_numbers( 2, 3 ); # says 5 If set to a true boolean instead of a coderef, has a slightly different behaviour: sub add_numbers { state $sig = signature( positional => [ Num, Num ], goto_next => !!1, ); 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 => !!1, positional => [ Num, Num ], goto_next => !!1, 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. =head4 C<< strictness >> B<< Bool|Str >> If you set C to a false value (0, undef, or the empty string), 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 a true boolean (i.e. 1) 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. state $signature = signature( strictness => '$::CHECK_TYPES', positional => [ Int, ArrayRef ], ); # Type checks are skipped { local $::CHECK_TYPES = 0; my ( $number, $list ) = $signature->( {}, {} ); } # Type checks are performed { local $::CHECK_TYPES = 1; my ( $number, $list ) = $signature->( {}, {} ); } A recommended use of this is with L. use Devel::StrictMode qw( STRICT ); state $signature = signature( strictness => STRICT, positional => [ Int, ArrayRef ], ); =head4 C<< multiple >> B<< ArrayRef >> This option allows your signature to support multiple calling conventions. Each entry in the array is an alternative signature, as a hashref: state $signature = signature( multiple => [ { positional => [ ArrayRef, Int ], }, { named => [ array => ArrayRef, index => Int ], named_to_list => 1, }, ], ); 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 a different order: state $signature = signature( multiple => [ { positional => [ ArrayRef, Int ] }, { positional => [ Int, ArrayRef ] }, ], ); my ( $xxx, $yyy ) = $signature->( @_ ); So how does your sub know whether C<< $xxx >> or C<< $yyy >> is the arrayref? 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: my @results = $signature->( @_ ); my ( $arr, $ix ) = ${^_TYPE_PARAMS_MULTISIG} == 1 ? reverse( @results ) : @results; A neater solution is to use a C coderef to re-order alternative signature results into your preferred order: state $signature = signature( multiple => [ { positional => [ ArrayRef, Int ] }, { positional => [ Int, ArrayRef ], goto_next => sub { reverse @_ } }, ], ); my ( $arr, $ix ) = $signature->( @_ ); 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: state $signature = signature( multiple => [ [ ArrayRef, Int ], { positional => [ Int, ArrayRef ], goto_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: state $sig_1 = signature( multiple => [ { method => 1, positional => [ ArrayRef, Int ] }, { method => 1, positional => [ Int, ArrayRef ] }, ], ); state $sig_2 = signature( method => 1, 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 deprecated, and support for it will be removed in a future release of Type::Params.) =head4 C<< message >> B Only used by C signatures. The error message to throw when no signatures match. =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<< bless >> B, C<< class >> B<< ClassName|ArrayRef >>, and C<< constructor >> B Named parameters are usually returned as a blessed object: sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ] ); my ( $arg ) = $sig->( @_ ); 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. sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ], bless => !!0, ); my ( $arg ) = $sig->( @_ ); 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 { return $_[0]{num1} } sub num2 { return $_[0]{num2} } sub sum { my $self = shift; return $self->num1 + $self->num2; } } sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ], bless => 'Params::For::AddNumbers', ); my ( $arg ) = $sig->( @_ ); 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; } } sub add_numbers { state $sig = signature( named => [ num1 => Num, num2 => Num ], class => 'Params::For::AddNumbers', ); my ( $arg ) = $sig->( @_ ); return $arg->sum; } If you wish to use a constructor named something other than C, then use: state $sig = signature( named => [ num1 => Num, num2 => Num ], class => 'Params::For::AddNumbers', constructor => 'new_from_hashref', ); Or as a shortcut: state $sig = signature( 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 >>. =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( positional => [ Int, \%options_for_first_parameter, Int, \%options_for_other_parameter, ], %more_options_for_signature, ); signature( 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: sub add_nums { state $sig = signature( positional => [ Int, Int, Bool, { optional => !!1 }, ], ); my ( $num1, $num2, $debug ) = $sig->( @_ ); 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: state $sig = signature( positional => [ 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: sub add_nums { state $sig = signature( positional => [ Num, ArrayRef[Num], { slurpy => !!1 }, ], ); my ( $first_num, $other_nums ) = $sig->( @_ ); my $sum = $first_num; $sum += $_ for @$other_nums; 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 ); sub process_data { state $sig = signature( method => true, named => [ input => FileHandle, output => FileHandle, flags => HashRef[Bool], { slurpy => true }, ], ); my ( $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( 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. state $check = signature( 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: state $check = signature( 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: state $check = signature( 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. 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<< coerce >> B Speaking of which, the C option allows you to indicate that a value should be coerced into the correct type: state $sig = signature( 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. sub foo { state $check = signature( positional => [ ArrayRef, { clone => 1 } ], ); my ( $arr ) = &$check; 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( named => [ fool => Int, { name => 'foo' }, bar => Int, ], ) You can, however, also name positional parameters, which don't usually have names. signature( 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. sub process_data { state $sig = signature( method => true, named => [ input => FileHandle, { getter => 'in' }, output => FileHandle, { getter => 'out' }, flags => HashRef[Bool], { slurpy => true }, ], ); my ( $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: state $sig = signature( method => true, named => [ input => Optional[ FileHandle ], output => Optional[ FileHandle ], flags => Slurpy[ HashRef[Bool] ], ], ); my ( $self, $arg ) = $sig->( @_ ); if ( $self->has_input and $self->has_output ) { ...; } Setting a C option allows you to choose a different name for this method. 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. sub add_numbers { state $sig = signature( named => [ first_number => Int, { alias => [ 'x' ] }, second_number => Int, { alias => 'y' }, ], ); my ( $arg ) = $sig->( @_ ); 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<< strictness >> B Overrides the signature option C on a per-parameter basis. =head2 C<< signature_for $function_name => ( %spec ) >> Like C, but instead of returning a coderef, wraps an existing function, so you don't need to deal with the mechanics of generating the signature at run-time, calling it, and extracting the returned values. The following three examples are roughly equivalent: sub add_nums { state $signature = signature( positional => [ Num, Num ], ); my ( $x, $y ) = $signature->( @_ ); return $x + $y; } Or: signature_for add_nums => ( positional => [ Num, Num ], ); sub add_nums { my ( $x, $y ) = @_; return $x + $y; } Or since Perl 5.20: signature_for add_nums => ( positional => [ Num, Num ], ); sub add_nums ( $x, $y ) { return $x + $y; } The C keyword turns C inside-out. The same signature specification options are supported, with the exception of C, C, and C which will not work. (If using the C option, then C is still supported in the I signatures.) If you are providing a signature for a sub in another package, then C<< signature_for "Some::Package::some_sub" => ( ... ) >> will work, as will C<< signature_for some_sub => ( package => "Some::Package", ... ) >>. If C is true, then C will respect inheritance when determining which sub to wrap. C will not be able to find lexical subs, so use C within the sub instead. The C option is what C uses to "connect" the signature to the body of the sub, so do not use it unless you understand the consequences and want to override the normal behaviour. If the sub being wrapped cannot be found, then C will usually throw an error. If you want it to "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 => 1 >> 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] }, ); 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 ], ); =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 => 0, %spec, named => \@named_params ) >>. =head2 C<< compile_named_oo( @named_params ) >> Equivalent to C<< signature( bless => 1, named => \@named_params ) >>. C<< compile_named_oo( \%spec, @named_params ) >> is equivalent to C<< signature( bless => 1, %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 => 0, 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 ); sub my_method { state $check = signature( method => Invocant, positional => [ ArrayRef, Int ], ); my ($self_or_class, $arr, $ix) = $check->(@_); 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. 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'; sub bar { state $check = signature( named => [ xxx => Int, yyy => ArrayRef, ], ); my ( $got ) = $check->( @_ ); 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-2023 by Toby Inkster. 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 3620014413237246 15710 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; $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.004000'; $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.004000'; $VERSION =~ tr/_//d; sub type { $_[0][0] } sub spelling { $_[0][1] } } { package Type::Parser::TokenStream; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.004000'; $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-2023 by Toby Inkster. 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 3121514413237246 16265 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typepackage Type::Registry; use 5.008001; use strict; use warnings; BEGIN { $Type::Registry::AUTHORITY = 'cpan:TOBYINK'; $Type::Registry::VERSION = '2.004000'; } $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-2023 by Toby Inkster. 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 2343014413237246 15176 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; 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; %$ref = @vals if @vals; } elsif ( 'ARRAY' eq ref $ref ) { tie @$ref, "Type::Tie::ARRAY", $type; @$ref = @vals if @vals; } else { tie $$ref, "Type::Tie::SCALAR", $type; $$ref = $vals[-1] if @vals; } return $ref; } }; { package Type::Tie::BASE; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.004000'; $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.004000'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIEARRAY { my $class = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type( $_[0] ); $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.004000'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIEHASH { my $class = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type( $_[0] ); $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.004000'; our @ISA = qw( Type::Tie::BASE ); $VERSION =~ tr/_//d; sub TIESCALAR { my $class = shift; my $self = bless( [ $class->_DEFAULT ], $class ); $self->_set_type($_[0]); $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. =begin trustme =item ttie =end trustme =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-2023 by Toby Inkster. 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. Tiny.pm000664001750001750 23206214413237246 15423 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; $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::Class Type::Tiny::ConsrtainedObject 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 ); 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 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 { $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 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.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.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 ); 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 ( $INC{"Moose.pm"} ) { my $method = $self->moose_type->can( @_ ); return sub { shift->moose_type->$method( @_ ) } if $method; } 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] ); } for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { if ( $_[0] eq $util ) { $self->{'_util'}{$util} ||= eval { $self->_build_util( $util ) }; return unless $self->{'_util'}{$util}; return sub { my $s = shift; $s->{'_util'}{$util}( @_ ) }; } } } #/ 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 ( $INC{"Moose.pm"} ) { my $method = $self->moose_type->can( $m ); return $self->moose_type->$method( @_ ) if $method; } 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"}; } for my $util ( qw/ grep map sort rsort first any all assert_any assert_all / ) { if ( $m eq $util ) { return ( $self->{'_util'}{$util} ||= $self->_build_util( $util ) )->( @_ ); } } } #/ 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.12; use strict; use warnings; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef Object ); use Type::Params qw( signature ); 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 [] }, ); sub add_child { state $check = signature( method => Object, positional => [ Object ], ); # method signature my ( $self, $child ) = $check->( @_ ); # unpack @_ 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.) =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. Called with the same parameters and 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 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-2023 by Toby Inkster. 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 7526214413237246 15567 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typepackage Type::Utils; use 5.008001; use strict; use warnings; BEGIN { $Type::Utils::AUTHORITY = 'cpan:TOBYINK'; $Type::Utils::VERSION = '2.004000'; } $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.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.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-2023 by Toby Inkster. 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 475414413237246 16060 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } 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 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-2023 by Toby Inkster. 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 13415414413237246 16426 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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; } $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 '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 @_; 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 @_; 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 @_; 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; 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 expresssion; 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.12; use strict; use warnings; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef Object ); use Type::Params qw( compile ); 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 [] }, ); sub add_child { state $check = signature( method => Object, positional => [ Object ], ); # method signature my ( $self, $child ) = $check->( @_ ); # unpack @_ 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. =begin trustme =item slurpy =end trustme =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,[]] >>. 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 implementions 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-2023 by Toby Inkster. 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 6771714413237246 16445 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Typespackage Types::TypeTiny; use 5.008001; use strict; use warnings; our $AUTHORITY = 'cpan:TOBYINK'; our $VERSION = '2.004000'; $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 blessed( $_ ) && _check_overload( $_, q[0+] ) && do { my $n = sprintf('%d', $_); $n==0 or $n==1 }; }, inlined => sub { qq/do { local \$_ = $_; !defined() or !ref() && ( \$_ eq '' || \$_ eq '0' || \$_ eq '1' ) or Scalar::Util::blessed(\$_) && ${\ +_get_check_overload_sub() }(\$_, q[bool]) or Scalar::Util::blessed(\$_) && ${\ +_get_check_overload_sub() }(\$_, q[0+]) && do { my \$n = sprintf('%d', $_); \$n==0 or \$n==1 } }/; }, 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.) 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-2023 by Toby Inkster. 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 1416014413237246 15173 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2056614413237246 16336 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2747314413237246 16172 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2434414413237246 15344 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1314114413237246 16142 0ustar00taitai000000000000Type-Tiny-2.004000/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 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1657014413237246 16321 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1320414413237246 16121 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1314214413237246 15752 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1750714413237246 16534 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1670014413237246 16517 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1313314413237246 16001 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1605314413237246 17040 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 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 [] }, #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 3133614413237246 15333 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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', ); done_testing; Enum.t000664001750001750 1742514413237246 15357 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1315614413237246 16443 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1301614413237246 15763 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1614314413237246 16506 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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." ); done_testing; HashLike.t000664001750001750 2123514413237246 16135 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2751314413237246 15772 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1720314413237246 16476 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1271114413237246 15176 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1622714413237246 16161 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1276014413237246 15346 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1332514413237246 15652 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1624314413237246 20177 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1513514413237246 17024 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2323414413237246 15163 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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'); }; done_testing; Maybe.t000664001750001750 1405414413237246 15503 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1327014413237246 16662 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1327014413237246 16667 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1371714413237246 20031 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1371714413237246 20036 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1356214413237246 20065 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1326214413237246 16710 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1271114413237246 15203 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1720514413237246 16163 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1337114413237246 16644 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1410414413237246 15650 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1312714413237246 16044 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1723014413237246 16232 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1514314413237246 16221 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1312214413237246 16243 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1327014413237246 16722 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1327014413237246 16727 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1371714413237246 20071 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1371714413237246 20076 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1556514413237246 15172 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1324314413237246 16334 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1513214413237246 16146 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1560414413237246 16312 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1330614413237246 16367 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1340314413237246 16645 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2301614413237246 15742 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1316214413237246 15215 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1760114413237246 16361 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 337714413237246 17121 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 1751114413237246 16174 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1347614413237246 16405 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1330414413237246 16516 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1342214413237246 17443 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1544614413237246 15341 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 2711714413237246 15543 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1635114413237246 16235 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1313714413237246 15510 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1624214413237246 20201 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1513514413237246 17027 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1271614413237246 15525 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 1507014413237246 21104 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 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 [] }, #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 116314413237246 15530 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 147414413237246 15365 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 154714413237246 14705 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 266614413237246 14774 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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(); gh80.t000664001750001750 151514413237246 14767 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 137514413237246 15002 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; rt102748.t000664001750001750 164514413237246 15340 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 412614413237246 15326 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 155714413237246 15340 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 304614413237246 15325 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 243314413237246 15340 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 145714413237246 15351 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 115214413237246 15324 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 113314413237246 15314 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 230414413237246 15332 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 314414413237246 15323 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 221414413237246 15253 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 512714413237246 15253 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 202514413237246 15251 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 232214413237246 15257 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 157714413237246 15425 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 137114413237246 15256 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 130714413237246 15414 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 234114413237246 15254 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 242414413237246 15260 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 160014413237246 15256 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 207714413237246 15274 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 156614413237246 15262 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 225714413237246 15704 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 345614413237246 15613 0ustar00taitai000000000000Type-Tiny-2.004000/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 correponding 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-2023 by Toby Inkster. This 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 1176614413237246 16173 0ustar00taitai000000000000Type-Tiny-2.004000/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 152014413237246 15266 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This 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 16545114413237246 17470 0ustar00taitai000000000000Type-Tiny-2.004000/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 13313614413237246 16777 0ustar00taitai000000000000Type-Tiny-2.004000/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 1447614413237246 17313 0ustar00taitai000000000000Type-Tiny-2.004000/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 67514413237246 20551 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; $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 1171414413237246 20363 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 357414413237246 20657 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 514614413237246 23154 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 has_minimum { exists $_[0]{minimum} } sub has_maximum { exists $_[0]{maximum} } sub _build_message { my $e = shift; if ( $e->has_minimum and $e->has_maximum and $e->minimum == $e->maximum ) { return sprintf( "Wrong number of parameters; got %d; expected %d", $e->got, $e->minimum, ); } elsif ( $e->has_minimum and $e->has_maximum and $e->minimum < $e->maximum ) { return sprintf( "Wrong number of parameters; got %d; expected %d to %d", $e->got, $e->minimum, $e->maximum, ); } elsif ( $e->has_minimum ) { return sprintf( "Wrong number of parameters; got %d; expected at least %d", $e->got, $e->minimum, ); } else { return sprintf( "Wrong number of parameters; got %d", $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. 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. =back =head2 Methods =over =item 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-2023 by Toby Inkster. 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 1340414413237246 21262 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 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<< 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-2023 by Toby Inkster. 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 406714413237246 17637 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Reply/Pluginpackage Reply::Plugin::TypeTiny; use strict; use warnings; BEGIN { $Reply::Plugin::TypeTiny::AUTHORITY = 'cpan:TOBYINK'; $Reply::Plugin::TypeTiny::VERSION = '2.004000'; } $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. =begin trustme =item mangle_error =end trustme =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-2023 by Toby Inkster. 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. FromMoose.pm000664001750001750 530014413237246 20100 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 603114413237246 17264 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 1070014413237246 20335 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Type/Params# INTERNAL MODULE: OO backend for Type::Params multisig-type signatures. package 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.004000'; } $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 ); require Type::Params::Signature; our @ISA = 'Type::Params::Signature'; sub new { my $class = shift; my %self = @_ == 1 ? %{$_[0]} : @_; my $self = bless \%self, $class; exists( $self->{$_} ) || ( $self->{$_} = $self->{base_options}{$_} ) for keys %{ $self->{base_options} }; $self->{sig_class} ||= 'Type::Params::Signature'; $self->{message} ||= 'Parameter validation failed'; 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 goto_next { $_[0]{base_options}{goto_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 { my $meta = $self->_build_meta_alternative( $_ ); $meta->{_index} = $index++; $meta; } @{ $self->alternatives } ]; } sub _build_meta_alternative { my ( $self, $alt ) = @_; if ( is_CodeRef $alt ) { return { closure => $alt }; } elsif ( is_HashRef $alt ) { my %opts = ( %{ $self->base_options }, goto_next => !!0, # don't propagate %$alt, want_source => !!0, want_object => !!0, want_details => !!1, ); my $sig = $self->sig_class->new_from_v2api( \%opts ); return $sig->return_wanted; } elsif ( is_ArrayRef $alt ) { my %opts = ( %{ $self->base_options }, goto_next => !!0, # don't propagate positional => $alt, want_source => !!0, want_object => !!0, want_details => !!1, ); my $sig = $self->sig_class->new_from_v2api( \%opts ); return $sig->return_wanted; } else { $self->_croak( 'Alternative signatures must be CODE, HASH, or ARRAY refs' ); } } sub _coderef_start_extra { my ( $self, $coderef ) = ( shift, @_ ); $coderef->add_line( 'my $r;' ); $coderef->add_line( 'undef ${^TYPE_PARAMS_MULTISIG};' ); $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} = ${^_TYPE_PARAMS_MULTISIG} = %d }%sif ( %s );', $alt_code, $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} = ${^_TYPE_PARAMS_MULTISIG} = %d }%sif ( %s );', $callback_var, $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; Parameter.pm000664001750001750 2122414413237246 17617 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Type/Params# INTERNAL MODULE: a parameter within a Type::Params::Signature. package 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.004000'; } $Type::Params::Parameter::VERSION =~ tr/_//d; use Types::Standard qw( -is -types ); 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} ]; } bless \%self, $class; } 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 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->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 _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; 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 $self->has_alias ) { $coderef->add_line( sprintf( 'for my $alias ( %s ) {', join( q{, }, map B::perlstring($_), @{ $self->alias } ), ) ); $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 ( $self->has_default ) { $self->{vartail} = $vartail; # hack $coderef->add_line( sprintf( '$dtmp = %s ? %s : %s;', $exists_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 ( $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; } 1; Signature.pm000664001750001750 5726314413237246 17654 0ustar00taitai000000000000Type-Tiny-2.004000/lib/Type/Params# INTERNAL MODULE: OO backend for Type::Params signatures. package 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.004000'; } $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; 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->BUILD; return $self; } { my $klass_id; my %klass_cache; sub BUILD { my $self = shift; if ( $self->{named_to_list} and not ref $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, ); } if ( defined $self->{bless} and $self->{bless} eq 1 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}; } } 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 ) { $multiple = [] unless is_ArrayRef $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 goto_next { $_[0]{goto_next} } sub is_named { $_[0]{is_named} } sub bless { $_[0]{bless} } sub class { $_[0]{class} } sub constructor { $_[0]{constructor} } sub named_to_list { $_[0]{named_to_list} } sub oo_trace { $_[0]{oo_trace} } 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->goto_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 ) { 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 ) { $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', ); } } 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, $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->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 ) . ';' ); $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->goto_next ) { if ( $list eq '@_' ) { return sprintf 'goto( $__NEXT__ )'; } 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_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}, ); } 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; Bitfield.pm000664001750001750 2630014413237246 17121 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 by Toby Inkster. 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 2570314413237246 16452 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 1415714413237246 21006 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 behavour 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-2023 by Toby Inkster. 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 2111014413237246 16257 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 _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 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-2023 by Toby Inkster. 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 3776014413237246 16317 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 _is_null_constraint { 0 } sub _build_display_name { my $self = shift; sprintf( "Enum[%s]", join q[,], @{ $self->unique_values } ); } 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; my $xsub; if ( my $xs_encoding = _xs_encoding( $self->unique_values ) ) { $xsub = Type::Tiny::XS::get_subname_for( $xs_encoding ); return "$xsub\($_[0]\)" if $xsub && !$Type::Tiny::AvoidCallbacks; } my $regexp = $self->_regexp; my $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. =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-2023 by Toby Inkster. 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 2357614413237246 20061 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 1503514413237246 16765 0ustar00taitai000000000000Type-Tiny-2.004000/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 800 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.12; use strict; use warnings; package Horse { use Moo; use Types::Standard qw( Str Int Enum ArrayRef InstanceOf ); use Type::Params qw( signature ); 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 [] }, ); sub add_child { state $check = signature( method => Object, positional => [ InstanceOf['Horse'] ] ); my ( $self, $child ) = $check->(@_); # unpack @_ 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.12 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, 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-2023 by Toby Inkster. 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 1570714413237246 16311 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 3151214413237246 16470 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 407214413237246 20065 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 by Toby Inkster. 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 336714413237246 16677 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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-2023 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 2005514413237246 17472 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 Bool ); 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 ); 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 Bool->check( $min_excl ) or _croak( "${base}Range minexcl must be a boolean; got $min_excl" ); !defined( $max_excl ) or Bool->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-2023 by Toby Inkster. 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 2442514413237246 17343 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 @_; 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 @_; 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 paramaters 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-2023 by Toby Inkster. 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 1243614413237246 20117 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $Types::Standard::ArrayRef::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::ArrayRef unless @_; 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; CycleTuple.pm000664001750001750 1311514413237246 20450 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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; 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; Dict.pm000664001750001750 3021014413237246 17255 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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; 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 expressable 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 1; HashRef.pm000664001750001750 1050214413237246 17714 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $Types::Standard::HashRef::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::HashRef unless @_; 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; Map.pm000664001750001750 1377614413237246 17131 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $Types::Standard::Map::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } my $meta = Types::Standard->meta; no warnings; sub __constraint_generator { return $meta->get_type( 'Map' ) unless @_; 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; ScalarRef.pm000664001750001750 526414413237246 20227 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $Types::Standard::ScalarRef::VERSION =~ tr/_//d; use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } no warnings; sub __constraint_generator { return Types::Standard::ScalarRef unless @_; 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; StrMatch.pm000664001750001750 604114413237246 20104 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $Types::Standard::StrMatch::VERSION =~ tr/_//d; use Type::Tiny (); use Types::Standard (); use Types::TypeTiny (); sub _croak ($;@) { require Error::TypeTiny; goto \&Error::TypeTiny::croak } 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 @_; 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 ref( $value ); my @m = ( $value =~ $regexp ); $checker->check( \@m ); } : sub { my $value = shift; !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 "!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 { "!ref($_) and length($_)>=$length" }; } if ( $regexp_string =~ /\A\(\?\^u?:\\A(\.+)\\z\)\z/ ) { my $length = length $1; return sub { "!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" ); } "!ref($v) and !!( $v =~ $serialized_re )"; }; } #/ else [ if ( $checker ) ] } #/ sub __inline_generator 1; Tied.pm000664001750001750 372114413237246 17246 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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 @_; 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 2323314413237246 17472 0ustar00taitai000000000000Type-Tiny-2.004000/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.004000'; } $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; 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; basic.t000664001750001750 120014413237246 23042 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 210714413237246 20662 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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->contex1t->{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 223314413237246 21725 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 2650614413237246 22660 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 304214413237246 23135 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 467114413237246 25446 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; 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; 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; 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; 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; 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 1036714413237246 23744 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1063014413237246 22324 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1034014413237246 23006 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1052214413237246 21617 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1310514413237246 20500 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 437614413237246 22004 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 225014413237246 23527 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 231514413237246 24204 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 370514413237246 20515 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 230214413237246 21224 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 502314413237246 21232 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 1077214413237246 20515 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 267614413237246 21235 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 326214413237246 20713 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 256714413237246 21226 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1112714413237246 22263 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 144014413237246 21547 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 213314413237246 23654 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 373614413237246 22403 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 317714413237246 22635 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 504114413237246 21554 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 236714413237246 20561 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 240114413237246 22152 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 321514413237246 21546 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 223614413237246 20567 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 147214413237246 23720 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 775114413237246 21612 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 411014413237246 22037 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 630414413237246 21544 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 222714413237246 17666 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 231014413237246 21715 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 440314413237246 24550 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 167314413237246 21533 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 166214413237246 17677 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 454314413237246 20422 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 276014413237246 20165 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is 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 177514413237246 20515 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 165014413237246 20514 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 241214413237246 20166 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is 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 303714413237246 20332 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1776414413237246 24600 0ustar00taitai000000000000Type-Tiny-2.004000/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 by Toby Inkster. This is free software; you can 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 2477114413237246 22742 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1171114413237246 22652 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This 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 1173714413237246 22245 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1774014413237246 21632 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 664614413237246 20712 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is 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 374714413237246 21110 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 336114413237246 21051 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 334114413237246 20533 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; got 0; expected 2}, 'exception calling new() with no args', ); like( exception { Silly::String->new() }, qr{^Wrong number of parameters; got 1; expected 2}, 'exception calling ->new() with no args', ); like( exception { Silly::String::set() }, qr{^Wrong number of parameters; got 0; expected 2}, 'exception calling set() with no args', ); done_testing; mixednamed.t000664001750001750 201514413237246 21200 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 456614413237246 23671 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 414414413237246 22574 0ustar00taitai000000000000Type-Tiny-2.004000/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 by Toby Inkster. This is free software; you can 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 551314413237246 20730 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 347514413237246 21555 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 231114413237246 20150 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 344114413237246 21062 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; got 0; expected 2}, '()'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters; 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 234014413237246 20241 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 344414413237246 20721 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 614014413237246 21251 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; got 0; expected 2}, '(1)'); } { my $e = exception { nth_root(1) }; like($e, qr{^Wrong number of parameters; 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; 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 1412414413237246 20447 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 560614413237246 21277 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; 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-defaults.t000664001750001750 151314413237246 21223 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 211514413237246 23336 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 426614413237246 21605 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 142314413237246 21153 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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-multi.t000664001750001750 1510714413237246 20572 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 ], goto_next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, goto_next => sub { ( undef, @_ ) } }, { named => [ LIST => ArrayRef, INDEX => Int ], goto_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 ], goto_next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, goto_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 ], goto_next => sub { @_[0, 2, 1] } }, ] }, { named => [ array => ArrayRef, index => Int, { alias => 'ix' } ], named_to_list => 1 }, { pos => [ ArrayRef, Int ], method => 0, goto_next => sub { ( undef, @_ ) } }, { named => [ LIST => ArrayRef, INDEX => Int ], goto_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=>'first', pos => [ ArrayRef, Int ] }, { ID=>'second', pos => [ Int, ArrayRef ], goto_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, goto_next => sub { ( undef, @_ ) } }, { ID=>'fifth', named => [ LIST => ArrayRef, INDEX => Int ], goto_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}, 1; is( __PACKAGE__->array_lookup2( { array => \@arr, index => $ix } ), $expect, 'third alternative (hashref)', ); is ${^_TYPE_PARAMS_MULTISIG}, 1; is( __PACKAGE__->array_lookup2( array => \@arr, ix => $ix ), $expect, 'third alternative (hash, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 1; is( __PACKAGE__->array_lookup2( { array => \@arr, ix => $ix } ), $expect, 'third alternative (hashref, alias)', ); is ${^_TYPE_PARAMS_MULTISIG}, 1; is( array_lookup2( \@arr, $ix ), $expect, 'fourth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 2; is( __PACKAGE__->array_lookup2( LIST => \@arr, INDEX => $ix ), $expect, 'fifth alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 3; is( array_lookup2( 'HELLOWORLD' ), 'helloworld', 'final alternative', ); is ${^_TYPE_PARAMS_MULTISIG}, 4; my $e = exception { array_lookup() }; like $e, qr/Parameter validation failed/; is ${^_TYPE_PARAMS_MULTISIG}, undef; }; } { my $sig; sub xyz { $sig ||= signature( named => [ { goto_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 => [ { goto_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 343314413237246 22605 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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)' } done_testing; v2-named-plus-slurpy.t000664001750001750 142514413237246 23017 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 351414413237246 20503 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; signature_for myfunc => ( method => Object | Str, named => [ arr => ArrayRef, int => Int ], ); sub myfunc ( $self, $arg ) { return $arg->arr->[ $arg->int ]; } sub myfunc2 { state $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)' } done_testing; v2-positional-backcompat.t000664001750001750 323314413237246 23700 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 150714413237246 24115 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 332114413237246 21574 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; signature_for myfunc => ( method => Object | Str, pos => [ ArrayRef, Int ], ); 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]; } }; 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-warnings.t000664001750001750 177514413237246 21256 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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'; 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', ); } done_testing; v2-wrap-inherited-method.t000664001750001750 200014413237246 23604 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 726714413237246 20054 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 242614413237246 22113 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1734314413237246 20211 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 176214413237246 21505 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 145414413237246 21431 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 634214413237246 20542 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 356014413237246 21123 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 217614413237246 22061 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 206614413237246 22065 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 225614413237246 20752 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 136114413237246 21302 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 425714413237246 17617 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 305614413237246 21132 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 114114413237246 23202 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 427114413237246 17520 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 305514413237246 20422 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 213114413237246 17630 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 216214413237246 20347 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 237614413237246 17456 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 146014413237246 20777 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1136014413237246 20741 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1217614413237246 17677 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 732214413237246 17352 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 376414413237246 22361 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 227414413237246 22447 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 206614413237246 23534 0ustar00taitai000000000000Type-Tiny-2.004000/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 by Toby Inkster. This is free software; you can 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 134514413237246 22404 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 174114413237246 21067 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 620614413237246 20410 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 544714413237246 21356 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1213714413237246 21227 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 156014413237246 20657 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 420214413237246 22143 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 175114413237246 20420 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 146014413237246 20626 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 224014413237246 20730 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; 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 234614413237246 21521 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This 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 240114413237246 21353 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This 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 342214413237246 20116 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 223714413237246 20335 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 213514413237246 20340 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 446314413237246 21263 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 607314413237246 21376 0ustar00taitai000000000000Type-Tiny-2.004000/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 210514413237246 21621 0ustar00taitai000000000000Type-Tiny-2.004000/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 34414413237246 23273 0ustar00taitai000000000000Type-Tiny-2.004000/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 407414413237246 21277 0ustar00taitai000000000000Type-Tiny-2.004000/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 335514413237246 20721 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 276214413237246 21155 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 116314413237246 21503 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 115014413237246 24305 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 477314413237246 23376 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 630414413237246 23251 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 203014413237246 20527 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 243114413237246 20232 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 267014413237246 20774 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 130714413237246 21324 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 431014413237246 20550 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 422114413237246 20247 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 212214413237246 21002 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 121314413237246 21336 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 206114413237246 23041 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 145214413237246 21011 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 160714413237246 23413 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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;basic.t000664001750001750 454714413237246 22326 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 304614413237246 22015 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 563714413237246 24746 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 301514413237246 22546 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 216314413237246 20551 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 345114413237246 21005 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 123314413237246 21335 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 626514413237246 20747 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 415414413237246 23361 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 345214413237246 21175 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 224014413237246 22537 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 136014413237246 22475 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 165314413237246 22506 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 146114413237246 24005 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 201714413237246 21562 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 214314413237246 21070 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 251714413237246 20643 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 473214413237246 21032 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 473614413237246 21044 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 222314413237246 17356 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1152714413237246 21457 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 174214413237246 20600 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 176414413237246 20350 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 107414413237246 21240 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 634214413237246 21745 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 112714413237246 22637 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 1026114413237246 22156 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 543114413237246 21607 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 240114413237246 21760 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 112414413237246 22500 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 171714413237246 22543 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is 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 310514413237246 22150 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 270014413237246 22603 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1071014413237246 20667 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 370114413237246 21741 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 3226614413237246 22517 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 135114413237246 21662 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 110214413237246 21540 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 222314413237246 21406 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 337114413237246 22161 0ustar00taitai000000000000Type-Tiny-2.004000/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 directy, 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-2023 by Toby Inkster. This is free software; you can 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 275314413237246 21274 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 214314413237246 21402 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 166714413237246 24457 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 203714413237246 24433 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 517414413237246 21423 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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', ); done_testing; structured.t000664001750001750 4354414413237246 22025 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 461614413237246 20523 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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; basic.t000664001750001750 447114413237246 20703 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 2630314413237246 21441 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 261414413237246 20545 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 265514413237246 22017 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 130114413237246 23750 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 302114413237246 21562 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is 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 1044314413237246 21151 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 212414413237246 20266 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 255514413237246 21052 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 206614413237246 21160 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 425514413237246 20720 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 157214413237246 21633 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 233014413237246 22367 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 235614413237246 22055 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 174414413237246 17255 0ustar00taitai000000000000Type-Tiny-2.004000/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 by Toby Inkster. This is free software; you can 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 361014413237246 21067 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; 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 202014413237246 17551 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 270514413237246 16717 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 545114413237246 23174 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 415114413237246 17434 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 413314413237246 20014 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 412114413237246 17613 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 171014413237246 17676 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 177114413237246 17264 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 212314413237246 21321 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 316314413237246 21706 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 2025314413237246 17265 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you 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 237114413237246 20726 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 573114413237246 17771 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 212514413237246 22014 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1561714413237246 23007 0ustar00taitai000000000000Type-Tiny-2.004000/t/30-external/Moose=pod =encoding utf-8 =head1 PURPOSE Check type constraints and coercions work with L native attibute 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-2023 by Toby Inkster. This is 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::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 250114413237246 21014 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 322014413237246 21350 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 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 335414413237246 20502 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 376614413237246 21415 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 330514413237246 20357 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 372514413237246 17260 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 423214413237246 17772 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 250114413237246 21022 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 307214413237246 20505 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 246714413237246 21420 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 245514413237246 21135 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 414414413237246 20362 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 154114413237246 17404 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 151414413237246 17767 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 575314413237246 20017 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 232714413237246 22023 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 304414413237246 22407 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 212714413237246 22773 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 147314413237246 20314 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 266714413237246 22267 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 216714413237246 21006 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 451614413237246 23064 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 435514413237246 22554 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 131514413237246 20544 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. This is free software; you can 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 1372414413237246 15660 0ustar00taitai000000000000Type-Tiny-2.004000/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 735014413237246 20646 0ustar00taitai000000000000Type-Tiny-2.004000/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 3625714413237246 20717 0ustar00taitai000000000000Type-Tiny-2.004000/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 2042314413237246 20517 0ustar00taitai000000000000Type-Tiny-2.004000/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 constaint. =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-2023 by Toby Inkster. 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 3153214413237246 20711 0ustar00taitai000000000000Type-Tiny-2.004000/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; sub set_account_name { state $check = signature( method => Object, positional => [ UpperCaseStr->no_coercions ], ); my ( $self, $name ) = $check->( @_ ); $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-2023 by Toby Inkster. 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 555514413237246 21422 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 1070114413237246 21421 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 3403114413237246 20676 0ustar00taitai000000000000Type-Tiny-2.004000/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 { my $i = assert_Int(shift); # needs to return a coderef to use as a constraint for the # parameterized type return sub { $_ % $i == 0 }; }, # optional but recommended inline_generator => sub { my $i = shift; return sub { my $varname = pop; return (undef, "$varname % $i == 0"); }; }, # probably the most complex bit coercion_generator => sub { my $i = $_[2]; 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-2023 by Toby Inkster. 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 646014413237246 17737 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 2405214413237246 21452 0ustar00taitai000000000000Type-Tiny-2.004000/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 { my ( $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 { my ( $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 { my ( $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 ); use Devel::StrictMode qw( STRICT ); sub add_number { state $check = signature( strictness => STRICT, method => 1, positional => [ Num ], ); my ( $self, $num ) = &$check; 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-2023 by Toby Inkster. 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 1753514413237246 20217 0ustar00taitai000000000000Type-Tiny-2.004000/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. sub repeat_string { state $check = signature( multiple => [ { positional => [ Str, Int ] }, { named => [ string => Str, count => Int ], named_to_list => 1 }, ], ); my ( $string, $count ) = $check->( @_ ); 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 C turns C inside out. Instead of this: sub foobar { state $check = signature( positional => [ Int, Str ] ); my ( $foo, $bar ) = $check->( @_ ); ...; } You do this: signature_for foobar => ( positional => [ Int, Str ], ); sub foobar { my ( $foo, $bar ) = @_; ...; } Or in Perl 5.20+, you can even do this: signature_for foobar => ( positional => [ Int, Str ], ); sub foobar ( $foo, $bar ) { ...; } =head2 Functions versus Methods For subs which are intended to be called as functions: signature( method => 0, ... ); signature( ... ); # this is the default anyway For subs which are intended to be called as methods on a blessed object: signature( method => Object, ... ); And for subs which are intended to be called as methods on a class: signature( method => ClassName, ... ); signature( method => Str, ... ); # less readable, but faster check! The following is 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( method => 1, ... ); =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: state $check = signature( head => [ Int ], named => [ foo => Int, bar => Optional[Int], baz => Optional[Int], ], ); $check->( 42, foo => 21 ); # ok $check->( 42, foo => 21, bar => 84 ); # ok $check->( 42, foo => 21, bar => 10.5 ); # not ok $check->( 42, foo => 21, quux => 84 ); # not ok =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-2023 by Toby Inkster. 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 1071014413237246 20527 0ustar00taitai000000000000Type-Tiny-2.004000/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 * 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 * 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-2023 by Toby Inkster. 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 1053514413237246 22540 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 1150614413237246 21524 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 6222414413237246 21363 0ustar00taitai000000000000Type-Tiny-2.004000/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 { my $self = shift; my ($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 ); ...; sub add_win { state $check = signature( method => 1, # allow for $self positional => [ PositiveInt, NonEmptyStr, NonEmptyStr, { optional => 1 }, ], ); my ( $self, $year, $race, $jockey ) = $check->(@_); my $win = [ $year, $race, $jockey ? $jockey : (), ]; push @{ $self->wins }, $win; return $self; } } The first time this method is called, it will compile a coderef called C<< $check >>. Then every time it is run, C<< $check >> will be called to check the method's parameters. It will throw an exception if they fail. C<< $check >> 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: state $check = signature( method => 1, positional => [ PositiveInt, NonEmptyStr, NonEmptyStr, { default => sub { "Eddie" } }, ], ); On older versions of Perl (prior to 5.10), C variables are not available. A workaround is to replace this: sub foo { state $x = bar(); ...; } With this: { # outer braces prevent other subs seeing $x my $x; # declare $x before sub foo() sub foo { $x = bar(); ...; } } (While we're having a general Perl syntax lesson, I'll note that C<< &$check >> with an ampersand and no parentheses is a shortcut for C<< $check->(@_) >> and actually runs slightly faster because it reuses the C<< @_ >> array for the called coderef. A lot of people dislike calling subs with an ampersand, so we will stick to the C<< $check->(@_) >> syntax in these examples. But do consider using the shortcut!) The generalized syntax for positional parameters in C is: state $check = signature( %general_options, positional => [ TypeForFirstParam, \%options_for_first_param, TypeForSecondParam, \%options_for_second_param, ..., ], ); As a shortcut for the C<< { optional => 1 } >> option, you can just use B like in B. state $check = signature( method => 1, positional => [ PositiveInt, NonEmptyStr, Optional[NonEmptyStr], ], ); You can also use C<0> and C<1> 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 the third parameter is allowed but not required. state $check = signature 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 ); ...; sub add_wins_for_year { state $check = signature( method => 1, positional => [ PositiveInt, Slurpy[ ArrayRef[NonEmptyStr] ], ], ); my ( $self, $year, $races ) = $check->(@_); 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] >>. 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 ); ...; sub add_win { state $check = signature( method => 1, named => [ year => PositiveInt, race => NonEmptyStr, jockey => NonEmptyStr, { optional => 1 }, ], ); my ( $self, $arg ) = $check->(@_); 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 ); ...; sub add_win { state $check = signature( method => 1, named => [ year => PositiveInt, race => NonEmptyStr, jockey => NonEmptyStr, { optional => 1 }, ], named_to_list => 1, ); my ( $self, $year, $race, $jockey ) = $check->(@_); my $win = [ $year, $race, $jockey ? $jockey : (), ]; push @{ $self->wins }, $win; return $self; } } 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-2023 by Toby Inkster. 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 2521214413237246 21441 0ustar00taitai000000000000Type-Tiny-2.004000/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 ); 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 { my $self = shift; tie my @kids, $ThisClass; \@kids; } # this method will tie an arrayref provided by the caller sub _trigger_children { my $self = shift; my ($new) = @_; tie @$new, $ThisClass; } sub add_child { state $check = signature( method => $ThisClass, positional => [ $ThisClass ], ); my ( $self, $kid ) = &$check; 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-2023 by Toby Inkster. 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 2462714413237246 21453 0ustar00taitai000000000000Type-Tiny-2.004000/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 horizonal 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!) =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 ); 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 ); 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 ); 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-2023 by Toby Inkster. 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 1416414413237246 21713 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 1513614413237246 21721 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 1304414413237246 21706 0ustar00taitai000000000000Type-Tiny-2.004000/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 ); # 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. sub get_older { state $check = signature( method => 1, positional => [ $Years ] ); my ( $self, $years ) = $check->( @_ ); $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-2023 by Toby Inkster. 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 511514413237246 22347 0ustar00taitai000000000000Type-Tiny-2.004000/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-2023 by Toby Inkster. 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 3245414413237246 21160 0ustar00taitai000000000000Type-Tiny-2.004000/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 171114413237246 21740 0ustar00taitai000000000000Type-Tiny-2.004000/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;