Specio-0.50/0000775000175000017500000000000014755224347012537 5ustar autarchautarchSpecio-0.50/Makefile.PL0000644000175000017500000000661614755224347014520 0ustar autarchautarch# This Makefile.PL for Specio was generated by # Dist::Zilla::Plugin::DROLSKY::MakeMaker 1.22 # and Dist::Zilla::Plugin::MakeMaker::Awesome 0.49. # Don't edit it but the dist.ini and plugins used to construct it. use strict; use warnings; use 5.008; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Type constraints and coercions for Perl", "AUTHOR" => "Dave Rolsky ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Specio", "LICENSE" => "artistic_2", "MIN_PERL_VERSION" => "5.008", "NAME" => "Specio", "PREREQ_PM" => { "B" => 0, "Carp" => 0, "Clone" => 0, "Devel::StackTrace" => 0, "Eval::Closure" => 0, "Exporter" => 0, "IO::File" => 0, "List::Util" => "1.33", "MRO::Compat" => 0, "Module::Runtime" => 0, "Role::Tiny" => "1.003003", "Role::Tiny::With" => 0, "Scalar::Util" => 0, "Sub::Quote" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Try::Tiny" => 0, "overload" => 0, "parent" => 0, "re" => 0, "strict" => 0, "version" => "0.83", "warnings" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "FindBin" => 0, "Test::More" => "0.96", "Test::Needs" => 0, "lib" => 0, "open" => 0, "utf8" => 0 }, "VERSION" => "0.50", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "B" => 0, "Carp" => 0, "Clone" => 0, "Devel::StackTrace" => 0, "Eval::Closure" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "FindBin" => 0, "IO::File" => 0, "List::Util" => "1.33", "MRO::Compat" => 0, "Module::Runtime" => 0, "Role::Tiny" => "1.003003", "Role::Tiny::With" => 0, "Scalar::Util" => 0, "Sub::Quote" => 0, "Test::Fatal" => 0, "Test::More" => "0.96", "Test::Needs" => 0, "Try::Tiny" => 0, "lib" => 0, "open" => 0, "overload" => 0, "parent" => 0, "re" => 0, "strict" => 0, "utf8" => 0, "version" => "0.83", "warnings" => 0 ); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 if ($] >= 5.010) { requires('XString') } unless ( eval { ExtUtils::MakeMaker->VERSION('6.63_03') } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.040 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $WriteMakefileArgs{$mm_key}{$module} and $WriteMakefileArgs{$mm_key}{$module} ne '0' and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; warn "$module already exists in FallbackPrereqs (at version $FallbackPrereqs{$module}) -- need to do a sane metamerge!" if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' and $FallbackPrereqs{$module} ne $version_or_range; $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; return; } sub requires { goto &runtime_requires } sub runtime_requires { my ($module, $version_or_range) = @_; _add_prereq(PREREQ_PM => $module, $version_or_range); } Specio-0.50/META.yml0000644000175000017500000007175314755224347014023 0ustar autarchautarch--- abstract: 'Type constraints and coercions for Perl' author: - 'Dave Rolsky ' build_requires: ExtUtils::MakeMaker: '0' File::Spec: '0' FindBin: '0' Test::More: '0.96' Test::Needs: '0' lib: '0' open: '0' utf8: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Specio no_index: directory: - t/lib provides: Specio: file: lib/Specio.pm version: '0.50' Specio::Coercion: file: lib/Specio/Coercion.pm version: '0.50' Specio::Constraint::AnyCan: file: lib/Specio/Constraint/AnyCan.pm version: '0.50' Specio::Constraint::AnyDoes: file: lib/Specio/Constraint/AnyDoes.pm version: '0.50' Specio::Constraint::AnyIsa: file: lib/Specio/Constraint/AnyIsa.pm version: '0.50' Specio::Constraint::Enum: file: lib/Specio/Constraint/Enum.pm version: '0.50' Specio::Constraint::Intersection: file: lib/Specio/Constraint/Intersection.pm version: '0.50' Specio::Constraint::ObjectCan: file: lib/Specio/Constraint/ObjectCan.pm version: '0.50' Specio::Constraint::ObjectDoes: file: lib/Specio/Constraint/ObjectDoes.pm version: '0.50' Specio::Constraint::ObjectIsa: file: lib/Specio/Constraint/ObjectIsa.pm version: '0.50' Specio::Constraint::Parameterizable: file: lib/Specio/Constraint/Parameterizable.pm version: '0.50' Specio::Constraint::Parameterized: file: lib/Specio/Constraint/Parameterized.pm version: '0.50' Specio::Constraint::Role::CanType: file: lib/Specio/Constraint/Role/CanType.pm version: '0.50' Specio::Constraint::Role::DoesType: file: lib/Specio/Constraint/Role/DoesType.pm version: '0.50' Specio::Constraint::Role::Interface: file: lib/Specio/Constraint/Role/Interface.pm version: '0.50' Specio::Constraint::Role::IsaType: file: lib/Specio/Constraint/Role/IsaType.pm version: '0.50' Specio::Constraint::Simple: file: lib/Specio/Constraint/Simple.pm version: '0.50' Specio::Constraint::Structurable: file: lib/Specio/Constraint/Structurable.pm version: '0.50' Specio::Constraint::Structured: file: lib/Specio/Constraint/Structured.pm version: '0.50' Specio::Constraint::Union: file: lib/Specio/Constraint/Union.pm version: '0.50' Specio::Declare: file: lib/Specio/Declare.pm version: '0.50' Specio::DeclaredAt: file: lib/Specio/DeclaredAt.pm version: '0.50' Specio::Exception: file: lib/Specio/Exception.pm version: '0.50' Specio::Exporter: file: lib/Specio/Exporter.pm version: '0.50' Specio::Helpers: file: lib/Specio/Helpers.pm version: '0.50' Specio::Library::Builtins: file: lib/Specio/Library/Builtins.pm version: '0.50' Specio::Library::Numeric: file: lib/Specio/Library/Numeric.pm version: '0.50' Specio::Library::Perl: file: lib/Specio/Library/Perl.pm version: '0.50' Specio::Library::String: file: lib/Specio/Library/String.pm version: '0.50' Specio::Library::Structured: file: lib/Specio/Library/Structured.pm version: '0.50' Specio::Library::Structured::Dict: file: lib/Specio/Library/Structured/Dict.pm version: '0.50' Specio::Library::Structured::Map: file: lib/Specio/Library/Structured/Map.pm version: '0.50' Specio::Library::Structured::Tuple: file: lib/Specio/Library/Structured/Tuple.pm version: '0.50' Specio::OO: file: lib/Specio/OO.pm version: '0.50' Specio::PartialDump: file: lib/Specio/PartialDump.pm version: '0.50' Specio::Registry: file: lib/Specio/Registry.pm version: '0.50' Specio::Role::Inlinable: file: lib/Specio/Role/Inlinable.pm version: '0.50' Specio::Subs: file: lib/Specio/Subs.pm version: '0.50' Specio::TypeChecks: file: lib/Specio/TypeChecks.pm version: '0.50' Test::Specio: file: lib/Test/Specio.pm version: '0.50' recommends: Ref::Util: '0.112' Sub::Util: '1.40' requires: B: '0' Carp: '0' Clone: '0' Devel::StackTrace: '0' Eval::Closure: '0' Exporter: '0' IO::File: '0' List::Util: '1.33' MRO::Compat: '0' Module::Runtime: '0' Role::Tiny: '1.003003' Role::Tiny::With: '0' Scalar::Util: '0' Sub::Quote: '0' Test::Fatal: '0' Test::More: '0.96' Try::Tiny: '0' overload: '0' parent: '0' perl: '5.008' re: '0' strict: '0' version: '0.83' warnings: '0' resources: bugtracker: https://github.com/houseabsolute/Specio/issues homepage: https://metacpan.org/release/Specio repository: git://github.com/houseabsolute/Specio.git version: '0.50' x_Dist_Zilla: perl: version: '5.038002' plugins: - class: Dist::Zilla::Plugin::DROLSKY::BundleAuthordep name: '@DROLSKY/DROLSKY::BundleAuthordep' version: '1.22' - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - CODE_OF_CONDUCT.md - CONTRIBUTING.md - LICENSE - Makefile.PL - README.md - cpanfile exclude_match: [] include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: '@DROLSKY/Git::GatherDir' version: '2.051' - class: Dist::Zilla::Plugin::ManifestSkip name: '@DROLSKY/ManifestSkip' version: '6.032' - class: Dist::Zilla::Plugin::License name: '@DROLSKY/License' version: '6.032' - class: Dist::Zilla::Plugin::ExecDir name: '@DROLSKY/ExecDir' version: '6.032' - class: Dist::Zilla::Plugin::ShareDir name: '@DROLSKY/ShareDir' version: '6.032' - class: Dist::Zilla::Plugin::Manifest name: '@DROLSKY/Manifest' version: '6.032' - class: Dist::Zilla::Plugin::CheckVersionIncrement name: '@DROLSKY/CheckVersionIncrement' version: '0.121750' - class: Dist::Zilla::Plugin::TestRelease name: '@DROLSKY/TestRelease' version: '6.032' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@DROLSKY/ConfirmRelease' version: '6.032' - class: Dist::Zilla::Plugin::UploadToCPAN name: '@DROLSKY/UploadToCPAN' version: '6.032' - class: Dist::Zilla::Plugin::VersionFromMainModule config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: '@DROLSKY/VersionFromMainModule' version: '0.04' - class: Dist::Zilla::Plugin::Authority name: '@DROLSKY/Authority' version: '1.009' - class: Dist::Zilla::Plugin::AutoPrereqs name: '@DROLSKY/AutoPrereqs' version: '6.032' - class: Dist::Zilla::Plugin::CopyFilesFromBuild name: '@DROLSKY/CopyFilesFromBuild' version: '0.170880' - class: Dist::Zilla::Plugin::GitHub::Meta name: '@DROLSKY/GitHub::Meta' version: '0.49' - class: Dist::Zilla::Plugin::GitHub::Update config: Dist::Zilla::Plugin::GitHub::Update: metacpan: 1 name: '@DROLSKY/GitHub::Update' version: '0.49' - class: Dist::Zilla::Plugin::MetaResources name: '@DROLSKY/MetaResources' version: '6.032' - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: finder_objects: - class: Dist::Zilla::Plugin::FinderCode name: '@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.032' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' inherit_missing: 1 inherit_version: 1 meta_noindex: 1 Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: '@DROLSKY/MetaProvides::Package' version: '2.004003' - class: Dist::Zilla::Plugin::Meta::Contributors name: '@DROLSKY/Meta::Contributors' version: '0.003' - class: Dist::Zilla::Plugin::MetaConfig name: '@DROLSKY/MetaConfig' version: '6.032' - class: Dist::Zilla::Plugin::MetaJSON name: '@DROLSKY/MetaJSON' version: '6.032' - class: Dist::Zilla::Plugin::MetaYAML name: '@DROLSKY/MetaYAML' version: '6.032' - class: Dist::Zilla::Plugin::NextRelease name: '@DROLSKY/NextRelease' version: '6.032' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: test type: requires name: '@DROLSKY/Test::More with subtest' version: '6.032' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: '@DROLSKY/Tools for use with precious' version: '6.032' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: '@DROLSKY/Test::Version which fixes https://github.com/plicease/Test-Version/issues/7' version: '6.032' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 0 check_all_prereqs: 0 modules: - Dist::Zilla::PluginBundle::DROLSKY phase: build run_under_travis: 0 skip: [] name: '@DROLSKY/Dist::Zilla::PluginBundle::DROLSKY' version: '0.060' - class: Dist::Zilla::Plugin::PromptIfStale config: Dist::Zilla::Plugin::PromptIfStale: check_all_plugins: 1 check_all_prereqs: 1 modules: [] phase: release run_under_travis: 0 skip: - Dist::Zilla::Plugin::DROLSKY::BundleAuthordep - Dist::Zilla::Plugin::DROLSKY::Contributors - Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch - Dist::Zilla::Plugin::DROLSKY::License - Dist::Zilla::Plugin::DROLSKY::MakeMaker - Dist::Zilla::Plugin::DROLSKY::PerlLinterConfigFiles - Dist::Zilla::Plugin::DROLSKY::Precious - Dist::Zilla::Plugin::DROLSKY::Test::Precious - Dist::Zilla::Plugin::DROLSKY::WeaverConfig - Pod::Weaver::PluginBundle::DROLSKY name: '@DROLSKY/PromptIfStale' version: '0.060' - class: Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable name: '@DROLSKY/Test::Pod::Coverage::Configurable' version: '0.07' - class: Dist::Zilla::Plugin::Test::PodSpelling config: Dist::Zilla::Plugin::Test::PodSpelling: directories: - bin - lib spell_cmd: '' stopwords: - API - ClassName - Coercions - DROLSKY - "DROLSKY's" - Kogman - LaxVersionStr - MUTC - ModuleName - NegativeInt - NegativeNum - NegativeOrZeroInt - NegativeOrZeroNum - NonEmptySimpleStr - NonEmptyStr - Num - PARAMETERIZABLE - PackageName - PayPal - PayPal - PositiveInt - PositiveNum - PositiveOrZeroInt - PositiveOrZeroNum - RegexpRef - Rolsky - Rolsky - "Rolsky's" - SIGNES - SPECIO - SafeIdentifier - ScalarRef - SimpleStr - SingleDigit - Specio - Str - StrictVersionStr - Throwable - Yuval - boolification - coercions - de - distro - drolsky - globification - inlinable - inline - isa - namespace - numification - parameterizable - parameterization - parameterized - reimplementation - sigils - slurpy - structurable - subtype - subtypes wordlist: Pod::Wordlist name: '@DROLSKY/Test::PodSpelling' version: '2.007006' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@DROLSKY/PodSyntaxTests' version: '6.032' - class: Dist::Zilla::Plugin::MojibakeTests name: '@DROLSKY/MojibakeTests' version: '0.8' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: '12' name: '@DROLSKY/RunExtraTests' version: '0.029' - class: Dist::Zilla::Plugin::Test::CPAN::Changes config: Dist::Zilla::Plugin::Test::CPAN::Changes: changelog: Changes filename: xt/release/cpan-changes.t name: '@DROLSKY/Test::CPAN::Changes' version: '0.013' - class: Dist::Zilla::Plugin::Test::CPAN::Meta::JSON name: '@DROLSKY/Test::CPAN::Meta::JSON' version: '0.004' - class: Dist::Zilla::Plugin::Test::EOL config: Dist::Zilla::Plugin::Test::EOL: filename: xt/author/eol.t finder: - ':ExecFiles' - ':InstallModules' - ':TestFiles' trailing_whitespace: 1 name: '@DROLSKY/Test::EOL' version: '0.19' - class: Dist::Zilla::Plugin::Test::NoTabs config: Dist::Zilla::Plugin::Test::NoTabs: filename: xt/author/no-tabs.t finder: - ':InstallModules' - ':ExecFiles' - ':TestFiles' name: '@DROLSKY/Test::NoTabs' version: '0.15' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: '@DROLSKY/Test::Portability' version: '2.001003' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: 0 fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: '@DROLSKY/Test::Compile' version: '2.058' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: '@DROLSKY/Test::ReportPrereqs' version: '0.029' - class: Dist::Zilla::Plugin::Test::Version name: '@DROLSKY/Test::Version' version: '1.09' - class: Dist::Zilla::Plugin::DROLSKY::Test::Precious name: '@DROLSKY/DROLSKY::Test::Precious' version: '1.22' - class: Dist::Zilla::Plugin::DROLSKY::Contributors name: '@DROLSKY/DROLSKY::Contributors' version: '1.22' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.48.1 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: '@DROLSKY/Git::Contributors' version: '0.037' - class: Dist::Zilla::Plugin::SurgicalPodWeaver config: Dist::Zilla::Plugin::PodWeaver: config_plugins: - '@DROLSKY' finder: - ':InstallModules' - ':PerlExecFiles' plugins: - class: Pod::Weaver::Plugin::EnsurePod5 name: '@CorePrep/EnsurePod5' version: '4.019' - class: Pod::Weaver::Plugin::H1Nester name: '@CorePrep/H1Nester' version: '4.019' - class: Pod::Weaver::Plugin::SingleEncoding name: '@DROLSKY/SingleEncoding' version: '4.019' - class: Pod::Weaver::Plugin::Transformer name: '@DROLSKY/List' version: '4.019' - class: Pod::Weaver::Plugin::Transformer name: '@DROLSKY/Verbatim' version: '4.019' - class: Pod::Weaver::Section::Region name: '@DROLSKY/header' version: '4.019' - class: Pod::Weaver::Section::Name name: '@DROLSKY/Name' version: '4.019' - class: Pod::Weaver::Section::Version name: '@DROLSKY/Version' version: '4.019' - class: Pod::Weaver::Section::Region name: '@DROLSKY/prelude' version: '4.019' - class: Pod::Weaver::Section::Generic name: SYNOPSIS version: '4.019' - class: Pod::Weaver::Section::Generic name: DESCRIPTION version: '4.019' - class: Pod::Weaver::Section::Generic name: OVERVIEW version: '4.019' - class: Pod::Weaver::Section::Collect name: ATTRIBUTES version: '4.019' - class: Pod::Weaver::Section::Collect name: METHODS version: '4.019' - class: Pod::Weaver::Section::Collect name: FUNCTIONS version: '4.019' - class: Pod::Weaver::Section::Collect name: TYPES version: '4.019' - class: Pod::Weaver::Section::Leftovers name: '@DROLSKY/Leftovers' version: '4.019' - class: Pod::Weaver::Section::Region name: '@DROLSKY/postlude' version: '4.019' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate SUPPORT' version: '4.019' - class: Pod::Weaver::Section::AllowOverride name: '@DROLSKY/allow override SUPPORT' version: '0.05' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate SOURCE' version: '4.019' - class: Pod::Weaver::Section::GenerateSection name: '@DROLSKY/generate DONATIONS' version: '4.019' - class: Pod::Weaver::Section::Authors name: '@DROLSKY/Authors' version: '4.019' - class: Pod::Weaver::Section::Contributors name: '@DROLSKY/Contributors' version: '0.009' - class: Pod::Weaver::Section::Legal name: '@DROLSKY/Legal' version: '4.019' - class: Pod::Weaver::Section::AllowOverride name: '@DROLSKY/allow override Legal' version: '0.05' - class: Pod::Weaver::Section::Region name: '@DROLSKY/footer' version: '4.019' name: '@DROLSKY/SurgicalPodWeaver' version: '0.0023' - class: Dist::Zilla::Plugin::DROLSKY::WeaverConfig name: '@DROLSKY/DROLSKY::WeaverConfig' version: '1.22' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: '@DROLSKY/README.md in build' version: '0.163250' - class: Dist::Zilla::Plugin::GenerateFile::FromShareDir config: Dist::Zilla::Plugin::GenerateFile::FromShareDir: destination_filename: CONTRIBUTING.md dist: Dist-Zilla-PluginBundle-DROLSKY encoding: UTF-8 has_xs: 0 location: build source_filename: CONTRIBUTING.md Dist::Zilla::Role::RepoFileInjector: allow_overwrite: 1 repo_root: . version: '0.009' name: '@DROLSKY/Generate CONTRIBUTING.md' version: '0.015' - class: Dist::Zilla::Plugin::GenerateFile::FromShareDir config: Dist::Zilla::Plugin::GenerateFile::FromShareDir: destination_filename: CODE_OF_CONDUCT.md dist: Dist-Zilla-PluginBundle-DROLSKY encoding: UTF-8 has_xs: 0 location: build source_filename: CODE_OF_CONDUCT.md Dist::Zilla::Role::RepoFileInjector: allow_overwrite: 1 repo_root: . version: '0.009' name: '@DROLSKY/Generate CODE_OF_CONDUCT.md' version: '0.015' - class: Dist::Zilla::Plugin::InstallGuide config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: '@DROLSKY/InstallGuide' version: '1.200014' - class: Dist::Zilla::Plugin::CPANFile name: '@DROLSKY/CPANFile' version: '6.032' - class: Dist::Zilla::Plugin::DROLSKY::License name: '@DROLSKY/DROLSKY::License' version: '1.22' - class: Dist::Zilla::Plugin::CheckStrictVersion name: '@DROLSKY/CheckStrictVersion' version: '0.001' - class: Dist::Zilla::Plugin::CheckSelfDependency config: Dist::Zilla::Plugin::CheckSelfDependency: finder: - ':InstallModules' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: '@DROLSKY/CheckSelfDependency' version: '0.011' - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: '@DROLSKY/CheckPrereqsIndexed' version: '0.022' - class: Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch config: Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . name: '@DROLSKY/DROLSKY::Git::CheckFor::CorrectBranch' version: '1.22' - class: Dist::Zilla::Plugin::EnsureChangesHasContent name: '@DROLSKY/EnsureChangesHasContent' version: '0.02' - class: Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts config: Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . name: '@DROLSKY/Git::CheckFor::MergeConflicts' version: '0.014' - class: Dist::Zilla::Plugin::DROLSKY::PerlLinterConfigFiles name: '@DROLSKY/DROLSKY::PerlLinterConfigFiles' version: '1.22' - class: Dist::Zilla::Plugin::DROLSKY::DevTools name: '@DROLSKY/DROLSKY::DevTools' version: '1.22' - class: Dist::Zilla::Plugin::DROLSKY::Precious name: '@DROLSKY/DROLSKY::Precious' version: '1.22' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - CODE_OF_CONDUCT.md - CONTRIBUTING.md - Changes - LICENSE - Makefile.PL - README.md - cpanfile - precious.toml allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . name: '@DROLSKY/Git::Check' version: '2.051' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: v%V%n%n%c signoff: 0 Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - CODE_OF_CONDUCT.md - CONTRIBUTING.md - Changes - LICENSE - Makefile.PL - README.md - cpanfile - precious.toml allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Commit generated files' version: '2.051' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v0.50 tag_format: v%V tag_message: v%V Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Git::Tag' version: '2.051' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . name: '@DROLSKY/Git::Push' version: '2.051' - class: Dist::Zilla::Plugin::BumpVersionAfterRelease config: Dist::Zilla::Plugin::BumpVersionAfterRelease: finders: - ':ExecFiles' - ':InstallModules' global: 0 munge_makefile_pl: 1 name: '@DROLSKY/BumpVersionAfterRelease' version: '0.018' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] commit_msg: 'Bump version after release' signoff: 0 Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: - (?^:.+) changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@DROLSKY/Commit version bump' version: '2.051' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.48.1 repo_root: . name: '@DROLSKY/Push version bump' version: '2.051' - class: Dist::Zilla::Plugin::DROLSKY::MakeMaker config: Dist::Zilla::Plugin::MakeMaker: make_path: make version: '6.032' Dist::Zilla::Plugin::MakeMaker::Awesome: version: '0.49' Dist::Zilla::Role::TestRunner: default_jobs: '12' version: '6.032' name: '@DROLSKY/DROLSKY::MakeMaker' version: '1.22' - class: Dist::Zilla::Plugin::Prereqs::Soften config: Dist::Zilla::Plugin::Prereqs::Soften: copy_to: [] modules: - Ref::Util - Sub::Util modules_from_features: ~ to_relationship: recommends name: Prereqs::Soften version: '0.006003' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: develop type: requires name: DevelopRequires version: '6.032' - class: Dist::Zilla::Plugin::DynamicPrereqs config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000037' version: '0.006' name: DynamicPrereqs version: '0.040' - class: Dist::Zilla::Plugin::MetaNoIndex name: MetaNoIndex version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.032' - class: Dist::Zilla::Plugin::FinderCode name: '@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM' version: '6.032' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: 0 version: '6.032' x_authority: cpan:DROLSKY x_contributors: - 'Chris White ' - 'cpansprout ' - 'Graham Knop ' - 'Karen Etheridge ' - 'Vitaly Lipatov ' x_generated_by_perl: v5.38.2 x_serialization_backend: 'YAML::Tiny version 1.74' x_spdx_expression: Artistic-2.0 Specio-0.50/Changes0000644000175000017500000003121414755224347014031 0ustar autarchautarch0.50 2025-02-18 - Fixed a bug in the Int type that caused it to accept numbers like 124512.000000000123, which when stringified, are stringified as integers. 0.49 2024-12-23 - Attempting to import any structured type caused a confusing "Can't store CODE items" error. Reported by Kerin Millar. - Removed the "this is alpha" warning from Specio::Library::Structured. Given that I don't plan on making any major changes to this module, it's as production-ready as it's going to get. 0.48 2022-06-11 - Importing types into a class which inherited from another class that had imported types wouldn't work, leaving the child class with no `t()` sub. Patch by Kerin Millar. 0.47 2021-01-29 - Change Specio constraint object's stringification overloading to return the type name rather than the default Perl object stringification, which gives you something like "Specio::Constraint::Parameterized=HASH(0x564d258efb48)". Anonymous types are special cased to return something you can print. - All types now overload the `eq` comparison operator. Moose expects types to be comparable in this manner when doing role summation. This fixes a bug reported by Martin Gruner. GH #18. 0.46 2020-03-14 - No code changes, just fixing a mistake in the POD. Reported by Petr Pisar. GH #17. 0.45 2019-11-24 - Made XString a prereq if installing with Perl 5.10+. 0.44 2019-08-14 - Replaced the use of B with XString if it is installed. The latter is much smaller and provides the one subroutine from B we cared about. Based on GH #15. Implemented by Nicolas R. 0.43 2018-10-26 - Optimized compile-time operations to make Specio itself quicker to load. Specio's load time is a non-trivial part of the load time of DateTime (and presumably other things that use it). Based on https://github.com/houseabsolute/DateTime.pm/issues/85. Reported by versable. 0.42 2017-11-04 - The Perl library claimed it provided types named LaxVersionStr and StrictVersionStr but they were really named LaxVersion and StrictVersion. The names have now been fixed to match the documentation, so they are LaxVersionStr and StrictVersionStr. 0.41 2017-11-04 - Fixed checks for whether a class is loaded in light of upcoming optimization in Perl 5.28. Fixed by Sprout (GH #12). 0.40 2017-08-03 - Fixed more bugs with {any,object}_{can,does,isa}_type. When passed a glob (not a globref) they would die in their type check. On Perl 5.16 or earlier, passing a number to an any_* type would also die. - Fixed subification overloading. If Sub::Quote was loaded, this would be used, but any environment variables needed for the closure would not be included. This broke enums, among other things. 0.39 2017-08-02 - Many bug fixes and improves to the types created by {any,object}_{can,does,isa}_type. In some cases, an invalid value could cause an exception in type check itself. In other cases, a value which failed a type check would cause an exception when generating a message describing the failure. These cases have all been fixed. - The messages describing a failure for all of these types have been improved. - You can now create anonymous *_does and *_isa types using the exports from Specio::Declare. 0.38 2017-07-01 - Simplify checks for overloading to not call overload::Overloaded(). Just checking the return value of overload::Method() is sufficient. 0.37 2017-05-09 - Possible fix for very weird failures seen under threaded Perls with some modules that use Specio. 0.36 2017-02-19 - Inlined coercions would attempt to coerce for every type which matched the value given, instead of stopping after the first type. Fixed by Graham Knop (GH #11). - Inlined coercions did not include the inline environment variables needed by the type from which the coercion was being performed. Fixed by Graham Knop (GH #8). - When you use the same type repeatedly as coderef (for example, as a constraint with Moo), it will only generated its subified form once, rather than regenerating it each time it is de-referenced. - Added an API to Specio::Subs to allow you to combine type libraries and helper subs in one package for exporting. See the Specio::Exporter docs for more details. 0.35 2017-02-12 - Added Specio::Subs, a module which allows you to turn one or more library's types into subroutines like is_Int() and to_Int(). - Added an inline_coercion method to Specio constraints. 0.34 2017-01-29 - Packages with Specio::Exporter as their parent can now specify additional arbitrary subs to exporter. See the Specio::Exporter docs for details. - Importing the same library twice in a given package would throw an exception. The second attempt to import is now ignored. - Added an alpha implementation of structured types. See Specio::Library::Structured for details. 0.33 2017-01-24 - Fixed a mistake in the SYNOPSIS for Specio::Declare. The example for the *_isa_type helpers was not correct. - Removed the alpha warning from the docs. This is being used by enough of my modules on CPAN that I don't plan on doing any big breaking changes without a deprecation first. 0.32 2017-01-12 - Fixed a bug in the inlining for types create by any_can_type() and object_can_type(). This inlining mostly worked by accident because of some List::Util XS magic, but this broke under the debugger. Reported by Christian Walde (GH #6) and Chan Wilson (https://github.com/houseabsolute/DateTime.pm/issues/49). 0.31 2016-11-05 - The stack trace contained by Specio::Exception objects no longer includes a stack frames for the Specio::Exception package. - Made the inline_environment() and description() methods public on type and coercion objects. 0.30 2016-10-15 - Fix a bug with the Sub::Quoted sub returned by $type->coercion_sub. If a type had more than one coercion, the generated sub could end up coercing the value to undef some of the time. Depending on hash key ordering, this could end up being a heisenbug that only occured some of the time. 0.29 2016-10-09 - Doc Specio::PartialDump because you may want to use it as part of the failure message generation code for a type. 0.28 2016-10-02 - Added a Test::Specio module to provide helpers for testing Specio libraries. - Fixed another bug with a subtype of special types and inlining. 0.27 2016-10-01 - Cloning a type with coercions defined on it would cause an exception. - Creating a subtype of a special type created by *_isa_type, *_can_type, or *_does_type, or enum would die when trying to inline the type constraint. - Removed the never-documented Any type. - Added documentation for each type in Specio::Library::Builtins. 0.26 2016-09-24 - Require Role::Tiny 1.003003. This should fix the test failures some CPANTesters reported with this error: Can't resolve method "???" overloading "&{}" in package "Specio::Constraint::Simple" at Specio::Constraint::Simple->new line 35. 0.25 2016-09-04 - Calling {any,object}_{isa,does}_type repeatedly in a package with the same class or role name would die. These subs are now special-cased to simply return an existing type for the given name when they receive a single argument (the name of the class or role). This could come up if you had two attributes both of which required an object of the same type. 0.24 2016-06-20 - Fix a bizarre failure on Perl before 5.14. AFAICT this was a test problem, not a library problem. 0.23 2016-06-20 - Added intersection types. 0.22 2016-06-18 - Require version.pm 0.83. I know 0.77 doesn't work but I'm not sure exactly which version fixed the problem, since I cannot install older versions. Reported by Slaven Rezic. RT #115418. 0.21 2016-06-18 - Don't load Sub::Quote, but use it if it's already loaded. Since Moo uses it, this should make Specio constraints just work with Moo. 0.20 2016-06-18 - Removed test dependency on namespace::autoclean. 0.19 2016-06-17 - Removed dependency on Devel::PartialDump by making a copy of just the bits we need. Gross but effective. 0.18 2016-06-15 - Added union types. - If a subtype's parent could be inlined and the subtype itself did not specify any additional constraints (inlinable or not), then the subtype was not being inlined, even though it could be. - This distro now works with Perl 5.8 (though it was only tested with 5.8.8). 0.17 2016-06-01 - Change "use v5.10" to "use 5.010". The former appears to cause warnings on older Perls. 0.16 2016-05-30 - Remove use of Class::Load and Module::Runtime. 0.15 2016-05-30 - The Num and Int type now accepts numbers in scientific notation such as 1e10 or -1.2e-5. - Removed various prereqs that weren't really needed. - Added three new libraries, Specio::Library::String, ::Numeric, and ::Perl. These provide additional commonly used string and numeric types, as well as some types related to Perl syntax. 0.14 2016-05-22 - Added an inline_assert method for constraint objects. This makes certain types of inlining tasks easier. - Parameterized constraint objects now have a default name based on the parent type and contained type. - Rewrote the code used for inlined types so that the generated inline code is optimized to check the most common cases first. - Fixed a bug where two enum types could not be inlined together in the same sub. 0.13 2016-05-15 - Parameterizing a type which generated inline parameterized constraints (like the ArrayRef and HashRef builtins) now dies if given a parameter which cannot itself be inlined. Mixing inlinable and non-inlinable constraints previously caused very confusing errors. 0.12 2015-12-19 - Fixed tests that failed if Moose wasn't installed. Reported by Karen Etheridge. RT #109247. 0.11 2014-05-27 - Remove a Perl 5.14-ism. 0.10 2014-05-26 - Added Class::Method::Modifiers to prereqs. - Made Specio classes faster by inlining all accessors and constructors. - Added support for Moo. Specio constraints now overloading sub-ification so you can pass them as "isa" values for Moo attributes. Also added a new $type->coercion_sub() method which returns a sub ref suitable for the "coerce" value. These all use Sub::Quote so that the returned sub refs can be inlined. 0.09 2014-05-25 - Reimplemented entirely without Moose. This module now implements its own half-assed (really, more like eighth-assed) OO system. * TODO: Integrate cleanly with Moo and Moose. * TODO: Improve the internal OO system to do some eighth-assed inlining so creating type objects is faster. 0.08 2013-06-08 - Removed the use of the encoding pragma from the tests. This pragma is deprecated in 5.18. 0.07 2013-03-03 - Disabled the tests that rely on an as-yet-unreleased Moose. These were mostly disabled but some cpan testers boxes were set up in a way that made them run. 0.06 2013-03-02 - Renamed Type to Specio. 0.05 2012-10-14 - This module didn't really need XS. It turns out that 5.10 added re::is_regexp() so we can use that instead. Thanks to Jesse Luehrs for pointing this out. 0.04 2012-09-30 - Added any_does_type and object_does_type declaration helpers. These check whether a class and/or object does a given role. They work with Moose, Mouse, and Role::Tiny. - Fixed implementation of any_isa_type and object_isa_type to match docs. If given more than one argument, the docs said they expected named parameters but internally the code expected positional parameters. 0.03 2012-09-30 - Various hacks to make Specio::Constraint objects play nice with Moose. Needs changes to Moose to work properly, however. - The message generator sub is no longer called as a method. It is called as a sub so it doesn't receive the type as an argument. - The inline environment variable names used for each type are now unique. This means that types will not step on each other if you want to inline more than one type check in the same scope. - Non-inlined type coercions were completely broken. - Added $type->is_same_type_as and $type->is_a_type_of methods. - The Maybe type was a subtype of Ref in the code, which is wrong. It is now a subtype of Item. - This module now explicitly requires Perl 5.10. 0.02 2012-05-14 - Now with lots more documentation, but this is still very alpha. Feedback from potential users is welcome. 0.01 2012-05-13 - First release upon an unsuspecting world. This is very alpha and subject to change. I'm mostly releasing it to get some feedback on the design. Do not use this in your code yet, unless you promise not to complain about the lack of docs or the fact that the next release breaks your code. Specio-0.50/CONTRIBUTING.md0000644000175000017500000001031314755224347014764 0ustar autarchautarch# CONTRIBUTING Thank you for considering contributing to this distribution. This file contains instructions that will help you work with the source code. Please note that if you have any questions or difficulties, you can reach the maintainer(s) through the bug queue described later in this document (preferred), or by emailing the releaser directly. You are not required to follow any of the steps in this document to submit a patch or bug report; these are just recommendations, intended to help you (and help us help you faster). The distribution is managed with [Dist::Zilla](https://metacpan.org/release/Dist-Zilla). However, you can still compile and test the code with the `Makefile.PL` in the repository: perl Makefile.PL make make test You may need to satisfy some dependencies. The easiest way to satisfy dependencies is to install the last release. This is available at https://metacpan.org/release/Specio You can use [`cpanminus`](https://metacpan.org/pod/App::cpanminus) to do this without downloading the tarball first: $> cpanm --reinstall --installdeps --with-recommends Specio [`Dist::Zilla`](https://metacpan.org/pod/Dist::Zilla) is a very powerful authoring tool, but requires a number of author-specific plugins. If you would like to use it for contributing, install it from CPAN, then the following command to install the needed distros: $> dzil authordeps --missing | cpanm There may also be additional requirements not needed by the dzil build which are needed for tests or other development: $> dzil listdeps --author --missing | cpanm Or, you can use the 'dzil stale' command to install all requirements at once: $> cpanm Dist::Zilla::App::Command::stale $> dzil stale --all | cpanm You can also do this via cpanm directly: $> cpanm --reinstall --installdeps --with-develop --with-recommends Specio Once installed, here are some dzil commands you might try: $> dzil build $> dzil test $> dzil test --release $> dzil xtest $> dzil listdeps --json $> dzil build --notgz You can learn more about Dist::Zilla at http://dzil.org/. The code for this distribution is [hosted on GitHub](https://github.com/houseabsolute/Specio). You can submit code changes by forking the repository, pushing your code changes to your clone, and then submitting a pull request. Please update the Changes file with a user-facing description of your changes as part of your work. See the GitHub documentation for [detailed instructions on pull requests](https://help.github.com/articles/creating-a-pull-request) If you have found a bug, but do not have an accompanying patch to fix it, you can submit an issue report [via the web](https://github.com/houseabsolute/Specio/issues). ## Continuous Integration All pull requests for this distribution will be automatically tested using [Azure Pipelines](https://dev.azure.com/houseabsolute/houseabsolute/_build). All CI results will be visible in the pull request on GitHub. Follow the appropriate links for details when tests fail. PRs cannot be merged until tests pass. ## Precious This distribution uses [precious](https://github.com/houseabsolute/precious) to enforce a uniform coding style. This is tested as part of the author testing suite. You can install this and any other necessary non-Perl tools by running `./dev-bin/install-xt-tools.sh`. Then you can use `precious` to tidy and lint your code: $> precious tidy -a $> precious lint -a Please run `precious tidy -a` and `precious lint -a` before committing your changes and address any issues that it reports. You can also set up a git pre-commit hook that checks all changed files for linting issues by running `./git/setup.pl`. ## Contributor Names If you send a patch or pull request, your name and email address will be included in the documentation as a contributor (using the attribution on the commit or patch), unless you specifically request for it not to be. If you wish to be listed under a different name or address, you should submit a pull request to the `.mailmap` file to contain the correct mapping. ## Generated By This file was generated via Dist::Zilla::Plugin::GenerateFile::FromShareDir 0.015 from a template file originating in Dist-Zilla-PluginBundle-DROLSKY-1.22. Specio-0.50/LICENSE0000644000175000017500000002152714755224347013551 0ustar autarchautarchThis software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. Specio-0.50/git/0000775000175000017500000000000014755224347013322 5ustar autarchautarchSpecio-0.50/git/hooks/0000775000175000017500000000000014755224347014445 5ustar autarchautarchSpecio-0.50/git/hooks/pre-commit.sh0000755000175000017500000000027014755224347017055 0ustar autarchautarch#!/bin/bash status=0 PRECIOUS=$(which precious) if [[ -z $PRECIOUS ]]; then PRECIOUS=./bin/precious fi "$PRECIOUS" lint -s if (( $? != 0 )); then status+=1 fi exit $status Specio-0.50/git/setup.pl0000755000175000017500000000076414755224347015027 0ustar autarchautarch#!/usr/bin/env perl use strict; use warnings; use Cwd qw( abs_path ); symlink_hook('pre-commit'); sub symlink_hook { my $hook = shift; my $dot = ".git/hooks/$hook"; my $file = "git/hooks/$hook.sh"; my $link = "../../$file"; if ( -e $dot ) { if ( -l $dot ) { return if readlink $dot eq $link; } warn "You already have a hook at $dot!\n"; return; } symlink $link, $dot or die "Could not link $dot => $link: $!"; } Specio-0.50/README.md0000644000175000017500000003641514755224347014025 0ustar autarchautarch# NAME Specio - Type constraints and coercions for Perl # VERSION version 0.50 # SYNOPSIS package MyApp::Type::Library; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveInt', parent => t('Int'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && ( ' . $_[1] . ' > 0 )'; }, ); # or ... declare( 'PositiveInt', parent => t('Int'), where => sub { $_[0] > 0 }, ); declare( 'ArrayRefOfPositiveInt', parent => t( 'ArrayRef', of => t('PositiveInt'), ), ); coerce( 'ArrayRefOfPositiveInt', from => t('PositiveInt'), using => sub { [ $_[0] ] }, ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_isa_type('MyApp::Person'); # DESCRIPTION The `Specio` distribution provides classes for representing type constraints and coercion, along with syntax sugar for declaring them. Note that this is not a proper type system for Perl. Nothing in this distribution will magically make the Perl interpreter start checking a value's type on assignment to a variable. In fact, there's no built-in way to apply a type to a variable at all. Instead, you can explicitly check a value against a type, and optionally coerce values to that type. # WHAT IS A TYPE? At it's core, a type is simply a constraint. A constraint is code that checks a value and returns true or false. Most constraints are represented by [Specio::Constraint::Simple](https://metacpan.org/pod/Specio%3A%3AConstraint%3A%3ASimple) objects. However, there are other type constraint classes for specialized kinds of constraints. Types can be named or anonymous, and each type can have a parent type. A type's constraint is optional because sometimes you may want to create a named subtype of some existing type without adding additional constraints. Constraints can be expressed either in terms of a simple subroutine reference or in terms of an inline generator subroutine reference. The former is easier to write but the latter is preferred because it allow for better optimization. A type can also have an optional message generator subroutine reference. You can use this to provide a more intelligent error message when a value does not pass the constraint, though the default message should suffice for most cases. Finally, you can associate a set of coercions with a type. A coercion is a subroutine reference (or inline generator, like constraints), that takes a value of one type and turns it into a value that matches the type the coercion belongs to. # BUILTIN TYPES This distribution ships with a set of builtin types representing the types provided by the Perl interpreter itself. They are arranged in a hierarchy as follows: Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object The `Item` type accepts anything and everything. The `Bool` type only accepts `undef`, `0`, or `1`. The `Undef` type only accepts `undef`. The `Defined` type accepts anything _except_ `undef`. The `Num` and `Int` types are stricter about numbers than Perl is. Specifically, they do not allow any sort of space in the number, nor do they accept "Nan", "Inf", or "Infinity". The `ClassName` type constraint checks that the name is valid _and_ that the class is loaded. The `FileHandle` type accepts either a glob, a scalar filehandle, or anything that isa [IO::Handle](https://metacpan.org/pod/IO%3A%3AHandle). All types accept overloaded objects that support the required operation. See below for details. ## Overloading Perl's overloading is horribly broken and doesn't make much sense at all. However, unlike Moose, all type constraints allow overloaded objects where they make sense. For types where overloading makes sense, we explicitly check that the object provides the type overloading we expect. We _do not_ simply try to use the object as the type in question and hope it works. This means that these checks effectively ignore the `fallback` setting for the overloaded object. In other words, an object that overloads stringification will not pass the `Bool` type check unless it _also_ overloads boolification. Most types do not check that the overloaded method actually returns something that matches the constraint. This may change in the future. The `Bool` type accepts an object that implements `bool` overloading. The `Str` type accepts an object that implements string (`q{""}`) overloading. The `Num` type accepts an object that implements numeric (`'0+'}`) overloading. The `Int` type does as well, but it will check that the overloading returns an actual integer. The `ClassName` type will accept an object with string overloading that returns a class name. To make this all more confusing, the `Value` type will _never_ accept an object, even though some of its subtypes will. The various reference types all accept objects which provide the appropriate overloading. The `FileHandle` type accepts an object which overloads globification as long as the returned glob is an open filehandle. # PARAMETERIZABLE TYPES Any type followed by a type parameter `` of `a `` in the hierarchy above can be parameterized. The parameter is itself a type, so you can say you want an "ArrayRef of Int", or even an "ArrayRef of HashRef of ScalarRef of ClassName". When they are parameterized, the `ScalarRef` and `ArrayRef` types check that the value(s) they refer to match the type parameter. For the `HashRef` type, the parameter applies to the values (keys are never checked). ## Maybe The `Maybe` type is a special parameterized type. It allows for either `undef` or a value. All by itself, it is meaningless, since it is equivalent to "Maybe of Item", which is equivalent to Item. When parameterized, it accepts either an `undef` or the type of its parameter. This is useful for optional attributes or parameters. However, you're probably better off making your code simply not pass the parameter at all This usually makes for a simpler API. # REGISTRIES AND IMPORTING Types are local to each package where they are used. When you "import" types from some other library, you are actually making a copy of that type. This means that a type named "Foo" in one package may not be the same as "Foo" in another package. This has potential for confusion, but it also avoids the magic action at a distance pollution that comes with a global type naming system. The registry is managed internally by the Specio distribution's modules, and is not exposed to your code. To access a type, you always call `t('TypeName')`. This returns the named type or dies if no such type exists. Because types are always copied on import, it's safe to create coercions on any type. Your coercion from `Str` to `Int` will not be seen by any other package, unless that package explicitly imports your `Int` type. When you import types, you import every type defined in the package you import from. However, you _can_ overwrite an imported type with your own type definition. You _cannot_ define the same type twice internally. # CREATING A TYPE LIBRARY By default, all types created inside a package are invisible to other packages. If you want to create a type library, you need to inherit from [Specio::Exporter](https://metacpan.org/pod/Specio%3A%3AExporter) package: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); Now the MyApp::Type::Library package will export a single type named `Foo`. It _does not_ re-export the types provided by [Specio::Library::Builtins](https://metacpan.org/pod/Specio%3A%3ALibrary%3A%3ABuiltins). If you want to make your library re-export some other libraries types, you can ask for this explicitly: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; declare( 'Foo, ... ); Now MyApp::Types::Library exports any types it defines, as well as all the types defined in [Specio::Library::Builtins](https://metacpan.org/pod/Specio%3A%3ALibrary%3A%3ABuiltins). # DECLARING TYPES Use the [Specio::Declare](https://metacpan.org/pod/Specio%3A%3ADeclare) module to declare types. It exports a set of helpers for declaring types. See that module's documentation for more details on these helpers. # USING SPECIO WITH [Moose](https://metacpan.org/pod/Moose) This should just work. Use a Specio type anywhere you'd specify a type. # USING SPECIO WITH [Moo](https://metacpan.org/pod/Moo) Using Specio with Moo is easy. You can pass Specio constraint objects as `isa` parameters for attributes. For coercions, simply call `$type->coercion_sub`. package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; my $str_type = t('Str'); has string => ( is => 'ro', isa => $str_type, ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); The subs returned by Specio use [Sub::Quote](https://metacpan.org/pod/Sub%3A%3AQuote) internally and are suitable for inlining. # USING SPECIO WITH OTHER THINGS See [Specio::Constraint::Simple](https://metacpan.org/pod/Specio%3A%3AConstraint%3A%3ASimple) for the API that all constraint objects share. # [Moose](https://metacpan.org/pod/Moose), [MooseX::Types](https://metacpan.org/pod/MooseX%3A%3ATypes), and Specio This module aims to supplant both [Moose](https://metacpan.org/pod/Moose)'s built-in type system (see [Moose::Util::TypeConstraints](https://metacpan.org/pod/Moose%3A%3AUtil%3A%3ATypeConstraints) aka MUTC) and [MooseX::Types](https://metacpan.org/pod/MooseX%3A%3ATypes), which attempts to patch some of the holes in the Moose built-in type design. Here are some of the salient differences: - Types names are strings, but they're not global Unlike Moose and MooseX::Types, type names are always local to the current package. There is no possibility of name collision between different modules, so you can safely use short type names. Unlike MooseX::Types, types are strings, so there is no possibility of colliding with existing class or subroutine names. - No type auto-creation Types are always retrieved using the `t()` subroutine. If you pass an unknown name to this subroutine it dies. This is different from Moose and MooseX::Types, which assume that unknown names are class names. - Anon types are explicit With [Moose](https://metacpan.org/pod/Moose) and [MooseX::Types](https://metacpan.org/pod/MooseX%3A%3ATypes), you use the same subroutine, `subtype()`, to declare both named and anonymous types. With Specio, you use `declare()` for named types and `anon()` for anonymous types. - Class and object types are separate Moose and MooseX::Types have `class_type` and `duck_type`. The former type requires an object, while the latter accepts a class name or object. With Specio, the distinction between accepting an object versus object or class is explicit. There are six declaration helpers, `object_can_type`, `object_does_type`, `object_isa_type`, `any_can_type`, `any_does_type`, and `any_isa_type`. - Overloading support is baked in Perl's overloading is quite broken but ignoring it makes Moose's type system frustrating to use in many cases. - Types can either have a constraint or inline generator, not both Moose and MooseX::Types types can be defined with a subroutine reference as the constraint, an inline generator subroutine, or both. This is purely for backwards compatibility, and it makes the internals more complicated than they need to be. With Specio, a constraint can have _either_ a subroutine reference or an inline generator, not both. - Coercions can be inlined I simply never got around to implementing this in Moose. - No crazy coercion features Moose has some bizarre (and mostly) undocumented features relating to coercions and parameterizable types. This is a misfeature. # OPTIONAL PREREQS There are several optional prereqs that if installed will make this distribution better in some way. - [Ref::Util](https://metacpan.org/pod/Ref%3A%3AUtil) Installing this will speed up a number of type checks for built-in types. - [XString](https://metacpan.org/pod/XString) If this is installed it will be loaded instead of the [B](https://metacpan.org/pod/B) module if you have Perl 5.10 or greater. This module is much more memory efficient than loading all of [B](https://metacpan.org/pod/B). - [Sub::Util](https://metacpan.org/pod/Sub%3A%3AUtil) or [Sub::Name](https://metacpan.org/pod/Sub%3A%3AName) If one of these is installed then stack traces that end up in Specio code will have much better subroutine names for any frames. # WHY THE NAME? This distro was originally called "Type", but that's an awfully generic top level namespace. Specio is Latin for for "look at" and "spec" is the root for the word "species". It's short, relatively easy to type, and not used by any other distro. # SUPPORT Bugs may be submitted at [https://github.com/houseabsolute/Specio/issues](https://github.com/houseabsolute/Specio/issues). # SOURCE The source code repository for Specio can be found at [https://github.com/houseabsolute/Specio](https://github.com/houseabsolute/Specio). # DONATIONS If you'd like to thank me for the work I've done on this module, please consider making a "donation" to me via PayPal. I spend a lot of free time creating free software, and would appreciate any support you'd care to offer. Please note that **I am not suggesting that you must do this** in order for me to continue working on this particular software. I will continue to do so, inasmuch as I have in the past, for as long as it interests me. Similarly, a donation made in this way will probably not make me work on this software much more, unless I get so many donations that I can consider working on free software full time (let's all have a chuckle at that together). To donate, log into PayPal and send money to autarch@urth.org, or use the button at [https://houseabsolute.com/foss-donations/](https://houseabsolute.com/foss-donations/). # AUTHOR Dave Rolsky # CONTRIBUTORS - Chris White - cpansprout - Graham Knop - Karen Etheridge - Vitaly Lipatov # COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the `LICENSE` file included with this distribution. Specio-0.50/perltidyrc0000644000175000017500000000045514755224347014645 0ustar autarchautarch-l=78 -i=4 -ci=4 -se -b -bar -boc -vt=0 -vtc=0 -cti=0 -pt=1 -bt=1 -sbt=1 -bbt=1 -nolq -npro -nsfs --blank-lines-before-packages=0 --opening-hash-brace-right --no-outdent-long-comments --iterations=2 -wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x=" Specio-0.50/META.json0000644000175000017500000013156014755224347014164 0ustar autarchautarch{ "abstract" : "Type constraints and coercions for Perl", "author" : [ "Dave Rolsky " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Specio", "no_index" : { "directory" : [ "t/lib" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Capture::Tiny" : "0", "Encode" : "0", "File::Spec" : "0", "FindBin" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Moo" : "0", "Moose" : "2.1207", "Mouse" : "0", "Perl::Critic" : "1.138", "Perl::Critic::Moose" : "1.05", "Perl::Tidy" : "20210111", "Pod::Checker" : "1.74", "Pod::Coverage::TrustPod" : "0", "Pod::Tidy" : "0.10", "Pod::Wordlist" : "0", "Ref::Util" : "0.112", "Sub::Quote" : "0", "Test::CPAN::Changes" : "0.19", "Test::CPAN::Meta::JSON" : "0.16", "Test::EOL" : "0", "Test::Mojibake" : "0", "Test::More" : "0.88", "Test::NoTabs" : "0", "Test::Pod" : "1.41", "Test::Pod::Coverage" : "1.08", "Test::Portability::Files" : "0", "Test::Spelling" : "0.17", "Test::Version" : "2.05", "Test::Without::Module" : "0", "namespace::autoclean" : "0" } }, "runtime" : { "recommends" : { "Ref::Util" : "0.112", "Sub::Util" : "1.40" }, "requires" : { "B" : "0", "Carp" : "0", "Clone" : "0", "Devel::StackTrace" : "0", "Eval::Closure" : "0", "Exporter" : "0", "IO::File" : "0", "List::Util" : "1.33", "MRO::Compat" : "0", "Module::Runtime" : "0", "Role::Tiny" : "1.003003", "Role::Tiny::With" : "0", "Scalar::Util" : "0", "Sub::Quote" : "0", "Test::Fatal" : "0", "Test::More" : "0.96", "Try::Tiny" : "0", "overload" : "0", "parent" : "0", "perl" : "5.008", "re" : "0", "strict" : "0", "version" : "0.83", "warnings" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "ExtUtils::MakeMaker" : "0", "File::Spec" : "0", "FindBin" : "0", "Test::More" : "0.96", "Test::Needs" : "0", "lib" : "0", "open" : "0", "utf8" : "0" } } }, "provides" : { "Specio" : { "file" : "lib/Specio.pm", "version" : "0.50" }, "Specio::Coercion" : { "file" : "lib/Specio/Coercion.pm", "version" : "0.50" }, "Specio::Constraint::AnyCan" : { "file" : "lib/Specio/Constraint/AnyCan.pm", "version" : "0.50" }, "Specio::Constraint::AnyDoes" : { "file" : "lib/Specio/Constraint/AnyDoes.pm", "version" : "0.50" }, "Specio::Constraint::AnyIsa" : { "file" : "lib/Specio/Constraint/AnyIsa.pm", "version" : "0.50" }, "Specio::Constraint::Enum" : { "file" : "lib/Specio/Constraint/Enum.pm", "version" : "0.50" }, "Specio::Constraint::Intersection" : { "file" : "lib/Specio/Constraint/Intersection.pm", "version" : "0.50" }, "Specio::Constraint::ObjectCan" : { "file" : "lib/Specio/Constraint/ObjectCan.pm", "version" : "0.50" }, "Specio::Constraint::ObjectDoes" : { "file" : "lib/Specio/Constraint/ObjectDoes.pm", "version" : "0.50" }, "Specio::Constraint::ObjectIsa" : { "file" : "lib/Specio/Constraint/ObjectIsa.pm", "version" : "0.50" }, "Specio::Constraint::Parameterizable" : { "file" : "lib/Specio/Constraint/Parameterizable.pm", "version" : "0.50" }, "Specio::Constraint::Parameterized" : { "file" : "lib/Specio/Constraint/Parameterized.pm", "version" : "0.50" }, "Specio::Constraint::Role::CanType" : { "file" : "lib/Specio/Constraint/Role/CanType.pm", "version" : "0.50" }, "Specio::Constraint::Role::DoesType" : { "file" : "lib/Specio/Constraint/Role/DoesType.pm", "version" : "0.50" }, "Specio::Constraint::Role::Interface" : { "file" : "lib/Specio/Constraint/Role/Interface.pm", "version" : "0.50" }, "Specio::Constraint::Role::IsaType" : { "file" : "lib/Specio/Constraint/Role/IsaType.pm", "version" : "0.50" }, "Specio::Constraint::Simple" : { "file" : "lib/Specio/Constraint/Simple.pm", "version" : "0.50" }, "Specio::Constraint::Structurable" : { "file" : "lib/Specio/Constraint/Structurable.pm", "version" : "0.50" }, "Specio::Constraint::Structured" : { "file" : "lib/Specio/Constraint/Structured.pm", "version" : "0.50" }, "Specio::Constraint::Union" : { "file" : "lib/Specio/Constraint/Union.pm", "version" : "0.50" }, "Specio::Declare" : { "file" : "lib/Specio/Declare.pm", "version" : "0.50" }, "Specio::DeclaredAt" : { "file" : "lib/Specio/DeclaredAt.pm", "version" : "0.50" }, "Specio::Exception" : { "file" : "lib/Specio/Exception.pm", "version" : "0.50" }, "Specio::Exporter" : { "file" : "lib/Specio/Exporter.pm", "version" : "0.50" }, "Specio::Helpers" : { "file" : "lib/Specio/Helpers.pm", "version" : "0.50" }, "Specio::Library::Builtins" : { "file" : "lib/Specio/Library/Builtins.pm", "version" : "0.50" }, "Specio::Library::Numeric" : { "file" : "lib/Specio/Library/Numeric.pm", "version" : "0.50" }, "Specio::Library::Perl" : { "file" : "lib/Specio/Library/Perl.pm", "version" : "0.50" }, "Specio::Library::String" : { "file" : "lib/Specio/Library/String.pm", "version" : "0.50" }, "Specio::Library::Structured" : { "file" : "lib/Specio/Library/Structured.pm", "version" : "0.50" }, "Specio::Library::Structured::Dict" : { "file" : "lib/Specio/Library/Structured/Dict.pm", "version" : "0.50" }, "Specio::Library::Structured::Map" : { "file" : "lib/Specio/Library/Structured/Map.pm", "version" : "0.50" }, "Specio::Library::Structured::Tuple" : { "file" : "lib/Specio/Library/Structured/Tuple.pm", "version" : "0.50" }, "Specio::OO" : { "file" : "lib/Specio/OO.pm", "version" : "0.50" }, "Specio::PartialDump" : { "file" : "lib/Specio/PartialDump.pm", "version" : "0.50" }, "Specio::Registry" : { "file" : "lib/Specio/Registry.pm", "version" : "0.50" }, "Specio::Role::Inlinable" : { "file" : "lib/Specio/Role/Inlinable.pm", "version" : "0.50" }, "Specio::Subs" : { "file" : "lib/Specio/Subs.pm", "version" : "0.50" }, "Specio::TypeChecks" : { "file" : "lib/Specio/TypeChecks.pm", "version" : "0.50" }, "Test::Specio" : { "file" : "lib/Test/Specio.pm", "version" : "0.50" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/houseabsolute/Specio/issues" }, "homepage" : "https://metacpan.org/release/Specio", "repository" : { "type" : "git", "url" : "git://github.com/houseabsolute/Specio.git", "web" : "https://github.com/houseabsolute/Specio" } }, "version" : "0.50", "x_Dist_Zilla" : { "perl" : { "version" : "5.038002" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::DROLSKY::BundleAuthordep", "name" : "@DROLSKY/DROLSKY::BundleAuthordep", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "CODE_OF_CONDUCT.md", "CONTRIBUTING.md", "LICENSE", "Makefile.PL", "README.md", "cpanfile" ], "exclude_match" : [], "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "@DROLSKY/Git::GatherDir", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::ManifestSkip", "name" : "@DROLSKY/ManifestSkip", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "@DROLSKY/License", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::ExecDir", "name" : "@DROLSKY/ExecDir", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::ShareDir", "name" : "@DROLSKY/ShareDir", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "@DROLSKY/Manifest", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::CheckVersionIncrement", "name" : "@DROLSKY/CheckVersionIncrement", "version" : "0.121750" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "@DROLSKY/TestRelease", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@DROLSKY/ConfirmRelease", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "@DROLSKY/UploadToCPAN", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::VersionFromMainModule", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "@DROLSKY/VersionFromMainModule", "version" : "0.04" }, { "class" : "Dist::Zilla::Plugin::Authority", "name" : "@DROLSKY/Authority", "version" : "1.009" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "@DROLSKY/AutoPrereqs", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromBuild", "name" : "@DROLSKY/CopyFilesFromBuild", "version" : "0.170880" }, { "class" : "Dist::Zilla::Plugin::GitHub::Meta", "name" : "@DROLSKY/GitHub::Meta", "version" : "0.49" }, { "class" : "Dist::Zilla::Plugin::GitHub::Update", "config" : { "Dist::Zilla::Plugin::GitHub::Update" : { "metacpan" : 1 } }, "name" : "@DROLSKY/GitHub::Update", "version" : "0.49" }, { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "@DROLSKY/MetaResources", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : { "finder_objects" : [ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.032" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", "inherit_missing" : 1, "inherit_version" : 1, "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "@DROLSKY/MetaProvides::Package", "version" : "2.004003" }, { "class" : "Dist::Zilla::Plugin::Meta::Contributors", "name" : "@DROLSKY/Meta::Contributors", "version" : "0.003" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "@DROLSKY/MetaConfig", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "@DROLSKY/MetaJSON", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "@DROLSKY/MetaYAML", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "@DROLSKY/NextRelease", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "test", "type" : "requires" } }, "name" : "@DROLSKY/Test::More with subtest", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "@DROLSKY/Tools for use with precious", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "@DROLSKY/Test::Version which fixes https://github.com/plicease/Test-Version/issues/7", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 0, "check_all_prereqs" : 0, "modules" : [ "Dist::Zilla::PluginBundle::DROLSKY" ], "phase" : "build", "run_under_travis" : 0, "skip" : [] } }, "name" : "@DROLSKY/Dist::Zilla::PluginBundle::DROLSKY", "version" : "0.060" }, { "class" : "Dist::Zilla::Plugin::PromptIfStale", "config" : { "Dist::Zilla::Plugin::PromptIfStale" : { "check_all_plugins" : 1, "check_all_prereqs" : 1, "modules" : [], "phase" : "release", "run_under_travis" : 0, "skip" : [ "Dist::Zilla::Plugin::DROLSKY::BundleAuthordep", "Dist::Zilla::Plugin::DROLSKY::Contributors", "Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch", "Dist::Zilla::Plugin::DROLSKY::License", "Dist::Zilla::Plugin::DROLSKY::MakeMaker", "Dist::Zilla::Plugin::DROLSKY::PerlLinterConfigFiles", "Dist::Zilla::Plugin::DROLSKY::Precious", "Dist::Zilla::Plugin::DROLSKY::Test::Precious", "Dist::Zilla::Plugin::DROLSKY::WeaverConfig", "Pod::Weaver::PluginBundle::DROLSKY" ] } }, "name" : "@DROLSKY/PromptIfStale", "version" : "0.060" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable", "name" : "@DROLSKY/Test::Pod::Coverage::Configurable", "version" : "0.07" }, { "class" : "Dist::Zilla::Plugin::Test::PodSpelling", "config" : { "Dist::Zilla::Plugin::Test::PodSpelling" : { "directories" : [ "bin", "lib" ], "spell_cmd" : "", "stopwords" : [ "API", "ClassName", "Coercions", "DROLSKY", "DROLSKY's", "Kogman", "LaxVersionStr", "MUTC", "ModuleName", "NegativeInt", "NegativeNum", "NegativeOrZeroInt", "NegativeOrZeroNum", "NonEmptySimpleStr", "NonEmptyStr", "Num", "PARAMETERIZABLE", "PackageName", "PayPal", "PayPal", "PositiveInt", "PositiveNum", "PositiveOrZeroInt", "PositiveOrZeroNum", "RegexpRef", "Rolsky", "Rolsky", "Rolsky's", "SIGNES", "SPECIO", "SafeIdentifier", "ScalarRef", "SimpleStr", "SingleDigit", "Specio", "Str", "StrictVersionStr", "Throwable", "Yuval", "boolification", "coercions", "de", "distro", "drolsky", "globification", "inlinable", "inline", "isa", "namespace", "numification", "parameterizable", "parameterization", "parameterized", "reimplementation", "sigils", "slurpy", "structurable", "subtype", "subtypes" ], "wordlist" : "Pod::Wordlist" } }, "name" : "@DROLSKY/Test::PodSpelling", "version" : "2.007006" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@DROLSKY/PodSyntaxTests", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "@DROLSKY/MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "12" } }, "name" : "@DROLSKY/RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Changes", "config" : { "Dist::Zilla::Plugin::Test::CPAN::Changes" : { "changelog" : "Changes", "filename" : "xt/release/cpan-changes.t" } }, "name" : "@DROLSKY/Test::CPAN::Changes", "version" : "0.013" }, { "class" : "Dist::Zilla::Plugin::Test::CPAN::Meta::JSON", "name" : "@DROLSKY/Test::CPAN::Meta::JSON", "version" : "0.004" }, { "class" : "Dist::Zilla::Plugin::Test::EOL", "config" : { "Dist::Zilla::Plugin::Test::EOL" : { "filename" : "xt/author/eol.t", "finder" : [ ":ExecFiles", ":InstallModules", ":TestFiles" ], "trailing_whitespace" : 1 } }, "name" : "@DROLSKY/Test::EOL", "version" : "0.19" }, { "class" : "Dist::Zilla::Plugin::Test::NoTabs", "config" : { "Dist::Zilla::Plugin::Test::NoTabs" : { "filename" : "xt/author/no-tabs.t", "finder" : [ ":InstallModules", ":ExecFiles", ":TestFiles" ] } }, "name" : "@DROLSKY/Test::NoTabs", "version" : "0.15" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "@DROLSKY/Test::Portability", "version" : "2.001003" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : 0, "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "@DROLSKY/Test::Compile", "version" : "2.058" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "@DROLSKY/Test::ReportPrereqs", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::Test::Version", "name" : "@DROLSKY/Test::Version", "version" : "1.09" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Test::Precious", "name" : "@DROLSKY/DROLSKY::Test::Precious", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Contributors", "name" : "@DROLSKY/DROLSKY::Contributors", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.48.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "@DROLSKY/Git::Contributors", "version" : "0.037" }, { "class" : "Dist::Zilla::Plugin::SurgicalPodWeaver", "config" : { "Dist::Zilla::Plugin::PodWeaver" : { "config_plugins" : [ "@DROLSKY" ], "finder" : [ ":InstallModules", ":PerlExecFiles" ], "plugins" : [ { "class" : "Pod::Weaver::Plugin::EnsurePod5", "name" : "@CorePrep/EnsurePod5", "version" : "4.019" }, { "class" : "Pod::Weaver::Plugin::H1Nester", "name" : "@CorePrep/H1Nester", "version" : "4.019" }, { "class" : "Pod::Weaver::Plugin::SingleEncoding", "name" : "@DROLSKY/SingleEncoding", "version" : "4.019" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@DROLSKY/List", "version" : "4.019" }, { "class" : "Pod::Weaver::Plugin::Transformer", "name" : "@DROLSKY/Verbatim", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/header", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Name", "name" : "@DROLSKY/Name", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Version", "name" : "@DROLSKY/Version", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/prelude", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "SYNOPSIS", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "DESCRIPTION", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Generic", "name" : "OVERVIEW", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "ATTRIBUTES", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "METHODS", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "FUNCTIONS", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Collect", "name" : "TYPES", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Leftovers", "name" : "@DROLSKY/Leftovers", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/postlude", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate SUPPORT", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::AllowOverride", "name" : "@DROLSKY/allow override SUPPORT", "version" : "0.05" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate SOURCE", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::GenerateSection", "name" : "@DROLSKY/generate DONATIONS", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Authors", "name" : "@DROLSKY/Authors", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::Contributors", "name" : "@DROLSKY/Contributors", "version" : "0.009" }, { "class" : "Pod::Weaver::Section::Legal", "name" : "@DROLSKY/Legal", "version" : "4.019" }, { "class" : "Pod::Weaver::Section::AllowOverride", "name" : "@DROLSKY/allow override Legal", "version" : "0.05" }, { "class" : "Pod::Weaver::Section::Region", "name" : "@DROLSKY/footer", "version" : "4.019" } ] } }, "name" : "@DROLSKY/SurgicalPodWeaver", "version" : "0.0023" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::WeaverConfig", "name" : "@DROLSKY/DROLSKY::WeaverConfig", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "@DROLSKY/README.md in build", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::GenerateFile::FromShareDir", "config" : { "Dist::Zilla::Plugin::GenerateFile::FromShareDir" : { "destination_filename" : "CONTRIBUTING.md", "dist" : "Dist-Zilla-PluginBundle-DROLSKY", "encoding" : "UTF-8", "has_xs" : 0, "location" : "build", "source_filename" : "CONTRIBUTING.md" }, "Dist::Zilla::Role::RepoFileInjector" : { "allow_overwrite" : 1, "repo_root" : ".", "version" : "0.009" } }, "name" : "@DROLSKY/Generate CONTRIBUTING.md", "version" : "0.015" }, { "class" : "Dist::Zilla::Plugin::GenerateFile::FromShareDir", "config" : { "Dist::Zilla::Plugin::GenerateFile::FromShareDir" : { "destination_filename" : "CODE_OF_CONDUCT.md", "dist" : "Dist-Zilla-PluginBundle-DROLSKY", "encoding" : "UTF-8", "has_xs" : 0, "location" : "build", "source_filename" : "CODE_OF_CONDUCT.md" }, "Dist::Zilla::Role::RepoFileInjector" : { "allow_overwrite" : 1, "repo_root" : ".", "version" : "0.009" } }, "name" : "@DROLSKY/Generate CODE_OF_CONDUCT.md", "version" : "0.015" }, { "class" : "Dist::Zilla::Plugin::InstallGuide", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "@DROLSKY/InstallGuide", "version" : "1.200014" }, { "class" : "Dist::Zilla::Plugin::CPANFile", "name" : "@DROLSKY/CPANFile", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::License", "name" : "@DROLSKY/DROLSKY::License", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::CheckStrictVersion", "name" : "@DROLSKY/CheckStrictVersion", "version" : "0.001" }, { "class" : "Dist::Zilla::Plugin::CheckSelfDependency", "config" : { "Dist::Zilla::Plugin::CheckSelfDependency" : { "finder" : [ ":InstallModules" ] }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "@DROLSKY/CheckSelfDependency", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "@DROLSKY/CheckPrereqsIndexed", "version" : "0.022" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Git::CheckFor::CorrectBranch", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." } }, "name" : "@DROLSKY/DROLSKY::Git::CheckFor::CorrectBranch", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::EnsureChangesHasContent", "name" : "@DROLSKY/EnsureChangesHasContent", "version" : "0.02" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." } }, "name" : "@DROLSKY/Git::CheckFor::MergeConflicts", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::PerlLinterConfigFiles", "name" : "@DROLSKY/DROLSKY::PerlLinterConfigFiles", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::DevTools", "name" : "@DROLSKY/DROLSKY::DevTools", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::Precious", "name" : "@DROLSKY/DROLSKY::Precious", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "CODE_OF_CONDUCT.md", "CONTRIBUTING.md", "Changes", "LICENSE", "Makefile.PL", "README.md", "cpanfile", "precious.toml" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." } }, "name" : "@DROLSKY/Git::Check", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "v%V%n%n%c", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "CODE_OF_CONDUCT.md", "CONTRIBUTING.md", "Changes", "LICENSE", "Makefile.PL", "README.md", "cpanfile", "precious.toml" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Commit generated files", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v0.50", "tag_format" : "v%V", "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Git::Tag", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." } }, "name" : "@DROLSKY/Git::Push", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::BumpVersionAfterRelease", "config" : { "Dist::Zilla::Plugin::BumpVersionAfterRelease" : { "finders" : [ ":ExecFiles", ":InstallModules" ], "global" : 0, "munge_makefile_pl" : 1 } }, "name" : "@DROLSKY/BumpVersionAfterRelease", "version" : "0.018" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], "commit_msg" : "Bump version after release", "signoff" : 0 }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [ "(?^:.+)" ], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "@DROLSKY/Commit version bump", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.48.1", "repo_root" : "." } }, "name" : "@DROLSKY/Push version bump", "version" : "2.051" }, { "class" : "Dist::Zilla::Plugin::DROLSKY::MakeMaker", "config" : { "Dist::Zilla::Plugin::MakeMaker" : { "make_path" : "make", "version" : "6.032" }, "Dist::Zilla::Plugin::MakeMaker::Awesome" : { "version" : "0.49" }, "Dist::Zilla::Role::TestRunner" : { "default_jobs" : "12", "version" : "6.032" } }, "name" : "@DROLSKY/DROLSKY::MakeMaker", "version" : "1.22" }, { "class" : "Dist::Zilla::Plugin::Prereqs::Soften", "config" : { "Dist::Zilla::Plugin::Prereqs::Soften" : { "copy_to" : [], "modules" : [ "Ref::Util", "Sub::Util" ], "modules_from_features" : null, "to_relationship" : "recommends" } }, "name" : "Prereqs::Soften", "version" : "0.006003" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "develop", "type" : "requires" } }, "name" : "DevelopRequires", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::DynamicPrereqs", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000037", "version" : "0.006" } }, "name" : "DynamicPrereqs", "version" : "0.040" }, { "class" : "Dist::Zilla::Plugin::MetaNoIndex", "name" : "MetaNoIndex", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.032" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "@DROLSKY/MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.032" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.032" } }, "x_authority" : "cpan:DROLSKY", "x_contributors" : [ "Chris White ", "cpansprout ", "Graham Knop ", "Karen Etheridge ", "Vitaly Lipatov " ], "x_generated_by_perl" : "v5.38.2", "x_serialization_backend" : "Cpanel::JSON::XS version 4.38", "x_spdx_expression" : "Artistic-2.0" } Specio-0.50/CODE_OF_CONDUCT.md0000644000175000017500000000625314755224347015342 0ustar autarchautarch# Contributor Covenant Code of Conduct ## Our Pledge In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, education, socio-economic status, nationality, personal appearance, race, religion, or sexual identity and orientation. ## Our Standards Examples of behavior that contributes to creating a positive environment include: * Using welcoming and inclusive language * Being respectful of differing viewpoints and experiences * Gracefully accepting constructive criticism * Focusing on what is best for the community * Showing empathy towards other community members Examples of unacceptable behavior by participants include: * The use of sexualized language or imagery and unwelcome sexual attention or advances * Trolling, insulting/derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or electronic address, without explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Our Responsibilities Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. ## Scope This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team at autarch@urth.org. All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html [homepage]: https://www.contributor-covenant.org Specio-0.50/TODO.md0000644000175000017500000000546714755224347013640 0ustar autarchautarch## Use Sub::Quote One attempt at this exists in the sub-quotify branch. This has several parts. First, type constraints should accept a single `constraint` parameter, rather than both a constraint and an `inline_generator`. If the `constraint` is a Sub::Quote sub, we can use that for inlining. This greatly simplified the API. The same should be done for the `coercion` & `inline_generator` parameters for coercions. Finally, the message_generator should be allow for a Sub::Quote sub and use that for inlining if possible. I'm not sure what the best API for the Sub::Quote subs is. Unlike with the existing generators, Sub::Quote expects that parameters are always passed via `@_`. This probably means that the sub you write should always look at `$_[0]`, which is a little gross when inlining, as it means we have to jam things into `@_` with something like: local @_ = ($value); Note that this also means B passing in the type constraint/coercion as the first argument. In other words, these subs are no longer methods. This is probably better for inlining anyway. Anything you wanted from the object should be something you can inline anyway (I hope). Note that parameterizable types I need to provide a parameterized_inline_generator sub (not a Sub::Quote). This sub shoudl I a quoted sub based on the type parameter. Sub::Quote makes this harder than it should be because it doesn't have a very nice API. Oh well. ## Better integration with Moose Make Moose support inlining coercions and message generation with Specio objects. Also, define a real API for type objects and have Moose just use duck typing internally. However, this should I be the existing Moose TC API, since it's quite broken. In particular, the relationship between constraint & coercion objects is backwards. A constraint should have many coercions, not vice versa. Specio gets this right. ## Support MooseX::Types barewords and string types with SpecioX modules For barewords: use SpecioX::Declare::Barewords => qw( Specio::Library::Builtins My::Library ); use Moose; has foo => ( isa => Str ); For string types: use SpecioX::StringTypes => qw( Specio::Library::Builtins My::Library ); use Moose; has foo => ( isa => 'Str' ); Or something like that. Internally these can both provide an attr trait and class trait that together look up a registry for the class by name, something like: use Specio::Registry qw( registry_for_package ); my $registry = registry_for_package($package); To parse things like `"ArrayRef[Str]"` we need to separate the type string parsing into its module that can return a data structure like: %parsed = ( name => 'ArrayRef', parameter => 'Str', ); Then we can look these up with: my $type = t( $parsed{name}, of => t( $parsed{parameter} ) ); Specio-0.50/lib/0000775000175000017500000000000014755224347013305 5ustar autarchautarchSpecio-0.50/lib/Test/0000775000175000017500000000000014755224347014224 5ustar autarchautarchSpecio-0.50/lib/Test/Specio.pm0000644000175000017500000012046714755224347016014 0ustar autarchautarchpackage Test::Specio; use strict; use warnings; our $VERSION = '0.50'; use IO::File; use Scalar::Util qw( blessed looks_like_number openhandle ); use Specio::Library::Builtins; use Specio::Library::Numeric; use Specio::Library::Perl; use Specio::Library::String; # Loading this will force subification to use Sub::Quote, which can expose # some bugs. use Sub::Quote; use Test::Fatal; use Test::More 0.96; use Try::Tiny; use Exporter qw( import ); our $ZERO = 0; our $ONE = 1; our $INT = 100; our $NEG_INT = -100; our $NUM = 42.42; our $NEG_NUM = -42.42; our $EMPTY_STRING = q{}; our $STRING = 'foo'; our $NUM_IN_STRING = 'has 42 in it'; our $INT_WITH_NL1 = "1\n"; our $INT_WITH_NL2 = "\n1"; our $SCALAR_REF = do { ## no critic (Variables::ProhibitUnusedVariables) \( my $var ); }; our $SCALAR_REF_REF = \$SCALAR_REF; our $ARRAY_REF = []; our $HASH_REF = {}; our $CODE_REF = sub { }; our $GLOB_REF = \*GLOB; our $FH; ## no critic (InputOutput::RequireBriefOpen) open $FH, '<', $INC{'Test/Specio.pm'} or die "Could not open $INC{'Test/Specio.pm'} for the test"; our $FH_OBJECT = IO::File->new( $INC{'Test/Specio.pm'}, 'r' ) or die "Could not open $INC{'Test/Specio.pm'} for the test"; our $REGEX = qr/../; our $REGEX_OBJ = bless qr/../, 'BlessedQR'; our $FAKE_REGEX = bless {}, 'Regexp'; our $OBJECT = bless {}, 'FakeObject'; our $UNDEF = undef; ## no critic (Modules::ProhibitMultiplePackages) { package _T::Thing; sub foo { } } our $CLASS_NAME = '_T::Thing'; { package _T::BoolOverload; use overload 'bool' => sub { ${ $_[0] } }, fallback => 0; sub new { my $bool = $_[1]; bless \$bool, __PACKAGE__; } } our $BOOL_OVERLOAD_TRUE = _T::BoolOverload->new(1); our $BOOL_OVERLOAD_FALSE = _T::BoolOverload->new(0); { package _T::StrOverload; use overload q{""} => sub { ${ $_[0] } }, fallback => 0; sub new { my $str = $_[1]; bless \$str, __PACKAGE__; } } our $STR_OVERLOAD_EMPTY = _T::StrOverload->new(q{}); our $STR_OVERLOAD_FULL = _T::StrOverload->new('full'); our $STR_OVERLOAD_CLASS_NAME = _T::StrOverload->new('_T::StrOverload'); { package _T::NumOverload; use overload '0+' => sub { ${ $_[0] } }, '+' => sub { ${ $_[0] } + $_[1] }, fallback => 0; sub new { my $num = $_[1]; bless \$num, __PACKAGE__; } } our $NUM_OVERLOAD_ZERO = _T::NumOverload->new( 0); our $NUM_OVERLOAD_ONE = _T::NumOverload->new( 1); our $NUM_OVERLOAD_NEG = _T::NumOverload->new(-42); our $NUM_OVERLOAD_DECIMAL = _T::NumOverload->new(42.42); our $NUM_OVERLOAD_NEG_DECIMAL = _T::NumOverload->new(42.42); { package _T::CodeOverload; use overload '&{}' => sub { ${ $_[0] } }, fallback => 0; sub new { my $code = $_[1]; bless \$code, __PACKAGE__; } } our $CODE_OVERLOAD = _T::CodeOverload->new( sub { } ); { package _T::RegexOverload; use overload 'qr' => sub { ${ $_[0] } }, fallback => 0; sub new { my $regex = $_[1]; bless \$regex, __PACKAGE__; } } our $REGEX_OVERLOAD = _T::RegexOverload->new(qr/foo/); { package _T::GlobOverload; use overload '*{}' => sub { ${ $_[0] } }, fallback => 0; sub new { my $glob = $_[1]; bless \$glob, __PACKAGE__; } } { package _T::ScalarOverload; use overload '${}' => sub { $_[0][0] }, fallback => 0; sub new { my $scalar = $_[1]; bless [$scalar], __PACKAGE__; } } our $SCALAR_OVERLOAD = _T::ScalarOverload->new('x'); { package _T::ArrayOverload; use overload '@{}' => sub { $_[0]{array} }, fallback => 0; sub new { my $array = $_[1]; bless { array => $array }, __PACKAGE__; } } our $ARRAY_OVERLOAD = _T::ArrayOverload->new( [ 1, 2, 3 ] ); { package _T::HashOverload; use overload '%{}' => sub { $_[0][0] }, fallback => 0; sub new { my $hash = $_[1]; # We use an array-based object so we make sure we test hash # overloading as opposed to just treating the object as a hash. bless [$hash], __PACKAGE__; } } our $HASH_OVERLOAD = _T::HashOverload->new( { x => 42, y => 84 } ); my @vars; BEGIN { open my $fh, '<', $INC{'Test/Specio.pm'} or die $!; while (<$fh>) { push @vars, $1 if /^our (\$[A-Z0-9_]+)(?: +=|;)/; } } our @EXPORT_OK = ( @vars, qw( builtins_tests describe test_constraint ) ); our %EXPORT_TAGS = ( vars => \@vars ); sub builtins_tests { my $GLOB = shift; my $GLOB_OVERLOAD = shift; my $GLOB_OVERLOAD_FH = shift; return { Item => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Defined => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], reject => [ $UNDEF, ], }, Undef => { accept => [ $UNDEF, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, Bool => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $EMPTY_STRING, $UNDEF, ], reject => [ $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, Maybe => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $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 => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Ref => { accept => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $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, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, qw( 1e10 1e-10 1.23456e10 1.23456e-10 1e10 1e-10 1.23456e10 1.23456e-10 -1e10 -1e-10 -1.23456e10 -1.23456e-10 -1e10 -1e-10 -1.23456e10 -1.23456e-10 -1e+10 1E10 ), ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $INT_WITH_NL1, $INT_WITH_NL2, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, Int => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], }, Str => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ScalarRef => { accept => [ $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ArrayRef => { accept => [ $ARRAY_REF, $ARRAY_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, HashRef => { accept => [ $HASH_REF, $HASH_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, CodeRef => { accept => [ $CODE_REF, $CODE_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, RegexpRef => { accept => [ $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $OBJECT, $UNDEF, $FAKE_REGEX, ], }, GlobRef => { accept => [ $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $FH_OBJECT, $OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $UNDEF, ], }, FileHandle => { accept => [ $FH, $FH_OBJECT, $GLOB_OVERLOAD_FH, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $UNDEF, ], }, Object => { accept => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $CODE_OVERLOAD, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $SCALAR_OVERLOAD, $ARRAY_OVERLOAD, $HASH_OVERLOAD, $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, $STR_OVERLOAD_CLASS_NAME, ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, }; } sub test_constraint { my $type = shift; my $tests = shift; my $describer = shift || \&describe; local $Test::Builder::Level = $Test::Builder::Level + 1; $type = t($type) unless blessed $type; subtest( ( $type->name || '' ), sub { try { my $not_inlined = $type->_constraint_with_parents; my $inlined; if ( $type->can_be_inlined ) { $inlined = $type->_generated_inline_sub; } for my $accept ( @{ $tests->{accept} || [] } ) { my $described = $describer->($accept); subtest( "accepts $described", sub { ok( $type->value_is_valid($accept), 'using ->value_is_valid' ); is( exception { $type->($accept) }, undef, 'using subref overloading' ); ok( $not_inlined->($accept), 'using non-inlined constraint' ); if ($inlined) { ok( $inlined->($accept), 'using inlined constraint' ); } } ); } for my $reject ( @{ $tests->{reject} || [] } ) { my $described = $describer->($reject); subtest( "rejects $described", sub { ok( !$type->value_is_valid($reject), 'using ->value_is_valid' ); # I don't love this test, but there's no way to know the # exact content of each type's validation failure # exception. We can, however, reasonably assume (I think) # that the exception thrown will include a trace starting # with Specio::Exception. like( exception { $type->($reject) }, qr/\QTrace begun at Specio::Exception->new/, 'using subref overloading' ); if ($inlined) { ok( !$inlined->($reject), 'using inlined constraint' ); } } ); } } catch { fail('No exception in test_constraint'); diag($_); }; } ); } sub describe { my $val = shift; return 'undef' unless defined $val; if ( !ref $val ) { return q{''} if $val eq q{}; return looks_like_number($val) && $val !~ /\n/ ? $val : Specio::Helpers::perlstring($val); } return 'open filehandle' if openhandle $val && !blessed $val; if ( blessed $val ) { my $desc = ( ref $val ) . ' object'; if ( $val->isa('_T::StrOverload') ) { $desc .= ' (' . describe("$val") . ')'; } elsif ( $val->isa('_T::BoolOverload') ) { $desc .= ' (' . ( $val ? 'true' : 'false' ) . ')'; } elsif ( $val->isa('_T::NumOverload') ) { $desc .= ' (' . describe( ${$val} ) . ')'; } return $desc; } else { return ( ref $val ) . ' reference'; } } 1; # ABSTRACT: Test helpers for Specio __END__ =pod =encoding UTF-8 =head1 NAME Test::Specio - Test helpers for Specio =head1 VERSION version 0.50 =head1 SYNOPSIS use Test::Specio qw( test_constraint :vars ); test_constraint( t('Foo'), { accept => [ 'foo', 'bar' ], reject => [ 42, {}, $EMPTY_STRING, $HASH_REF ], } ); =head1 DESCRIPTION This package provides some helper functions and variables for testing Specio types. =head1 EXPORTS This module provides the following exports: =head2 test_constraint( $type, $tests, [ $describer ] ) This subroutine accepts two arguments. The first should be a Specio type object. The second is hashref which can contain the keys C and C. Each key should contain an arrayref of values which the type accepts or rejects. The third argument is optional. This is a sub reference which will be called to generate a description of the value being tested. This defaults to calling this package's C sub, but you can provide your own. =head2 describe($value) Given a value, this subroutine returns a string describing that value in a useful way for test output. It know about the various classes used for the variables exported by this package and will do something intelligent when such a variable. =head2 builtins_tests( $GLOB, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH ) This subroutine returns a hashref containing test variables for all builtin types. The hashref has a form like this: { Bool => { accept => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, ..., ], reject => [ $INT, $NEG_INT, $NUM, $NEG_NUM, ..., $OBJECT, ], }, Maybe => {...}, } You need to pass in a glob, an object which overloads globification, and an object which overloads globification to return an open filehandle. See below for more details on how to create these things. =head2 Variables This module also exports many variables containing values which are useful for testing constraints. Note that references are always empty unless stated otherwise. You can import these variables individually or import all of them with the C<:vars> import tag. =over 4 =item * C<$ZERO> =item * C<$ONE> =item * C<$INT> An arbitrary positive integer. =item * C<$NEG_INT> An arbitrary negative integer. =item * C<$NUM> An arbitrary positive non-integer number. =item * C<$NEG_NUM> An arbitrary negative non-integer number. =item * C<$EMPTY_STRING> =item * C<$STRING> An arbitrary non-empty string. =item * C<$NUM_IN_STRING> An arbitrary string which contains a number. =item * C<$INT_WITH_NL1> An string containing an integer followed by a newline. =item * C<$INT_WITH_NL2> An string containing a newline followed by an integer. =item * C<$SCALAR_REF> =item * C<$SCALAR_REF_REF> A reference containing a reference to a scalar. =item * C<$ARRAY_REF> =item * C<$HASH_REF> =item * C<$CODE_REF> =item * C<$GLOB_REF> =item * C<$FH> An opened filehandle. =item * C<$FH_OBJECT> An opened L object. =item * C<$REGEX> A regex created with C. =item * C<$REGEX_OBJ> A regex created with C that was then blessed into class. =item * C<$FAKE_REGEX> A non-regex blessed into the C class which Perl uses internally for C objects. =item * C<$OBJECT> An arbitrary object. =item * C<$UNDEF> =item * C<$CLASS_NAME> A string containing a loaded package name. =item * C<$BOOL_OVERLOAD_TRUE> An object which overloads boolification to return true. =item * C<$BOOL_OVERLOAD_FALSE> An object which overloads boolification to return false. =item * C<$STR_OVERLOAD_EMPTY> An object which overloads stringification to return an empty string. =item * C<$STR_OVERLOAD_FULL> An object which overloads stringification to return a non-empty string. =item * C<$STR_OVERLOAD_CLASS_NAME> An object which overloads stringification to return a loaded package name. =item * C<$NUM_OVERLOAD_ZERO> =item * C<$NUM_OVERLOAD_ONE> =item * C<$NUM_OVERLOAD_NEG> =item * C<$NUM_OVERLOAD_DECIMAL> =item * C<$NUM_OVERLOAD_NEG_DECIMAL> =item * C<$CODE_OVERLOAD> =item * C<$SCALAR_OVERLOAD> An object which overloads scalar dereferencing to return a non-empty string. =item * C<$ARRAY_OVERLOAD> An object which overloads array dereferencing to return a non-empty array. =item * C<$HASH_OVERLOAD> An object which overloads hash dereferencing to return a non-empty hash. =back =head2 Globs and the _T::GlobOverload package To create a glob you can pass around for tests, use this code: my $GLOB = do { no warnings 'once'; *SOME_GLOB; }; The C<_T::GlobOverload> package is defined when you load C so you can create your own glob overloading objects. Such objects cannot be exported because the glob they return does not transfer across packages properly. You can create such a variable like this: local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); If you want to create a glob overloading object that returns a filehandle, do this: local *BAR; open BAR, '<', $^X or die "Could not open $^X for the test"; my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/0000775000175000017500000000000014755224347014527 5ustar autarchautarchSpecio-0.50/lib/Specio/DeclaredAt.pm0000644000175000017500000000606714755224347017064 0ustar autarchautarchpackage Specio::DeclaredAt; use strict; use warnings; our $VERSION = '0.50'; use Specio::OO; { my $attrs = { package => { isa => 'Str', required => 1, }, filename => { isa => 'Str', required => 1, }, line => { isa => 'Int', required => 1, }, subroutine => { isa => 'Str', predicate => 'has_subroutine', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub new_from_caller { my $class = shift; my $depth = shift; my %p; @p{qw( package filename line )} = ( caller($depth) )[ 0, 1, 2 ]; my $sub = ( caller( $depth + 1 ) )[3]; $p{subroutine} = $sub if defined $sub; return $class->new(%p); } sub description { my $self = shift; my $package = $self->package; my $filename = $self->filename; my $line = $self->line; my $desc = "declared in package $package ($filename) at line $line"; if ( $self->has_subroutine ) { $desc .= ' in sub named ' . $self->subroutine; } return $desc; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class to represent where a type or coercion was declared __END__ =pod =encoding UTF-8 =head1 NAME Specio::DeclaredAt - A class to represent where a type or coercion was declared =head1 VERSION version 0.50 =head1 SYNOPSIS my $declared = Specio::DeclaredAt->new_from_caller(1); print $declared->description; =head1 DESCRIPTION This class provides a thin wrapper around some of the return values from Perl's C built-in. It's used internally to identify where types and coercions are being declared, which is useful when generating error messages. =head1 API This class provides the following methods. =head2 Specio::DeclaredAt->new_from_caller($depth) Given a call stack depth, this method returns a new C object. =head2 $declared_at->package, $declared_at->filename, $declared_at->line Returns the call stack information recorded when the object was created. These values are always populated. =head2 $declared_at->subroutine Returns the subroutine from the call stack. This may be an C =head2 $declared_at->has_subroutine Returns true if there is a subroutine name associated with this object. =head2 $declared_at->description Puts all the information together into a single string like "declared in package Foo::Bar (.../Foo/Bar.pm) at line 42 in sub named blah". =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Exception.pm0000644000175000017500000000550014755224347017021 0ustar autarchautarchpackage Specio::Exception; use strict; use warnings; use overload q{""} => 'as_string', fallback => 1; our $VERSION = '0.50'; use Devel::StackTrace; use Scalar::Util qw( blessed ); use Specio::OO; { my $attrs = { message => { isa => 'Str', required => 1, }, type => { does => 'Specio::Constraint::Role::Interface', required => 1, }, value => { required => 1, }, stack_trace => { init_arg => undef, }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; $self->{stack_trace} = Devel::StackTrace->new( ignore_package => __PACKAGE__ ); return; } sub as_string { my $self = shift; my $str = $self->message; $str .= "\n\n" . $self->stack_trace->as_string; return $str; } sub throw { my $self = shift; die $self if blessed $self; die $self->new(@_); } __PACKAGE__->_ooify; 1; # ABSTRACT: An exception class for type constraint failures __END__ =pod =encoding UTF-8 =head1 NAME Specio::Exception - An exception class for type constraint failures =head1 VERSION version 0.50 =head1 SYNOPSIS use Try::Tiny; try { $type->validate_or_die($value); } catch { if ( $_->isa('Specio::Exception') ) { print $_->message, "\n"; print $_->type->name, "\n"; print $_->value, "\n"; } }; =head1 DESCRIPTION This exception class is thrown by Specio when a type check fails. It emulates the L API, but doesn't use that module to avoid adding a dependency on L. =for Pod::Coverage BUILD throw =head1 API This class provides the following methods: =head2 $exception->message The error message associated with the exception. =head2 $exception->stack_trace A L object for the exception. =head2 $exception->type The type constraint object against which the value failed. =head2 $exception->value The value that failed the type check. =head2 $exception->as_string The exception as a string. This includes the method and the stack trace. =head1 OVERLOADING This class overloads stringification to call the C method. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Helpers.pm0000644000175000017500000000673114755224347016474 0ustar autarchautarchpackage Specio::Helpers; use strict; use warnings; use Carp qw( croak ); use Exporter 'import'; use overload (); our $VERSION = '0.50'; use Scalar::Util qw( blessed ); our @EXPORT_OK = qw( install_t_sub is_class_loaded perlstring _STRINGLIKE ); sub install_t_sub { # Specio::DeclaredAt use Specio::OO, which in turn uses # Specio::Helpers. If we load this with "use" we get a cirular require and # a big mess. require Specio::DeclaredAt; my $caller = shift; my $types = shift; # XXX - check to see if their t() is something else entirely? { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; # We used to check ->can('t') but that was wrong, since it would # return if a parent class had a t() sub. return if *{ $caller . '::t' }{CODE}; } my $t = sub { my $name = shift; croak 'The t subroutine requires a single non-empty string argument' unless _STRINGLIKE($name); croak "There is no type named $name available for the $caller package" unless exists $types->{$name}; my $found = $types->{$name}; return $found unless @_; my %p = @_; croak 'Cannot parameterize a non-parameterizable type' unless $found->can('parameterize'); return $found->parameterize( declared_at => Specio::DeclaredAt->new_from_caller(1), %p, ); }; { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; no warnings 'redefine'; *{ $caller . '::t' } = $t; } return; } ## no critic (Subroutines::ProhibitSubroutinePrototypes, Subroutines::ProhibitExplicitReturnUndef) sub _STRINGLIKE ($) { return $_[0] if _STRING( $_[0] ); return $_[0] if blessed $_[0] && overload::Method( $_[0], q{""} ) && length "$_[0]"; return undef; } # Borrowed from Params::Util sub _STRING ($) { return defined $_[0] && !ref $_[0] && length( $_[0] ) ? $_[0] : undef; } BEGIN { if ( $] >= 5.010 && eval { require XString; 1 } ) { *perlstring = \&XString::perlstring; } else { require B; *perlstring = \&B::perlstring; } } # Borrowed from Types::Standard sub is_class_loaded { my $stash = do { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; \%{ $_[0] . '::' }; }; return 1 if exists $stash->{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; } 1; # ABSTRACT: Helper subs for the Specio distro __END__ =pod =encoding UTF-8 =head1 NAME Specio::Helpers - Helper subs for the Specio distro =head1 VERSION version 0.50 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Subs.pm0000644000175000017500000001454214755224347016005 0ustar autarchautarchpackage Specio::Subs; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( croak ); use Eval::Closure qw( eval_closure ); use Module::Runtime qw( use_package_optimistically ); use Specio::Library::Perl; use Specio::Registry qw( exportable_types_for_package ); sub import { shift; my @libs = @_; my $caller = caller(); my $ident = t('Identifier'); use_package_optimistically($_) for @libs; for my $types ( map { exportable_types_for_package($_) } @libs ) { for my $name ( keys %{$types} ) { croak qq{Cannot use '$name' type to create a check sub. It results in an invalid Perl subroutine name} unless $ident->check( 'is_' . $name ); _export_subs( $name, $types->{$name}, $caller ); } } } sub _export_subs { my $name = shift; my $type = shift; my $caller = shift; _export_validation_subs( $name, $type, $caller ); return unless $type->has_coercions; _export_coercion_subs( $name, $type, $caller ); } sub _export_validation_subs { my $name = shift; my $type = shift; my $caller = shift; my $is_name = 'is_' . $name; my $assert_name = 'assert_' . $name; if ( $type->can_be_inlined ) { _make_sub( $caller, $is_name, $type->inline_check('$_[0]') ); _make_sub( $caller, $assert_name, $type->inline_assert('$_[0]') ); } else { _install_sub( $caller, $is_name, sub { $type->value_is_valid( $_[0] ) } ); _install_sub( $caller, $assert_name, sub { $type->validate_or_die( $_[0] ) } ); } } sub _export_coercion_subs { my $name = shift; my $type = shift; my $caller = shift; my $to_name = 'to_' . $name; if ( $type->can_inline_coercion ) { _make_sub( $caller, $to_name, $type->inline_coercion('$_[0]') ); } else { _install_sub( $caller, $to_name, sub { $type->coerce_value( $_[0] ) } ); } my $force_name = 'force_' . $name; if ( $type->can_inline_coercion_and_check ) { _make_sub( $caller, $force_name, $type->inline_coercion_and_check('$_[0]') ); } else { _install_sub( $caller, $force_name, sub { my $val = $type->coerce_value( $_[0] ); $type->validate_or_die($val); return $val; } ); } } sub _make_sub { my $caller = shift; my $sub_name = shift; my $source = shift; my $env = shift; my $sub = eval_closure( source => 'sub { ' . $source . ' }', environment => $env, description => $caller . '::' . $sub_name . ' generated by ' . __PACKAGE__, ); _install_sub( $caller, $sub_name, $sub ); return; } my $sub_namer = do { eval { require Sub::Util; Sub::Util->VERSION(1.40); Sub::Util->can('set_subname'); } or eval { require Sub::Name; Sub::Name->can('subname'); } or sub { return $_[1] }; }; my %Installed; sub _install_sub { my $caller = shift; my $sub_name = shift; my $sub = shift; my $fq_name = $caller . '::' . $sub_name; { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{$fq_name} = $sub_namer->( $fq_name, $sub ); } $Installed{$caller} ||= []; push @{ $Installed{$caller} }, $sub_name; return; } sub subs_installed_into { my $package = shift; return @{ $Installed{$package} || [] }; } 1; # ABSTRACT: Make validation and coercion subs from Specio types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Subs - Make validation and coercion subs from Specio types =head1 VERSION version 0.50 =head1 SYNOPSIS use Specio::Subs qw( Specio::Library::Builtins Specio::Library::Perl My::Lib ); if ( is_PackageName($var) ) { ... } assert_Str($var); my $person1 = to_Person($var); my $person2 = force_Person($var); =head1 DESCRIPTION This module generates a set of helpful validation and coercion subroutines for all of the types defined in one or more libraries. To use it, simply import C passing a list of one or more library names. This module will load those libraries as needed. If any of the types in any libraries have names that do not work as part of a Perl subroutine name, this module will throw an exception. If you have L or L installed, one of those will be used to name the generated subroutines. =head1 "EXPORTS" The following subs are created in the importing package: =head2 is_$type($value) This subroutine returns a boolean indicating whether or not the C<$value> is valid for the type. =head2 assert_$type($value) This subroutine dies if the C<$value> is not valid for the type. =head2 to_$type($value) This subroutine attempts to coerce C<$value> into the given type. If it cannot be coerced it returns the original C<$value>. This is only created if the type has coercions. =head2 force_$type($value) This subroutine attempts to coerce C<$value> into the given type, and dies if it cannot do so. This is only created if the type has coercions. =head1 ADDITIONAL API =for Pod::Coverage subs_installed_into This module has a subroutine named C. It is not exported but it can be called by its fully qualified name. It accepts a single argument, a package name. It returns a list of subs that it generated and installed in the given package, if any. This exists to make it easy to write a type library that combines other libraries and generates helper subs for export all at once. See the L docs for more details. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Coercion.pm0000644000175000017500000002006414755224347016626 0ustar autarchautarchpackage Specio::Coercion; use strict; use warnings; our $VERSION = '0.50'; use Specio::OO; use Role::Tiny::With; use Specio::Role::Inlinable; with 'Specio::Role::Inlinable'; { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Role::Inlinable::_attrs(); ## use critic my $attrs = { %{$role_attrs}, from => { does => 'Specio::Constraint::Role::Interface', required => 1, }, to => { does => 'Specio::Constraint::Role::Interface', required => 1, weak_ref => 1, }, _coercion => { isa => 'CodeRef', predicate => '_has_coercion', init_arg => 'coercion', }, _optimized_coercion => { isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_optimized_coercion', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; die 'A type coercion should have either a coercion or inline_generator parameter, not both' if $self->_has_coercion && $self->_has_inline_generator; die 'A type coercion must have either a coercion or inline_generator parameter' unless $self->_has_coercion || $self->_has_inline_generator; return; } sub coerce { my $self = shift; my $value = shift; return $self->_optimized_coercion->($value); } sub inline_coercion { my $self = shift; return $self->_inline_generator->( $self, @_ ); } sub _build_optimized_coercion { my $self = shift; if ( $self->_has_inline_generator ) { return $self->_generated_inline_sub; } else { return $self->_coercion; } } sub can_be_inlined { my $self = shift; return $self->_has_inline_generator && $self->from->can_be_inlined; } sub _build_description { my $self = shift; my $from_name = defined $self->from->name ? $self->from->name : 'anonymous type'; my $to_name = defined $self->to->name ? $self->to->name : 'anonymous type'; my $desc = "coercion from $from_name to $to_name"; $desc .= q{ } . $self->declared_at->description; return $desc; } sub clone_with_new_to { my $self = shift; my $new_to = shift; my $from = $self->from; local $self->{from} = undef; local $self->{to} = undef; my $clone = $self->clone; $clone->{from} = $from; $clone->{to} = $new_to; return $clone; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class representing a coercion from one type to another __END__ =pod =encoding UTF-8 =head1 NAME Specio::Coercion - A class representing a coercion from one type to another =head1 VERSION version 0.50 =head1 SYNOPSIS my $coercion = $type->coercion_from_type('Int'); my $new_value = $coercion->coerce_value(42); if ( $coercion->can_be_inlined() ) { my $code = $coercion->inline_coercion('$_[0]'); } =head1 DESCRIPTION This class represents a coercion from one type to another. Internally, a coercion is a piece of code that takes a value of one type returns a new value of a new type. For example, a coercion from c to C might round a number to its nearest integer and return that integer. Coercions can be implemented either as a simple subroutine reference or as an inline generator subroutine. Using an inline generator is faster but more complicated. =for Pod::Coverage BUILD clone_with_new_to =head1 API This class provides the following methods. =head2 Specio::Coercion->new( ... ) This method creates a new coercion object. It accepts the following named parameters: =over 4 =item * from => $type The type this coercion is from. The type must be an object which does the L interface. This parameter is required. =item * to => $type The type this coercion is to. The type must be an object which does the L interface. This parameter is required. =item * coercion => sub { ... } A subroutine reference implementing the coercion. It will be called as a method on the object and passed a single argument, the value to coerce. It should return the new value. This parameter is mutually exclusive with C. Either this parameter or the C parameter is required. You can also pass this option with the key C in the parameter list. =item * inline_generator => sub { ... } This should be a subroutine reference which returns a string containing a single term. This code should I end in a semicolon. This code should implement the coercion. The generator will be called as a method on the coercion with a single argument. That argument is the name of the variable being coerced, something like C<'$_[0]'> or C<'$var'>. This parameter is mutually exclusive with C. Either this parameter or the C parameter is required. You can also pass this option with the key C in the parameter list. =item * inline_environment => {} This should be a hash reference of variable names (with sigils) and values for that variable. The values should be I to the values of the variables. This environment will be used when compiling the coercion as part of a subroutine. The named variables will be captured as closures in the generated subroutine, using L. It should be very rare to need to set this in the constructor. It's more likely that a special coercion subclass would need to provide values that it generates internally. This parameter defaults to an empty hash reference. =item * declared_at => $declared_at This parameter must be a L object. This parameter is required. =back =head2 $coercion->from(), $coercion->to(), $coercion->declared_at() These methods are all read-only attribute accessors for the corresponding attribute. =head2 $coercion->description This returns a string describing the coercion. This includes the names of the to and from type and where the coercion was declared, so you end up with something like C<'coercion from Foo to Bar declared in package My::Lib (lib/My/Lib.pm) at line 42'>. =head2 $coercion->coerce($value) Given a value of the right "from" type, returns a new value of the "to" type. This method does not actually check that the types of given or return values. =head2 $coercion->inline_coercion($var) Given a variable name like C<'$_[0]'> this returns a string with code for the coercion. Note that this method will die if the coercion does not have an inline generator. =head2 $coercion->can_be_inlined() This returns true if the coercion has an inline generator I the constraint it is from can be inlined. This exists primarily for the benefit of the C method for type constraint object. =head2 $coercion->inline_environment() This returns a hash defining the variables that need to be closed over when inlining the coercion. The keys are full variable names like C<'$foo'> or C<'@bar'>. The values are I to a variable of the matching type. =head2 $coercion->clone() Returns a clone of this object. =head2 $coercion->clone_with_new_to($new_to_type) This returns a clone of the coercion, replacing the "to" type with a new one. This is intended for use when the to type itself is being cloned as part of importing that type. We need to make sure the newly cloned coercion has the newly cloned type as well. =head1 ROLES This class does the L role. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/0000775000175000017500000000000014755224347016133 5ustar autarchautarchSpecio-0.50/lib/Specio/Library/Structured/0000775000175000017500000000000014755224347020277 5ustar autarchautarchSpecio-0.50/lib/Specio/Library/Structured/Map.pm0000644000175000017500000000463114755224347021354 0ustar autarchautarchpackage Specio::Library::Structured::Map; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use List::Util 1.33 (); use Specio::Library::Builtins; use Specio::TypeChecks qw( does_role ); my $hashref = t('HashRef'); sub parent {$hashref} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _inline { $hashref->inline_check( $_[1] ); } sub _parameterization_args_builder { shift; my $args = shift; for my $k (qw( key value )) { does_role( $args->{$k}, 'Specio::Constraint::Role::Interface' ) or confess qq{The "$k" parameter passed to ->parameterize must be one or more objects which do the Specio::Constraint::Role::Interface role}; confess qq{The "$k" parameter passed to ->parameterize must be an inlinable constraint} unless $args->{$k}->can_be_inlined; } return map { $_ => $args->{$_} } qw( key value ); } sub _name_builder { my $self = shift; my $p = shift; ## no critic (Subroutines::ProtectPrivateSubs) return 'Map{ ' . $self->_name_or_anon( $p->{key} ) . ' => ' . $self->_name_or_anon( $p->{value} ) . ' }'; } sub _structured_inline_generator { shift; my $val = shift; my %args = @_; my $code = <<'EOF'; ( ( %s ) && ( List::Util::all { %s } keys %%{ %s } ) && ( List::Util::all { %s } values %%{ %s } ) ) EOF return sprintf( $code, $hashref->_inline_check($val), $args{key}->inline_check('$_'), $val, $args{value}->inline_check('$_'), $val, ); } 1; # ABSTRACT: Guts of Map structured type __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Structured::Map - Guts of Map structured type =head1 VERSION version 0.50 =head1 DESCRIPTION There are no user facing parts here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Structured/Tuple.pm0000644000175000017500000001171214755224347021726 0ustar autarchautarchpackage Specio::Library::Structured::Tuple; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use List::Util 1.33 (); use Scalar::Util qw( blessed ); use Specio::Library::Builtins; use Specio::TypeChecks qw( does_role ); my $arrayref = t('ArrayRef'); sub parent {$arrayref} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _inline { $arrayref->inline_check( $_[1] ); } sub _parameterization_args_builder { shift; my $args = shift; my $saw_slurpy; my $saw_optional; for my $p ( @{$args} ) { if ($saw_slurpy) { confess 'A Tuple cannot have any parameters after a slurpy parameter'; } if ( $saw_optional && blessed($p) ) { confess 'A Tuple cannot have a non-optional parameter after an optional parameter'; } my $type; if ( blessed($p) ) { $type = $p; } else { if ( ref $p eq 'HASH' ) { if ( $p->{optional} ) { $saw_optional = 1; $type = $p->{optional}; } if ( $p->{slurpy} ) { $saw_slurpy = 1; $type = $p->{slurpy}; } } else { confess 'Can only pass types, optional types, and slurpy types when defining a Tuple'; } } if ( $saw_optional && $saw_slurpy ) { confess 'Cannot defined a slurpy Tuple with optional slots as well'; } does_role( $type, 'Specio::Constraint::Role::Interface' ) or confess 'All parameters passed to ->parameterize must be objects which do the Specio::Constraint::Role::Interface role'; confess 'All parameters passed to ->parameterize must be inlinable constraints' unless $type->can_be_inlined; } return ( of => $args ); } sub _name_builder { my $self = shift; my $p = shift; my @names; for my $m ( @{ $p->{of} } ) { ## no critic (Subroutines::ProtectPrivateSubs) if ( blessed($m) ) { push @names, $self->_name_or_anon($m); } elsif ( $m->{optional} ) { push @names, $self->_name_or_anon( $m->{optional} ) . '?'; } elsif ( $m->{slurpy} ) { push @names, $self->_name_or_anon( $m->{slurpy} ) . '...'; } } return 'Tuple[ ' . ( join ', ', @names ) . ' ]'; } sub _structured_inline_generator { shift; my $val = shift; my %args = @_; my @of = @{ $args{of} }; my $slurpy; $slurpy = ( pop @of )->{slurpy} if !blessed( $of[-1] ) && $of[-1]->{slurpy}; my @code = sprintf( '( %s )', $arrayref->_inline_check($val) ); unless ($slurpy) { my $min = 0; my $max = 0; for my $p (@of) { # Unblessed values are optional. if ( blessed($p) ) { $min++; $max++; } else { $max++; } } if ($min) { push @code, sprintf( '( @{ %s } >= %d && @{ %s } <= %d )', $val, $min, $val, $max ); } } for my $i ( 0 .. $#of ) { my $p = $of[$i]; my $access = sprintf( '%s->[%d]', $val, $i ); if ( !blessed($p) ) { my $type = $p->{optional}; push @code, sprintf( '( @{%s} >= %d ? ( %s ) : 1 )', $val, $i + 1, $type->_inline_check($access) ); } else { push @code, sprintf( '( %s )', $p->_inline_check($access) ); } } if ($slurpy) { my $non_slurpy = scalar @of; my $check = '( @{%s} > %d ? ( List::Util::all { %s } @{%s}[%d .. $#{%s}] ) : 1 )'; push @code, sprintf( $check, $val, $non_slurpy, $slurpy->_inline_check('$_'), $val, $non_slurpy, $val, ); } return '( ' . ( join ' && ', @code ) . ' )'; } 1; # ABSTRACT: Guts of Tuple structured type __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Structured::Tuple - Guts of Tuple structured type =head1 VERSION version 0.50 =head1 DESCRIPTION There are no user facing parts here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Structured/Dict.pm0000644000175000017500000000751214755224347021523 0ustar autarchautarchpackage Specio::Library::Structured::Dict; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use List::Util 1.33 (); use Scalar::Util qw( blessed ); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::TypeChecks qw( does_role ); my $hashref = t('HashRef'); sub parent {$hashref} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _inline { $hashref->inline_check( $_[1] ); } sub _parameterization_args_builder { shift; my $args = shift; for my $p ( ( $args->{slurpy} || () ), values %{ $args->{kv} } ) { my $type; if ( blessed($p) ) { $type = $p; } else { if ( ref $p eq 'HASH' && $p->{optional} ) { $type = $p->{optional}; } else { confess 'Can only pass types, optional types, and slurpy types when defining a Dict'; } } does_role( $type, 'Specio::Constraint::Role::Interface' ) or confess 'All parameters passed to ->parameterize must be objects which do the Specio::Constraint::Role::Interface role'; confess 'All parameters passed to ->parameterize must be inlinable constraints' unless $type->can_be_inlined; } return %{$args}; } sub _name_builder { my $self = shift; my $p = shift; ## no critic (Subroutines::ProtectPrivateSubs) my @kv; for my $k ( sort keys %{ $p->{kv} } ) { my $v = $p->{kv}{$k}; if ( blessed($v) ) { push @kv, "$k => " . $self->_name_or_anon($v); } elsif ( $v->{optional} ) { push @kv, "$k => " . $self->_name_or_anon( $v->{optional} ) . '?'; } } if ( $p->{slurpy} ) { push @kv, $self->_name_or_anon( $p->{slurpy} ) . '...'; } return 'Dict{ ' . ( join ', ', @kv ) . ' }'; } sub _structured_inline_generator { shift; my $val = shift; my %args = @_; my @code = sprintf( '( %s )', $hashref->_inline_check($val) ); for my $k ( sort keys %{ $args{kv} } ) { my $p = $args{kv}{$k}; my $access = sprintf( '%s->{%s}', $val, perlstring($k) ); if ( !blessed($p) ) { my $type = $p->{optional}; push @code, sprintf( '( exists %s ? ( %s ) : 1 )', $access, $type->_inline_check($access) ); } else { push @code, sprintf( '( %s )', $p->_inline_check($access) ); } } if ( $args{slurpy} ) { my $check = '( do { my %%_____known_____ = map { $_ => 1 } ( %s ); List::Util::all { %s } grep { ! $_____known_____{$_} } sort keys %%{ %s } } )'; push @code, sprintf( $check, ( join ', ', map { perlstring($_) } keys %{ $args{kv} } ), $args{slurpy}->_inline_check( sprintf( '%s->{$_}', $val ) ), $val, ); } return '( ' . ( join ' && ', @code ) . ' )'; } 1; # ABSTRACT: Guts of Dict structured type __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Structured::Dict - Guts of Dict structured type =head1 VERSION version 0.50 =head1 DESCRIPTION There are no user facing parts here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Builtins.pm0000644000175000017500000003040114755224347020256 0ustar autarchautarchpackage Specio::Library::Builtins; use strict; use warnings; our $VERSION = '0.50'; use parent 'Specio::Exporter'; use List::Util 1.33 (); use overload (); use re (); use Scalar::Util (); use Specio::Constraint::Parameterizable; use Specio::Declare; use Specio::Helpers (); BEGIN { local $@ = undef; my $has_ref_util = eval { require Ref::Util; Ref::Util->VERSION('0.112'); 1 }; sub _HAS_REF_UTIL () {$has_ref_util} } declare( 'Item', inline => sub {'1'} ); declare( 'Undef', parent => t('Item'), inline => sub { '!defined(' . $_[1] . ')'; } ); declare( 'Defined', parent => t('Item'), inline => sub { 'defined(' . $_[1] . ')'; } ); declare( 'Bool', parent => t('Item'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 7 ); ( ( !ref( %s ) && ( !defined( %s ) || %s eq q{} || %s eq '1' || %s eq '0' ) ) || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, 'bool' ) ) ) EOF } ); declare( 'Value', parent => t('Defined'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && !ref(' . $_[1] . ')'; } ); declare( 'Ref', parent => t('Defined'), # no need to call parent - ref also checks for definedness inline => sub { 'ref(' . $_[1] . ')' } ); declare( 'Str', parent => t('Value'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 6 ); ( ( defined( %s ) && !ref( %s ) && ( ( ref( \%s ) eq 'SCALAR' ) || do { ( ref( \( my $val = %s ) ) eq 'SCALAR' ) } ) ) || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, q{""} ) ) ) EOF } ); declare( 'Num', parent => t('Str'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 5 ); ( ( defined( %s ) && !ref( %s ) && ( do { ( my $val = %s ) =~ /\A -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \z/x } ) ) || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '0+' ) ) ) EOF } ); declare( 'Int', parent => t('Num'), inline => sub { return sprintf( <<'EOF', ( $_[1] ) x 6 ); ( ( defined( %s ) && !ref( %s ) && ( do { my $val1 = %s; $val1 =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ && $val1 == int($val1) } ) ) || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '0+' ) && ( do { my $val2 = %s + 0; $val2 =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/ && $val2 == int($val2) } ) ) ) EOF } ); { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_coderef(%s)' : q{ref(%s) eq 'CODE'}; declare( 'CodeRef', parent => t('Ref'), inline => sub { return sprintf( <<"EOF", ( $_[1] ) x 3 ); ( $ref_check || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '&{}' ) ) ) EOF } ); } { # This is a 5.8 back-compat shim stolen from Type::Tiny's Devel::Perl58Compat # module. unless ( exists &re::is_regexp || _HAS_REF_UTIL ) { require B; *re::is_regexp = sub { ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval) eval { B::svref_2object( $_[0] )->MAGIC->TYPE eq 'r' }; }; } my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_regexpref(%s)' : 're::is_regexp(%s)'; declare( 'RegexpRef', parent => t('Ref'), inline => sub { return sprintf( <<"EOF", ( $_[1] ) x 3 ); ( $ref_check || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, 'qr' ) ) ) EOF }, ); } { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_globref(%s)' : q{ref( %s ) eq 'GLOB'}; declare( 'GlobRef', parent => t('Ref'), inline => sub { return sprintf( <<"EOF", ( $_[1] ) x 3 ); ( $ref_check || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '*{}' ) ) ) EOF } ); } { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_globref(%s)' : q{ref( %s ) eq 'GLOB'}; # NOTE: scalar filehandles are GLOB refs, but a GLOB ref is not always a # filehandle declare( 'FileHandle', parent => t('Ref'), inline => sub { return sprintf( <<"EOF", ( $_[1] ) x 6 ); ( ( $ref_check && Scalar::Util::openhandle( %s ) ) || ( Scalar::Util::blessed( %s ) && ( %s->isa('IO::Handle') || ( defined overload::Method( %s, '*{}' ) && Scalar::Util::openhandle( *{ %s } ) ) ) ) ) EOF } ); } { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_blessed_ref(%s)' : 'Scalar::Util::blessed(%s)'; declare( 'Object', parent => t('Ref'), inline => sub { sprintf( $ref_check, $_[1] ) }, ); } declare( 'ClassName', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ); ( ( %s ) && length "%s" && Specio::Helpers::is_class_loaded( "%s" ) ) EOF }, ); { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_scalarref(%s) || Ref::Util::is_plain_refref(%s)' : q{ref( %s ) eq 'SCALAR' || ref( %s ) eq 'REF'}; my $base_scalarref_check = sub { return sprintf( <<"EOF", ( $_[0] ) x 4 ); ( ( $ref_check ) || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '\${}' ) ) ) EOF }; declare( 'ScalarRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_scalarref_check->( $_[1] ) }, parameterized_inline_generator => sub { shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( %s ) )', $base_scalarref_check->($val), $parameter->inline_check( '${' . $val . '}' ), ); } ); } { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_arrayref(%s)' : q{ref( %s ) eq 'ARRAY'}; my $base_arrayref_check = sub { return sprintf( <<"EOF", ( $_[0] ) x 3 ); ( $ref_check || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '\@{}' ) ) ) EOF }; declare( 'ArrayRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_arrayref_check->( $_[1] ) }, parameterized_inline_generator => sub { shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( List::Util::all { %s } @{ %s } ) )', $base_arrayref_check->($val), $parameter->inline_check('$_'), $val, ); } ); } { my $ref_check = _HAS_REF_UTIL ? 'Ref::Util::is_plain_hashref(%s)' : q{ref( %s ) eq 'HASH'}; my $base_hashref_check = sub { return sprintf( <<"EOF", ( $_[0] ) x 3 ); ( $ref_check || ( Scalar::Util::blessed( %s ) && defined overload::Method( %s, '%%{}' ) ) ) EOF }; declare( 'HashRef', type_class => 'Specio::Constraint::Parameterizable', parent => t('Ref'), inline => sub { $base_hashref_check->( $_[1] ) }, parameterized_inline_generator => sub { shift; my $parameter = shift; my $val = shift; return sprintf( '( ( %s ) && ( List::Util::all { %s } values %%{ %s } ) )', $base_hashref_check->($val), $parameter->inline_check('$_'), $val, ); } ); } declare( 'Maybe', type_class => 'Specio::Constraint::Parameterizable', parent => t('Item'), inline => sub {'1'}, parameterized_inline_generator => sub { shift; my $parameter = shift; my $val = shift; return sprintf( <<'EOF', $val, $parameter->inline_check($val) ); ( !defined( %s ) || ( %s ) ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for Perl's built-in types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Builtins - Implements type constraint objects for Perl's built-in types =head1 VERSION version 0.50 =head1 DESCRIPTION This library provides a set of types parallel to those provided by Moose. The types are in the following hierarchy Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object =head2 Item Accepts any value =head2 Bool Accepts a non-reference that is C, an empty string, C<0>, or C<1>. It also accepts any object which overloads boolification. =head2 Maybe (of `a) A parameterizable type which accepts C or the type C<`a>. If not parameterized this type will accept any value. =head2 Undef Only accepts C. =head2 Value Accepts any non-reference value. =head2 Str Accepts any non-reference value or an object which overloads stringification. =head2 Num Accepts nearly the same values as C, but does not accept numbers with leading or trailing spaces, infinities, or NaN. Also accepts an object which overloads numification. =head2 Int Accepts any integer value, or an object which overloads numification and numifies to an integer. =head2 ClassName Accepts any value which passes C where the string is a loaded package. =head2 Ref Accepts any reference. =head2 ScalarRef (of `a) Accepts a scalar reference or an object which overloads scalar dereferencing. If parameterized, the dereferenced value must be of type C<`a>. =head2 ArrayRef (of `a) Accepts a array reference or an object which overloads array dereferencing. If parameterized, the values in the arrayref must be of type C<`a>. =head2 HashRef (of `a) Accepts a hash reference or an object which overloads hash dereferencing. If parameterized, the values in the hashref must be of type C<`a>. =head2 CodeRef Accepts a code (sub) reference or an object which overloads code dereferencing. =head2 RegexpRef Accepts a regex object created by C or an object which overloads regex interpolation. =head2 GlobRef Accepts a glob reference or an object which overloads glob dereferencing. =head2 FileHandle Accepts a glob reference which is an open file handle, any C Object or subclass, or an object which overloads glob dereferencing and returns a glob reference which is an open file handle. =head2 Object Accepts any blessed object. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/String.pm0000644000175000017500000000411014755224347017731 0ustar autarchautarchpackage Specio::Library::String; use strict; use warnings; our $VERSION = '0.50'; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'NonEmptySimpleStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 3 ); ( %s && length %s > 0 && length %s <= 255 && %s !~ /[\n\r\x{2028}\x{2029}]/ ) EOF }, ); declare( 'NonEmptyStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && length %s ) EOF }, ); declare( 'SimpleStr', parent => t('Str'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ); ( %s && length %s <= 255 && %s !~ /[\n\r\x{2028}\x{2029}]/ ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common string types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::String - Implements type constraint objects for some common string types =head1 VERSION version 0.50 =head1 DESCRIPTION This library provides some additional string types for common cases. =head2 NonEmptyStr A string which has at least one character. =head2 SimpleStr A string that is 255 characters or less with no vertical whitespace characters. =head2 NonEmptySimpleStr A non-empty string that is 255 characters or less with no vertical whitespace characters. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Numeric.pm0000644000175000017500000000622514755224347020076 0ustar autarchautarchpackage Specio::Library::Numeric; use strict; use warnings; our $VERSION = '0.50'; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s > 0 ) EOF }, ); declare( 'PositiveOrZeroNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s >= 0 ) EOF }, ); declare( 'PositiveInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s > 0 ) EOF }, ); declare( 'PositiveOrZeroInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s >= 0 ) EOF }, ); declare( 'NegativeNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s < 0 ) EOF }, ); declare( 'NegativeOrZeroNum', parent => t('Num'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s <= 0 ) EOF }, ); declare( 'NegativeInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s < 0 ) EOF }, ); declare( 'NegativeOrZeroInt', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s <= 0 ) EOF }, ); declare( 'SingleDigit', parent => t('Int'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), ( $_[1] ) x 2 ); ( %s && %s >= -9 && %s <= 9 ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common numeric types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Numeric - Implements type constraint objects for some common numeric types =head1 VERSION version 0.50 =head1 DESCRIPTION This library provides some additional string numeric for common cases. =head2 PositiveNum =head2 PositiveOrZeroNum =head2 PositiveInt =head2 PositiveOrZeroInt =head2 NegativeNum =head2 NegativeOrZeroNum =head2 NegativeInt =head2 NegativeOrZeroInt =head2 SingleDigit A single digit from -9 to 9. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Structured.pm0000644000175000017500000001513514755224347020640 0ustar autarchautarchpackage Specio::Library::Structured; use strict; use warnings; our $VERSION = '0.50'; use parent 'Specio::Exporter'; use Carp qw( confess ); use Scalar::Util qw( blessed ); use Specio::Constraint::Structurable; use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured::Dict; use Specio::Library::Structured::Map; use Specio::Library::Structured::Tuple; use Specio::TypeChecks qw( does_role ); ## no critic (Variables::ProtectPrivateVars) declare( 'Dict', type_class => 'Specio::Constraint::Structurable', parent => Specio::Library::Structured::Dict->parent, inline => \&Specio::Library::Structured::Dict::_inline, parameterization_args_builder => \&Specio::Library::Structured::Dict::_parameterization_args_builder, name_builder => \&Specio::Library::Structured::Dict::_name_builder, structured_inline_generator => \&Specio::Library::Structured::Dict::_structured_inline_generator, ); declare( 'Map', type_class => 'Specio::Constraint::Structurable', parent => Specio::Library::Structured::Map->parent, inline => \&Specio::Library::Structured::Map::_inline, parameterization_args_builder => \&Specio::Library::Structured::Map::_parameterization_args_builder, name_builder => \&Specio::Library::Structured::Map::_name_builder, structured_inline_generator => \&Specio::Library::Structured::Map::_structured_inline_generator, ); declare( 'Tuple', type_class => 'Specio::Constraint::Structurable', parent => Specio::Library::Structured::Tuple->parent, inline => \&Specio::Library::Structured::Tuple::_inline, parameterization_args_builder => \&Specio::Library::Structured::Tuple::_parameterization_args_builder, name_builder => \&Specio::Library::Structured::Tuple::_name_builder, structured_inline_generator => \&Specio::Library::Structured::Tuple::_structured_inline_generator, ); ## use critic sub optional { return { optional => shift }; } sub slurpy { return { slurpy => shift }; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _also_export {qw( optional slurpy )} ## use critic 1; # ABSTRACT: Structured types for Specio (Dict, Map, Tuple) __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Structured - Structured types for Specio (Dict, Map, Tuple) =head1 VERSION version 0.50 =head1 SYNOPSIS use Specio::Library::Builtins; use Specio::Library::String; use Specio::Library::Structured; my $map = t( 'Map', of => { key => t('NonEmptyStr'), value => t('Int'), }, ); my $tuple = t( 'Tuple', of => [ t('Str'), t('Num') ], ); my $dict = t( 'Dict', of => { kv => { name => t('Str'), age => t('Int'), }, }, ); =head1 DESCRIPTION This library provides a set of structured types for Specio, C, C, and C. This library also exports two helper subs used for some types, C and C. All structured types are parameterized by calling C<< t( 'Type Name', of => ... ) >>. The arguments passed after C vary for each type. =head2 Dict A C is a hashref with a well-defined set of keys and types for those key. The argument passed to C should be a single hashref. That hashref must contain a C key defining the expected keys and the types for their values. This C value is itself a hashref. If a key/value pair is optional, use C around the I for that key: my $person = t( 'Dict', of => { kv => { first => t('NonEmptyStr'), middle => optional( t('NonEmptyStr') ), last => t('NonEmptyStr'), }, }, ); If a key is optional, then it can be omitted entirely, but if it passed then it's type will be checked, so it cannot just be set to C. You can also pass a C key. If this is passed, then the C will allow other, unknown keys, as long as they match the specified type: my $person = t( 'Dict', of => { kv => { first => t('NonEmptyStr'), middle => optional( t('NonEmptyStr') ), last => t('NonEmptyStr'), }, slurpy => t('Int'), }, ); =head2 Map A C is a hashref with specified types for its keys and values, but no well-defined key names. The argument passed to C should be a single hashref with two keys, C and C. The type for the C will typically be some sort of key, but if you're using a tied hash or an object with hash overloading it could conceivably be any sort of value. =head2 Tuple A C is an arrayref with a fixed set of members in a specific order. The argument passed to C should be a single arrayref consisting of types. You can mark a slot in the C as optional by wrapping the type in a call to C: my $record = t( 'Tuple', of => [ t('PositiveInt'), t('Str'), optional( t('Num') ), optional( t('Num') ), ], ); You can have as many C elements as you want, but they must always come in sequence at the end of the tuple definition. You cannot interleave required and optional elements. You can also make the Tuple accept an arbitrary number of values by wrapping the last type in a call to C: my $record = t( 'Tuple', of => [ t('PositiveInt'), t('Str'), slurpy( t('Num') ), ], ); In this case, the C will require the first two elements and then allow any number (including zero) of C elements. You cannot mix C and C in a C definition. =for Pod::Coverage optional slurpy =head1 LIMITATIONS Currently all structured types require that the types they are structured with can be inlined. This may change in the future, but inlining all your types is a really good idea, so you should do that anyway. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Library/Perl.pm0000644000175000017500000001023414755224347017371 0ustar autarchautarchpackage Specio::Library::Perl; use strict; use warnings; our $VERSION = '0.50'; use parent 'Specio::Exporter'; use Specio::Library::String; use version 0.83 (); use Specio::Declare; my $package_inline = sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*(?:::\w+)*\z/ ) EOF }; declare( 'PackageName', parent => t('NonEmptyStr'), inline => $package_inline, ); declare( 'ModuleName', parent => t('NonEmptyStr'), inline => $package_inline, ); declare( 'DistName', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*(?:-\w+)*\z/ ) EOF }, ); declare( 'Identifier', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s =~ /\A[^\W\d]\w*\z/ ) EOF }, ); declare( 'SafeIdentifier', parent => t('Identifier'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && %s !~ /\A[_ab]\z/ ) EOF }, ); declare( 'LaxVersionStr', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && version::is_lax(%s) ) EOF }, ); declare( 'StrictVersionStr', parent => t('NonEmptyStr'), inline => sub { return sprintf( <<'EOF', $_[0]->parent->inline_check( $_[1] ), $_[1] ); ( %s && version::is_strict(%s) ) EOF }, ); 1; # ABSTRACT: Implements type constraint objects for some common Perl language things __END__ =pod =encoding UTF-8 =head1 NAME Specio::Library::Perl - Implements type constraint objects for some common Perl language things =head1 VERSION version 0.50 =head1 DESCRIPTION This library provides some additional string types for common cases. =head2 PackageName A valid package name. Unlike the C constraint from the L library, this package does not need to be loaded. This type does allow Unicode characters. =head2 ModuleName Same as C. =head2 DistName A valid distribution name like C Basically this is the same as a package name with the double-colons replaced by dashes. Note that there are some historical distribution names that don't fit this pattern, like C. This type does allow Unicode characters. =head2 Identifier An L is something that could be used as a symbol name or other identifier (filehandle, directory handle, subroutine name, format name, or label). It's what you put after the sigil (dollar sign, at sign, percent sign) in a variable name. Generally, it's a bunch of word characters not starting with a digit. This type does allow Unicode characters. =head2 SafeIdentifier This is just like an C but it excludes the single-character variables underscore (C<_>), C< and C, as these are special variables to the Perl interpreter. =head2 LaxVersionStr and StrictVersionStr Lax and strict version strings use the L and L methods from C to check if the given string would be a valid lax or strict version. L covers the details but basically: lax versions are everything you may do, and strict omit many of the usages best avoided. =head2 CREDITS Much of the code and docs for this library comes from MooseX::Types::Perl, written by Ricardo SIGNES . =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/TypeChecks.pm0000644000175000017500000000354114755224347017130 0ustar autarchautarchpackage Specio::TypeChecks; use strict; use warnings; our $VERSION = '0.50'; use Exporter qw( import ); use Specio::Helpers qw( is_class_loaded ); use Scalar::Util qw( blessed ); our @EXPORT_OK = qw( does_role is_ArrayRef is_ClassName is_CodeRef is_HashRef is_Int is_Str isa_class ); sub is_ArrayRef { return ref $_[0] eq 'ARRAY'; } sub is_CodeRef { return ref $_[0] eq 'CODE'; } sub is_HashRef { return ref $_[0] eq 'HASH'; } sub is_Str { defined( $_[0] ) && !ref( $_[0] ) && ref( \$_[0] ) eq 'SCALAR' || ref( \( my $val = $_[0] ) eq 'SCALAR' ); } sub is_Int { ( defined( $_[0] ) && !ref( $_[0] ) && ref( \$_[0] ) eq 'SCALAR' || ref( \( my $val = $_[0] ) eq 'SCALAR' ) ) && $_[0] =~ /^[0-9]+$/; } sub is_ClassName { is_class_loaded( $_[0] ); } sub isa_class { blessed( $_[0] ) && $_[0]->isa( $_[1] ); } sub does_role { blessed( $_[0] ) && $_[0]->can('does') && $_[0]->does( $_[1] ); } 1; # ABSTRACT: Type checks used internally for Specio classes (it's not self-bootstrapping (yet?)) __END__ =pod =encoding UTF-8 =head1 NAME Specio::TypeChecks - Type checks used internally for Specio classes (it's not self-bootstrapping (yet?)) =head1 VERSION version 0.50 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Declare.pm0000644000175000017500000004270614755224347016433 0ustar autarchautarchpackage Specio::Declare; use strict; use warnings; use parent 'Exporter'; our $VERSION = '0.50'; use Carp qw( croak ); use Specio::Coercion; use Specio::Constraint::Simple; use Specio::DeclaredAt; use Specio::Helpers qw( install_t_sub _STRINGLIKE ); use Specio::Registry qw( internal_types_for_package register ); ## no critic (Modules::ProhibitAutomaticExportation) our @EXPORT = qw( anon any_can_type any_does_type any_isa_type coerce declare enum intersection object_can_type object_does_type object_isa_type union ); ## use critic sub import { my $package = shift; my $caller = caller(); $package->export_to_level( 1, $package, @_ ); install_t_sub( $caller, internal_types_for_package($caller) ); return; } sub declare { my $name = _STRINGLIKE(shift) or croak 'You must provide a name for declared types'; my %p = @_; my $tc = _make_tc( name => $name, %p ); register( scalar caller(), $name, $tc, 'exportable' ); return $tc; } sub anon { return _make_tc(@_); } sub enum { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Enum; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), values => $p{values}, type_class => 'Specio::Constraint::Enum', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub object_can_type { my $name; $name = shift if @_ % 2; my %p = @_; # This cannot be loaded earlier, since it loads Specio::Library::Builtins, # which in turn wants to load Specio::Declare (the current module). require Specio::Constraint::ObjectCan; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), methods => $p{methods}, type_class => 'Specio::Constraint::ObjectCan', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub object_does_type { my $name; $name = shift if @_ % 2; my %p = @_; my $caller = scalar caller(); # If we are being called repeatedly with a single argument, then we don't # want to blow up because the type has already been declared. This would # force the user to use t() for all calls but the first, making their code # pointlessly more complicated. unless ( keys %p ) { if ( my $exists = internal_types_for_package($caller)->{$name} ) { return $exists; } } require Specio::Constraint::ObjectDoes; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), role => ( defined $p{role} ? $p{role} : $name ), type_class => 'Specio::Constraint::ObjectDoes', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub object_isa_type { my $name; $name = shift if @_ % 2; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $exists = internal_types_for_package($caller)->{$name} ) { return $exists; } } require Specio::Constraint::ObjectIsa; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), class => ( defined $p{class} ? $p{class} : $name ), type_class => 'Specio::Constraint::ObjectIsa', ); register( $caller, $name, $tc, 'exportable' ) if defined $name; return $tc; } sub any_can_type { my $name; $name = shift if @_ % 2; my %p = @_; # This cannot be loaded earlier, since it loads Specio::Library::Builtins, # which in turn wants to load Specio::Declare (the current module). require Specio::Constraint::AnyCan; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), methods => $p{methods}, type_class => 'Specio::Constraint::AnyCan', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub any_does_type { my $name; $name = shift if @_ % 2; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $exists = internal_types_for_package($caller)->{$name} ) { return $exists; } } require Specio::Constraint::AnyDoes; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), role => ( defined $p{role} ? $p{role} : $name ), type_class => 'Specio::Constraint::AnyDoes', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub any_isa_type { my $name; $name = shift if @_ % 2; my %p = @_; my $caller = scalar caller(); unless ( keys %p ) { if ( my $exists = internal_types_for_package($caller)->{$name} ) { return $exists; } } require Specio::Constraint::AnyIsa; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), class => ( defined $p{class} ? $p{class} : $name ), type_class => 'Specio::Constraint::AnyIsa', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub intersection { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Intersection; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), %p, type_class => 'Specio::Constraint::Intersection', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub union { my $name; $name = shift if @_ % 2; my %p = @_; require Specio::Constraint::Union; my $tc = _make_tc( ( defined $name ? ( name => $name ) : () ), %p, type_class => 'Specio::Constraint::Union', ); register( scalar caller(), $name, $tc, 'exportable' ) if defined $name; return $tc; } sub _make_tc { my %p = @_; my $class = delete $p{type_class} || 'Specio::Constraint::Simple'; $p{constraint} = delete $p{where} if exists $p{where}; $p{message_generator} = delete $p{message} if exists $p{message}; $p{inline_generator} = delete $p{inline} if exists $p{inline}; return $class->new( %p, declared_at => Specio::DeclaredAt->new_from_caller(2), ); } sub coerce { my $to = shift; my %p = @_; $p{coercion} = delete $p{using} if exists $p{using}; $p{inline_generator} = delete $p{inline} if exists $p{inline}; return $to->add_coercion( Specio::Coercion->new( to => $to, %p, declared_at => Specio::DeclaredAt->new_from_caller(1), ) ); } 1; # ABSTRACT: Specio declaration subroutines __END__ =pod =encoding UTF-8 =head1 NAME Specio::Declare - Specio declaration subroutines =head1 VERSION version 0.50 =head1 SYNOPSIS package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); declare( 'ArrayRefOfInt', parent => t( 'ArrayRef', of => t('Int') ), ); my $even = anon( parent => t('Int'), inline => sub { my $type = shift; my $value_var = shift; return $value_var . ' % 2 == 0'; }, ); coerce( t('ArrayRef'), from => t('Foo'), using => sub { [ $_[0] ] }, ); coerce( $even, from => t('Int'), using => sub { $_[0] % 2 ? $_[0] + 1 : $_[0] }, ); # Specio name is DateTime any_isa_type('DateTime'); # Specio name is DateTimeObject object_isa_type( 'DateTimeObject', class => 'DateTime' ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_can_type( 'DuckObject', methods => [ 'duck_walk', 'quack' ], ); enum( 'Colors', values => [qw( blue green red )], ); intersection( 'HashRefAndArrayRef', of => [ t('HashRef'), t('ArrayRef') ], ); union( 'IntOrArrayRef', of => [ t('Int'), t('ArrayRef') ], ); =head1 DESCRIPTION This package exports a set of type declaration helpers. Importing this package also causes it to create a C subroutine in the calling package. =head1 SUBROUTINES This module exports the following subroutines. =head2 t('name') This subroutine lets you access any types you have declared so far, as well as any types you imported from another type library. If you pass an unknown name, it throws an exception. =head2 declare(...) This subroutine declares a named type. The first argument is the type name, followed by a set of key/value parameters: =over 4 =item * parent => $type The parent should be another type object. Specifically, it can be anything which does the L role. The parent can be a named or anonymous type. =item * where => sub { ... } This is a subroutine which defines the type constraint. It will be passed a single argument, the value to check, and it should return true or false to indicate whether or not the value is valid for the type. This parameter is mutually exclusive with the C parameter. =item * inline => sub { ... } This is a subroutine that is called to generate inline code to validate the type. Inlining can be I faster than simply providing a subroutine with the C parameter, but is often more complicated to get right. The inline generator is called as a method on the type with one argument. This argument is a I containing the variable name to use in the generated code. Typically this is something like C<'$_[0]'> or C<'$value'>. The inline generator subroutine should return a I of code representing a single term, and it I be terminated with a semicolon. This allows the inlined code to be safely included in an C statement, for example. You can use C blocks and ternaries to get everything into one term. Do not assign to the variable you are testing. This single term should evaluate to true or false. The inline generator is expected to include code to implement both the current type and all its parents. Typically, the easiest way to do this is to write a subroutine something like this: sub { my $self = shift; my $var = shift; return $self->parent->inline_check($var) . ' and more checking code goes here'; } Or, more concisely: sub { $_[0]->parent->inline_check( $_[1] ) . 'more code that checks $_[1]' } The C parameter is mutually exclusive with the C parameter. =item * message_generator => sub { ... } A subroutine to generate an error message when the type check fails. The default message says something like "Validation failed for type named Int declared in package Specio::Library::Builtins (.../Specio/blib/lib/Specio/Library/Builtins.pm) at line 147 in sub named (eval) with value 1.1". You can override this to provide something more specific about the way the type failed. The subroutine you provide will be called as a method on the type with two arguments. The first is the description of the type (the bit in the message above that starts with "type named Int ..." and ends with "... in sub named (eval)". This description says what the thing is and where it was defined. The second argument is the value that failed the type check, after any coercions that might have been applied. =back =head2 anon(...) This subroutine declares an anonymous type. It is identical to C except that it expects a list of key/value parameters without a type name as the first parameter. =head2 coerce(...) This declares a coercion from one type to another. The first argument should be an object which does the L role. This can be either a named or anonymous type. This type is the type that the coercion is I. The remaining arguments are key/value parameters: =over 4 =item * from => $type This must be an object which does the L role. This is type that we are coercing I. Again, this can be either a named or anonymous type. =item * using => sub { ... } This is a subroutine which defines the type coercion. It will be passed a single argument, the value to coerce. It should return a new value of the type this coercion is to. This parameter is mutually exclusive with the C parameter. =item * inline => sub { ... } This is a subroutine that is called to generate inline code to perform the coercion. The inline generator is called as a method on the type with one argument. This argument is a I containing the variable name to use in the generated code. Typically this is something like C<'$_[0]'> or C<'$value'>. The inline generator subroutine should return a I of code representing a single term, and it I be terminated with a semicolon. This allows the inlined code to be safely included in an C statement, for example. You can use C blocks and ternaries to get everything into one term. This single term should evaluate to the new value. =back =head1 DECLARATION HELPERS This module also exports some helper subs for declaring certain kinds of types: =head2 any_isa_type, object_isa_type The C helper creates a type which accepts a class name or object of the given class. The C helper creates a type which only accepts an object of the given class. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which should be a class name. This is the class that the type requires. The type name argument can be omitted to create an anonymous type. You can also pass just a single argument, in which case that will be used as both the type's name and the class for the constraint to check. =head2 any_does_type, object_does_type The C helper creates a type which accepts a class name or object which does the given role. The C helper creates a type which only accepts an object which does the given role. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which should be a role name. This is the class that the type requires. This should just work (I hope) with roles created by L, L, and L (using L). The type name argument can be omitted to create an anonymous type. You can also pass just a single argument, in which case that will be used as both the type's name and the role for the constraint to check. =head2 any_can_type, object_can_type The C helper creates a type which accepts a class name or object with the given methods. The C helper creates a type which only accepts an object with the given methods. These subroutines take a type name as the first argument. The remaining arguments are key/value pairs. Currently this is just the C key, which can be either a string or array reference of strings. These strings are the required methods for the type. The type name argument can be omitted to create an anonymous type. =head2 enum This creates a type which accepts a string matching a given list of acceptable values. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of acceptable string values. The type name argument can be omitted to create an anonymous type. =head2 intersection This creates a type which is the intersection of two or more other types. A union only accepts values which match all of its underlying types. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of types. The type name argument can be omitted to create an anonymous type. =head2 union This creates a type which is the union of two or more other types. A union accepts any of its underlying types. The first argument is the type name. The remaining arguments are key/value pairs. Currently this is just the C key. This should an array reference of types. The type name argument can be omitted to create an anonymous type. =head1 PARAMETERIZED TYPES You can create a parameterized type by calling C with additional parameters, like this: my $arrayref_of_int = t( 'ArrayRef', of => t('Int') ); my $arrayref_of_hashref_of_int = t( 'ArrayRef', of => t( 'HashRef', of => t('Int'), ), ); The C subroutine assumes that if it receives more than one argument, it should look up the named type and call C<< $type->parameterize(...) >> with the additional arguments. If the named type cannot be parameterized, it throws an error. You can also call C<< $type->parameterize >> directly if needed. See L for details. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Registry.pm0000644000175000017500000000407114755224347016675 0ustar autarchautarchpackage Specio::Registry; use strict; use warnings; use parent 'Exporter'; our $VERSION = '0.50'; use Carp qw( confess croak ); our @EXPORT_OK = qw( exportable_types_for_package internal_types_for_package register ); my %Registry; sub register { confess 'register requires three or four arguments (package, name, type, [exportable])' unless @_ == 3 || @_ == 4; my $package = shift; my $name = shift; my $type = shift; my $exportable = shift; croak "The $package package already has a type named $name" if $Registry{$package}{internal}{$name}; # This is structured so that we can always return a _reference_ for # *_types_for_package. This means that the generated t sub sees any # changes to the registry as they happen. This is important inside a # package that is declaring new types. It needs to be able to see types it # has declared. $Registry{$package}{internal}{$name} = $type; $Registry{$package}{exportable}{$name} = $type if $exportable; return; } sub exportable_types_for_package { my $package = shift; return $Registry{$package}{exportable} ||= {}; } sub internal_types_for_package { my $package = shift; return $Registry{$package}{internal} ||= {}; } 1; # ABSTRACT: Implements the per-package type registry __END__ =pod =encoding UTF-8 =head1 NAME Specio::Registry - Implements the per-package type registry =head1 VERSION version 0.50 =head1 DESCRIPTION There's nothing public here. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/OO.pm0000644000175000017500000002364414755224347015411 0ustar autarchautarchpackage Specio::OO; use strict; use warnings; use Carp qw( confess ); use Clone (); use List::Util 1.33 qw( all ); use MRO::Compat; use Role::Tiny; use Scalar::Util qw( weaken ); use Specio::Helpers qw( perlstring ); use Specio::PartialDump qw( partial_dump ); use Specio::TypeChecks; our $VERSION = '0.50'; use Exporter qw( import ); ## no critic (Modules::ProhibitAutomaticExportation) our @EXPORT = qw( clone _ooify ); ## use critic ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _ooify { my $class = shift; my $attrs = $class->_attrs; for my $name ( sort keys %{$attrs} ) { my $attr = $attrs->{$name}; _inline_reader( $class, $name, $attr ); _inline_predicate( $class, $name, $attr ); } _inline_constructor($class); } ## use critic sub _inline_reader { my $class = shift; my $name = shift; my $attr = shift; my $reader; if ( $attr->{lazy} && ( my $builder = $attr->{builder} ) ) { my $source = <<'EOF'; sub { unless ( exists $_[0]->{%s} ) { $_[0]->{%s} = $_[0]->%s; Scalar::Util::weaken( $_[0]->{%s} ) if %s && ref $_[0]->{%s}; } $_[0]->{%s}; } EOF $reader = sprintf( $source, $name, $name, $builder, $name, ( $attr->{weak_ref} ? 1 : 0 ), $name, $name, ); } else { $reader = sprintf( 'sub { $_[0]->{%s} }', $name ); } { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::' . $name } = _eval_or_die( $reader, $class . '->' . $name, ); } } sub _inline_predicate { my $class = shift; my $name = shift; my $attr = shift; return unless $attr->{predicate}; my $predicate = "sub { exists \$_[0]->{$name} }"; { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::' . $attr->{predicate} } = _eval_or_die( $predicate, $class . '->' . $attr->{predicate}, ); } } my @RolesWithBUILD = qw( Specio::Constraint::Role::Interface ); # This is an optimization to avoid calling this many times over: # # Specio::TypeChecks->can( 'is_' . $attr->{isa} ) my %TypeChecks; BEGIN { for my $sub (@Specio::TypeChecks::EXPORT_OK) { my ($type) = $sub =~ /^is_(.+)$/ or next; $TypeChecks{$type} = Specio::TypeChecks->can($sub); } } sub _inline_constructor { my $class = shift; my @build_subs; for my $parent ( @{ mro::get_linear_isa($class) } ) { { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; push @build_subs, $parent . '::BUILD' if defined &{ $parent . '::BUILD' }; } } # This is all a hack to avoid needing Class::Method::Modifiers to add a # BUILD from a role. We can't just call the method in the role "BUILD" or # it will be shadowed by a class's BUILD. So we give it a wacky unique # name. We need to explicitly know which roles have a _X_BUILD method # because Role::Tiny doesn't provide a way to list all the roles applied # to a class. for my $role (@RolesWithBUILD) { if ( Role::Tiny::does_role( $class, $role ) ) { ( my $build_name = $role ) =~ s/::/_/g; $build_name = q{_} . $build_name . '_BUILD'; push @build_subs, $role . '::' . $build_name; } } my $constructor = <<'EOF'; sub { my $class = shift; my %p = do { if ( @_ == 1 ) { if ( ref $_[0] eq 'HASH' ) { %{ shift() }; } else { Specio::OO::_constructor_confess( Specio::OO::_bad_args_message( $class, @_ ) ); } } else { Specio::OO::_constructor_confess( Specio::OO::_bad_args_message( $class, @_ ) ) if @_ % 2; @_; } }; my $self = bless {}, $class; EOF my $attrs = $class->_attrs; for my $name ( sort keys %{$attrs} ) { my $attr = $attrs->{$name}; my $key_name = defined $attr->{init_arg} ? $attr->{init_arg} : $name; if ( $attr->{required} ) { $constructor .= <<"EOF"; Specio::OO::_constructor_confess( "$class->new requires a $key_name argument.") unless exists \$p{$key_name}; EOF } if ( $attr->{builder} && !$attr->{lazy} ) { my $builder = $attr->{builder}; $constructor .= <<"EOF"; \$p{$key_name} = $class->$builder unless exists \$p{$key_name}; EOF } if ( $attr->{isa} ) { my $validator; if ( $TypeChecks{ $attr->{isa} } ) { $validator = 'Specio::TypeChecks::is_' . $attr->{isa} . "( \$p{$key_name} )"; } else { my $quoted_class = perlstring( $attr->{isa} ); $validator = "Specio::TypeChecks::isa_class( \$p{$key_name}, $quoted_class )"; } $constructor .= <<"EOF"; if ( exists \$p{$key_name} && !$validator ) { Carp::confess( Specio::OO::_bad_value_message( "The value you provided to $class->new for $key_name is not a valid $attr->{isa}.", \$p{$key_name}, ) ); } EOF } if ( $attr->{does} ) { my $quoted_role = perlstring( $attr->{does} ); $constructor .= <<"EOF"; if ( exists \$p{$key_name} && !Specio::TypeChecks::does_role( \$p{$key_name}, $quoted_role ) ) { Carp::confess( Specio::OO::_bad_value_message( "The value you provided to $class->new for $key_name does not do the $attr->{does} role.", \$p{$key_name}, ) ); } EOF } if ( $attr->{weak_ref} ) { $constructor .= " Scalar::Util::weaken( \$p{$key_name} );\n"; } $constructor .= " \$self->{$name} = \$p{$key_name} if exists \$p{$key_name};\n"; $constructor .= "\n"; } $constructor .= ' $self->' . $_ . "(\\%p);\n" for @build_subs; $constructor .= <<'EOF'; return $self; } EOF { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $class . '::new' } = _eval_or_die( $constructor, $class . '->new', ); } } # This used to be done with Eval::Closure but that added a lot of unneeded # overhead. We're never actually eval'ing a closure, just plain source, so # doing it by hand is a worthwhile optimization. sub _eval_or_die { local $@ = undef; ## no critic (Variables::RequireInitializationForLocalVars) # $SIG{__DIE__} = undef causes warnings with 5.8.x local $SIG{__DIE__}; ## no critic (BuiltinFunctions::ProhibitStringyEval) my $sub = eval <<"EOF"; #line 1 "$_[1]" $_[0]; EOF my $e = $@; die $e if $e; return $sub; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _constructor_confess { local $Carp::CarpLevel = $Carp::CarpLevel + 1; confess shift; } sub _bad_args_message { my $class = shift; return "$class->new requires either a hashref or hash as arguments. You passed " . partial_dump(@_); } sub _bad_value_message { my $message = shift; my $value = shift; return $message . ' You passed ' . partial_dump($value); } ## use critic my %BuiltinTypes = map { $_ => 1 } qw( SCALAR ARRAY HASH CODE REF GLOB LVALUE FORMAT IO VSTRING Regexp ); sub clone { my $self = shift; # Attributes which provide a clone method are cloned by calling that # method on the _clone_ (not the original). This is primarily to allow us # to clone the coercions contained by a type in a way that doesn't lead to # circular clone (type clones coercions which in turn need to clone their # to/from types which in turn ...). my $attrs = $self->_attrs; my %special = map { $_ => $attrs->{$_}{clone} } grep { $attrs->{$_}{clone} } keys %{$attrs}; my $new; for my $key ( keys %{$self} ) { my $value = $self->{$key}; if ( $special{$key} ) { $new->{$key} = $value; next; } # This is a weird hacky way of trying to avoid calling # Scalar::Util::blessed, which showed up as a hotspot in profiling of # loading DateTime. That's because we call ->clone a _lot_ (it's # called every time a type is exported). my $ref = ref $value; $new->{$key} = !$ref ? $value : $ref eq 'CODE' ? $value : $BuiltinTypes{$ref} ? Clone::clone($value) : $value->clone; } bless $new, ( ref $self ); for my $key ( keys %special ) { my $method = $special{$key}; $new->{$key} = $new->$method; } return $new; } 1; # ABSTRACT: A painfully poor reimplementation of Moo(se) __END__ =pod =encoding UTF-8 =head1 NAME Specio::OO - A painfully poor reimplementation of Moo(se) =head1 VERSION version 0.50 =head1 DESCRIPTION Specio can't depend on Moo or Moose, so this module provides a terrible reimplementation of a small slice of their features. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/PartialDump.pm0000644000175000017500000001267014755224347017313 0ustar autarchautarchpackage Specio::PartialDump; use strict; use warnings; our $VERSION = '0.50'; use Scalar::Util qw( looks_like_number reftype blessed ); use Exporter qw( import ); our @EXPORT_OK = qw( partial_dump ); my $MaxLength = 100; my $MaxElements = 6; my $MaxDepth = 2; sub partial_dump { my (@args) = @_; my $dump = _should_dump_as_pairs(@args) ? _dump_as_pairs( 1, @args ) : _dump_as_list( 1, @args ); if ( length($dump) > $MaxLength ) { my $max_length = $MaxLength - 3; $max_length = 0 if $max_length < 0; substr( $dump, $max_length, length($dump) - $max_length ) = '...'; } return $dump; } sub _should_dump_as_pairs { my (@what) = @_; return if @what % 2 != 0; # must be an even list for ( my $i = 0; $i < @what; $i += 2 ) { return if ref $what[$i]; # plain strings are keys } return 1; } sub _dump_as_pairs { my ( $depth, @what ) = @_; my $truncated; if ( defined $MaxElements and ( @what / 2 ) > $MaxElements ) { $truncated = 1; @what = splice( @what, 0, $MaxElements * 2 ); } return join( ', ', _dump_as_pairs_recursive( $depth, @what ), ( $truncated ? "..." : () ) ); } sub _dump_as_pairs_recursive { my ( $depth, @what ) = @_; return unless @what; my ( $key, $value, @rest ) = @what; return ( ( _format_key( $depth, $key ) . ': ' . _format( $depth, $value ) ), _dump_as_pairs_recursive( $depth, @rest ), ); } sub _dump_as_list { my ( $depth, @what ) = @_; my $truncated; if ( @what > $MaxElements ) { $truncated = 1; @what = splice( @what, 0, $MaxElements ); } return join( ', ', ( map { _format( $depth, $_ ) } @what ), ( $truncated ? "..." : () ) ); } sub _format { my ( $depth, $value ) = @_; defined($value) ? ( ref($value) ? ( blessed($value) ? _format_object( $depth, $value ) : _format_ref( $depth, $value ) ) : ( looks_like_number($value) ? _format_number( $depth, $value ) : _format_string( $depth, $value ) ) ) : _format_undef( $depth, $value ),; } sub _format_key { my ( undef, $key ) = @_; return $key; } sub _format_ref { my ( $depth, $ref ) = @_; if ( $depth > $MaxDepth ) { return overload::StrVal($ref); } else { my $reftype = reftype($ref); $reftype = 'SCALAR' if $reftype eq 'REF' || $reftype eq 'LVALUE'; my $method = "_format_" . lc $reftype; if ( my $sub = __PACKAGE__->can($method) ) { return $sub->( $depth, $ref ); } else { return overload::StrVal($ref); } } } sub _format_array { my ( $depth, $array ) = @_; my $class = blessed($array) || ''; $class .= "=" if $class; return $class . "[ " . _dump_as_list( $depth + 1, @$array ) . " ]"; } sub _format_hash { my ( $depth, $hash ) = @_; my $class = blessed($hash) || ''; $class .= "=" if $class; return $class . "{ " . _dump_as_pairs( $depth + 1, map { $_ => $hash->{$_} } sort keys %$hash ) . " }"; } sub _format_scalar { my ( $depth, $scalar ) = @_; my $class = blessed($scalar) || ''; $class .= "=" if $class; return $class . "\\" . _format( $depth + 1, $$scalar ); } sub _format_object { my ( $depth, $object ) = @_; return _format_ref( $depth, $object ); } sub _format_string { my ( undef, $str ) = @_; # FIXME use String::Escape ? # remove vertical whitespace $str =~ s/\n/\\n/g; $str =~ s/\r/\\r/g; # reformat nonprintables $str =~ s/(\P{IsPrint})/"\\x{" . sprintf("%x", ord($1)) . "}"/ge; _quote($str); } sub _quote { my ($str) = @_; qq{"$str"}; } sub _format_undef {"undef"} sub _format_number { my ( undef, $value ) = @_; return "$value"; } # ABSTRACT: A partially rear-ended copy of Devel::PartialDump without prereqs 1; __END__ =pod =encoding UTF-8 =head1 NAME Specio::PartialDump - A partially rear-ended copy of Devel::PartialDump without prereqs =head1 VERSION version 0.50 =head1 SYNOPSIS use Specio::PartialDump qw( partial_dump ); partial_dump( { foo => 42 } ); partial_dump(qw( a b c d e f g )); partial_dump( foo => 42, bar => [ 1, 2, 3 ], ); =head1 DESCRIPTION This is a copy of Devel::PartialDump with all the OO bits and prereqs removed. You may want to use this module in your own code to generate nicely formatted messages when a type constraint fails. This module optionally exports one sub, C. This sub accepts any number of arguments. If given more than one, it will assume that it's either been given a list of key/value pairs (to build a hash) or a list of values (to build an array) and dump them appropriately. Objects and references are stringified in a sane way. =for Pod::Coverage partial_dump =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is copyright (c) 2008 by יובל קוג'מן (Yuval Kogman). This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut Specio-0.50/lib/Specio/Constraint/0000775000175000017500000000000014755224347016653 5ustar autarchautarchSpecio-0.50/lib/Specio/Constraint/ObjectIsa.pm0000644000175000017500000000512214755224347021052 0ustar autarchautarchpackage Specio::Constraint::ObjectIsa; use strict; use warnings; our $VERSION = '0.50'; use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::IsaType; with 'Specio::Constraint::Role::IsaType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', $val, $val, perlstring( $self->class ) ); ( Scalar::Util::blessed( %s ) && %s->isa(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {0} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object that inherits from a specific class __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectIsa - A class for constraints which require an object that inherits from a specific class =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectIsa->new(...); print $type->class; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object that inherits from a specific class. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectIsa->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single class name. =head2 $object_isa->class Returns the class name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Parameterizable.pm0000644000175000017500000001302314755224347022315 0ustar autarchautarchpackage Specio::Constraint::Parameterizable; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use Role::Tiny::With; use Specio::Constraint::Parameterized; use Specio::DeclaredAt; use Specio::OO; use Specio::TypeChecks qw( does_role isa_class ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Constraint::Role::Interface::_attrs(); ## use critic my $attrs = { %{$role_attrs}, _parameterized_constraint_generator => { isa => 'CodeRef', init_arg => 'parameterized_constraint_generator', predicate => '_has_parameterized_constraint_generator', }, _parameterized_inline_generator => { isa => 'CodeRef', init_arg => 'parameterized_inline_generator', predicate => '_has_parameterized_inline_generator', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; if ( $self->_has_constraint ) { die 'A parameterizable constraint with a constraint parameter must also have a parameterized_constraint_generator' unless $self->_has_parameterized_constraint_generator; } if ( $self->_has_inline_generator ) { die 'A parameterizable constraint with an inline_generator parameter must also have a parameterized_inline_generator' unless $self->_has_parameterized_inline_generator; } return; } sub parameterize { my $self = shift; my %args = @_; my ( $parameter, $declared_at ) = @args{qw( of declared_at )}; does_role( $parameter, 'Specio::Constraint::Role::Interface' ) or confess 'The "of" parameter passed to ->parameterize must be an object which does the Specio::Constraint::Role::Interface role'; if ($declared_at) { isa_class( $declared_at, 'Specio::DeclaredAt' ) or confess 'The "declared_at" parameter passed to ->parameterize must be a Specio::DeclaredAt object'; } $declared_at = Specio::DeclaredAt->new_from_caller(1) unless defined $declared_at; my %p = ( parent => $self, parameter => $parameter, declared_at => $declared_at, ); if ( $self->_has_parameterized_constraint_generator ) { $p{constraint} = $self->_parameterized_constraint_generator->($parameter); } else { confess 'The "of" parameter passed to ->parameterize must be an inlinable constraint if the parameterizable type has an inline_generator' unless $parameter->can_be_inlined; my $ig = $self->_parameterized_inline_generator; $p{inline_generator} = sub { $ig->( shift, $parameter, @_ ) }; } return Specio::Constraint::Parameterized->new(%p); } __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents parameterizable constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Parameterizable - A class which represents parameterizable constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $arrayref = t('ArrayRef'); my $arrayref_of_int = $arrayref->parameterize( of => t('Int') ); =head1 DESCRIPTION This class implements the API for parameterizable types like C and C. =for Pod::Coverage BUILD =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Parameterizable->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parameterized_constraint_generator This is a subroutine that generates a new constraint subroutine when the type is parameterized. It will be called as a method on the type and will be passed a single argument, the type object for the type parameter. This parameter is mutually exclusive with the C parameter. =item * parameterized_inline_generator This is a subroutine that generates a new inline generator subroutine when the type is parameterized. It will be called as a method on the L object when that object needs to generate an inline constraint. It will receive the type parameter as the first argument and the variable name as a string as the second. This probably seems fairly confusing, so looking at the examples in the L code may be helpful. This parameter is mutually exclusive with the C parameter. =back =head2 $type->parameterize(...) This method takes two arguments. The C argument should be an object which does the L role, and is required. The other argument, C, is optional. If it is not given, then a new L object is creating using a call stack depth of 1. This method returns a new L object. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Simple.pm0000644000175000017500000002570214755224347020446 0ustar autarchautarchpackage Specio::Constraint::Simple; use strict; use warnings; our $VERSION = '0.50'; use Role::Tiny::With; use Specio::OO; with 'Specio::Constraint::Role::Interface'; __PACKAGE__->_ooify; 1; # ABSTRACT: Class for simple (non-parameterized or specialized) types __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Simple - Class for simple (non-parameterized or specialized) types =head1 VERSION version 0.50 =head1 SYNOPSIS my $str = t('Str'); print $str->name; # Str my $parent = $str->parent; if ( $str->value_is_valid($value) ) { ... } $str->validate_or_die($value); my $code = $str->inline_coercion_and_check('$_[0]'); =head1 DESCRIPTION This class implements simple type constraints, constraints without special properties or parameterization. It does not actually contain any real code of its own. The entire implementation is provided by the L role, but the primary API for type constraints is documented here. All other type constraint classes in this distribution implement this API, except where otherwise noted. =head1 API This class provides the following methods. =head2 Specio::Constraint::Simple->new(...) This creates a new constraint. It accepts the following named parameters: =over 4 =item * name => $name This is the type's name. The name is optional, but if provided it must be a string. =item * parent => $type The type's parent type. This must be an object which does the L role. This parameter is optional. =item * constraint => sub { ... } A subroutine reference implementing the constraint. It will be called as a method on the object and passed a single argument, the value to check. It should return true or false to indicate whether the value matches the constraint. This parameter is mutually exclusive with C. You can also pass this option with the key C in the parameter list. =item * inline_generator => sub { ... } This should be a subroutine reference which returns a string containing a single term. This code should I end in a semicolon. This code should implement the constraint. The generator will be called as a method on the constraint with a single argument. That argument is the name of the variable being coerced, something like C<'$_[0]'> or C<'$var'>. The inline generator is expected to include code to implement both the current type and all its parents. Typically, the easiest way to do this is to write a subroutine something like this: sub { my $self = shift; my $var = shift; return $_[0]->parent->inline_check( $_[1] ) . ' and more checking code goes here'; } This parameter is mutually exclusive with C. You can also pass this option with the key C in the parameter list. =item * inline_environment => {} This should be a hash reference of variable names (with sigils) and values for that variable. The values should be I to the values of the variables. This environment will be used when compiling the constraint as part of a subroutine. The named variables will be captured as closures in the generated subroutine, using L. It should be very rare to need to set this in the constructor. It's more likely that a special type subclass would need to provide values that it generates internally. If you do set this, you are responsible for generating variable names that won't clash with anything else in the inlined code. This parameter defaults to an empty hash reference. =item * message_generator => sub { ... } A subroutine to generate an error message when the type check fails. The default message says something like "Validation failed for type named Int declared in package Specio::Library::Builtins (.../Specio/blib/lib/Specio/Library/Builtins.pm) at line 147 in sub named (eval) with value 1.1". You can override this to provide something more specific about the way the type failed. The subroutine you provide will be called as a subroutine, I, with two arguments. The first is the description of the type (the bit in the message above that starts with "type named Int ..." and ends with "... in sub named (eval)". This description says what the thing is and where it was defined. The second argument is the value that failed the type check, after any coercions that might have been applied. You can also pass this option with the key C in the parameter list. =item * declared_at => $declared_at This parameter must be a L object. This parameter is required. =back It is possible to create a type without a constraint of its own. =head2 $type->name Returns the name of the type as it was passed the constructor. =head2 $type->parent Returns the parent type passed to the constructor. If the type has no parent this returns C. =head2 $type->is_anon Returns false for named types, true otherwise. =head2 $type->is_a_type_of($other_type) Given a type object, this returns true if the type this method is called on is a descendant of that type or is that type. =head2 $type->is_same_type_as($other_type) Given a type object, this returns true if the type this method is called on is the same as that type. =head2 $type->coercions Returns a list of L objects which belong to this constraint. =head2 $type->coercion_from_type($name) Given a type name, this method returns a L object which coerces from that type, if such a coercion exists. =head2 $type->validate_or_die($value) This method does nothing if the value is valid. If it is not, it throws a L. =head2 $type->value_is_valid($value) Returns true or false depending on whether the C<$value> passes the type constraint. =head2 $type->has_real_constraint This returns true if the type was created with a C or C parameter. This is used internally to skip type checks for types that don't actually implement a constraint. =head2 $type->description This returns a string describing the type. This includes the type's name and where it was declared, so you end up with something like C<'type named Foo declared in package My::Lib (lib/My/Lib.pm) at line 42'>. If the type is anonymous the name will be "anonymous type". =head2 $type->id This is a unique id for the type as a string. This is useful if you need to make a hash key based on a type, for example. This should be treated as an essentially arbitrary and opaque string, and could change at any time in the future. If you want something human-readable, use the C<< $type->description >> method. =head2 $type->add_coercion($coercion) This adds a new L to the type. If the type already has a coercion from the same type as the new coercion, it will throw an error. =head2 $type->has_coercion_from_type($other_type) This method returns true if the type can coerce from the other type. =head2 $type->coerce_value($value) This attempts to coerce a value into a new value that matches the type. It checks all of the type's coercions. If it finds one which has a "from" type that accepts the value, it runs the coercion and returns the new value. If it cannot find a matching coercion it returns the original value. =head2 $type->inline_coercion_and_check($var) Given a variable name, this returns a string of code and an environment hash that implements all of the type's coercions as well as the type check itself. This will throw an exception unless both the type and all of its coercions are inlinable. The generated code will throw a L if the type constraint fails. If the constraint passes, then the generated code returns the (possibly coerced) value. The return value is a two-element list. The first element is the code. The second is a hash reference containing variables which need to be in scope for the code to work. This is intended to be passed to L's C subroutine. The returned code is a single C block without a terminating semicolon. =head2 $type->inline_assert($var) Given a variable name, this generates code that implements the constraint and throws an exception if the variable does not pass the constraint. The return value is a two-element list. The first element is the code. The second is a hash reference containing variables which need to be in scope for the code to work. This is intended to be passed to L's C subroutine. =head2 $type->inline_check($var) Given a variable name, this returns a string of code that implements the constraint. If the type is not inlinable, this method throws an error. =head2 $type->inline_coercion($var) Given a variable name, this returns a string of code and an environment hash that implements all of the type's coercions. I This will throw an exception unless all of the type's coercions are inlinable. The return value is a two-element list. The first element is the code. The second is a hash reference containing variables which need to be in scope for the code to work. This is intended to be passed to L's C subroutine. The returned code is a single C block without a terminating semicolon. =head2 $type->inline_environment() This returns a hash defining the variables that need to be closed over when inlining the type. The keys are full variable names like C<'$foo'> or C<'@bar'>. The values are I to a variable of the matching type. =head2 $type->coercion_sub This method returns a sub ref that takes a single argument and applied all relevant coercions to it. This sub ref will use L if all the type's coercions are inlinable. This method exists primarily for the benefit of L. =head1 OVERLOADING All constraints implement the following overloads: =head2 Subroutine De-referencing This is done for the benefit of L. The returned subroutine uses L if the type constraint is inlinable. =head2 Stringification For non-anonymous types, this will be the type's name. For anonymous types, a string like "__ANON__(Str)" is generated. However, this string should not be expected to be stable across releases, so don't use it for things like equality checks! =head2 Boolification This always returns true. =head2 String Equality (eq) This calls C<< $type->is_same_type_as($other) >> to compare the two types. =head1 ROLES This role does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/AnyIsa.pm0000644000175000017500000000625014755224347020376 0ustar autarchautarchpackage Specio::Constraint::AnyIsa; use strict; use warnings; our $VERSION = '0.50'; use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::IsaType; with 'Specio::Constraint::Role::IsaType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 7, perlstring( $self->class ) ); ( ( Scalar::Util::blessed(%s) || ( defined(%s) && !ref(%s) && length(%s) && %s !~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs # Passing a GLOB from (my $glob = *GLOB) gives us a very weird # scalar. It's not a ref and it has a length but trying to # call ->can on it throws an exception && ref( \%s ) ne 'GLOB' ) ) && %s->isa(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {1} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or an object that inherit from a specific class __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyIsa - A class for constraints which require a class name or an object that inherit from a specific class =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::AnyIsa->new(...); print $type->class; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or an object that inherit from a specific class. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyIsa->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single class name. =head2 $any_isa->class Returns the class name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Intersection.pm0000644000175000017500000001017614755224347021662 0ustar autarchautarchpackage Specio::Constraint::Intersection; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use List::Util 1.33 qw( all ); use Role::Tiny::With; use Specio::OO; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( _constraint _inline_generator )) { delete $attrs->{$name}{predicate}; $attrs->{$name}{init_arg} = undef; $attrs->{$name}{lazy} = 1; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } delete $attrs->{parent}; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{of} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub parent {undef} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_parent {0} sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; return unless all { $_->_has_name } @{ $self->of }; return join q{ & }, map { $_->name } @{ $self->of }; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_constraint { my $self = shift; return !$self->_has_inline_generator; } ## use critic sub _build_constraint { return $_[0]->_optimized_constraint; } sub _build_optimized_constraint { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) my @c = map { $_->_optimized_constraint } @{ $self->of }; return sub { return all { $_->( $_[0] ) } @c; }; } sub _has_inline_generator { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return all { $_->_has_inline_generator } @{ $self->of }; } sub _build_inline_generator { my $self = shift; return sub { return '(' . ( join q{ && }, map { sprintf( '( %s )', $_->_inline_generator->( $_, $_[1] ) ) } @{ $self->of } ) . ')'; } } sub _build_inline_environment { my $self = shift; my %env; for my $type ( @{ $self->of } ) { %env = ( %env, %{ $type->inline_environment }, ); } return \%env; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for intersection constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Intersection - A class for intersection constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::Untion->new(...); =head1 DESCRIPTION This is a specialized type constraint class for intersections, which will allow a value which matches each one of several distinct types. =for Pod::Coverage parent =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Intersection->new( ... ) The C parameter is ignored if it passed, as it is always C The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be an arrayref of type objects. =head2 $union->of Returns an array reference of the individual types which makes up this intersection. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Enum.pm0000644000175000017500000000625214755224347020120 0ustar autarchautarchpackage Specio::Constraint::Enum; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use Role::Tiny::With; use Scalar::Util qw( refaddr ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{values} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } { my $Str = t('Str'); sub _build_parent {$Str} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 2, $self->_env_var_name, $val ); ( !ref( %s ) && defined( %s ) && $%s{ %s } ) EOF }; sub _build_inline_generator {$_inline_generator} } sub _build_inline_environment { my $self = shift; my %values = map { $_ => 1 } @{ $self->values }; return { '%' . $self->_env_var_name => \%values }; } sub _env_var_name { my $self = shift; return '_Specio_Constraint_Enum_' . refaddr($self); } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a string matching one of a set of values __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Enum - A class for constraints which require a string matching one of a set of values =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::Enum->new(...); print $_, "\n" for @{ $type->values }; =head1 DESCRIPTION This is a specialized type constraint class for types which require a string that matches one of a list of values. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Enum->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be a an arrayref of valid strings for the type. =head2 $enum->values Returns an array reference of valid values for the type. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Union.pm0000644000175000017500000001011514755224347020275 0ustar autarchautarchpackage Specio::Constraint::Union; use strict; use warnings; our $VERSION = '0.50'; use Clone; use List::Util 1.33 qw( all any ); use Role::Tiny::With; use Specio::OO; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( _constraint _inline_generator )) { delete $attrs->{$name}{predicate}; $attrs->{$name}{init_arg} = undef; $attrs->{$name}{lazy} = 1; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } delete $attrs->{parent}; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{of} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub parent {undef} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_parent {0} sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; return unless all { $_->_has_name } @{ $self->of }; return join q{ | }, map { $_->name } @{ $self->of }; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _has_constraint { my $self = shift; return !$self->_has_inline_generator; } ## use critic sub _build_constraint { return $_[0]->_optimized_constraint; } sub _build_optimized_constraint { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) my @c = map { $_->_optimized_constraint } @{ $self->of }; return sub { return any { $_->( $_[0] ) } @c; }; } sub _has_inline_generator { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return all { $_->_has_inline_generator } @{ $self->of }; } sub _build_inline_generator { my $self = shift; return sub { return '(' . ( join q{ || }, map { sprintf( '( %s )', $_->_inline_generator->( $_, $_[1] ) ) } @{ $self->of } ) . ')'; } } sub _build_inline_environment { my $self = shift; my %env; for my $type ( @{ $self->of } ) { %env = ( %env, %{ $type->inline_environment }, ); } return \%env; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class for union constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Union - A class for union constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::Untion->new(...); =head1 DESCRIPTION This is a specialized type constraint class for unions, which will allow a value which matches any one of several distinct types. =for Pod::Coverage parent =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::Union->new( ... ) The C parameter is ignored if it passed, as it is always C The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. Finally, this class requires an additional parameter, C. This must be an arrayref of type objects. =head2 $union->of Returns an array reference of the individual types which makes up this union. =head1 ROLES This class does the L and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/AnyDoes.pm0000644000175000017500000000574514755224347020564 0ustar autarchautarchpackage Specio::Constraint::AnyDoes; use strict; use warnings; our $VERSION = '0.50'; use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::DoesType; with 'Specio::Constraint::Role::DoesType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 8, perlstring( $self->role ) ); ( ( Scalar::Util::blessed(%s) || ( !ref(%s) && defined(%s) && length(%s) && %s !~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs && ref( \%s ) ne 'GLOB' ) ) && %s->can('does') && %s->does(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {1} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or an object that does a specific role __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyDoes - A class for constraints which require a class name or an object that does a specific role =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::AnyDoes->new(...); print $type->role; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or an object that does a specific role. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyDoes->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single role name. =head2 $any_isa->role Returns the role name passed to the constructor. =head1 ROLES This class does the L, L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/ObjectDoes.pm0000644000175000017500000000510714755224347021233 0ustar autarchautarchpackage Specio::Constraint::ObjectDoes; use strict; use warnings; our $VERSION = '0.50'; use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::DoesType; with 'Specio::Constraint::Role::DoesType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; return sprintf( <<'EOF', ($val) x 3, perlstring( $self->role ) ); ( Scalar::Util::blessed(%s) && %s->can('does') && %s->does(%s) ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {0} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object that does a specific role __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectDoes - A class for constraints which require an object that does a specific role =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectDoes->new(...); print $type->role; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object that does a specific role. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectDoes->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be a single role name. =head2 $object_isa->role Returns the role name passed to the constructor. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Structurable.pm0000644000175000017500000001641414755224347021674 0ustar autarchautarchpackage Specio::Constraint::Structurable; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use Role::Tiny::With; use Scalar::Util qw( blessed ); use Specio::DeclaredAt; use Specio::OO; use Specio::Constraint::Structured; use Specio::TypeChecks qw( does_role isa_class ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Constraint::Role::Interface::_attrs(); ## use critic my $attrs = { %{$role_attrs}, _parameterization_args_builder => { isa => 'CodeRef', init_arg => 'parameterization_args_builder', required => 1, }, _name_builder => { isa => 'CodeRef', init_arg => 'name_builder', required => 1, }, _structured_constraint_generator => { isa => 'CodeRef', init_arg => 'structured_constraint_generator', predicate => '_has_structured_constraint_generator', }, _structured_inline_generator => { isa => 'CodeRef', init_arg => 'structured_inline_generator', predicate => '_has_structured_inline_generator', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub BUILD { my $self = shift; if ( $self->_has_constraint ) { die 'A structurable constraint with a constraint parameter must also have a structured_constraint_generator' unless $self->_has_structured_constraint_generator; } if ( $self->_has_inline_generator ) { die 'A structurable constraint with an inline_generator parameter must also have a structured_inline_generator' unless $self->_has_structured_inline_generator; } return; } sub parameterize { my $self = shift; my %args = @_; my $declared_at = $args{declared_at}; if ($declared_at) { isa_class( $declared_at, 'Specio::DeclaredAt' ) or confess q{The "declared_at" parameter passed to ->parameterize must be a Specio::DeclaredAt object}; } my %parameters = $self->_parameterization_args_builder->( $self, $args{of} ); $declared_at = Specio::DeclaredAt->new_from_caller(1) unless defined $declared_at; my %new_p = ( parent => $self, parameters => \%parameters, declared_at => $declared_at, name => $self->_name_builder->( $self, \%parameters ), ); if ( $self->_has_structured_constraint_generator ) { $new_p{constraint} = $self->_structured_constraint_generator->(%parameters); } else { for my $p ( grep { blessed($_) && does_role('Specio::Constraint::Role::Interface') } values %parameters ) { confess q{Any type objects passed to ->parameterize must be inlinable constraints if the structurable type has an inline_generator} unless $p->can_be_inlined; } my $ig = $self->_structured_inline_generator; $new_p{inline_generator} = sub { $ig->( shift, shift, %parameters, @_ ) }; } return Specio::Constraint::Structured->new(%new_p); } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _name_or_anon { return $_[1]->_has_name ? $_[1]->name : 'ANON'; } ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents structurable constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Structurable - A class which represents structurable constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $tuple = t('Tuple'); my $tuple_of_str_int = $tuple->parameterize( of => [ t('Str'), t('Int') ] ); =head1 DESCRIPTION This class implements the API for structurable types like C, C< and C. =for Pod::Coverage BUILD =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Structurable->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parameterization_args_builder This is a subroutine that takes the values passed to C and returns a hash of named arguments. These arguments will then be passed into the C or C. This should also do argument checking to make sure that the argument passed are valid. For example, the C type turns the arrayref passed to C into a hash, along the way checking that the caller did not do things like interleave optional and required elements or mix optional and slurpy together in the definition. This parameter is required. =item * name_builder This is a subroutine that is called to generate a name for the structured type when it is created. This will be called as a method on the C object. It will be passed the hash of arguments returned by the C. This parameter is required. =item * structured_constraint_generator This is a subroutine that generates a new constraint subroutine when the type is structured. It will be called as a method on the type and will be passed the hash of arguments returned by the C. This parameter is mutually exclusive with the C parameter. This parameter or the C parameter is required. =item * structured_inline_generator This is a subroutine that generates a new inline generator subroutine when the type is structured. It will be called as a method on the L object when that object needs to generate an inline constraint. It will receive the type parameter as the first argument and the variable name as a string as the second. The remaining arguments will be the parameter hash returned by the C. This probably seems fairly confusing, so looking at the examples in the L code may be helpful. This parameter is mutually exclusive with the C parameter. This parameter or the C parameter is required. =back =head2 $type->parameterize(...) This method takes two arguments. The C argument should be an object which does the L role, and is required. The other argument, C, is optional. If it is not given, then a new L object is creating using a call stack depth of 1. This method returns a new L object. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Structured.pm0000644000175000017500000000531514755224347021357 0ustar autarchautarchpackage Specio::Constraint::Structured; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use List::Util 1.33 qw( all ); use Role::Tiny::With; use Specio::OO; use Specio::TypeChecks qw( does_role ); use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic $attrs->{parent}{isa} = 'Specio::Constraint::Structurable'; $attrs->{parent}{required} = 1; $attrs->{parameters} = { isa => 'HashRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub can_be_inlined { my $self = shift; return $self->_has_inline_generator; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents structured constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Structured - A class which represents structured constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $tuple = t('Tuple'); my $tuple_of_str_int = $tuple->parameterize( of => [ t('Str'), t('Int') ] ); my $parent = $tuple_of_str_int->parent; # returns Tuple my $parameters = $arrayref_of_int->parameters; # returns { of => [ t('Str'), t('Int') ] } =head1 DESCRIPTION This class implements the API for structured types. =for Pod::Coverage can_be_inlined type_parameter =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Structured->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parent This should be the L object from which this object was created. This parameter is required. =item * parameters This is the hashref of parameters for the structured type. These are the parameters returned by the C type's C. The exact form of this hashref will vary for each structured type. This parameter is required. =back =head2 $type->parameters Returns the hashref that was passed to the constructor. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Role/0000775000175000017500000000000014755224347017554 5ustar autarchautarchSpecio-0.50/lib/Specio/Constraint/Role/Interface.pm0000644000175000017500000003734014755224347022017 0ustar autarchautarchpackage Specio::Constraint::Role::Interface; use strict; use warnings; our $VERSION = '0.50'; use Carp qw( confess ); use Eval::Closure qw( eval_closure ); use List::Util 1.33 qw( all any first ); use Specio::Exception; use Specio::PartialDump qw( partial_dump ); use Specio::TypeChecks qw( is_CodeRef ); use Role::Tiny 1.003003; use Specio::Role::Inlinable; with 'Specio::Role::Inlinable'; use overload( q{""} => '_stringify', '&{}' => '_subification', 'bool' => sub {1}, 'eq' => 'is_same_type_as', ); { ## no critic (Subroutines::ProtectPrivateSubs) my $role_attrs = Specio::Role::Inlinable::_attrs(); ## use critic my $attrs = { %{$role_attrs}, name => { isa => 'Str', predicate => '_has_name', }, parent => { does => 'Specio::Constraint::Role::Interface', predicate => '_has_parent', }, _constraint => { isa => 'CodeRef', init_arg => 'constraint', predicate => '_has_constraint', }, _optimized_constraint => { isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_optimized_constraint', }, _ancestors => { isa => 'ArrayRef', init_arg => undef, lazy => 1, builder => '_build_ancestors', }, _message_generator => { isa => 'CodeRef', init_arg => undef, }, _coercions => { builder => '_build_coercions', clone => '_clone_coercions', }, _subification => { init_arg => undef, lazy => 1, builder => '_build_subification', }, # Because types are cloned on import, we can't directly compare type # objects. Because type names can be reused between packages (no global # registry) we can't compare types based on name either. _signature => { isa => 'Str', init_arg => undef, lazy => 1, builder => '_build_signature', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } my $NullConstraint = sub {1}; # See Specio::OO to see how this is used. ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _Specio_Constraint_Role_Interface_BUILD { my $self = shift; my $p = shift; unless ( $self->_has_constraint || $self->_has_inline_generator ) { $self->{_constraint} = $NullConstraint; } die 'A type constraint should have either a constraint or inline_generator parameter, not both' if $self->_has_constraint && $self->_has_inline_generator; $self->{_message_generator} = $self->_wrap_message_generator( $p->{message_generator} ); return; } ## use critic sub _wrap_message_generator { my $self = shift; my $generator = shift; unless ( defined $generator ) { $generator = sub { my $description = shift; my $value = shift; return "Validation failed for $description with value " . partial_dump($value); }; } my $d = $self->description; return sub { $generator->( $d, @_ ) }; } sub coercions { values %{ $_[0]->{_coercions} } } sub coercion_from_type { $_[0]->{_coercions}{ $_[1] } } sub _has_coercion_from_type { exists $_[0]->{_coercions}{ $_[1] } } sub _add_coercion { $_[0]->{_coercions}{ $_[1] } = $_[2] } sub has_coercions { scalar keys %{ $_[0]->{_coercions} } } sub validate_or_die { my $self = shift; my $value = shift; return if $self->value_is_valid($value); Specio::Exception->throw( message => $self->_message_generator->($value), type => $self, value => $value, ); } sub value_is_valid { my $self = shift; my $value = shift; return $self->_optimized_constraint->($value); } sub _ancestors_and_self { my $self = shift; return ( ( reverse @{ $self->_ancestors } ), $self ); } sub is_a_type_of { my $self = shift; my $type = shift; return any { $_->_signature eq $type->_signature } $self->_ancestors_and_self; } sub is_same_type_as { my $self = shift; my $type = shift; return $self->_signature eq $type->_signature; } sub is_anon { my $self = shift; return !$self->_has_name; } sub has_real_constraint { my $self = shift; return ( $self->_has_constraint && $self->_constraint ne $NullConstraint ) || $self->_has_inline_generator; } sub can_be_inlined { my $self = shift; return 1 if $self->_has_inline_generator; return 0 if $self->_has_constraint && $self->_constraint ne $NullConstraint; # If this type is an empty subtype of an inlinable parent, then we can # inline this type as well. return 1 if $self->_has_parent && $self->parent->can_be_inlined; return 0; } sub _build_generated_inline_sub { my $self = shift; my $type = $self->_self_or_first_inlinable_ancestor; my $source = 'sub { ' . $type->_inline_generator->( $type, '$_[0]' ) . '}'; return eval_closure( source => $source, environment => $type->inline_environment, description => 'inlined sub for ' . $self->description, ); } sub _self_or_first_inlinable_ancestor { my $self = shift; my $type = first { $_->_has_inline_generator } reverse $self->_ancestors_and_self; # This should never happen because ->can_be_inlined should always be # checked before this builder is called. die 'Cannot generate an inline sub' unless $type; return $type; } sub _build_optimized_constraint { my $self = shift; if ( $self->can_be_inlined ) { return $self->_generated_inline_sub; } else { return $self->_constraint_with_parents; } } sub _constraint_with_parents { my $self = shift; my @constraints; for my $type ( $self->_ancestors_and_self ) { next unless $type->has_real_constraint; # If a type can be inlined, we can use that and discard all of the # ancestors we've seen so far, since we can assume that the inlined # constraint does all of the ancestor checks in addition to its own. if ( $type->can_be_inlined ) { @constraints = $type->_generated_inline_sub; } else { push @constraints, $type->_constraint; } } return $NullConstraint unless @constraints; return sub { all { $_->( $_[0] ) } @constraints; }; } # This is only used for identifying from types as part of coercions, but I # want to leave open the possibility of using something other than # _description in the future. sub id { my $self = shift; return $self->description; } sub add_coercion { my $self = shift; my $coercion = shift; my $from_id = $coercion->from->id; confess "Cannot add two coercions fom the same type: $from_id" if $self->_has_coercion_from_type($from_id); $self->_add_coercion( $from_id => $coercion ); return; } sub has_coercion_from_type { my $self = shift; my $type = shift; return $self->_has_coercion_from_type( $type->id ); } sub coerce_value { my $self = shift; my $value = shift; for my $coercion ( $self->coercions ) { next unless $coercion->from->value_is_valid($value); return $coercion->coerce($value); } return $value; } sub can_inline_coercion { my $self = shift; return all { $_->can_be_inlined } $self->coercions; } sub can_inline_coercion_and_check { my $self = shift; return all { $_->can_be_inlined } $self, $self->coercions; } sub inline_coercion { my $self = shift; my $arg_name = shift; die 'Cannot inline coercion' unless $self->can_inline_coercion; my $source = 'do { my $value = ' . $arg_name . ';'; my ( $coerce, $env ); ( $coerce, $arg_name, $env ) = $self->_inline_coercion($arg_name); $source .= $coerce . $arg_name . '};'; return ( $source, $env ); } sub inline_coercion_and_check { my $self = shift; my $arg_name = shift; die 'Cannot inline coercion and check' unless $self->can_inline_coercion_and_check; my $source = 'do { my $value = ' . $arg_name . ';'; my ( $coerce, $env ); ( $coerce, $arg_name, $env ) = $self->_inline_coercion($arg_name); my ( $assert, $assert_env ) = $self->inline_assert($arg_name); $source .= $coerce; $source .= $assert; $source .= $arg_name . '};'; return ( $source, { %{$env}, %{$assert_env} } ); } sub _inline_coercion { my $self = shift; my $arg_name = shift; return ( q{}, $arg_name, {} ) unless $self->has_coercions; my %env; $arg_name = '$value'; my $source = $arg_name . ' = '; for my $coercion ( $self->coercions ) { $source .= '(' . $coercion->from->inline_check($arg_name) . ') ? (' . $coercion->inline_coercion($arg_name) . ') : '; %env = ( %env, %{ $coercion->inline_environment }, %{ $coercion->from->inline_environment }, ); } $source .= $arg_name . ';'; return ( $source, $arg_name, \%env ); } { my $counter = 1; sub inline_assert { my $self = shift; my $type_var_name = '$_Specio_Constraint_Interface_type' . $counter; my $message_generator_var_name = '$_Specio_Constraint_Interface_message_generator' . $counter; my %env = ( $type_var_name => \$self, $message_generator_var_name => \( $self->_message_generator ), %{ $self->inline_environment }, ); my $source = $self->inline_check( $_[0] ); $source .= ' or '; $source .= $self->_inline_throw_exception( $_[0], $message_generator_var_name, $type_var_name ); $source .= ';'; $counter++; return ( $source, \%env ); } } sub inline_check { my $self = shift; die 'Cannot inline' unless $self->can_be_inlined; my $type = $self->_self_or_first_inlinable_ancestor; return $type->_inline_generator->( $type, @_ ); } # For some idiotic reason I called $type->_subify directly in Code::TidyAll so # I'll leave this in here for now. ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _subify { $_[0]->_subification } ## use critic sub _build_subification { my $self = shift; if ( defined &Sub::Quote::quote_sub && $self->can_be_inlined ) { return Sub::Quote::quote_sub( $self->inline_assert('$_[0]') ); } else { return sub { $self->validate_or_die( $_[0] ) }; } } sub _inline_throw_exception { shift; my $value_var = shift; my $message_generator_var_name = shift; my $type_var_name = shift; #<<< return 'Specio::Exception->throw( ' . ' message => ' . $message_generator_var_name . '->(' . $value_var . '),' . ' type => ' . $type_var_name . ',' . ' value => ' . $value_var . ' )'; #>>> } # This exists for the benefit of Moo sub coercion_sub { my $self = shift; if ( defined &Sub::Quote::quote_sub && all { $_->can_be_inlined } $self->coercions ) { my $inline = q{}; my %env; for my $coercion ( $self->coercions ) { $inline .= sprintf( '$_[0] = %s if %s;' . "\n", $coercion->inline_coercion('$_[0]'), $coercion->from->inline_check('$_[0]') ); %env = ( %env, %{ $coercion->inline_environment }, %{ $coercion->from->inline_environment }, ); } $inline .= sprintf( "%s;\n", '$_[0]' ); return Sub::Quote::quote_sub( $inline, \%env ); } else { return sub { $self->coerce_value(shift) }; } } sub _build_ancestors { my $self = shift; my @parents; my $type = $self; while ( $type = $type->parent ) { push @parents, $type; } return \@parents; } sub _build_description { my $self = shift; my $desc = $self->is_anon ? 'anonymous type' : 'type named ' . $self->name; $desc .= q{ } . $self->declared_at->description; return $desc; } sub _build_coercions { {} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _clone_coercions { my $self = shift; my $coercions = $self->_coercions; my %clones; for my $name ( keys %{$coercions} ) { my $coercion = $coercions->{$name}; $clones{$name} = $coercion->clone_with_new_to($self); } return \%clones; } ## use critic sub _stringify { my $self = shift; return $self->name unless $self->is_anon; return sprintf( '__ANON__(%s)', $self->parent . q{} ); } sub _build_signature { my $self = shift; # This assumes that when a type is cloned, the underlying constraint or # generator sub is copied by _reference_, so it has the same memory # address and stringifies to the same value. XXX - will this break under # threads? return join "\n", ## no critic (Subroutines::ProtectPrivateSubs) ( $self->_has_parent ? $self->parent->_signature : () ), ( defined $self->_constraint ? $self->_constraint : $self->_inline_generator ); } # Moose compatibility methods - these exist as a temporary hack to make Specio # work with Moose. sub has_coercion { shift->has_coercions; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _inline_check { shift->inline_check(@_); } sub _compiled_type_constraint { shift->_optimized_constraint; } ## use critic; # This class implements the methods that Moose expects from coercions as well. sub coercion { return shift; } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _compiled_type_coercion { my $self = shift; return sub { return $self->coerce_value(shift); }; } ## use critic sub has_message { 1; } sub message { shift->_message_generator; } sub get_message { my $self = shift; my $value = shift; return $self->_message_generator->( $self, $value ); } sub check { shift->value_is_valid(@_); } sub coerce { shift->coerce_value(@_); } 1; # ABSTRACT: The interface all type constraints should provide __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::Interface - The interface all type constraints should provide =head1 VERSION version 0.50 =head1 DESCRIPTION This role defines the interface that all type constraints must provide, and provides most (or all) of the implementation. The L class simply consumes this role and provides no additional code. Other constraint classes add features or override some of this role's functionality. =for Pod::Coverage .* =head1 API See the L documentation for details. See the internals of various constraint classes to see how this role can be overridden or expanded upon. =head1 ROLES This role does the L role. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Role/CanType.pm0000644000175000017500000001146714755224347021464 0ustar autarchautarchpackage Specio::Constraint::Role::CanType; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use Scalar::Util qw( blessed ); use Specio::PartialDump qw( partial_dump ); use Role::Tiny; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{methods} = { isa => 'ArrayRef', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my $type = ( split /::/, blessed $self )[-1]; my @methods = @{ $self->methods }; my $all_word_list = _word_list(@methods); my $allow_classes = $self->_allow_classes; unless ( defined $generator ) { $generator = sub { shift; my $value = shift; return "An undef will never pass an $type check (wants $all_word_list)" unless defined $value; my $class = blessed $value; if ( !defined $class ) { # If we got here we know that blessed returned undef, so if # it's a ref then it must not be blessed. if ( ref $value ) { my $dump = partial_dump($value); return "An unblessed reference ($dump) will never pass an $type check (wants $all_word_list)"; } # If it's defined and not an unblessed ref it must be a # string. If we allow classes (vs just objects) then it might # be a valid class name. But an empty string is never a valid # class name. We cannot call q{}->can. return "An empty string will never pass an $type check (wants $all_word_list)" unless length $value; if ( ref \$value eq 'GLOB' ) { return "A glob will never pass an $type check (wants $all_word_list)"; } if ( $value =~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs ) { return "A number ($value) will never pass an $type check (wants $all_word_list)"; } $class = $value if $allow_classes; # At this point we either have undef or a non-empty string in # $class. unless ( defined $class ) { my $dump = partial_dump($value); return "A plain scalar ($dump) will never pass an $type check (wants $all_word_list)"; } } my @missing = grep { !$value->can($_) } @methods; my $noun = @missing == 1 ? 'method' : 'methods'; my $list = _word_list( map {qq['$_']} @missing ); return "The $class class is missing the $list $noun"; }; } return sub { $generator->( undef, @_ ) }; } ## use critic sub _word_list { my @items = sort { $a cmp $b } @_; return $items[0] if @items == 1; return join ' and ', @items if @items == 2; my $final = pop @items; my $list = join ', ', @items; $list .= ', and ' . $final; return $list; } 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyCan and Specio::Constraint::ObjectCan __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::CanType - Provides a common implementation for Specio::Constraint::AnyCan and Specio::Constraint::ObjectCan =head1 VERSION version 0.50 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Role/IsaType.pm0000644000175000017500000000706714755224347021500 0ustar autarchautarchpackage Specio::Constraint::Role::IsaType; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use Scalar::Util qw( blessed ); use Specio::PartialDump qw( partial_dump ); use Role::Tiny; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{class} = { isa => 'ClassName', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my $type = ( split /::/, blessed $self )[-1]; my $class = $self->class; my $allow_classes = $self->_allow_classes; unless ( defined $generator ) { $generator = sub { shift; my $value = shift; return "An undef will never pass an $type check (wants $class)" unless defined $value; if ( ref $value && !blessed $value ) { my $dump = partial_dump($value); return "An unblessed reference ($dump) will never pass an $type check (wants $class)"; } if ( !blessed $value ) { return "An empty string will never pass an $type check (wants $class)" unless length $value; if ( $value =~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs ) { return "A number ($value) will never pass an $type check (wants $class)"; } if ( !$allow_classes ) { my $dump = partial_dump($value); return "A plain scalar ($dump) will never pass an $type check (wants $class)"; } } my $got = blessed $value; $got ||= $value; return "The $got class is not a subclass of the $class class"; }; } return sub { $generator->( undef, @_ ) }; } ## use critic 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyIsa and Specio::Constraint::ObjectIsa __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::IsaType - Provides a common implementation for Specio::Constraint::AnyIsa and Specio::Constraint::ObjectIsa =head1 VERSION version 0.50 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Role/DoesType.pm0000644000175000017500000000705414755224347021652 0ustar autarchautarchpackage Specio::Constraint::Role::DoesType; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use Scalar::Util qw( blessed ); use Specio::PartialDump qw( partial_dump ); use Role::Tiny; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic for my $name (qw( parent _inline_generator )) { $attrs->{$name}{init_arg} = undef; $attrs->{$name}{builder} = $name =~ /^_/ ? '_build' . $name : '_build_' . $name; } $attrs->{role} = { isa => 'Str', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _wrap_message_generator { my $self = shift; my $generator = shift; my $type = ( split /::/, blessed $self )[-1]; my $role = $self->role; my $allow_classes = $self->_allow_classes; unless ( defined $generator ) { $generator = sub { shift; my $value = shift; return "An undef will never pass an $type check (wants $role)" unless defined $value; if ( ref $value && !blessed $value ) { my $dump = partial_dump($value); return "An unblessed reference ($dump) will never pass an $type check (wants $role)"; } if ( !blessed $value ) { return "An empty string will never pass an $type check (wants $role)" unless length $value; if ( $value =~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs ) { return "A number ($value) will never pass an $type check (wants $role)"; } if ( !$allow_classes ) { my $dump = partial_dump($value); return "A plain scalar ($dump) will never pass an $type check (wants $role)"; } } my $got = blessed $value; $got ||= $value; return "The $got class does not consume the $role role"; }; } return sub { $generator->( undef, @_ ) }; } ## use critic 1; # ABSTRACT: Provides a common implementation for Specio::Constraint::AnyDoes and Specio::Constraint::ObjectDoes __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Role::DoesType - Provides a common implementation for Specio::Constraint::AnyDoes and Specio::Constraint::ObjectDoes =head1 VERSION version 0.50 =head1 DESCRIPTION See L and L for details. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/Parameterized.pm0000644000175000017500000000624614755224347022013 0ustar autarchautarchpackage Specio::Constraint::Parameterized; use strict; use warnings; our $VERSION = '0.50'; use Clone (); use Role::Tiny::With; use Specio::OO; use Specio::Constraint::Role::Interface; with 'Specio::Constraint::Role::Interface'; { ## no critic (Subroutines::ProtectPrivateSubs) my $attrs = Clone::clone( Specio::Constraint::Role::Interface::_attrs() ); ## use critic $attrs->{parent}{isa} = 'Specio::Constraint::Parameterizable'; $attrs->{parent}{required} = 1; delete $attrs->{name}{predicate}; $attrs->{name}{lazy} = 1; $attrs->{name}{builder} = '_build_name'; $attrs->{parameter} = { does => 'Specio::Constraint::Role::Interface', required => 1, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } sub _has_name { my $self = shift; return defined $self->name; } sub _build_name { my $self = shift; ## no critic (Subroutines::ProtectPrivateSubs) return unless $self->parent->_has_name && $self->parameter->_has_name; return $self->parent->name . '[' . $self->parameter->name . ']'; } sub can_be_inlined { my $self = shift; return $self->_has_inline_generator && $self->parameter->can_be_inlined; } # Moose compatibility methods - these exist as a temporary hack to make Specio # work with Moose. sub type_parameter { shift->parameter; } __PACKAGE__->_ooify; 1; # ABSTRACT: A class which represents parameterized constraints __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::Parameterized - A class which represents parameterized constraints =head1 VERSION version 0.50 =head1 SYNOPSIS my $arrayref = t('ArrayRef'); my $arrayref_of_int = $arrayref->parameterize( of => t('Int') ); my $parent = $arrayref_of_int->parent; # returns ArrayRef my $parameter = $arrayref_of_int->parameter; # returns Int =head1 DESCRIPTION This class implements the API for parameterized types. =for Pod::Coverage can_be_inlined type_parameter =head1 API This class implements the same API as L, with a few additions. =head2 Specio::Constraint::Parameterized->new(...) This class's constructor accepts two additional parameters: =over 4 =item * parent This should be the L object from which this object was created. This parameter is required. =item * parameter This is the type parameter for the parameterized type. This must be an object which does the L role. This parameter is required. =back =head2 $type->parameter Returns the type that was passed to the constructor. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/ObjectCan.pm0000644000175000017500000000561514755224347021046 0ustar autarchautarchpackage Specio::Constraint::ObjectCan; use strict; use warnings; our $VERSION = '0.50'; use List::Util 1.33 (); use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::CanType; with 'Specio::Constraint::Role::CanType'; { my $Object = t('Object'); sub _build_parent {$Object} } { my $_inline_generator = sub { my $self = shift; my $val = shift; my $methods = join ', ', map { perlstring($_) } @{ $self->methods }; return sprintf( <<'EOF', $val, $methods ); ( do { my $v = %s; Scalar::Util::blessed($v) && List::Util::all { $v->can($_) } %s; } ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {0} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require an object with a set of methods __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::ObjectCan - A class for constraints which require an object with a set of methods =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::ObjectCan->new(...); print $_, "\n" for @{ $type->methods }; =head1 DESCRIPTION This is a specialized type constraint class for types which require an object with a defined set of methods. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::ObjectCan->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be an array reference of method names which the constraint requires. You can also pass a single string and it will be converted to an array reference internally. =head2 $object_can->methods Returns an array reference containing the methods this constraint requires. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Constraint/AnyCan.pm0000644000175000017500000000723714755224347020371 0ustar autarchautarchpackage Specio::Constraint::AnyCan; use strict; use warnings; our $VERSION = '0.50'; use List::Util 1.33 (); use Role::Tiny::With; use Scalar::Util (); use Specio::Helpers qw( perlstring ); use Specio::Library::Builtins; use Specio::OO; use Specio::Constraint::Role::CanType; with 'Specio::Constraint::Role::CanType'; { my $Defined = t('Defined'); sub _build_parent {$Defined} } { my $_inline_generator = sub { my $self = shift; my $val = shift; my $methods = join ', ', map { perlstring($_) } @{ $self->methods }; return sprintf( <<'EOF', $val, $methods ); ( do { # We need to assign this since if it's something like $_[0] then # inside the all block @_ gets redefined and we can no longer get at # the value. my $v = %s; ( Scalar::Util::blessed($v) || ( defined($v) && !ref($v) && length($v) && $v !~ /\A \s* -?[0-9]+(?:\.[0-9]+)? (?:[Ee][\-+]?[0-9]+)? \s* \z/xs # Passing a GLOB from (my $glob = *GLOB) gives us a very weird # scalar. It's not a ref and it has a length but trying to # call ->can on it throws an exception && ref( \$v ) ne 'GLOB' ) ) && List::Util::all { $v->can($_) } %s; } ) EOF }; sub _build_inline_generator {$_inline_generator} } ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _allow_classes {1} ## use critic __PACKAGE__->_ooify; 1; # ABSTRACT: A class for constraints which require a class name or object with a set of methods __END__ =pod =encoding UTF-8 =head1 NAME Specio::Constraint::AnyCan - A class for constraints which require a class name or object with a set of methods =head1 VERSION version 0.50 =head1 SYNOPSIS my $type = Specio::Constraint::AnyCan->new(...); print $_, "\n" for @{ $type->methods }; =head1 DESCRIPTION This is a specialized type constraint class for types which require a class name or object with a defined set of methods. =head1 API This class provides all of the same methods as L, with a few differences: =head2 Specio::Constraint::AnyCan->new( ... ) The C parameter is ignored if it passed, as it is always set to the C type. The C and C parameters are also ignored. This class provides its own default inline generator subroutine reference. This class overrides the C default if none is provided. Finally, this class requires an additional parameter, C. This must be an array reference of method names which the constraint requires. You can also pass a single string and it will be converted to an array reference internally. =head2 $any_can->methods Returns an array reference containing the methods this constraint requires. =head1 ROLES This class does the L, L, and L roles. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Role/0000775000175000017500000000000014755224347015430 5ustar autarchautarchSpecio-0.50/lib/Specio/Role/Inlinable.pm0000644000175000017500000000574714755224347017676 0ustar autarchautarchpackage Specio::Role::Inlinable; use strict; use warnings; our $VERSION = '0.50'; use Eval::Closure qw( eval_closure ); use Role::Tiny; requires '_build_description'; { my $attrs = { _inline_generator => { is => 'ro', isa => 'CodeRef', predicate => '_has_inline_generator', init_arg => 'inline_generator', }, inline_environment => { is => 'ro', isa => 'HashRef', lazy => 1, init_arg => 'inline_environment', builder => '_build_inline_environment', }, _generated_inline_sub => { is => 'ro', isa => 'CodeRef', init_arg => undef, lazy => 1, builder => '_build_generated_inline_sub', }, declared_at => { is => 'ro', isa => 'Specio::DeclaredAt', required => 1, }, description => { is => 'ro', isa => 'Str', init_arg => undef, lazy => 1, builder => '_build_description', }, }; ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _attrs { return $attrs; } } # These are here for backwards compatibility. Some other packages that I wrote # may call the private methods. ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _description { $_[0]->description } sub _inline_environment { $_[0]->inline_environment } ## use critic sub can_be_inlined { my $self = shift; return $self->_has_inline_generator; } sub _build_generated_inline_sub { my $self = shift; my $source = 'sub { ' . $self->_inline_generator->( $self, '$_[0]' ) . '}'; return eval_closure( source => $source, environment => $self->inline_environment, description => 'inlined sub for ' . $self->description, ); } sub _build_inline_environment { return {}; } 1; # ABSTRACT: A role for things which can be inlined (type constraints and coercions) __END__ =pod =encoding UTF-8 =head1 NAME Specio::Role::Inlinable - A role for things which can be inlined (type constraints and coercions) =head1 VERSION version 0.50 =head1 DESCRIPTION This role implements a common API for inlinable things, type constraints and coercions. It is fully documented in the relevant classes. =for Pod::Coverage .* =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio/Exporter.pm0000644000175000017500000000730614755224347016701 0ustar autarchautarchpackage Specio::Exporter; use strict; use warnings; our $VERSION = '0.50'; use parent 'Exporter'; use Specio::Helpers qw( install_t_sub ); use Specio::Registry qw( exportable_types_for_package internal_types_for_package register ); my %Exported; sub import { my $package = shift; my $reexport = shift; my $caller = caller(); return if $Exported{$caller}{$package}; my $exported = exportable_types_for_package($package); while ( my ( $name, $type ) = each %{$exported} ) { register( $caller, $name, $type->clone, $reexport ); } install_t_sub( $caller, internal_types_for_package($caller), ); if ( $package->can('_also_export') ) { for my $sub ( $package->_also_export ) { ## no critic (TestingAndDebugging::ProhibitNoStrict) no strict 'refs'; *{ $caller . '::' . $sub } = \&{ $package . '::' . $sub }; } } $Exported{$caller}{$package} = 1; return; } 1; # ABSTRACT: Base class for type libraries __END__ =pod =encoding UTF-8 =head1 NAME Specio::Exporter - Base class for type libraries =head1 VERSION version 0.50 =head1 SYNOPSIS package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; declare( ... ); # more types here package MyApp::Foo; use MyApp::Type::Library =head1 DESCRIPTION Inheriting from this package makes your package a type exporter. By default, types defined in a package are never visible outside of the package. When you inherit from this package, all the types you define internally become available via exports. The exported types are available through the importing package's C subroutine. By default, types your package imports are not re-exported: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; In this case, the types provided by L are not exported to packages which C. You can explicitly ask for types to be re-exported: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; In this case, packages which C will get all the types from L as well as any types defined in C. =head1 ADDITIONAL EXPORTS If you want to export some additional subroutines from a package which has C as its parent, define a sub named C<_also_export>. This sub should return a I of subroutines defined in your package that should also be exported. These subs will be exported unconditionally to any package that uses your package. =head1 COMBINING LIBRARIES WITH L You can combine loading libraries with subroutine generation using L by using C<_also_export> and C: package My::Library; use My::Library::Internal -reexport; use Specio::Library::Builtins -reexport; use Specio::Subs qw( My::Library::Internal Specio::Library::Builtins ); sub _also_export { return Specio::Subs::subs_installed_into(__PACKAGE__); } =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 AUTHOR Dave Rolsky =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/lib/Specio.pm0000644000175000017500000003512014755224347015064 0ustar autarchautarchpackage Specio; use strict; use warnings; use 5.008; our $VERSION = '0.50'; 1; # ABSTRACT: Type constraints and coercions for Perl __END__ =pod =encoding UTF-8 =head1 NAME Specio - Type constraints and coercions for Perl =head1 VERSION version 0.50 =head1 SYNOPSIS package MyApp::Type::Library; use Specio::Declare; use Specio::Library::Builtins; declare( 'PositiveInt', parent => t('Int'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . ' && ( ' . $_[1] . ' > 0 )'; }, ); # or ... declare( 'PositiveInt', parent => t('Int'), where => sub { $_[0] > 0 }, ); declare( 'ArrayRefOfPositiveInt', parent => t( 'ArrayRef', of => t('PositiveInt'), ), ); coerce( 'ArrayRefOfPositiveInt', from => t('PositiveInt'), using => sub { [ $_[0] ] }, ); any_can_type( 'Duck', methods => [ 'duck_walk', 'quack' ], ); object_isa_type('MyApp::Person'); =head1 DESCRIPTION The C distribution provides classes for representing type constraints and coercion, along with syntax sugar for declaring them. Note that this is not a proper type system for Perl. Nothing in this distribution will magically make the Perl interpreter start checking a value's type on assignment to a variable. In fact, there's no built-in way to apply a type to a variable at all. Instead, you can explicitly check a value against a type, and optionally coerce values to that type. =head1 WHAT IS A TYPE? At it's core, a type is simply a constraint. A constraint is code that checks a value and returns true or false. Most constraints are represented by L objects. However, there are other type constraint classes for specialized kinds of constraints. Types can be named or anonymous, and each type can have a parent type. A type's constraint is optional because sometimes you may want to create a named subtype of some existing type without adding additional constraints. Constraints can be expressed either in terms of a simple subroutine reference or in terms of an inline generator subroutine reference. The former is easier to write but the latter is preferred because it allow for better optimization. A type can also have an optional message generator subroutine reference. You can use this to provide a more intelligent error message when a value does not pass the constraint, though the default message should suffice for most cases. Finally, you can associate a set of coercions with a type. A coercion is a subroutine reference (or inline generator, like constraints), that takes a value of one type and turns it into a value that matches the type the coercion belongs to. =head1 BUILTIN TYPES This distribution ships with a set of builtin types representing the types provided by the Perl interpreter itself. They are arranged in a hierarchy as follows: Item Bool Maybe (of `a) Undef Defined Value Str Num Int ClassName Ref ScalarRef (of `a) ArrayRef (of `a) HashRef (of `a) CodeRef RegexpRef GlobRef FileHandle Object The C type accepts anything and everything. The C type only accepts C, C<0>, or C<1>. The C type only accepts C. The C type accepts anything I C. The C and C types are stricter about numbers than Perl is. Specifically, they do not allow any sort of space in the number, nor do they accept "Nan", "Inf", or "Infinity". The C type constraint checks that the name is valid I that the class is loaded. The C type accepts either a glob, a scalar filehandle, or anything that isa L. All types accept overloaded objects that support the required operation. See below for details. =head2 Overloading Perl's overloading is horribly broken and doesn't make much sense at all. However, unlike Moose, all type constraints allow overloaded objects where they make sense. For types where overloading makes sense, we explicitly check that the object provides the type overloading we expect. We I simply try to use the object as the type in question and hope it works. This means that these checks effectively ignore the C setting for the overloaded object. In other words, an object that overloads stringification will not pass the C type check unless it I overloads boolification. Most types do not check that the overloaded method actually returns something that matches the constraint. This may change in the future. The C type accepts an object that implements C overloading. The C type accepts an object that implements string (C) overloading. The C type accepts an object that implements numeric (C<'0+'}>) overloading. The C type does as well, but it will check that the overloading returns an actual integer. The C type will accept an object with string overloading that returns a class name. To make this all more confusing, the C type will I accept an object, even though some of its subtypes will. The various reference types all accept objects which provide the appropriate overloading. The C type accepts an object which overloads globification as long as the returned glob is an open filehandle. =head1 PARAMETERIZABLE TYPES Any type followed by a type parameter C in the hierarchy above can be parameterized. The parameter is itself a type, so you can say you want an "ArrayRef of Int", or even an "ArrayRef of HashRef of ScalarRef of ClassName". When they are parameterized, the C and C types check that the value(s) they refer to match the type parameter. For the C type, the parameter applies to the values (keys are never checked). =head2 Maybe The C type is a special parameterized type. It allows for either C or a value. All by itself, it is meaningless, since it is equivalent to "Maybe of Item", which is equivalent to Item. When parameterized, it accepts either an C or the type of its parameter. This is useful for optional attributes or parameters. However, you're probably better off making your code simply not pass the parameter at all This usually makes for a simpler API. =head1 REGISTRIES AND IMPORTING Types are local to each package where they are used. When you "import" types from some other library, you are actually making a copy of that type. This means that a type named "Foo" in one package may not be the same as "Foo" in another package. This has potential for confusion, but it also avoids the magic action at a distance pollution that comes with a global type naming system. The registry is managed internally by the Specio distribution's modules, and is not exposed to your code. To access a type, you always call C. This returns the named type or dies if no such type exists. Because types are always copied on import, it's safe to create coercions on any type. Your coercion from C to C will not be seen by any other package, unless that package explicitly imports your C type. When you import types, you import every type defined in the package you import from. However, you I overwrite an imported type with your own type definition. You I define the same type twice internally. =head1 CREATING A TYPE LIBRARY By default, all types created inside a package are invisible to other packages. If you want to create a type library, you need to inherit from L package: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'Foo', parent => t('Str'), where => sub { $_[0] =~ /foo/i }, ); Now the MyApp::Type::Library package will export a single type named C. It I re-export the types provided by L. If you want to make your library re-export some other libraries types, you can ask for this explicitly: package MyApp::Type::Library; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; declare( 'Foo, ... ); Now MyApp::Types::Library exports any types it defines, as well as all the types defined in L. =head1 DECLARING TYPES Use the L module to declare types. It exports a set of helpers for declaring types. See that module's documentation for more details on these helpers. =head1 USING SPECIO WITH L This should just work. Use a Specio type anywhere you'd specify a type. =head1 USING SPECIO WITH L Using Specio with Moo is easy. You can pass Specio constraint objects as C parameters for attributes. For coercions, simply call C<< $type->coercion_sub >>. package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; my $str_type = t('Str'); has string => ( is => 'ro', isa => $str_type, ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); The subs returned by Specio use L internally and are suitable for inlining. =head1 USING SPECIO WITH OTHER THINGS See L for the API that all constraint objects share. =head1 L, L, and Specio This module aims to supplant both L's built-in type system (see L aka MUTC) and L, which attempts to patch some of the holes in the Moose built-in type design. Here are some of the salient differences: =over 4 =item * Types names are strings, but they're not global Unlike Moose and MooseX::Types, type names are always local to the current package. There is no possibility of name collision between different modules, so you can safely use short type names. Unlike MooseX::Types, types are strings, so there is no possibility of colliding with existing class or subroutine names. =item * No type auto-creation Types are always retrieved using the C subroutine. If you pass an unknown name to this subroutine it dies. This is different from Moose and MooseX::Types, which assume that unknown names are class names. =item * Anon types are explicit With L and L, you use the same subroutine, C, to declare both named and anonymous types. With Specio, you use C for named types and C for anonymous types. =item * Class and object types are separate Moose and MooseX::Types have C and C. The former type requires an object, while the latter accepts a class name or object. With Specio, the distinction between accepting an object versus object or class is explicit. There are six declaration helpers, C, C, C, C, C, and C. =item * Overloading support is baked in Perl's overloading is quite broken but ignoring it makes Moose's type system frustrating to use in many cases. =item * Types can either have a constraint or inline generator, not both Moose and MooseX::Types types can be defined with a subroutine reference as the constraint, an inline generator subroutine, or both. This is purely for backwards compatibility, and it makes the internals more complicated than they need to be. With Specio, a constraint can have I a subroutine reference or an inline generator, not both. =item * Coercions can be inlined I simply never got around to implementing this in Moose. =item * No crazy coercion features Moose has some bizarre (and mostly) undocumented features relating to coercions and parameterizable types. This is a misfeature. =back =head1 OPTIONAL PREREQS There are several optional prereqs that if installed will make this distribution better in some way. =over 4 =item * L Installing this will speed up a number of type checks for built-in types. =item * L If this is installed it will be loaded instead of the L module if you have Perl 5.10 or greater. This module is much more memory efficient than loading all of L. =item * L or L If one of these is installed then stack traces that end up in Specio code will have much better subroutine names for any frames. =back =head1 WHY THE NAME? This distro was originally called "Type", but that's an awfully generic top level namespace. Specio is Latin for for "look at" and "spec" is the root for the word "species". It's short, relatively easy to type, and not used by any other distro. =head1 SUPPORT Bugs may be submitted at L. =head1 SOURCE The source code repository for Specio can be found at L. =head1 DONATIONS If you'd like to thank me for the work I've done on this module, please consider making a "donation" to me via PayPal. I spend a lot of free time creating free software, and would appreciate any support you'd care to offer. Please note that B in order for me to continue working on this particular software. I will continue to do so, inasmuch as I have in the past, for as long as it interests me. Similarly, a donation made in this way will probably not make me work on this software much more, unless I get so many donations that I can consider working on free software full time (let's all have a chuckle at that together). To donate, log into PayPal and send money to autarch@urth.org, or use the button at L. =head1 AUTHOR Dave Rolsky =head1 CONTRIBUTORS =for stopwords Chris White cpansprout Graham Knop Karen Etheridge Vitaly Lipatov =over 4 =item * Chris White =item * cpansprout =item * Graham Knop =item * Karen Etheridge =item * Vitaly Lipatov =back =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2012 - 2025 by Dave Rolsky. This is free software, licensed under: The Artistic License 2.0 (GPL Compatible) The full text of the license can be found in the F file included with this distribution. =cut Specio-0.50/xt/0000775000175000017500000000000014755224347013172 5ustar autarchautarchSpecio-0.50/xt/release/0000775000175000017500000000000014755224347014612 5ustar autarchautarchSpecio-0.50/xt/release/cpan-changes.t0000644000175000017500000000034414755224347017325 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::CPAN::Changes 0.013 use Test::More 0.96 tests => 1; use Test::CPAN::Changes; subtest 'changes_ok' => sub { changes_file_ok('Changes'); }; Specio-0.50/xt/release/meta-json.t0000644000175000017500000000006414755224347016672 0ustar autarchautarch#!perl use Test::CPAN::Meta::JSON; meta_json_ok(); Specio-0.50/xt/author/0000775000175000017500000000000014755224347014474 5ustar autarchautarchSpecio-0.50/xt/author/no-ref-util.t0000644000175000017500000000125014755224347017016 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Test::Without::Module 'Ref::Util'; use Specio::Library::Builtins; my @types = qw( ArrayRef CodeRef FileHandle GlobRef HashRef Object RegexpRef ScalarRef ); for my $t (@types) { my $inline = t($t)->_inline_generator('$_[0]'); unlike( $inline, qr/Ref::Util/, "inline code for $t does not use Ref::Util when it is not available" ); } open my $fh, '<', 't/builtins-sanity.t' or die $!; ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) eval do { local $/ = undef; <$fh> }; die $@ if $@; close $fh or die $!; Specio-0.50/xt/author/pod-spell.t0000644000175000017500000000241414755224347016557 0ustar autarchautarchuse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::PodSpelling 2.007006 use Test::Spelling 0.17; use Pod::Wordlist; add_stopwords(); all_pod_files_spelling_ok( qw( bin lib ) ); __DATA__ API AnyCan AnyDoes AnyIsa Builtins CanType Chris ClassName Coercion Coercions Constraint DROLSKY DROLSKY's Dave Declare DeclaredAt Dict DoesType Enum Etheridge Exception Exporter Graham Helpers Inlinable Interface Intersection IsaType Karen Knop Kogman LaxVersionStr Library Lipatov MUTC Map ModuleName NegativeInt NegativeNum NegativeOrZeroInt NegativeOrZeroNum NonEmptySimpleStr NonEmptyStr Num Numeric OO ObjectCan ObjectDoes ObjectIsa PARAMETERIZABLE PackageName Parameterizable Parameterized PartialDump PayPal Perl PositiveInt PositiveNum PositiveOrZeroInt PositiveOrZeroNum RegexpRef Registry Role Rolsky Rolsky's SIGNES SPECIO SafeIdentifier ScalarRef Simple SimpleStr SingleDigit Specio Str StrictVersionStr String Structurable Structured Subs Test Throwable Tuple TypeChecks Union Vitaly White Yuval autarch boolification chrisw coercions cpansprout de distro drolsky ether globification haarg inlinable inline isa lav lib namespace numification parameterizable parameterization parameterized reimplementation sigils slurpy structurable subtype subtypes Specio-0.50/xt/author/precious.t0000644000175000017500000000105714755224347016513 0ustar autarchautarchuse strict; use warnings; use Test::More; use Capture::Tiny qw( capture ); use Encode qw( decode ); use FindBin qw( $Bin ); binmode $_, ':encoding(utf-8)' for map { Test::More->builder->$_ } qw( output failure_output todo_output ); chdir "$Bin/../.." or die "Cannot chdir to $Bin/../..: $!"; my ( $out, $err ) = capture { system(qw( precious lint -a )) }; $_ = decode( 'UTF-8', $_ ) for grep {defined} $out, $err; is( $? >> 8, 0, 'precious lint -a exited with 0' ) or diag($out); is( $err, q{}, 'no output to stderr' ); done_testing(); Specio-0.50/xt/author/no-tabs.t0000644000175000017500000000543514755224347016231 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 use Test::More 0.88; use Test::NoTabs; my @files = ( 'lib/Specio.pm', 'lib/Specio/Coercion.pm', 'lib/Specio/Constraint/AnyCan.pm', 'lib/Specio/Constraint/AnyDoes.pm', 'lib/Specio/Constraint/AnyIsa.pm', 'lib/Specio/Constraint/Enum.pm', 'lib/Specio/Constraint/Intersection.pm', 'lib/Specio/Constraint/ObjectCan.pm', 'lib/Specio/Constraint/ObjectDoes.pm', 'lib/Specio/Constraint/ObjectIsa.pm', 'lib/Specio/Constraint/Parameterizable.pm', 'lib/Specio/Constraint/Parameterized.pm', 'lib/Specio/Constraint/Role/CanType.pm', 'lib/Specio/Constraint/Role/DoesType.pm', 'lib/Specio/Constraint/Role/Interface.pm', 'lib/Specio/Constraint/Role/IsaType.pm', 'lib/Specio/Constraint/Simple.pm', 'lib/Specio/Constraint/Structurable.pm', 'lib/Specio/Constraint/Structured.pm', 'lib/Specio/Constraint/Union.pm', 'lib/Specio/Declare.pm', 'lib/Specio/DeclaredAt.pm', 'lib/Specio/Exception.pm', 'lib/Specio/Exporter.pm', 'lib/Specio/Helpers.pm', 'lib/Specio/Library/Builtins.pm', 'lib/Specio/Library/Numeric.pm', 'lib/Specio/Library/Perl.pm', 'lib/Specio/Library/String.pm', 'lib/Specio/Library/Structured.pm', 'lib/Specio/Library/Structured/Dict.pm', 'lib/Specio/Library/Structured/Map.pm', 'lib/Specio/Library/Structured/Tuple.pm', 'lib/Specio/OO.pm', 'lib/Specio/PartialDump.pm', 'lib/Specio/Registry.pm', 'lib/Specio/Role/Inlinable.pm', 'lib/Specio/Subs.pm', 'lib/Specio/TypeChecks.pm', 'lib/Test/Specio.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/additional-exports.t', 't/anon.t', 't/any-does-isa.t', 't/builtins-sanity.t', 't/builtins.t', 't/coercion.t', 't/combines.t', 't/conflicts.t', 't/declare-helpers.t', 't/dict.t', 't/does-type.t', 't/exception.t', 't/import-twice.t', 't/inheritance.t', 't/inline-environment.t', 't/inline.t', 't/integer-edge-case.t', 't/intersection.t', 't/lib/Specio/Library/CannotSub.pm', 't/lib/Specio/Library/Coercions.pm', 't/lib/Specio/Library/Combines.pm', 't/lib/Specio/Library/Conflict.pm', 't/lib/Specio/Library/NoInline.pm', 't/lib/Specio/Library/Union.pm', 't/lib/Specio/Library/WithSubs.pm', 't/lib/Specio/Library/XY.pm', 't/library-with-subs.t', 't/map.t', 't/multiple-libraries.t', 't/numeric-sanity.t', 't/overloading-moose-bug.t', 't/overloading.t', 't/parameterized.t', 't/perl-sanity.t', 't/string-sanity.t', 't/subs.t', 't/t-clean.t', 't/tuple.t', 't/union-library.t', 't/union.t', 't/with-moo.t', 't/with-moose.t' ); notabs_ok($_) foreach @files; done_testing; Specio-0.50/xt/author/portability.t0000644000175000017500000000013014755224347017213 0ustar autarchautarchuse strict; use warnings; use Test::More; use Test::Portability::Files; run_tests(); Specio-0.50/xt/author/mojibake.t0000644000175000017500000000015114755224347016435 0ustar autarchautarch#!perl use strict; use warnings qw(all); use Test::More; use Test::Mojibake; all_files_encoding_ok(); Specio-0.50/xt/author/test-version.t0000644000175000017500000000063714755224347017327 0ustar autarchautarchuse strict; use warnings; use Test::More; # generated by Dist::Zilla::Plugin::Test::Version 1.09 use Test::Version; my @imports = qw( version_all_ok ); my $params = { is_strict => 1, has_version => 1, multiple => 0, }; push @imports, $params if version->parse( $Test::Version::VERSION ) >= version->parse('1.002'); Test::Version->import(@imports); version_all_ok; done_testing; Specio-0.50/xt/author/pod-coverage.t0000644000175000017500000000172014755224347017232 0ustar autarchautarch#!perl # This file was automatically generated by Dist::Zilla::Plugin::Test::Pod::Coverage::Configurable 0.07. use Test::Pod::Coverage 1.08; use Test::More 0.88; BEGIN { if ( $] <= 5.008008 ) { plan skip_all => 'These tests require Pod::Coverage::TrustPod, which only works with Perl 5.8.9+'; } } use Pod::Coverage::TrustPod; my %skip = map { $_ => 1 } qw( ); my @modules; for my $module ( all_modules() ) { next if $skip{$module}; push @modules, $module; } plan skip_all => 'All the modules we found were excluded from POD coverage test.' unless @modules; plan tests => scalar @modules; my %trustme = (); my @also_private; for my $module ( sort @modules ) { pod_coverage_ok( $module, { coverage_class => 'Pod::Coverage::TrustPod', also_private => \@also_private, trustme => $trustme{$module} || [], }, "pod coverage for $module" ); } done_testing(); Specio-0.50/xt/author/00-compile.t0000644000175000017500000000521014755224347016522 0ustar autarchautarchuse 5.006; use strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::Compile 2.058 use Test::More; plan tests => 41; my @module_files = ( 'Specio.pm', 'Specio/Coercion.pm', 'Specio/Constraint/AnyCan.pm', 'Specio/Constraint/AnyDoes.pm', 'Specio/Constraint/AnyIsa.pm', 'Specio/Constraint/Enum.pm', 'Specio/Constraint/Intersection.pm', 'Specio/Constraint/ObjectCan.pm', 'Specio/Constraint/ObjectDoes.pm', 'Specio/Constraint/ObjectIsa.pm', 'Specio/Constraint/Parameterizable.pm', 'Specio/Constraint/Parameterized.pm', 'Specio/Constraint/Role/CanType.pm', 'Specio/Constraint/Role/DoesType.pm', 'Specio/Constraint/Role/Interface.pm', 'Specio/Constraint/Role/IsaType.pm', 'Specio/Constraint/Simple.pm', 'Specio/Constraint/Structurable.pm', 'Specio/Constraint/Structured.pm', 'Specio/Constraint/Union.pm', 'Specio/Declare.pm', 'Specio/DeclaredAt.pm', 'Specio/Exception.pm', 'Specio/Exporter.pm', 'Specio/Helpers.pm', 'Specio/Library/Builtins.pm', 'Specio/Library/Numeric.pm', 'Specio/Library/Perl.pm', 'Specio/Library/String.pm', 'Specio/Library/Structured.pm', 'Specio/Library/Structured/Dict.pm', 'Specio/Library/Structured/Map.pm', 'Specio/Library/Structured/Tuple.pm', 'Specio/OO.pm', 'Specio/PartialDump.pm', 'Specio/Registry.pm', 'Specio/Role/Inlinable.pm', 'Specio/Subs.pm', 'Specio/TypeChecks.pm', 'Test/Specio.pm' ); # no fake home requested my @switches = ( -d 'blib' ? '-Mblib' : '-Ilib', ); use File::Spec; use IPC::Open3; use IO::Handle; open my $stdin, '<', File::Spec->devnull or die "can't open devnull: $!"; my @warnings; for my $lib (@module_files) { # see L my $stderr = IO::Handle->new; diag('Running: ', join(', ', map { my $str = $_; $str =~ s/'/\\'/g; q{'} . $str . q{'} } $^X, @switches, '-e', "require q[$lib]")) if $ENV{PERL_COMPILE_TEST_DEBUG}; my $pid = open3($stdin, '>&STDERR', $stderr, $^X, @switches, '-e', "require q[$lib]"); binmode $stderr, ':crlf' if $^O eq 'MSWin32'; my @_warnings = <$stderr>; waitpid($pid, 0); is($?, 0, "$lib loaded ok"); shift @_warnings if @_warnings and $_warnings[0] =~ /^Using .*\bblib/ and not eval { +require blib; blib->VERSION('1.01') }; if (@_warnings) { warn @_warnings; push @warnings, @_warnings; } } is(scalar(@warnings), 0, 'no warnings found') or diag 'got warnings: ', ( Test::More->can('explain') ? Test::More::explain(\@warnings) : join("\n", '', @warnings) ); Specio-0.50/xt/author/pod-syntax.t0000644000175000017500000000025214755224347016764 0ustar autarchautarch#!perl # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); Specio-0.50/xt/author/eol.t0000644000175000017500000000546714755224347015452 0ustar autarchautarchuse strict; use warnings; # this test was generated with Dist::Zilla::Plugin::Test::EOL 0.19 use Test::More 0.88; use Test::EOL; my @files = ( 'lib/Specio.pm', 'lib/Specio/Coercion.pm', 'lib/Specio/Constraint/AnyCan.pm', 'lib/Specio/Constraint/AnyDoes.pm', 'lib/Specio/Constraint/AnyIsa.pm', 'lib/Specio/Constraint/Enum.pm', 'lib/Specio/Constraint/Intersection.pm', 'lib/Specio/Constraint/ObjectCan.pm', 'lib/Specio/Constraint/ObjectDoes.pm', 'lib/Specio/Constraint/ObjectIsa.pm', 'lib/Specio/Constraint/Parameterizable.pm', 'lib/Specio/Constraint/Parameterized.pm', 'lib/Specio/Constraint/Role/CanType.pm', 'lib/Specio/Constraint/Role/DoesType.pm', 'lib/Specio/Constraint/Role/Interface.pm', 'lib/Specio/Constraint/Role/IsaType.pm', 'lib/Specio/Constraint/Simple.pm', 'lib/Specio/Constraint/Structurable.pm', 'lib/Specio/Constraint/Structured.pm', 'lib/Specio/Constraint/Union.pm', 'lib/Specio/Declare.pm', 'lib/Specio/DeclaredAt.pm', 'lib/Specio/Exception.pm', 'lib/Specio/Exporter.pm', 'lib/Specio/Helpers.pm', 'lib/Specio/Library/Builtins.pm', 'lib/Specio/Library/Numeric.pm', 'lib/Specio/Library/Perl.pm', 'lib/Specio/Library/String.pm', 'lib/Specio/Library/Structured.pm', 'lib/Specio/Library/Structured/Dict.pm', 'lib/Specio/Library/Structured/Map.pm', 'lib/Specio/Library/Structured/Tuple.pm', 'lib/Specio/OO.pm', 'lib/Specio/PartialDump.pm', 'lib/Specio/Registry.pm', 'lib/Specio/Role/Inlinable.pm', 'lib/Specio/Subs.pm', 'lib/Specio/TypeChecks.pm', 'lib/Test/Specio.pm', 't/00-report-prereqs.dd', 't/00-report-prereqs.t', 't/additional-exports.t', 't/anon.t', 't/any-does-isa.t', 't/builtins-sanity.t', 't/builtins.t', 't/coercion.t', 't/combines.t', 't/conflicts.t', 't/declare-helpers.t', 't/dict.t', 't/does-type.t', 't/exception.t', 't/import-twice.t', 't/inheritance.t', 't/inline-environment.t', 't/inline.t', 't/integer-edge-case.t', 't/intersection.t', 't/lib/Specio/Library/CannotSub.pm', 't/lib/Specio/Library/Coercions.pm', 't/lib/Specio/Library/Combines.pm', 't/lib/Specio/Library/Conflict.pm', 't/lib/Specio/Library/NoInline.pm', 't/lib/Specio/Library/Union.pm', 't/lib/Specio/Library/WithSubs.pm', 't/lib/Specio/Library/XY.pm', 't/library-with-subs.t', 't/map.t', 't/multiple-libraries.t', 't/numeric-sanity.t', 't/overloading-moose-bug.t', 't/overloading.t', 't/parameterized.t', 't/perl-sanity.t', 't/string-sanity.t', 't/subs.t', 't/t-clean.t', 't/tuple.t', 't/union-library.t', 't/union.t', 't/with-moo.t', 't/with-moose.t' ); eol_unix_ok($_, { trailing_whitespace => 1 }) foreach @files; done_testing; Specio-0.50/perlcriticrc0000644000175000017500000000370514755224347015152 0ustar autarchautarchseverity = 3 verbose = 11 theme = (core && (pbp || bugs || maintenance || cosmetic || complexity || security || tests)) || moose program-extensions = pl psgi t exclude = Subroutines::ProhibitCallsToUndeclaredSubs [BuiltinFunctions::ProhibitStringySplit] severity = 3 [CodeLayout::RequireTrailingCommas] severity = 3 [ControlStructures::ProhibitCStyleForLoops] severity = 3 [InputOutput::RequireCheckedSyscalls] functions = :builtins exclude_functions = sleep severity = 3 [RegularExpressions::ProhibitComplexRegexes] max_characters = 200 [RegularExpressions::ProhibitUnusualDelimiters] severity = 3 [Subroutines::ProhibitUnusedPrivateSubroutines] private_name_regex = _(?!build)\w+ [TestingAndDebugging::ProhibitNoWarnings] allow = redefine [ValuesAndExpressions::ProhibitEmptyQuotes] severity = 3 [ValuesAndExpressions::ProhibitInterpolationOfLiterals] severity = 3 [ValuesAndExpressions::RequireUpperCaseHeredocTerminator] severity = 3 [Variables::ProhibitPackageVars] add_packages = Carp Test::Builder [-Subroutines::RequireFinalReturn] # This incorrectly thinks signatures are prototypes. [-Subroutines::ProhibitSubroutinePrototypes] [-ErrorHandling::RequireCarping] # No need for /xsm everywhere [-RegularExpressions::RequireDotMatchAnything] [-RegularExpressions::RequireExtendedFormatting] [-RegularExpressions::RequireLineBoundaryMatching] # http://stackoverflow.com/questions/2275317/why-does-perlcritic-dislike-using-shift-to-populate-subroutine-variables [-Subroutines::RequireArgUnpacking] # "use v5.14" is more readable than "use 5.014" [-ValuesAndExpressions::ProhibitVersionStrings] # Explicitly returning undef is a _good_ thing in many cases, since it # prevents very common errors when using a sub in list context to construct a # hash and ending up with a missing value or key. [-Subroutines::ProhibitExplicitReturnUndef] # Sometimes I want to write "return unless $x > 4" [-ControlStructures::ProhibitNegativeExpressionsInUnlessAndUntilConditions] Specio-0.50/cpanfile0000644000175000017500000000465614755224347014254 0ustar autarchautarch# This file is generated by Dist::Zilla::Plugin::CPANFile v6.032 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "B" => "0"; requires "Carp" => "0"; requires "Clone" => "0"; requires "Devel::StackTrace" => "0"; requires "Eval::Closure" => "0"; requires "Exporter" => "0"; requires "IO::File" => "0"; requires "List::Util" => "1.33"; requires "MRO::Compat" => "0"; requires "Module::Runtime" => "0"; requires "Role::Tiny" => "1.003003"; requires "Role::Tiny::With" => "0"; requires "Scalar::Util" => "0"; requires "Sub::Quote" => "0"; requires "Test::Fatal" => "0"; requires "Test::More" => "0.96"; requires "Try::Tiny" => "0"; requires "overload" => "0"; requires "parent" => "0"; requires "perl" => "5.008"; requires "re" => "0"; requires "strict" => "0"; requires "version" => "0.83"; requires "warnings" => "0"; recommends "Ref::Util" => "0.112"; recommends "Sub::Util" => "1.40"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "FindBin" => "0"; requires "Test::More" => "0.96"; requires "Test::Needs" => "0"; requires "lib" => "0"; requires "open" => "0"; requires "utf8" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Capture::Tiny" => "0"; requires "Encode" => "0"; requires "File::Spec" => "0"; requires "FindBin" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Moo" => "0"; requires "Moose" => "2.1207"; requires "Mouse" => "0"; requires "Perl::Critic" => "1.138"; requires "Perl::Critic::Moose" => "1.05"; requires "Perl::Tidy" => "20210111"; requires "Pod::Checker" => "1.74"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Tidy" => "0.10"; requires "Pod::Wordlist" => "0"; requires "Ref::Util" => "0.112"; requires "Sub::Quote" => "0"; requires "Test::CPAN::Changes" => "0.19"; requires "Test::CPAN::Meta::JSON" => "0.16"; requires "Test::EOL" => "0"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.88"; requires "Test::NoTabs" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.17"; requires "Test::Version" => "2.05"; requires "Test::Without::Module" => "0"; requires "namespace::autoclean" => "0"; }; Specio-0.50/t/0000775000175000017500000000000014755224347013002 5ustar autarchautarchSpecio-0.50/t/inline-environment.t0000644000175000017500000000415514755224347017012 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Constraint::Simple; use Specio::DeclaredAt; use Specio::Library::Builtins; { my $t = Specio::Constraint::Simple->new( name => 'Foo', parent => t('Str'), inline_generator => sub {'1'}, inline_environment => { '$scalar' => 42 }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $ref = Specio::Constraint::Simple->new( name => 'Bar', parent => t('Ref'), inline_generator => sub {'1'}, inline_environment => { '$scalar_from' => 77 }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $from_int = Specio::Coercion->new( from => t('Int'), to => $t, inline_generator => sub {'1'}, inline_environment => { '%hash' => { y => 84 }, }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $from_num = Specio::Coercion->new( from => t('Num'), to => $t, inline_generator => sub {'1'}, inline_environment => { '@array' => [ 1, 2, 3 ], }, declared_at => Specio::DeclaredAt->new_from_caller(0), ); my $from_ref = Specio::Coercion->new( from => $ref, to => $t, inline_generator => sub {'1'}, declared_at => Specio::DeclaredAt->new_from_caller(0), ); $t->add_coercion($from_int); $t->add_coercion($from_num); $t->add_coercion($from_ref); my ( undef, $env ) = $t->inline_coercion_and_check('$var'); my %expect = ( '$scalar' => 42, '$scalar_from' => 77, '%hash' => { y => 84 }, '@array' => [ 1, 2, 3 ], ); for my $key ( sort keys %expect ) { is_deeply( $env->{$key}, $expect{$key}, "inline_coercion_and_check merges all inline environment hashes together - $key", ); } } done_testing(); Specio-0.50/t/anon.t0000644000175000017500000000152714755224347014125 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; { my $anon = anon( parent => t('Str'), where => sub { length $_[0] }, ); isa_ok( $anon, 'Specio::Constraint::Simple', 'return value from anon' ); ok( $anon->value_is_valid('x'), q{anon type allows "x"} ); ok( !$anon->value_is_valid(q{}), 'anon type reject empty string' ); } { my $anon = anon( parent => t('Str'), inline => sub { $_[0]->parent->inline_check( $_[1] ) . " && length $_[1]"; }, ); isa_ok( $anon, 'Specio::Constraint::Simple', 'return value from anon' ); ok( $anon->value_is_valid('x'), q{inlinable anon type allows "x"} ); ok( !$anon->value_is_valid(q{}), 'inlinable anon type reject empty string' ); } done_testing(); Specio-0.50/t/multiple-libraries.t0000644000175000017500000000062214755224347016772 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Specio::Library::Builtins; use Specio::Library::XY; { for my $type (qw( X Y Str Undef )) { is( exception { ok( t($type), "type named $type is available" ) }, undef, "no exception retrieving $type type" ); } } done_testing(); Specio-0.50/t/with-moose.t0000644000175000017500000001455214755224347015267 0ustar autarchautarch## no critic (Modules::ProhibitMultiplePackages, Moose::RequireMakeImmutable, Moose::RequireCleanNamespace) use strict; use warnings; use Test::Needs { Moose => '2.1207', }; use Test::Fatal; use Test::More 0.96; { package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moose; ::is( ::exception { has size => ( is => 'ro', isa => t('Int'), ); }, undef, 'no exception passing a Specio object as the isa parameter for a Moose attr' ); has numbers => ( is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => 1, ); my $ucstr2 = declare( 'Ucstr2', parent => t('Str'), inline_as => sub { shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr2, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr2 => ( is => 'ro', isa => $ucstr2, coerce => 1, ); my $ucstr3 = declare( 'Ucstr3', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr3, from => t('Str'), inline_generator => sub { shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr3 => ( is => 'ro', isa => $ucstr3, coerce => 1, ); my $ucstr4 = declare( 'Ucstr4', parent => t('Str'), inline_as => sub { shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr4, from => t('Str'), inline_generator => sub { shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr4 => ( is => 'ro', isa => $ucstr4, coerce => 1, ); } is( exception { Foo->new( size => 42 ) }, undef, 'no exception with new( size => $int )' ); like( exception { Foo->new( size => 'foo' ) }, qr/\QAttribute (size) does not pass the type constraint/, 'got exception with new( size => $str )' ); is( exception { Foo->new( numbers => [ 1, 2, 3 ] ) }, undef, 'no exception with new( numbers => [$int, $int, $int] )' ); is( exception { Foo->new( ucstr => 'ABC' ) }, undef, 'no exception with new( ucstr => $ucstr )' ); { my $foo; is( exception { $foo = Foo->new( ucstr => 'abc' ) }, undef, 'no exception with new( ucstr => $lcstr )' ); is( $foo->ucstr, 'ABC', 'ucstr attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr2 => 'abc' ) }, undef, 'no exception with new( ucstr2 => $lcstr )' ); is( $foo->ucstr2, 'ABC', 'ucstr2 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr3 => 'abc' ) }, undef, 'no exception with new( ucstr3 => $lcstr )' ); is( $foo->ucstr3, 'ABC', 'ucstr3 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr4 => 'abc' ) }, undef, 'no exception with new( ucstr4 => $lcstr )' ); is( $foo->ucstr4, 'ABC', 'ucstr4 attribute was coerced to upper case' ); } { package Bar; use Specio::Library::Builtins; use Specio::Declare; use Moose; ::is( ::exception { has native => ( traits => ['Array'], is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), default => sub { [] }, handles => { add_native => 'push' }, ); }, undef, 'no exception creating native Array attr where isa => ArrayRef of Int' ); declare( 'AofStr', parent => t( 'ArrayRef', of => t('Str') ), ); coerce( t('AofStr'), from => t('Str'), using => sub { [ $_[0] ] }, ); coerce( t('Str'), from => t('HashRef'), using => sub { return join '-', sort keys %{ $_[0] } }, ); ::is( ::exception { has coerced => ( traits => ['Array'], is => 'ro', isa => t('AofStr'), default => sub { [] }, coerce => 1, handles => { add_coerced => 'push' }, ); }, undef, 'no exception creating native Array attr where isa => AofStr and coerce => 1' ); ::like( ::exception { has native2 => ( traits => ['Array'], is => 'ro', isa => t('Str'), ); }, qr/\QThe type constraint for native2 must be a subtype of ArrayRef but it's a Str/, 'got exception creating native Array attr where isa => Str' ); } { my $bar = Bar->new; is( exception { $bar->add_native(42) }, undef, 'no exception pushing int onto native trait' ); like( exception { $bar->add_native('foo') }, qr/\QA new member value for native\E.+\Qfor type named Int\E.+\Qwith value "foo"/, 'got exception pushing str onto native trait' ); } { my $bar = Bar->new; is( exception { $bar->add_coerced( { a => 1, b => 2 } ) }, undef, 'no exception pushing hashref onto coerced attribute' ); is_deeply( $bar->coerced, ['a-b'], 'pushed value was coerced as expected', ); like( exception { $bar->add_coerced(qr/foobar/) }, qr/\QAttribute (coerced) does not pass the type constraint because/, 'got exception trying to push regex object onto coerced attribute' ); } done_testing(); Specio-0.50/t/import-twice.t0000644000175000017500000000044114755224347015607 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Library::Builtins; is( exception { Specio::Library::Builtins->import }, undef, 'no exception importing the same library twice' ); isa_ok( t('Num'), 'Specio::Constraint::Simple' ); done_testing(); Specio-0.50/t/string-sanity.t0000644000175000017500000001247114755224347016005 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Library::String; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my $LONG_STR_255 = 'x' x 255; my $LONG_STR_256 = 'x' x 256; my @STRINGS_WITH_VSPACE = map { join $_, qw( foo bar ) } ( "\n", "\r", "\r\n", "\x{2028}", "\x{2029}", ); my %tests = ( NonEmptySimpleStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_FULL, $LONG_STR_255, ], reject => [ $EMPTY_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $STR_OVERLOAD_EMPTY, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], }, NonEmptyStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $INT_WITH_NL1, $INT_WITH_NL2, $NUM, $NEG_NUM, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_FULL, $LONG_STR_255, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, PackageName => { accept => [ $CLASS_NAME, $STR_OVERLOAD_CLASS_NAME, qw( Specio Spec::Library::Builtins strict _Foo A123::456 ), "Has::Chinese::\x{3403}::In::It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo:::Bar Foo: Foo:: Foo::Bar:: ::Foo ), 'Has::Spaces In It', ], }, SimpleStr => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $LONG_STR_255, ], reject => [ $INT_WITH_NL1, $INT_WITH_NL2, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, $LONG_STR_256, @STRINGS_WITH_VSPACE, ], }, ); for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.50/t/coercion.t0000644000175000017500000001611314755224347014770 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Eval::Closure qw( eval_closure ); use Specio::Declare; use Specio::Library::Builtins; { my $arrayref = t('ArrayRef'); ok( !$arrayref->has_coercions, 'ArrayRef type object does not have coercions' ); ok( !Specio::Library::Builtins::t('ArrayRef')->has_coercions, 'ArrayRef type in Specio::Library::Builtins package does not have coercions' ); coerce( $arrayref, from => t('Int'), using => sub { [ $_[0] ] }, ); my $clone; is( exception { $clone = $arrayref->clone }, undef, 'can clone constraint with coercions without an exception' ); for my $pair ( [ 'ArrayRef', $arrayref ], [ 'clone of Arrayref', $clone ] ) { my ( $name, $type ) = @{$pair}; subtest( $name, sub { ok( $type->has_coercions, 'ArrayRef type object has coercions' ); ok( !Specio::Library::Builtins::t('ArrayRef')->has_coercions, 'ArrayRef type in Specio::Library::Builtins package does not have coercions (coercions only apply to local copy of type)' ); ok( $type->has_coercion_from_type( t('Int') ), 'has a coercion for the Int type' ); ok( !$type->has_coercion_from_type( t('Str') ), 'does not have a coercion for the Str type' ); is_deeply( $type->coerce_value(42), [42], 'coerced int to arrayref', ); is( $type->coerce_value(42.1), 42.1, 'cannot coerce num to arrayref - returns original value', ); ok( !$type->can_inline_coercion_and_check, 'cannot inline coercion and check for arrayref' ); } ); } } { my $hashref = t('HashRef'); coerce( $hashref, from => t('ArrayRef'), inline_generator => sub { return '{ @{ ' . $_[1] . '} }'; }, ); ok( $hashref->can_inline_coercion, 'can inline coercion for hashref' ); ok( $hashref->can_inline_coercion_and_check, 'can inline coercion and check for hashref' ); coerce( $hashref, from => t('Int'), inline_generator => sub { return '{ ' . $_[1] . ' => 1 }'; }, ); ok( $hashref->can_inline_coercion_and_check, 'can inline coercion and check for hashref with two coercions' ); ok( $hashref->can_inline_coercion, 'can inline coercion for hashref' ); subtest( 'inline_coercion_and_check', sub { my ( $source, $environment ) = $hashref->inline_coercion_and_check('$_[0]'); my $coerce_and_check; is( exception { $coerce_and_check = eval_closure( source => 'sub { ' . $source . ' }', environment => $environment, description => 'inlined coerce and check sub', ); }, undef, 'no error evaling closure for coercion and check' ); is_deeply( $coerce_and_check->( { x => 1 } ), { x => 1 }, 'hashref is passed through coerce and check unchanged' ); is_deeply( $coerce_and_check->( [ x => 1 ] ), { x => 1 }, 'arrayref is coerced to hashref' ); is_deeply( $coerce_and_check->(42), { 42 => 1 }, 'integer is coerced to hashref' ); like( exception { $coerce_and_check->('foo') }, qr/\QValidation failed for type named HashRef declared in package Specio::Library::Builtins\E.+\Qwith value "foo"/, 'string throws exception' ); } ); subtest( 'inline_coercion', sub { my ( $source, $environment ) = $hashref->inline_coercion('$_[0]'); my $coerce; is( exception { $coerce = eval_closure( source => 'sub { ' . $source . ' }', environment => $environment, description => 'inlined coerce sub', ); }, undef, 'no error evaling closure for coercion and check' ); is_deeply( $coerce->( { x => 1 } ), { x => 1 }, 'hashref is passed through coerce and check unchanged' ); is_deeply( $coerce->( [ x => 1 ] ), { x => 1 }, 'arrayref is coerced to hashref' ); is_deeply( $coerce->(42), { 42 => 1 }, 'integer is coerced to hashref' ); } ); } { my $hashref = declare( 'HashRef2', parent => t('HashRef'), ); coerce( $hashref, from => t('ArrayRef'), using => sub { return { @{ $_[0] } }; }, ); coerce( $hashref, from => t('Int'), using => sub { return { $_[0] => 1 }; }, ); is_deeply( $hashref->coerce_value( [ x => 1 ] ), { x => 1 }, 'arrayref is coerced to hashref' ); is_deeply( $hashref->coerce_value(42), { 42 => 1 }, 'integer is coerced to hashref' ); is( $hashref->coerce_value('foo'), 'foo', 'cannot coerce num to arrayref - returns original value', ); } { my $str = t('Str'); like( exception { coerce( $str, from => t('Int'), ); }, qr/\QA type coercion must have either a coercion or inline_generator parameter/, 'a coercion must have a coercion sub or an inline generator' ); } { my $str = declare( 'Str2', parent => t('Str'), ); coerce( $str, from => t('Num'), inline => sub { return "$_[1] + 10"; }, ); coerce( $str, from => t('Int'), inline => sub { return "$_[1] + 10"; }, ); my ( $source, $env ) = $str->inline_coercion('$_[0]'); my $code = eval_closure( source => "sub { $source }", environment => $env, ); is( $code->(-10), 0, 'inlined coercion only fires one coercion', ); } done_testing(); Specio-0.50/t/00-report-prereqs.dd0000644000175000017500000001117114755224347016521 0ustar autarchautarchdo { my $x = { 'configure' => { 'requires' => { 'ExtUtils::MakeMaker' => '0' } }, 'develop' => { 'requires' => { 'Capture::Tiny' => '0', 'Encode' => '0', 'File::Spec' => '0', 'FindBin' => '0', 'IO::Handle' => '0', 'IPC::Open3' => '0', 'Moo' => '0', 'Moose' => '2.1207', 'Mouse' => '0', 'Perl::Critic' => '1.138', 'Perl::Critic::Moose' => '1.05', 'Perl::Tidy' => '20210111', 'Pod::Checker' => '1.74', 'Pod::Coverage::TrustPod' => '0', 'Pod::Tidy' => '0.10', 'Pod::Wordlist' => '0', 'Ref::Util' => '0.112', 'Sub::Quote' => '0', 'Test::CPAN::Changes' => '0.19', 'Test::CPAN::Meta::JSON' => '0.16', 'Test::EOL' => '0', 'Test::Mojibake' => '0', 'Test::More' => '0.88', 'Test::NoTabs' => '0', 'Test::Pod' => '1.41', 'Test::Pod::Coverage' => '1.08', 'Test::Portability::Files' => '0', 'Test::Spelling' => '0.17', 'Test::Version' => '2.05', 'Test::Without::Module' => '0', 'namespace::autoclean' => '0' } }, 'runtime' => { 'recommends' => { 'Ref::Util' => '0.112', 'Sub::Util' => '1.40' }, 'requires' => { 'B' => '0', 'Carp' => '0', 'Clone' => '0', 'Devel::StackTrace' => '0', 'Eval::Closure' => '0', 'Exporter' => '0', 'IO::File' => '0', 'List::Util' => '1.33', 'MRO::Compat' => '0', 'Module::Runtime' => '0', 'Role::Tiny' => '1.003003', 'Role::Tiny::With' => '0', 'Scalar::Util' => '0', 'Sub::Quote' => '0', 'Test::Fatal' => '0', 'Test::More' => '0.96', 'Try::Tiny' => '0', 'overload' => '0', 'parent' => '0', 'perl' => '5.008', 're' => '0', 'strict' => '0', 'version' => '0.83', 'warnings' => '0' } }, 'test' => { 'recommends' => { 'CPAN::Meta' => '2.120900' }, 'requires' => { 'ExtUtils::MakeMaker' => '0', 'File::Spec' => '0', 'FindBin' => '0', 'Test::More' => '0.96', 'Test::Needs' => '0', 'lib' => '0', 'open' => '0', 'utf8' => '0' } } }; $x; }Specio-0.50/t/inline.t0000644000175000017500000001006214755224347014442 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Eval::Closure qw( eval_closure ); use Specio::Declare; use Specio::Library::Builtins; { my $str = t('Str'); my $int = t('Int'); my ( $str_source, $str_env ) = $str->inline_coercion_and_check('$value1'); my ( $int_source, $int_env ) = $int->inline_coercion_and_check('$value2'); my $sub = 'sub { ' . 'my $value1 = shift;' . 'my $value2 = shift;' . 'my $str_val = ' . $str_source . ';' . 'my $int_val = ' . $int_source . ';' . 'return ($str_val, $int_val)' . ' }'; my $coerce_and_check; is( exception { $coerce_and_check = eval_closure( source => $sub, environment => { %{$str_env}, %{$int_env}, }, description => 'inlined coerce and check sub for str and int', ); }, undef, 'no exception evaling a closure for str and int inlining in one sub', ); is_deeply( [ $coerce_and_check->( 'string', 42 ) ], [ 'string', 42 ], 'both types pass check and are returned' ); like( exception { $coerce_and_check->( [], 42 ) }, qr/Validation failed for type named Str/, 'got exception passing arrayref for Str value' ); like( exception { $coerce_and_check->( 'string', [] ) }, qr/Validation failed for type named Int/, 'got exception passing arrayref for Int value' ); } { my $enum1 = enum( Enum1 => values => [qw( foo bar baz )] ); my $enum2 = enum( Enum2 => values => [qw( a b c )] ); my ( $enum1_source, $enum1_env ) = $enum1->inline_coercion_and_check('$value1'); my ( $enum2_source, $enum2_env ) = $enum2->inline_coercion_and_check('$value2'); my $sub = 'sub { ' . 'my $value1 = shift;' . 'my $value2 = shift;' . 'my $enum1_val = ' . $enum1_source . ';' . 'my $enum2_val = ' . $enum2_source . ';' . 'return ($enum1_val, $enum2_val)' . ' }'; my $coerce_and_check; is( exception { $coerce_and_check = eval_closure( source => $sub, environment => { %{$enum1_env}, %{$enum2_env}, }, description => 'inlined coerce and check sub for two enums', ); }, undef, 'no exception evaling a closure for inlining two enums in one sub', ); is_deeply( [ $coerce_and_check->( 'foo', 'a' ) ], [ 'foo', 'a' ], 'both types pass check and are returned' ); like( exception { $coerce_and_check->( [], 'c' ) }, qr/Validation failed for type named Enum1/, 'got exception passing arrayref for Enum1 value' ); like( exception { $coerce_and_check->( 'bar', [] ) }, qr/Validation failed for type named Enum2/, 'got exception passing arrayref for Enum2 value' ); } { # Note that the same bug would apply to role types and other special types # that have a specialized _inline_generator. my $foo = declare( 'Foo', parent => any_isa_type('Specio::Coercion'), ); my $constraint; is( exception { $constraint = $foo->_generated_inline_sub }, undef, 'building an inline sub for an empty subtype of an any_isa_type does not die' ); ok( !$constraint->('Specio::Constraint::Simple'), 'generated constraint rejects values as expected' ); ok( $constraint->('Specio::Coercion'), 'generated constraint accepts values as expected' ); my $code; is( exception { $code = $foo->inline_check('$x') }, undef, 'building inline code for an empty subtype of an any_isa_type does not die' ); like( $code, qr/\$x->isa\((["'])Specio::Coercion\1\)/, 'generated code contains expected check' ); } done_testing(); Specio-0.50/t/overloading.t0000644000175000017500000000432014755224347015475 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins qw( HashRef Int Str ); use Specio::Library::Structured; my @types = ( t('Int'), t('HashRef'), t( 'HashRef', of => t('Int') ), declare( 'Tuple[ Int, Str ]', parent => t( 'Tuple', of => [ t('Int'), t('Str'), ], ), ), declare( 'Dict{ bar => Int, foo => Str }', parent => t( 'Dict', of => { kv => { foo => t('Str'), bar => t('Int'), }, }, ), ), union( 'IntOrStr', of => [ t('Int'), t('Str') ] ), intersection( 'IntAndStr', of => [ t('Int'), t('Str') ] ), enum( 'Colors', values => [qw( red blue )] ), object_does_type('Foo'), any_does_type('Foo'), object_isa_type('Specio::Constraint::Simple'), any_isa_type('Specio::Constraint::Simple'), anon( parent => t( 'HashRef', of => t('Str') ) ), ); for my $type (@types) { my $test_name = sprintf( "%s - $type", ref $type ); subtest( $test_name, sub { unless ( $type->is_anon ) { is( "$type", $type->name, sprintf( 'stringifying a %s returns its name - %s', ref $type, $type->name, ), ); } cmp_ok( $type, 'eq', $type, 'type overloads eq so it is equal to itself' ); } ); } { my $anon1 = anon( parent => t( 'HashRef', of => t('Str') ) ); is( "$anon1", '__ANON__(HashRef[Str])', "anonymous type stringification of $anon1" ); my $anon2 = anon( parent => anon( parent => t( 'HashRef', of => t('Str') ) ) ); is( "$anon2", '__ANON__(__ANON__(HashRef[Str]))', "anonymous type stringification of $anon2" ); my $anon3 = anon( parent => enum( values => [qw( red blue )] ) ); is( "$anon3", '__ANON__(__ANON__(Str))', "anonymous type stringification of $anon3" ); } done_testing(); Specio-0.50/t/any-does-isa.t0000644000175000017500000001755214755224347015470 0ustar autarchautarchuse strict; use warnings; use utf8; use open ':encoding(UTF-8)', ':std'; use Test::Fatal; use Test::More 0.96; use Specio::Declare; ## no critic (Modules::ProhibitMultiplePackages) { package Foo; sub quux { } } subtest( 'object_can_type', sub { my $object_can = object_can_type( methods => [ 'foo', 'bar' ] ); like( exception { $object_can->validate_or_die(undef) }, qr/\QAn undef will never pass an ObjectCan check (wants bar and foo)/, 'exception for undef' ); like( exception { $object_can->validate_or_die(q{}) }, qr/\QAn empty string will never pass an ObjectCan check (wants bar and foo)/, 'exception for empty string' ); like( exception { $object_can->validate_or_die('Foo') }, qr/\QA plain scalar ("Foo") will never pass an ObjectCan check (wants bar and foo)/, 'exception for non-empty string' ); like( exception { $object_can->validate_or_die(42) }, qr/\QA number (42) will never pass an ObjectCan check (wants bar and foo)/, 'exception for number' ); like( exception { $object_can->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an ObjectCan check (wants bar and foo)/, 'exception for arrayref' ); like( exception { $object_can->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class is missing the 'bar' and 'foo' methods/, 'exception for object without wanted methods' ); } ); subtest( 'any_can_type', sub { my $any_can = any_can_type( methods => [ 'foo', 'bar' ] ); like( exception { $any_can->validate_or_die(undef) }, qr/\QAn undef will never pass an AnyCan check (wants bar and foo)/, 'exception for undef' ); like( exception { $any_can->validate_or_die(q{}) }, qr/\QAn empty string will never pass an AnyCan check (wants bar and foo)/, 'exception for empty string' ); like( exception { $any_can->validate_or_die('Baz') }, qr/\QThe Baz class is missing the 'bar' and 'foo' methods/, 'exception for non-empty string' ); like( exception { $any_can->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an AnyCan check (wants bar and foo)/, 'exception for arrayref' ); like( exception { $any_can->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class is missing the 'bar' and 'foo' methods/, 'exception for non-empty string' ); } ); subtest( 'object_isa_type', sub { my $object_isa = object_isa_type( class => 'Foo' ); like( exception { $object_isa->validate_or_die(undef) }, qr/\QAn undef will never pass an ObjectIsa check (wants Foo)/, 'exception for undef' ); like( exception { $object_isa->validate_or_die(q{}) }, qr/\QAn empty string will never pass an ObjectIsa check (wants Foo)/, 'exception for empty string' ); like( exception { $object_isa->validate_or_die('Foo') }, qr/\QA plain scalar ("Foo") will never pass an ObjectIsa check (wants Foo)/, 'exception for non-empty string' ); like( exception { $object_isa->validate_or_die(42) }, qr/\QA number (42) will never pass an ObjectIsa check (wants Foo)/, 'exception for number' ); like( exception { $object_isa->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an ObjectIsa check (wants Foo)/, 'exception for arrayref' ); like( exception { $object_isa->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class is not a subclass of the Foo class/, 'exception for object of the wrong class' ); } ); subtest( 'any_isa_type', sub { my $any_isa = any_isa_type( class => 'Foo' ); like( exception { $any_isa->validate_or_die(undef) }, qr/\QAn undef will never pass an AnyIsa check (wants Foo)/, 'exception for undef' ); like( exception { $any_isa->validate_or_die(q{}) }, qr/\QAn empty string will never pass an AnyIsa check (wants Foo)/, 'exception for empty string' ); like( exception { $any_isa->validate_or_die('Baz') }, qr/\QThe Baz class is not a subclass of the Foo class/, 'exception for plain scalar' ); like( exception { $any_isa->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an AnyIsa check (wants Foo)/, 'exception for arrayref' ); like( exception { $any_isa->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class is not a subclass of the Foo class/, 'exception for object of the wrong class' ); } ); { package Role::Foo; use Role::Tiny; } subtest( 'object_does_type', sub { my $object_does = object_does_type( role => 'Role::Foo' ); like( exception { $object_does->validate_or_die(undef) }, qr/\QAn undef will never pass an ObjectDoes check (wants Role::Foo)/, 'exception for undef' ); like( exception { $object_does->validate_or_die(q{}) }, qr/\QAn empty string will never pass an ObjectDoes check (wants Role::Foo)/, 'exception for empty string' ); like( exception { $object_does->validate_or_die('Role::Foo') }, qr/\QA plain scalar ("Role::Foo") will never pass an ObjectDoes check (wants Role::Foo)/, 'exception for non-empty string' ); like( exception { $object_does->validate_or_die(42) }, qr/\QA number (42) will never pass an ObjectDoes check (wants Role::Foo)/, 'exception for number' ); like( exception { $object_does->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an ObjectDoes check (wants Role::Foo)/, 'exception for arrayref' ); like( exception { $object_does->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class does not consume the Role::Foo role/, 'exception for object that does not consume the wanted role' ); } ); subtest( 'any_does_type', sub { my $any_does = any_does_type( role => 'Role::Foo' ); like( exception { $any_does->validate_or_die(undef) }, qr/\QAn undef will never pass an AnyDoes check (wants Role::Foo)/, 'exception for undef' ); like( exception { $any_does->validate_or_die(q{}) }, qr/\QAn empty string will never pass an AnyDoes check (wants Role::Foo)/, 'exception for empty string' ); like( exception { $any_does->validate_or_die('Baz') }, qr/\QThe Baz class does not consume the Role::Foo role/, 'exception for plain scalar' ); like( exception { $any_does->validate_or_die( [] ) }, qr/\QAn unblessed reference ([ ]) will never pass an AnyDoes check (wants Role::Foo)/, 'exception for arrayref' ); like( exception { $any_does->validate_or_die( bless {}, 'Baz' ) }, qr/\QThe Baz class does not consume the Role::Foo role/, 'exception for object that does not consume the wanted role' ); } ); done_testing(); Specio-0.50/t/combines.t0000644000175000017500000000063114755224347014764 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Specio::Library::Combines; { for my $type (qw( X Y Str Undef )) { is( exception { ok( t($type), "type named $type is available" ) }, undef, "no exception retrieving $type type - exported by combining library" ); } } done_testing(); Specio-0.50/t/00-report-prereqs.t0000644000175000017500000001360114755224347016375 0ustar autarchautarch#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029 use Test::More tests => 1; use ExtUtils::MakeMaker; use File::Spec; # from $version::LAX my $lax_version_re = qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )? | (?:\.[0-9]+) (?:_[0-9]+)? ) | (?: v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )? | (?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)? ) )/x; # hide optional CPAN::Meta modules from prereq scanner # and check if they are available my $cpan_meta = "CPAN::Meta"; my $cpan_meta_pre = "CPAN::Meta::Prereqs"; my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic # Verify requirements? my $DO_VERIFY_PREREQS = 1; sub _max { my $max = shift; $max = ( $_ > $max ) ? $_ : $max for @_; return $max; } sub _merge_prereqs { my ($collector, $prereqs) = @_; # CPAN::Meta::Prereqs object if (ref $collector eq $cpan_meta_pre) { return $collector->with_merged_prereqs( CPAN::Meta::Prereqs->new( $prereqs ) ); } # Raw hashrefs for my $phase ( keys %$prereqs ) { for my $type ( keys %{ $prereqs->{$phase} } ) { for my $module ( keys %{ $prereqs->{$phase}{$type} } ) { $collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module}; } } } return $collector; } my @include = qw( ); my @exclude = qw( ); # Add static prereqs to the included modules list my $static_prereqs = do './t/00-report-prereqs.dd'; # Merge all prereqs (either with ::Prereqs or a hashref) my $full_prereqs = _merge_prereqs( ( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ), $static_prereqs ); # Add dynamic prereqs to the included modules list (if we can) my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; my $cpan_meta_error; if ( $source && $HAS_CPAN_META && (my $meta = eval { CPAN::Meta->load_file($source) } ) ) { $full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs); } else { $cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source) $source = 'static metadata'; } my @full_reports; my @dep_errors; my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs; # Add static includes into a fake section for my $mod (@include) { $req_hash->{other}{modules}{$mod} = 0; } for my $phase ( qw(configure build test runtime develop other) ) { next unless $req_hash->{$phase}; next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING}); for my $type ( qw(requires recommends suggests conflicts modules) ) { next unless $req_hash->{$phase}{$type}; my $title = ucfirst($phase).' '.ucfirst($type); my @reports = [qw/Module Want Have/]; for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) { next if grep { $_ eq $mod } @exclude; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; if ($mod eq 'perl') { push @reports, ['perl', $want, $]]; next; } my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; if ($prefix) { my $have = MM->parse_version( File::Spec->catfile($prefix, $file) ); $have = "undef" unless defined $have; push @reports, [$mod, $want, $have]; if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) { if ( $have !~ /\A$lax_version_re\z/ ) { push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)"; } elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) { push @dep_errors, "$mod version '$have' is not in required range '$want'"; } } } else { push @reports, [$mod, $want, "missing"]; if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) { push @dep_errors, "$mod is not installed ($req_string)"; } } } if ( @reports ) { push @full_reports, "=== $title ===\n\n"; my $ml = _max( map { length $_->[0] } @reports ); my $wl = _max( map { length $_->[1] } @reports ); my $hl = _max( map { length $_->[2] } @reports ); if ($type eq 'modules') { splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports; } else { splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl]; push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports; } push @full_reports, "\n"; } } } if ( @full_reports ) { diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports; } if ( $cpan_meta_error || @dep_errors ) { diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n"; } if ( $cpan_meta_error ) { my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml'; diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n"; } if ( @dep_errors ) { diag join("\n", "\nThe following REQUIRED prerequisites were not satisfied:\n", @dep_errors, "\n" ); } pass('Reported prereqs'); # vim: ts=4 sts=4 sw=4 et: Specio-0.50/t/dict.t0000644000175000017500000002140714755224347014114 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured; ## no critic (Subroutines::ProtectPrivateSubs) declare( 'UCStr', parent => t('Str'), inline => sub { $_[0]->parent->_inline_check( $_[1] ) . " && $_[1] =~ /^[A-Z]+\$/"; }, ); ## use critic declare( 'Dict{ bar => Int, foo => UCStr }', parent => t( 'Dict', of => { kv => { foo => t('UCStr'), bar => t('Int'), }, }, ), ); declare( 'Dict{ bar => Int, baz => Num?, foo => UCStr }', parent => t( 'Dict', of => { kv => { foo => t('UCStr'), bar => t('Int'), baz => optional( t('Num') ), }, }, ), ); declare( 'Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }', parent => t( 'Dict', of => { kv => { foo => t('UCStr'), bar => t('Int'), baz => optional( t('Num') ), }, slurpy => t('HashRef'), }, ), ); # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); test_constraint( t('Dict{ bar => Int, foo => UCStr }'), { accept => [ { foo => 'BAZ', bar => 42, }, _T::HashOverload->new( { foo => 'BAZ', bar => 42, } ), ], reject => [ $HASH_REF, { foo => 'baz', bar => 42, }, { foo => 'BAZ', bar => 42.1, }, { foo => 'BAZ' }, { bar => 42 }, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); test_constraint( t('Dict{ bar => Int, baz => Num?, foo => UCStr }'), { accept => [ { foo => 'BAZ', bar => 42, }, _T::HashOverload->new( { foo => 'BAZ', bar => 42, } ), { foo => 'BAZ', bar => 42, baz => 42.1, }, _T::HashOverload->new( { foo => 'BAZ', bar => 42, baz => 42.1, } ), ], reject => [ $HASH_REF, { foo => 'baz', bar => 42, }, { foo => 'BAZ', bar => 42.1, }, { foo => 'BAZ', bar => 42, baz => 'string', }, { foo => 'BAZ' }, { bar => 42 }, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); test_constraint( t('Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }'), { accept => [ { foo => 'BAZ', bar => 42, quux => {}, }, _T::HashOverload->new( { foo => 'BAZ', bar => 42, quux => {}, } ), { foo => 'BAZ', bar => 42, baz => 42.1, quux => { x => 1 }, }, _T::HashOverload->new( { foo => 'BAZ', bar => 42, baz => 42.1, quux => { x => 1 }, } ), ], reject => [ $HASH_REF, { foo => 'baz', bar => 42, }, { foo => 'BAZ', bar => 42.1, }, { foo => 'BAZ', bar => 42, baz => 'string', }, { foo => 'BAZ' }, { bar => 42 }, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( t('Dict{ bar => Int, foo => UCStr }')->parent->name, 'Dict{ bar => Int, foo => UCStr }', 'got expected name for simple Dict' ); is( t('Dict{ bar => Int, baz => Num?, foo => UCStr }')->parent->name, 'Dict{ bar => Int, baz => Num?, foo => UCStr }', 'got expected name for Dict with optional key' ); is( t('Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }') ->parent->name, 'Dict{ bar => Int, baz => Num?, foo => UCStr, HashRef... }', 'got expected name for slurpy Dict with optional key' ); ## no critic (Modules::ProhibitMultiplePackages) { package Declarer; use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured; use parent 'Specio::Exporter'; declare( 'SomeDict', 'parent' => t( 'Dict', of => { kv => { foo => t('Str'), bar => t('Int'), }, }, ), ); } { package ImportInto; ::is( ::exception { Declarer->import }, undef, 'No exception thrown when importing a Map type', ); } done_testing(); Specio-0.50/t/lib/0000775000175000017500000000000014755224347013550 5ustar autarchautarchSpecio-0.50/t/lib/Specio/0000775000175000017500000000000014755224347014772 5ustar autarchautarchSpecio-0.50/t/lib/Specio/Library/0000775000175000017500000000000014755224347016376 5ustar autarchautarchSpecio-0.50/t/lib/Specio/Library/XY.pm0000644000175000017500000000046314755224347017275 0ustar autarchautarchpackage Specio::Library::XY; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'X', parent => t('Str'), where => sub { $_[0] =~ /x/ }, ); declare( 'Y', parent => t('X'), where => sub { $_[0] =~ /y/ }, ); 1; Specio-0.50/t/lib/Specio/Library/CannotSub.pm0000644000175000017500000000024214755224347020624 0ustar autarchautarchpackage Specio::Library::CannotSub; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; declare( 'My Type', where => sub {1} ); 1; Specio-0.50/t/lib/Specio/Library/Union.pm0000644000175000017500000000103414755224347020020 0ustar autarchautarchpackage Specio::Library::Union; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; my $locale_object = declare( 'LocaleObject', parent => t('Object'), inline => sub { # Using $_[1] directly in the string causes some weirdness with 5.8 my $var = $_[1]; return <<"EOF"; ( $var->isa('DateTime::Locale::FromData') || $var->isa('DateTime::Locale::Base') ) EOF }, ); union( 'Union', of => [ t('Str'), $locale_object ], ); 1; Specio-0.50/t/lib/Specio/Library/NoInline.pm0000644000175000017500000000162114755224347020445 0ustar autarchautarchpackage Specio::Library::NoInline; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'IntNI', parent => t('Defined'), where => sub { ( defined( $_[0] ) && !ref( $_[0] ) && ( do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val1 = $_[0] ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ) || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '0+' ) && do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val2 = $_[0] + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ); }, ); 1; Specio-0.50/t/lib/Specio/Library/Coercions.pm0000644000175000017500000000061514755224347020660 0ustar autarchautarchpackage Specio::Library::Coercions; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'IntC', parent => t('Int'), ); coerce( t('IntC'), from => t('ArrayRef'), using => sub { scalar @{ $_[0] } }, ); coerce( t('IntC'), from => t('HashRef'), inline => sub {"scalar keys %{ $_[1] }"}, ); 1; Specio-0.50/t/lib/Specio/Library/WithSubs.pm0000644000175000017500000000061514755224347020504 0ustar autarchautarchpackage Specio::Library::WithSubs; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Library::Builtins -reexport; use Specio::Library::Numeric -reexport; use Specio::Subs qw( Specio::Library::Builtins Specio::Library::Numeric ); ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _also_export { return Specio::Subs::subs_installed_into(__PACKAGE__); } 1; Specio-0.50/t/lib/Specio/Library/Combines.pm0000644000175000017500000000025714755224347020475 0ustar autarchautarchpackage Specio::Library::Combines; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Library::Builtins -reexport; use Specio::Library::XY -reexport; 1; Specio-0.50/t/lib/Specio/Library/Conflict.pm0000644000175000017500000000030514755224347020471 0ustar autarchautarchpackage Specio::Library::Conflict; use strict; use warnings; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins; declare( 'X', parent => t('Int'), ); 1; Specio-0.50/t/declare-helpers.t0000644000175000017500000005777414755224347016250 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( describe test_constraint :vars ); use Specio::Declare; use Specio::PartialDump qw( partial_dump ); # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); ## no critic (Modules::ProhibitMultiplePackages) { package Foo; sub new { return bless {}, shift; } sub foo {42} } { package Baz; ## no critic (ClassHierarchies::ProhibitExplicitISA) our @ISA = 'Foo'; sub bar {84} } { package Quux; sub whatever { } } { package Role::Foo; use Role::Tiny; } { package Does::Role::Foo; use Role::Tiny::With; with 'Role::Foo'; sub new { return bless {}, shift; } } { my $tc = object_can_type( 'Need2Obj', methods => [qw( foo bar )], ); is( $tc->name, 'Need2Obj', 'constraint has the expected name' ); test_constraint( $tc, { accept => [ Baz->new ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } subtest( 'any_can_type which needs 2 methods', sub { my $tc = any_can_type( 'Need2Any', methods => [qw( foo bar )], ); is( $tc->name, 'Need2Any', 'constraint has the expected name' ); test_constraint( $tc, { accept => [ 'Baz', Baz->new ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); subtest( 'any_can_type which needs 3 methods', sub { my $tc = object_can_type( 'Need3Obj', methods => [qw( foo bar baz )], ); test_constraint( $tc, { reject => [ 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); subtest( 'object_can_type which needs 2 methods', sub { my $tc = object_can_type( methods => [qw( foo bar )], ); test_constraint( $tc, { accept => [ Baz->new ], reject => [ 'Baz', $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); subtest( 'object_can_type which needs 3 methods', sub { my $tc = object_can_type( methods => [qw( foo bar baz )], ); test_constraint( $tc, { reject => [ 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); ok( !$tc->value_is_valid( Baz->new ), 'Baz object is not valid for anon ObjectCan type' ); } ); subtest( 'object_isa_type (Foo class)', sub { my $tc = object_isa_type('Foo'); is( $tc->name, 'Foo', 'name defaults to class name' ); test_constraint( $tc, { accept => [ Foo->new, Baz->new ], reject => [ 'Baz', $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( exception { is( $tc . q{}, object_isa_type('Foo') . q{}, 'object_isa_type returns the same type for the same class each time' ); }, undef, 'no exception calling object_isa_type repeatedly with the same class name' ); } ); subtest( 'any_isa_type (isa Foo)', sub { my $tc = any_isa_type( 'FooAny', class => 'Foo', ); is( $tc->name, 'FooAny', 'can provide an explicit name' ); test_constraint( $tc, { accept => [ 'Foo', Foo->new, 'Baz', Baz->new ], reject => [ $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( exception { is( $tc . q{}, any_isa_type('FooAny') . q{}, 'any_isa_type returns the same type for the same class each time' ); }, undef, 'no exception calling any_isa_type repeatedly with the same class name' ); } ); subtest( 'object_isa_type (isa Quux)', sub { my $tc = object_isa_type('Quux'); test_constraint( $tc, { reject => [ 'Foo', Foo->new, 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); subtest( 'any_isa_type (isa Quux)', sub { my $tc = any_isa_type( 'QuuxAny', class => 'Quux', ); test_constraint( $tc, { reject => [ 'Foo', Foo->new, 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); subtest( 'object_does_type (Role::Foo class)', sub { my $tc = object_does_type('Role::Foo'); is( $tc->name, 'Role::Foo', 'name defaults to role name' ); test_constraint( $tc, { accept => [ Does::Role::Foo->new, ], reject => [ 'Does::Role::Foo', Foo->new, 'Foo', Baz->new, 'Baz', $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( exception { is( $tc . q{}, object_does_type('Role::Foo') . q{}, 'object_does_type returns the same type for the same class each time' ); }, undef, 'no exception calling object_does_type repeatedly with the same class name' ); } ); subtest( 'any_does_type (does Role::Foo)', sub { my $tc = any_does_type( 'Role::FooAny', role => 'Role::Foo', ); test_constraint( $tc, { accept => [ 'Does::Role::Foo', Does::Role::Foo->new, ], reject => [ 'Foo', Foo->new, 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( exception { is( $tc . q{}, any_does_type('Role::FooAny') . q{}, 'any_does_type returns the same type for the same class each time' ); }, undef, 'no exception calling any_does_type repeatedly with the same class name' ); } ); subtest( 'enum', sub { my $tc = enum( 'Enum1', values => [qw( a b c )], ); test_constraint( $tc, { accept => [qw( a b c )], reject => [ 'd', 42, 'Foo', Foo->new, 'Baz', Baz->new, $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); } ); done_testing(); Specio-0.50/t/overloading-moose-bug.t0000644000175000017500000000166614755224347017402 0ustar autarchautarch## no critic (Modules::ProhibitMultiplePackages, Moose::RequireCleanNamespace, Moose::RequireMakeImmutable) use strict; use warnings; use Test::Needs { Moose => '2.1207', }; use Test::Fatal; use Test::More 0.96; { package RoleA; use Specio::Library::Builtins; use Moose::Role; has 'A' => ( is => 'rw', isa => t('HashRef'), ); package RoleB; use Moose::Role; with 'RoleA'; package ClassA; use Moose; # The fact that RoleB _already_ has RoleA triggers Moose's internal Role # summation algorithm. That in turn attempts to compare each attribute of # the roles for equality. This requires that the types passed for "isa" in # the attribute definition implement equality comparison overloading if # they are objects. ::is( ::exception { with 'RoleA', 'RoleB' }, undef, 'no exception consuming RoleA and RoleB', ); } done_testing(); Specio-0.50/t/conflicts.t0000644000175000017500000000060614755224347015153 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Specio::Library::XY; require Specio::Library::Conflict; like( exception { Specio::Library::Conflict->import }, qr/\QThe main package already has a type named X/, 'Got an exception when a library import conflicts with already declared types' ); done_testing(); Specio-0.50/t/union.t0000644000175000017500000001674214755224347014327 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Constraint::Union; use Specio::Declare; use Specio::DeclaredAt; use Specio::Library::Builtins; # The test output looks something like this: # # "Attempt to free unreferenced scalar: SV 0xf64bf0 at /home/autarch/perl5/perlbrew/perls/perl-5.12.5/lib/site_perl/5.12.5/Test/Builder.pm line 302." # # But the problem isn't in Test::Builder. It's something to do with # overloading, because it happens when we try to test the non-inlined types # with a NumOverload object. plan skip_all => 'This test triggers some odd overloading bug that causes a segfault on older perls' if $] < 5.014; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my %tests = ( accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), $ARRAY_REF, $ARRAY_OVERLOAD, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], ); subtest( 'unnamed union made of two builtins', sub { my $unnamed_union = Specio::Constraint::Union->new( of => [ t('Int'), t('ArrayRef') ], declared_at => Specio::DeclaredAt->new_from_caller(0), ); ok( $unnamed_union->_has_inline_generator, 'union of two types with inline generator has a generator' ); is( $unnamed_union->name, 'Int | ArrayRef', 'name is generated from constituent types' ); ok( !$unnamed_union->is_anon, 'unnamed union is not anonymous because name is generated' ); is( $unnamed_union->parent, undef, 'parent method returns undef' ); ok( !$unnamed_union->_has_parent, 'union has no parent' ); test_constraint( $unnamed_union, \%tests ); } ); subtest( 'explicitly named union made of two builtins', sub { my $named_union = union( 'MyUnion', of => [ t('Int'), t('ArrayRef') ], ); is( $named_union->name, 'MyUnion', 'name passed to union() is used' ); test_constraint( $named_union, \%tests ); } ); subtest( 'union made of two types without inline generators', sub { my $my_int = anon( parent => t('Num'), constraint => sub { return ( ( defined( $_[0] ) && !ref( $_[0] ) && ( do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val1 = $_[0] ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ) || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '0+' ) && do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val2 = $_[0] + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ); }, ); my $my_arrayref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'ARRAY' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '@{}' ) ) ); }, ); my $no_inline_union = union( of => [ $my_int, $my_arrayref ], ); is( $no_inline_union->name, undef, 'no name if union includes anonymous types', ); ok( $no_inline_union->is_anon, 'union is anonymous if any of its constituents are anonymous' ); test_constraint( $no_inline_union, \%tests ); } ); subtest( 'union made of builtin and type without inline generator', sub { my $my_int = anon( parent => t('Num'), constraint => sub { return ( ( defined( $_[0] ) && !ref( $_[0] ) && ( do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val1 = $_[0] ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ) || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '0+' ) && do { ## no critic (Variables::ProhibitUnusedVarsStricter) ( my $val2 = $_[0] + 0 ) =~ /\A-?[0-9]+(?:[Ee]\+?[0-9]+)?\z/; } ) ); }, ); my $mixed_inline_union = union( of => [ $my_int, t('ArrayRef') ], ); is( $mixed_inline_union->name, undef, 'no name if union includes anonymous types', ); ok( $mixed_inline_union->is_anon, 'union is anonymous if any of its constituents are anonymous' ); test_constraint( $mixed_inline_union, \%tests ); } ); done_testing(); Specio-0.50/t/builtins-sanity.t0000644000175000017500000002012414755224347016322 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Test::Specio qw( builtins_tests describe test_constraint :vars ); use Specio::Library::Builtins; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); my $tests = builtins_tests( $GLOB, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH ); for my $name ( sort keys %{$tests} ) { test_constraint( $name, $tests->{$name} ); } my %ptype_tests = ( Maybe => { accept => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, $UNDEF, ], reject => [ $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, ], }, ScalarRef => { accept => [ \$ZERO, \$ONE, \$INT, \$NEG_INT, \$NUM, \$NEG_NUM, \$EMPTY_STRING, \$STRING, \$NUM_IN_STRING, \$INT_WITH_NL1, \$INT_WITH_NL2, ], reject => [ \$BOOL_OVERLOAD_TRUE, \$BOOL_OVERLOAD_FALSE, \$STR_OVERLOAD_EMPTY, \$STR_OVERLOAD_FULL, \$NUM_OVERLOAD_ZERO, \$NUM_OVERLOAD_ONE, \$NUM_OVERLOAD_NEG, \$NUM_OVERLOAD_NEG_DECIMAL, \$NUM_OVERLOAD_DECIMAL, \$SCALAR_REF, \$SCALAR_REF_REF, \$SCALAR_OVERLOAD, \$ARRAY_REF, \$ARRAY_OVERLOAD, \$HASH_REF, \$HASH_OVERLOAD, \$CODE_REF, \$CODE_OVERLOAD, \$GLOB, \$GLOB_REF, \$GLOB_OVERLOAD, \$GLOB_OVERLOAD_FH, \$FH, \$FH_OBJECT, \$REGEX, \$REGEX_OBJ, \$REGEX_OVERLOAD, \$FAKE_REGEX, \$OBJECT, \$UNDEF, ], }, ArrayRef => { accept => [ [], ( map { [$_] } $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ), ], reject => [ map { [$_] } $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, HashRef => { accept => [ {}, ( map { { foo => $_ } } $ZERO, $ONE, $INT, $NEG_INT, $NUM, $NEG_NUM, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $INT_WITH_NL1, $INT_WITH_NL2, $GLOB, ) ], reject => [ map { { foo => $_ } } $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); # We want to test all parameterized types using a type parameter that actually # checks the value (so not Any or Item). for my $pair ( [ 'Maybe' => \&describe ], [ ScalarRef => sub { 'scalar ref to ' . describe( ${ $_[0] } ) } ], [ ArrayRef => sub { 'array ref to ' . describe( $_[0]->[0] ) } ], [ HashRef => sub { 'hash ref to ' . describe( $_[0]->{foo} ) } ], ) { my ( $ptype, $describe ) = @{$pair}; my $constraint = t( $ptype, of => t('Value') ); test_constraint( $constraint, $ptype_tests{$ptype}, $describe, ); next unless $tests->{$ptype}{reject}; # A parameterized type should reject all of the things that the # unparameterized version rejects. test_constraint( $constraint, { reject => $tests->{$ptype}{reject} }, \&describe, ); } my %substr_test_str = ( ClassName => 'x' . $CLASS_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 for my $type_name (qw( Str Num Int ClassName )) { my $str = $substr_test_str{$type_name} || '123456789123456789'; my $type = t($type_name); my $not_inlined = $type->_constraint_with_parents; my $inlined; if ( $type->can_be_inlined ) { $inlined = $type->_generated_inline_sub; } ok( $type->value_is_valid( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using ->value_is_valid' ); ok( $not_inlined->( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using unoptimized constraint' ); ok( $inlined->( substr( $str, 1, 9 ) ), $type_name . ' accepts return val from substr using inlined constraint' ); # only Str accepts empty strings. next unless $type_name eq 'Str'; ok( $type->value_is_valid( substr( $str, 0, 0 ) ), $type_name . ' accepts empty return val from substr using ->value_is_valid' ); ok( $not_inlined->( 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' ); } done_testing(); Specio-0.50/t/additional-exports.t0000644000175000017500000000146114755224347017001 0ustar autarchautarch## no critic (Modules::ProhibitMultiplePackages) use strict; use warnings; use Test::More 0.96; { package Foo; use parent 'Specio::Exporter'; use Specio::Declare; use Specio::Library::Builtins -reexport; declare( 'FooType', parent => t('Str'), ); sub foo {42} ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines) sub _also_export {'foo'} } { package Bar; Foo->import; ::ok( t('FooType'), 'FooType type was exported by Foo package', ); ::ok( t('Str'), 'built-in types were exported by Foo package', ); ::ok( Bar->can('foo'), 'foo sub was exported by Foo package' ); ::is( Bar->foo, 42, 'Bar->foo returns expected value' ); } done_testing(); Specio-0.50/t/perl-sanity.t0000644000175000017500000000703314755224347015437 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Library::String; my %tests = ( PackageName => { accept => [ $CLASS_NAME, $STR_OVERLOAD_CLASS_NAME, qw( Specio Spec::Library::Builtins strict _Foo A123::456 ), "Has::Chinese::\x{3403}::In::It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo:::Bar Foo: Foo:: Foo::Bar:: ::Foo My-Distro ), 'Has::Spaces In It', ], }, DistName => { accept => [ qw( Specio Spec-Library-Builtins strict _Foo A123-456 ), "Has-Chinese-\x{3403}-In-It" ], reject => [ $EMPTY_STRING, $STR_OVERLOAD_EMPTY, qw( 0Foo Foo:Bar Foo-:Bar Foo: Foo- Foo-Bar- -Foo My::Package ), 'Has-Spaces In It', ], }, Identifier => { accept => [ qw( _ a b c d A B C D Foo Bar _what_ foo_bar f1234 f1j2_o1 ), "\x{3403}", "has_\x{3403}", "has_\x{3403}_in_it", ], reject => [ q{ }, $EMPTY_STRING, 'a b', '4foo', ] }, SafeIdentifier => { accept => [ qw( c d A B C D Foo Bar _what_ foo_bar f1234 f1j2_o1 ), "\x{3403}", "has_\x{3403}", "has_\x{3403}_in_it", ], reject => [ qw( _ a b ), q{ }, $EMPTY_STRING, 'a b', '4foo', ] }, LaxVersionStr => { accept => [ qw( v1.2.3.4 v1.2 1.2.3 1.2345.6 v1.23_4 1.2345 1.2345_01 0.1 v0.1.2 ) ], reject => [ qw( 1.2_3_4 42.a a.b vA.b ), ], }, StrictVersionStr => { accept => [ qw( v1.2.3.4 v1.234.5 2.3456 0.1 v0.1.2 ), ], reject => [ qw( v1.2 1.2345.6 v1.23_4 1.2345_01 ) ], }, ); $tests{ModuleName} = $tests{PackageName}; for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.50/t/integer-edge-case.t0000644000175000017500000000061414755224347016436 0ustar autarchautarchuse strict; use warnings; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; my $int = t('Int'); ok( $int->check(42), '42 is an Int' ); ok( $int->check(42.0), '42.0 is an Int' ); ok( !$int->check(42.5), '42.5 is not an Int' ); ok( !$int->check(124512.000000000123), '124512.000000000123 is not an Int' ); done_testing(); Specio-0.50/t/inheritance.t0000644000175000017500000000112014755224347015450 0ustar autarchautarch## no critic (Modules::ProhibitMultiplePackages) use strict; use warnings; use Test::More 0.96; use Specio::Library::Builtins; # This test is about a bug where a parent class with a t() sub causes the t() # sub to not be added in a child class that uses a type-exporter. { package Parent; use Specio::Library::Builtins; sub type { t('Int'); } } { package Child; use parent -norequire => 'Parent'; use Specio::Library::Builtins; sub type { t('Str'); } } is( Child::type(), t('Str'), 'Child class has a t() sub' ); done_testing(); Specio-0.50/t/map.t0000644000175000017500000000672614755224347013755 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::String; use Specio::Library::Structured; ## no critic (Subroutines::ProtectPrivateSubs) declare( 'UCStr', parent => t('Str'), inline => sub { $_[0]->parent->_inline_check( $_[1] ) . " && $_[1] =~ /^[A-Z]+\$/"; }, ); ## use critic declare( 'UCStrToIntMap', parent => t( 'Map', of => { key => t('UCStr'), value => t('Int'), }, ), ); # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); test_constraint( t('UCStrToIntMap'), { accept => [ { FOO => 42 }, _T::HashOverload->new( { FOO => 42 } ), $HASH_REF, _T::HashOverload->new( {} ), ], reject => [ { foo => 42 }, _T::HashOverload->new( { foo => 42 } ), { FOO => 42.1 }, _T::HashOverload->new( { FOO => 42.1 } ), { FOO => [] }, _T::HashOverload->new( { FOO => [] } ), $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( t( 'Map', of => { key => t('NonEmptyStr'), value => t( 'HashRef', of => t('Int') ), }, )->name, 'Map{ NonEmptyStr => HashRef[Int] }', 'Map type has expected generated name' ); ## no critic (Modules::ProhibitMultiplePackages) { package Declarer; use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured; use parent 'Specio::Exporter'; declare( 'SomeMap', 'parent' => t( 'Map', 'of' => { 'key' => t('Str'), 'value' => t('Str'), } ) ); } { package ImportInto; ::is( ::exception { Declarer->import }, undef, 'No exception thrown when importing a Map type', ); } done_testing(); Specio-0.50/t/parameterized.t0000644000175000017500000000571214755224347016026 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; { my $arrayref = t('ArrayRef'); ok( $arrayref->value_is_valid( [ {}, 42, 'foo' ] ), 'ArrayRef does not care about member types' ); my $from_method = t1($arrayref); for my $pair ( [ filename => __FILE__ ], [ line => 42 ], [ package => 'main' ], [ subroutine => 'main::t1' ], ) { my ( $key, $expect ) = @{$pair}; is( $from_method->declared_at->$key, $expect, "declared_at $key is the expected value for parameterized type made from ->parameterize" ); } my $from_t = t2(); for my $pair ( [ filename => __FILE__ ], [ line => 84 ], [ package => 'main' ], [ subroutine => 'main::t2' ], ) { my ( $key, $expect ) = @{$pair}; is( $from_t->declared_at->$key, $expect, "declared_at $key is the expected value for parameterized type made from calling t" ); } declare( 'ArrayRefOfInt', parent => t( 'ArrayRef', of => t('Int') ), ); ok( t('ArrayRefOfInt'), 'there is an ArrayRefOfInt type declared' ); my $anon = anon( parent => t( 'ArrayRef', of => t('Int') ), ); for my $pair ( [ $from_method, '->parameterize' ], [ $from_t, 't(...)' ], [ t('ArrayRefOfInt'), 'named type' ], [ $anon, 'anon type' ], ) { my ( $arrayref_of_int, $desc ) = @{$pair}; ok( !$arrayref_of_int->value_is_valid( [ {}, 42, 'foo' ] ), "ArrayRef of Int [$desc] does care about member types" ); ok( $arrayref_of_int->value_is_valid( [ -1, 42, 1_000_000 ] ), "ArrayRef of Int [$desc] accepts array ref of all integers" ); ok( !$arrayref_of_int->value_is_valid(42), "ArrayRef of Int [$desc] rejects integer" ); ok( !$arrayref_of_int->value_is_valid( {} ), "ArrayRef of Int [$desc] rejects hashref" ); } } { like( exception { declare( 'MyInt', where => sub { $_[0] =~ /\A-?[0-9]+\z/ }, ); declare( 'ArrayRefOfMyInt', parent => t( 'ArrayRef', of => t('MyInt') ), ); }, qr/\QThe "of" parameter passed to ->parameterize must be an inlinable constraint if the parameterizable type has an inline_generator/, 'A parameterizable type with an inline generator cannot be parameterized with a type that cannot be inlined', ); } done_testing(); sub t1 { my $arrayref = shift; # line 42 return $arrayref->parameterize( of => t('Int') ); } sub t2 { # line 84 return t( 'ArrayRef', of => t('Int') ),; } Specio-0.50/t/union-library.t0000644000175000017500000000046514755224347015764 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Specio::Library::Union; { is( exception { ok( t('Union'), 'type named Union is available' ) }, undef, 'no exception retrieving Union type' ); } done_testing(); Specio-0.50/t/library-with-subs.t0000644000175000017500000000070614755224347016557 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Specio::Library::WithSubs; ok( t('Int'), 'Int type is available' ); ok( t('PositiveInt'), 'PositiveInt type is available' ); ok( __PACKAGE__->can('is_Int'), 'is_Int() was exported from library' ); ok( __PACKAGE__->can('is_PositiveInt'), 'is_PositiveInt() was exported from library' ); done_testing(); Specio-0.50/t/numeric-sanity.t0000644000175000017500000000351214755224347016135 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::More 0.96; use Test::Specio qw( test_constraint ); use Specio::Library::Numeric; my %tests = ( PositiveNum => { accept => [ 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], reject => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], }, PositiveOrZeroNum => { accept => [ 0, 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], reject => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], }, PositiveInt => { accept => [ 1, 2, 3, 2**32, 1e20 ], reject => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, 1.1 ], }, PositiveOrZeroInt => { accept => [ 0, 1, 2, 3, 2**32, 1e20 ], reject => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, 1.1 ], }, NegativeNum => { accept => [ -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], reject => [ 0, 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], }, NegativeOrZeroNum => { accept => [ 0, -1, -1 * ( 2**32 ), -1.2, -0.000000000000001, -1e19, -1.1e10 ], reject => [ 1, 2, 3, 2**32, 1.2, 0.000000000000001, 1e20, 1.1e10 ], }, NegativeInt => { accept => [ -1, -2, -3, -1 * ( 2**32 ), -1e20 ], reject => [ 0, 1, 2**32, -1.2, -0.000000000000001, 1.1, 1.1e10 ], }, NegativeOrZeroInt => { accept => [ 0, -1, -2, -3, -1 * ( 2**32 ), -1e20 ], reject => [ 1, 2**32, -1.2, -0.000000000000001, 1.1, 1.1e10 ], }, SingleDigit => { accept => [ -9 .. 9 ], reject => [ 10, -10, 1.1, -1.1 ], }, ); for my $name ( sort keys %tests ) { test_constraint( $name, $tests{$name} ); } done_testing(); Specio-0.50/t/intersection.t0000644000175000017500000001471414755224347015702 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Constraint::Intersection; use Specio::Declare; use Specio::DeclaredAt; use Specio::Library::Builtins; # The test output looks something like this: # # "Attempt to free unreferenced scalar: SV 0xf64bf0 at /home/autarch/perl5/perlbrew/perls/perl-5.12.5/lib/site_perl/5.12.5/Test/Builder.pm line 302." # # But the problem isn't in Test::Builder. It's something to do with # overloading, because it happens when we try to test the non-inlined types # with a NumOverload object. plan skip_all => 'This test triggers some odd overloading bug that causes a segfault on older perls' if $] < 5.014; # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); { package HashArray; use overload '@{}' => sub { return [ x => 42 ] }; use overload '%{}' => sub { return { x => 42 } }; } my $HASH_ARRAY_OBJECT = bless {}, 'HashArray'; my %tests = ( accept => [$HASH_ARRAY_OBJECT], reject => [ $ZERO, $ONE, $INT, $NEG_INT, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, qw( 1e20 1e100 -1e10 -1e+10 1E20 ), $ARRAY_REF, $ARRAY_OVERLOAD, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $NUM, $NEG_NUM, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $HASH_REF, $HASH_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, qw( 1e-10 -1e-10 1.23456e10 1.23456e-10 -1.23456e10 -1.23456e-10 -1.23456e+10 ), ], ); subtest( 'unnamed intersection made of two builtins', sub { my $unnamed_intersection = Specio::Constraint::Intersection->new( of => [ t('HashRef'), t('ArrayRef') ], declared_at => Specio::DeclaredAt->new_from_caller(0), ); ok( $unnamed_intersection->_has_inline_generator, 'intersection of two types with inline generator has a generator' ); is( $unnamed_intersection->name, 'HashRef & ArrayRef', 'name is generated from constituent types' ); ok( !$unnamed_intersection->is_anon, 'unnamed intersection is not anonymous because name is generated' ); is( $unnamed_intersection->parent, undef, 'parent method returns undef' ); ok( !$unnamed_intersection->_has_parent, 'intersection has no parent' ); test_constraint( $unnamed_intersection, \%tests ); } ); subtest( 'explicitly named intersection made of two builtins', sub { my $named_intersection = intersection( 'MyIntersection', of => [ t('HashRef'), t('ArrayRef') ], ); is( $named_intersection->name, 'MyIntersection', 'name passed to intersection() is used' ); test_constraint( $named_intersection, \%tests ); } ); subtest( 'intersection made of two types without inline generators', sub { my $my_hashref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'HASH' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '%{}' ) ) ); }, ); my $my_arrayref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'ARRAY' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '@{}' ) ) ); }, ); my $no_inline_intersection = intersection( of => [ $my_hashref, $my_arrayref ], ); is( $no_inline_intersection->name, undef, 'no name if intersection includes anonymous types', ); ok( $no_inline_intersection->is_anon, 'intersection is anonymous if any of its constituents are anonymous' ); test_constraint( $no_inline_intersection, \%tests ); } ); subtest( 'intersection made of builtin and type without inline generator', sub { my $my_hashref = anon( parent => t('Ref'), constraint => sub { return ( ref( $_[0] ) eq 'HASH' || ( Scalar::Util::blessed( $_[0] ) && overload::Overloaded( $_[0] ) && defined overload::Method( $_[0], '%{}' ) ) ); }, ); my $mixed_inline_intersection = intersection( of => [ $my_hashref, t('ArrayRef') ], ); is( $mixed_inline_intersection->name, undef, 'no name if intersection includes anonymous types', ); ok( $mixed_inline_intersection->is_anon, 'intersection is anonymous if any of its constituents are anonymous' ); test_constraint( $mixed_inline_intersection, \%tests ); } ); done_testing(); Specio-0.50/t/subs.t0000644000175000017500000000640714755224347014150 0ustar autarchautarchuse strict; use warnings; use FindBin qw( $Bin ); use lib "$Bin/lib"; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( builtins_tests describe :vars ); use Specio::Declare; use Specio::Subs qw( Specio::Library::Builtins Specio::Library::NoInline ); # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); { my $tests = builtins_tests( $GLOB, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH ); for my $name ( sort keys %{$tests} ) { test_subs( $name, $tests->{$name} ); } test_subs( 'IntNI', $tests->{Int} ); } { like( exception { Specio::Subs->import('Specio::Library::CannotSub') }, qr/Cannot use 'My Type' type to create a check sub. It results in an invalid Perl subroutine name/, 'got exception trying to make subs from a library where the types are not valid sub names' ); } subtest( 'coercions', sub { is( exception { Specio::Subs->import('Specio::Library::Coercions') }, undef, 'no exception making subs from library with coercions' ); is( to_IntC( [ 1, 2, 3 ] ), 3, 'to_IntC(ARRAYREF) returns 3' ); is( force_IntC( [ 1, 2, 3 ] ), 3, 'force_IntC(ARRAYREF) returns 3' ); is( to_IntC( { a => 1, b => 2 } ), 2, 'to_IntC(HASHREF) returns 2' ); is( force_IntC( { a => 1, b => 2 } ), 2, 'force_IntC(HASHREF) returns 2' ); is_deeply( to_IntC( \'x' ), \'x', 'to_IntC(SCALARREF) returns original value' ); like( exception { force_IntC( \'x' ) }, qr/Validation failed for type named IntC/, 'force_IntC(SCALARREF) throws exception' ); } ); sub test_subs { my $name = shift; my $tests = shift; my $is_sub = 'is_' . $name; my $is = __PACKAGE__->can($is_sub) or die "No sub named $is_sub in main"; my $assert = __PACKAGE__->can( 'assert_' . $name ); subtest( $name, sub { for my $val ( @{ $tests->{accept} } ) { ok( $is->($val), 'is: ' . describe($val) ); is( exception { $assert->($val) }, undef, 'assert: ' . describe($val) ); } for my $val ( @{ $tests->{reject} } ) { ok( !$is->($val), '!is: ' . describe($val) ); like( exception { $assert->($val) }, qr/Validation failed/, '!assert: ' . describe($val) ); } } ); } done_testing(); Specio-0.50/t/exception.t0000644000175000017500000000127414755224347015167 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Library::Builtins; { my $str = t('Str'); my $e = exception { $str->validate_or_die(undef); }; ok( $e, 'validate_or_die throws something when given a bad value' ); isa_ok( $e, 'Specio::Exception' ); like( $e->message, qr/Validation failed for type named Str .+ with value undef/, 'exception contains expected error' ); $e = exception { $str->validate_or_die( [] ); }; like( $e->message, qr/Validation failed for type named Str .+ with value \[\s*\]/, 'exception contains expected error' ); } done_testing(); Specio-0.50/t/with-moo.t0000644000175000017500000001201014755224347014722 0ustar autarchautarchuse strict; use warnings; use Test::Needs 'Moo'; use Test::Fatal; use Test::More 0.96; { package Foo; use Specio::Declare; use Specio::Library::Builtins; use Moo; ::is( ::exception { has size => ( is => 'ro', isa => t('Int'), ); }, undef, 'no exception passing a Specio object as the isa parameter for a Moo attr' ); has numbers => ( is => 'ro', isa => t( 'ArrayRef', of => t('Int') ), ); my $ucstr = declare( 'UCStr', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr => ( is => 'ro', isa => $ucstr, coerce => $ucstr->coercion_sub, ); my $ucstr2 = declare( 'Ucstr2', parent => t('Str'), inline_as => sub { shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr2, from => t('Str'), using => sub { return uc $_[0] }, ); has ucstr2 => ( is => 'ro', isa => $ucstr2, coerce => $ucstr2->coercion_sub, ); my $ucstr3 = declare( 'Ucstr3', parent => t('Str'), where => sub { $_[0] =~ /^[A-Z]+$/ }, ); coerce( $ucstr3, from => t('Str'), inline_generator => sub { shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr3 => ( is => 'ro', isa => $ucstr3, coerce => $ucstr3->coercion_sub, ); my $ucstr4 = declare( 'Ucstr4', parent => t('Str'), inline_as => sub { shift; my $value_var = shift; return $value_var . ' =~ /^[A-Z]+$/'; }, ); coerce( $ucstr4, from => t('Str'), inline_generator => sub { shift; my $value_var = shift; return 'uc ' . $value_var; }, ); has ucstr4 => ( is => 'ro', isa => $ucstr4, coerce => $ucstr4->coercion_sub, ); } is( exception { Foo->new( size => 42 ) }, undef, 'no exception with new( size => $int )' ); like( exception { Foo->new( size => 'foo' ) }, qr/\QValidation failed for type named Int\E.+\Qwith value "foo"/, 'got exception with new( size => $str )' ); is( exception { Foo->new( numbers => [ 1, 2, 3 ] ) }, undef, 'no exception with new( numbers => [$int, $int, $int] )' ); is( exception { Foo->new( ucstr => 'ABC' ) }, undef, 'no exception with new( ucstr => $ucstr )' ); { my $foo; is( exception { $foo = Foo->new( ucstr => 'abc' ) }, undef, 'no exception with new( ucstr => $lcstr )' ); is( $foo->ucstr, 'ABC', 'ucstr attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr2 => 'abc' ) }, undef, 'no exception with new( ucstr2 => $lcstr )' ); is( $foo->ucstr2, 'ABC', 'ucstr2 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr3 => 'abc' ) }, undef, 'no exception with new( ucstr3 => $lcstr )' ); is( $foo->ucstr3, 'ABC', 'ucstr3 attribute was coerced to upper case' ); } { my $foo; is( exception { $foo = Foo->new( ucstr4 => 'abc' ) }, undef, 'no exception with new( ucstr4 => $lcstr )' ); is( $foo->ucstr4, 'ABC', 'ucstr4 attribute was coerced to upper case' ); } # There was a bug in Specio for any attribute with a type with more than one # coercion. In order to guarantee that it occurs, you need a a class with just # one attribute. { ## no critic (Modules::ProhibitMultiplePackages) package Bar; use Specio::Declare; use Specio::Library::Builtins; use Moo; coerce( t('Str'), from => t('ArrayRef'), inline_generator => sub { shift; my $value_var = shift; return "join q{}, \@{$value_var}"; }, ); coerce( t('Str'), from => t('HashRef'), inline_generator => sub { shift; my $value_var = shift; return "join q{}, keys %{$value_var}"; }, ); has bar => ( is => 'ro', isa => t('Str'), coerce => t('Str')->coercion_sub, ); } { is( exception { Bar->new( bar => ['a'], ) }, undef, q{no exception with Bar->new( bar => ['a'] )} ); is( exception { Bar->new( bar => { a => 1 } ) }, undef, q{no exception with Bar->new( bar => { a => 1 } )} ); } done_testing(); Specio-0.50/t/tuple.t0000644000175000017500000001762214755224347014326 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Test::Specio qw( test_constraint :vars ); use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured; ## no critic (Subroutines::ProtectPrivateSubs) declare( 'UCStr', parent => t('Str'), inline => sub { $_[0]->parent->_inline_check( $_[1] ) . " && $_[1] =~ /^[A-Z]+\$/"; }, ); ## use critic declare( 'Tuple[ UCStr, Int, Str ]', parent => t( 'Tuple', of => [ t('UCStr'), t('Int'), t('Str'), ], ), ); declare( 'Tuple[ UCStr, Int, Str? ]', parent => t( 'Tuple', of => [ t('UCStr'), t('Int'), optional( t('Str') ), ], ), ); declare( 'Tuple[ UCStr, Int, Str?, Str? ]', parent => t( 'Tuple', of => [ t('UCStr'), t('Int'), optional( t('Str') ), optional( t('Str') ), ], ), ); declare( 'Tuple[UCStr, Int, Str...]', parent => t( 'Tuple', of => [ t('UCStr'), t('Int'), slurpy( t('Str') ), ], ), ); # The glob vars only work when they're use in the same package as where # they're declared. Globs are weird. my $GLOB = do { ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; *SOME_GLOB; }; ## no critic (Variables::RequireInitializationForLocalVars) local *FOO; my $GLOB_OVERLOAD = _T::GlobOverload->new( \*FOO ); local *BAR; { ## no critic (InputOutput::ProhibitBarewordFileHandles, InputOutput::RequireBriefOpen) open BAR, '<', $^X or die "Could not open $^X for the test"; } my $GLOB_OVERLOAD_FH = _T::GlobOverload->new( \*BAR ); test_constraint( t('Tuple[ UCStr, Int, Str ]'), { accept => [ [ 'FOO', 42, 'bar' ], ], reject => [ [ 'FOO', 42 ], [ 'FOO', 42, 'bar', 5 ], [ 'foo', 42, 'bar' ], $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); test_constraint( t('Tuple[ UCStr, Int, Str? ]'), { accept => [ [ 'FOO', 42, 'bar' ], [ 'FOO', 42 ], ], reject => [ [ 'FOO', 42, 'bar', 5 ], [ 'foo', 42, 'bar' ], $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); test_constraint( t('Tuple[ UCStr, Int, Str?, Str? ]'), { accept => [ [ 'FOO', 42, 'bar', 'buz' ], [ 'FOO', 42, 'bar' ], [ 'FOO', 42 ], ], reject => [ [ 'FOO', 42, 'bar', [] ], [ 'FOO', 42, [] ], [ 'foo', 42, 'bar' ], $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); test_constraint( t('Tuple[UCStr, Int, Str...]'), { accept => [ [ 'FOO', 42, 'bar' ], [ 'FOO', 42 ], [ 'FOO', 42, ('bar') x 4 ], ], reject => [ [ 'FOO', 42, 'bar', [] ], [ 'foo', 42, 'bar' ], [ 'foo', 42, [] ], $ZERO, $ONE, $BOOL_OVERLOAD_TRUE, $BOOL_OVERLOAD_FALSE, $INT, $NEG_INT, $NUM, $NEG_NUM, $NUM_OVERLOAD_ZERO, $NUM_OVERLOAD_ONE, $NUM_OVERLOAD_NEG, $NUM_OVERLOAD_NEG_DECIMAL, $NUM_OVERLOAD_DECIMAL, $EMPTY_STRING, $STRING, $NUM_IN_STRING, $STR_OVERLOAD_EMPTY, $STR_OVERLOAD_FULL, $INT_WITH_NL1, $INT_WITH_NL2, $SCALAR_REF, $SCALAR_REF_REF, $SCALAR_OVERLOAD, $ARRAY_REF, $ARRAY_OVERLOAD, $CODE_REF, $CODE_OVERLOAD, $GLOB, $GLOB_REF, $GLOB_OVERLOAD, $GLOB_OVERLOAD_FH, $FH, $FH_OBJECT, $REGEX, $REGEX_OBJ, $REGEX_OVERLOAD, $FAKE_REGEX, $OBJECT, $UNDEF, ], }, ); is( t('Tuple[ UCStr, Int, Str ]')->parent->name, 'Tuple[ UCStr, Int, Str ]', 'got expected generated name for simple Tuple' ); is( t('Tuple[ UCStr, Int, Str? ]')->parent->name, 'Tuple[ UCStr, Int, Str? ]', 'got expected generated name for Tuple with optional element' ); is( t('Tuple[UCStr, Int, Str...]')->parent->name, 'Tuple[ UCStr, Int, Str... ]', 'got expected generated name for Tuple with slurpy' ); ## no critic (Modules::ProhibitMultiplePackages) { package Declarer; use Specio::Declare; use Specio::Library::Builtins; use Specio::Library::Structured; use parent 'Specio::Exporter'; declare( 'SomeTuple', 'parent' => t( 'Tuple', 'of' => [ t('Str'), t('Str'), ], ) ); } { package ImportInto; ::is( ::exception { Declarer->import }, undef, 'No exception thrown when importing a Map type', ); } done_testing(); Specio-0.50/t/builtins.t0000644000175000017500000000354614755224347015026 0ustar autarchautarchuse strict; use warnings; use utf8; use open ':encoding(UTF-8)', ':std'; use Test::More 0.96; use Specio::Declare; use Specio::Library::Builtins; use Specio::PartialDump qw( partial_dump ); { my $str = t('Str'); isa_ok( $str, 'Specio::Constraint::Simple' ); like( $str->declared_at->filename, qr/Builtins\.pm/, 'declared_at has the right filename' ); for my $value ( q{}, 'foo', 'bar::baz', "\x{3456}", 0, 42 ) { ok( $str->value_is_valid($value), partial_dump($value) . ' is a valid Str value' ); } ## no critic (TestingAndDebugging::ProhibitNoWarnings) no warnings 'once'; ## use critic my $foo = 'foo'; for my $value ( undef, \42, \$foo, [], {}, sub { }, *glob, \*globref ) { ok( !$str->value_is_valid($value), partial_dump($value) . ' is not a valid Str value' ); } } is( t('Str')->parent->name, 'Value', 'parent of Str is Value' ); my $str_clone = t('Str')->clone; for my $name (qw( Str Value Defined Item )) { ok( t('Str')->is_a_type_of( t($name) ), "Str is_a_type_of($name)" ); next if $name eq 'Str'; ok( $str_clone->is_a_type_of( t($name) ), "Str clone is_a_type_of($name)" ); } for my $name (qw( Maybe ArrayRef Object )) { ok( !t('Str')->is_a_type_of( t($name) ), "Str ! is_a_type_of($name)" ); ok( !$str_clone->is_a_type_of( t($name) ), "Str clone ! is_a_type_of($name)" ); } for my $type ( t('Str'), $str_clone ) { ok( $type->is_same_type_as( t('Str') ), $type->name . ' is_same_type_as Str' ); } { my $child = anon( parent => t('Str') ); ok( $child->can_be_inlined, 'child of builtin with no additional constraint can be inlined' ); } done_testing(); Specio-0.50/t/t-clean.t0000644000175000017500000000040414755224347014506 0ustar autarchautarchuse strict; use warnings; use Test::Needs 'namespace::autoclean'; use Test::More 0.96; { package Foo; use namespace::autoclean; use Specio::Library::Builtins; } ok( !Foo->can('t'), 't sub is cleaned by namespace::autoclean' ); done_testing(); Specio-0.50/t/does-type.t0000644000175000017500000001051014755224347015073 0ustar autarchautarchuse strict; use warnings; use Test::Fatal; use Test::More 0.96; use Specio::Declare; ## no critic (Modules::ProhibitMultiplePackages) { package Class::DoesNoRoles; sub new { return bless {}, shift; } } { package Role::MooseStyle; use Role::Tiny; } { package Class::MooseStyle; use Role::Tiny::With; with 'Role::MooseStyle'; sub new { bless {}, __PACKAGE__; } } { my $any_does_moose = any_does_type( 'AnyDoesMoose', role => 'Role::MooseStyle', ); _test_any_type( $any_does_moose, 'Class::MooseStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMoose', role => 'Role::MooseStyle', ); _test_object_type( $object_does_moose, 'Class::MooseStyle' ); } { is( exception { is( object_does_type('Role::MooseStyle') . q{}, object_does_type('Role::MooseStyle') . q{}, 'object_does_type returns the same type for the same role each time' ); }, undef, 'no exception calling object_does_type repeatedly with the same role name' ); is( exception { is( any_does_type('Role::MooseStyle') . q{}, any_does_type('Role::MooseStyle') . q{}, 'any_does_type returns the same type for the same role each time' ); }, undef, 'no exception calling any_does_type repeatedly with the same role name' ); } SKIP: { skip 'These tests require Mouse and Perl 5.10+', 8 if $] < 5.010000 || !eval { require Mouse; 1 }; ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) eval <<'EOF'; { package Role::MouseStyle; use Mouse::Role; } { package Class::MouseStyle; use Mouse; with 'Role::MouseStyle'; } EOF die $@ if $@; my $any_does_moose = any_does_type( 'AnyDoesMouse', role => 'Role::MouseStyle', ); _test_any_type( $any_does_moose, 'Class::MouseStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMouse', role => 'Role::MouseStyle', ); _test_object_type( $object_does_moose, 'Class::MouseStyle' ); } SKIP: { skip 'These tests require Moo', 8 unless eval { require Moo; 1 }; ## no critic (BuiltinFunctions::ProhibitStringyEval, ErrorHandling::RequireCheckingReturnValueOfEval) eval <<'EOF'; { package Role::MooStyle; use Moo::Role; } { package Class::MooStyle; use Moo; with 'Role::MooStyle'; } EOF ## use critic die $@ if $@; my $any_does_moose = any_does_type( 'AnyDoesMoo', role => 'Role::MooStyle', ); _test_any_type( $any_does_moose, 'Class::MooStyle' ); my $object_does_moose = object_does_type( 'ObjectDoesMoo', role => 'Role::MooStyle', ); _test_object_type( $object_does_moose, 'Class::MooStyle' ); } done_testing(); sub _test_any_type { my $type = shift; my $class_name = shift; my $type_name = $type->name; ok( $type->value_is_valid($class_name), "$class_name class name is valid for $type_name" ); ok( $type->value_is_valid( $class_name->new ), "$class_name object is valid for $type_name" ); ok( !$type->value_is_valid('Class::DoesNoRoles'), "Class::DoesNoRoles class name is not valid for $type_name" ); ok( !$type->value_is_valid( Class::DoesNoRoles->new ), "Class::DoesNoRoles object is not valid for $type_name" ); } sub _test_object_type { my $type = shift; my $class_name = shift; my $type_name = $type->name; ok( !$type->value_is_valid($class_name), "$class_name class name is not valid for $type_name" ); ok( $type->value_is_valid( $class_name->new ), "$class_name object is valid for $type_name" ); ok( !$type->value_is_valid('Class::DoesNoRoles'), "Class::DoesNoRoles class name is not valid for $type_name" ); ok( !$type->value_is_valid( Class::DoesNoRoles->new ), "Class::DoesNoRoles object is not valid for $type_name" ); } Specio-0.50/MANIFEST0000644000175000017500000000520214755224347013665 0ustar autarchautarch# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. CODE_OF_CONDUCT.md CONTRIBUTING.md Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README.md TODO.md azure-pipelines.yml cpanfile dev-bin/install-xt-tools.sh dist.ini git/hooks/pre-commit.sh git/setup.pl lib/Specio.pm lib/Specio/Coercion.pm lib/Specio/Constraint/AnyCan.pm lib/Specio/Constraint/AnyDoes.pm lib/Specio/Constraint/AnyIsa.pm lib/Specio/Constraint/Enum.pm lib/Specio/Constraint/Intersection.pm lib/Specio/Constraint/ObjectCan.pm lib/Specio/Constraint/ObjectDoes.pm lib/Specio/Constraint/ObjectIsa.pm lib/Specio/Constraint/Parameterizable.pm lib/Specio/Constraint/Parameterized.pm lib/Specio/Constraint/Role/CanType.pm lib/Specio/Constraint/Role/DoesType.pm lib/Specio/Constraint/Role/Interface.pm lib/Specio/Constraint/Role/IsaType.pm lib/Specio/Constraint/Simple.pm lib/Specio/Constraint/Structurable.pm lib/Specio/Constraint/Structured.pm lib/Specio/Constraint/Union.pm lib/Specio/Declare.pm lib/Specio/DeclaredAt.pm lib/Specio/Exception.pm lib/Specio/Exporter.pm lib/Specio/Helpers.pm lib/Specio/Library/Builtins.pm lib/Specio/Library/Numeric.pm lib/Specio/Library/Perl.pm lib/Specio/Library/String.pm lib/Specio/Library/Structured.pm lib/Specio/Library/Structured/Dict.pm lib/Specio/Library/Structured/Map.pm lib/Specio/Library/Structured/Tuple.pm lib/Specio/OO.pm lib/Specio/PartialDump.pm lib/Specio/Registry.pm lib/Specio/Role/Inlinable.pm lib/Specio/Subs.pm lib/Specio/TypeChecks.pm lib/Test/Specio.pm perlcriticrc perltidyrc precious.toml t/00-report-prereqs.dd t/00-report-prereqs.t t/additional-exports.t t/anon.t t/any-does-isa.t t/builtins-sanity.t t/builtins.t t/coercion.t t/combines.t t/conflicts.t t/declare-helpers.t t/dict.t t/does-type.t t/exception.t t/import-twice.t t/inheritance.t t/inline-environment.t t/inline.t t/integer-edge-case.t t/intersection.t t/lib/Specio/Library/CannotSub.pm t/lib/Specio/Library/Coercions.pm t/lib/Specio/Library/Combines.pm t/lib/Specio/Library/Conflict.pm t/lib/Specio/Library/NoInline.pm t/lib/Specio/Library/Union.pm t/lib/Specio/Library/WithSubs.pm t/lib/Specio/Library/XY.pm t/library-with-subs.t t/map.t t/multiple-libraries.t t/numeric-sanity.t t/overloading-moose-bug.t t/overloading.t t/parameterized.t t/perl-sanity.t t/string-sanity.t t/subs.t t/t-clean.t t/tuple.t t/union-library.t t/union.t t/with-moo.t t/with-moose.t xt/author/00-compile.t xt/author/eol.t xt/author/mojibake.t xt/author/no-ref-util.t xt/author/no-tabs.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/precious.t xt/author/test-version.t xt/release/cpan-changes.t xt/release/meta-json.t Specio-0.50/INSTALL0000644000175000017500000000447514755224347013600 0ustar autarchautarchThis is the Perl distribution Specio. Installing Specio is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm Specio If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan Specio ## Manual installation As a last resort, you can manually install it. If you have not already downloaded the release tarball, you can find the download link on the module's MetaCPAN page: https://metacpan.org/pod/Specio Untar the tarball, install configure prerequisites (see below), then build it: % perl Makefile.PL % make && make test Then install it: % make install On Windows platforms, you should use `dmake` or `nmake`, instead of `make`. If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib The prerequisites of this distribution will also have to be installed manually. The prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated by running the manual build process described above. ## Configure Prerequisites This distribution requires other modules to be installed before this distribution's installer can be run. They can be found under the "configure_requires" key of META.yml or the "{prereqs}{configure}{requires}" key of META.json. ## Other Prerequisites This distribution may require additional modules to be installed after running Makefile.PL. Look for prerequisites in the following phases: * to run make, PHASE = build * to use the module code itself, PHASE = runtime * to run tests, PHASE = test They can all be found in the "PHASE_requires" key of MYMETA.yml or the "{prereqs}{PHASE}{requires}" key of MYMETA.json. ## Documentation Specio documentation is available as POD. You can run `perldoc` from a shell to read the documentation: % perldoc Specio For more information on installing Perl modules via CPAN, please see: https://www.cpan.org/modules/INSTALL.html Specio-0.50/dist.ini0000644000175000017500000000145714755224347014210 0ustar autarchautarchname = Specio author = Dave Rolsky license = Artistic_2_0 copyright_holder = Dave Rolsky copyright_year = 2012 ; authordep Dist::Zilla::PluginBundle::DROLSKY = 1.22 [@DROLSKY] dist = Specio prereqs_skip = Moo prereqs_skip = Moose prereqs_skip = Mouse prereqs_skip = namespace::autoclean prereqs_skip = Sub::Name prereqs_skip = XString stopwords_file = .stopwords use_github_issues = 1 Test::TidyAll.minimum_perl = 5.010000 -remove = Test::CleanNamespaces -remove = Test::Pod::No404s -remove = Test::Synopsis [Prereqs::Soften] module = Ref::Util module = Sub::Util [Prereqs / DevelopRequires] Moo = 0 Moose = 2.1207 Mouse = 0 namespace::autoclean = 0 Ref::Util = 0.112 Sub::Quote = 0 [DynamicPrereqs] -condition = $] >= 5.010 -body = requires('XString') [MetaNoIndex] directory = t/lib Specio-0.50/precious.toml0000644000175000017500000000303614755224347015265 0ustar autarchautarchexclude = [ ".build/**/*", "Specio-*/**/*", "blib/**/*", "lib/Specio/PartialDump.pm", "t/00-*", "t/author-*", "t/release-*", "t/zzz-*", "xt/**/*", ] [commands.omegasort-gitignore] type = "both" include = "**/.gitignore" cmd = [ "omegasort", "--sort=path" ] lint_flags = "--check" tidy_flags = "--in-place" ok_exit_codes = 0 lint_failure_exit_codes = 1 expect_stderr = true [commands.omegasort-stopwords] type = "both" include = ".stopwords" cmd = [ "omegasort", "--sort=text", "--case-insensitive" ] lint_flags = "--check" tidy_flags = "--in-place" ok_exit_codes = 0 lint_failure_exit_codes = 1 expect_stderr = true [commands.perlcritic] type = "lint" include = [ "**/*.{pl,pm,t,psgi}" ] cmd = [ "perlcritic", "--profile=$PRECIOUS_ROOT/perlcriticrc" ] ok_exit_codes = 0 lint_failure_exit_codes = 2 [commands.perltidy] type = "both" include = [ "**/*.{pl,pm,t,psgi}" ] cmd = [ "perltidy", "--profile=$PRECIOUS_ROOT/perltidyrc" ] lint_flags = [ "--assert-tidy", "--no-standard-output", "--outfile=/dev/null" ] tidy_flags = [ "--backup-and-modify-in-place", "--backup-file-extension=/" ] ok_exit_codes = 0 lint_failure_exit_codes = 2 expect_stderr = true [commands.podchecker] type = "lint" include = [ "**/*.{pl,pm,pod}" ] cmd = [ "podchecker", "--warnings", "--warnings" ] ok_exit_codes = [ 0, 2 ] lint_failure_exit_codes = 1 expect_stderr = true [commands.podtidy] type = "tidy" include = [ "**/*.{pl,pm,pod}" ] cmd = [ "podtidy", "--columns", "80", "--inplace", "--nobackup" ] ok_exit_codes = 0 lint_failure_exit_codes = 1 Specio-0.50/azure-pipelines.yml0000644000175000017500000000132514755224347016375 0ustar autarchautarchresources: repositories: - repository: ci-perl-helpers type: github name: houseabsolute/ci-perl-helpers endpoint: houseabsolute stages: - template: templates/helpers/build.yml@ci-perl-helpers parameters: debug: true - template: templates/helpers/linux.yml@ci-perl-helpers parameters: coverage: codecov debug: true include_threads: true test_xt: true use_default_perls: true - template: templates/helpers/macos.yml@ci-perl-helpers parameters: debug: true include_threads: true use_default_perls: true - template: templates/helpers/windows.yml@ci-perl-helpers parameters: debug: true use_default_perls: true Specio-0.50/dev-bin/0000775000175000017500000000000014755224347014063 5ustar autarchautarchSpecio-0.50/dev-bin/install-xt-tools.sh0000755000175000017500000000075614755224347017665 0ustar autarchautarch#!/bin/sh set -e TARGET="$HOME/bin" if [ $(id -u) -eq 0 ]; then TARGET="/usr/local/bin" fi echo "Installing dev tools to $TARGET" mkdir -p $TARGET curl --silent --location \ https://raw.githubusercontent.com/houseabsolute/ubi/master/bootstrap/bootstrap-ubi.sh | sh "$TARGET/ubi" --project houseabsolute/precious --in "$TARGET" "$TARGET/ubi" --project houseabsolute/omegasort --in "$TARGET" echo "Add $TARGET to your PATH in order to use precious for linting and tidying"