diff options
Diffstat (limited to 'lib/Type/Tiny.pm')
| -rw-r--r-- | lib/Type/Tiny.pm | 105 |
1 files changed, 103 insertions, 2 deletions
diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm index 2caa4541..c53c3011 100644 --- a/lib/Type/Tiny.pm +++ b/lib/Type/Tiny.pm @@ -10,13 +10,72 @@ BEGIN { BEGIN { $Type::Tiny::AUTHORITY = 'cpan:TOBYINK'; - $Type::Tiny::VERSION = '2.000001'; + $Type::Tiny::VERSION = '2.002000'; $Type::Tiny::XS_VERSION = '0.016'; } $Type::Tiny::VERSION =~ tr/_//d; $Type::Tiny::XS_VERSION =~ tr/_//d; +our @InternalPackages = qw( + Devel::TypeTiny::Perl56Compat + Devel::TypeTiny::Perl58Compat + Error::TypeTiny + Error::TypeTiny::Assertion + Error::TypeTiny::Compilation + Error::TypeTiny::WrongNumberOfParameters + Eval::TypeTiny + Eval::TypeTiny::CodeAccumulator + Eval::TypeTiny::Sandbox + Exporter::Tiny + Reply::Plugin::TypeTiny + Test::TypeTiny + Type::Coercion + Type::Coercion::FromMoose + Type::Coercion::Union + Type::Library + Type::Params + Type::Params::Alternatives + Type::Params::Parameter + Type::Params::Signature + Type::Parser + Type::Parser::AstBuilder + Type::Parser::Token + Type::Parser::TokenStream + Type::Registry + Types::Common + Types::Common::Numeric + Types::Common::String + Types::Standard + Types::Standard::_Stringable + Types::Standard::ArrayRef + Types::Standard::CycleTuple + Types::Standard::Dict + Types::Standard::HashRef + Types::Standard::Map + Types::Standard::ScalarRef + Types::Standard::StrMatch + Types::Standard::Tied + Types::Standard::Tuple + Types::TypeTiny + Type::Tie + Type::Tie::ARRAY + Type::Tie::BASE + Type::Tie::HASH + Type::Tie::SCALAR + Type::Tiny + Type::Tiny::_DeclaredType + Type::Tiny::_HalfOp + Type::Tiny::Class + Type::Tiny::ConsrtainedObject + Type::Tiny::Duck + Type::Tiny::Enum + Type::Tiny::Intersection + Type::Tiny::Role + Type::Tiny::Union + Type::Utils +); + use Scalar::Util qw( blessed ); use Types::TypeTiny (); @@ -244,6 +303,19 @@ sub new { $params{$_} = $params{$_} . '' if defined $params{$_}; } + my $level = 0; + while ( not exists $params{definition_context} and $level < 20 ) { + our $_TT_GUTS ||= do { + my $g = join '|', map quotemeta, grep !m{^Types::}, @InternalPackages; + qr/\A(?:$g)\z/o + }; + my $package = caller $level; + if ( $package !~ $_TT_GUTS ) { + @{ $params{definition_context} = {} }{ qw/ package file line / } = caller $level; + } + ++$level; + } + if ( exists $params{parent} ) { $params{parent} = ref( $params{parent} ) =~ /^Type::Tiny\b/ @@ -364,9 +436,20 @@ sub new { ) for keys %{ $params{my_methods} }; } #/ if ( $params{my_methods...}) + # In general, mutating a type constraint after it's been created + # is a bad idea and will probably not work. However some places are + # especially harmful and can lead to confusing errors, so allow + # subclasses to lock down particular keys. + # + $self->_lockdown( sub { + &Internals::SvREADONLY( $_, !!1 ) for @_; + } ); + return $self; } #/ sub new +sub _lockdown {} + sub DESTROY { my $self = shift; delete( $ALL_TYPES{ $self->{uniq} } ); @@ -553,6 +636,14 @@ sub _build_compiled_check { }; } #/ sub _build_compiled_check +sub definition_context { + my $self = shift; + my $found = $self->find_parent(sub { + ref $_->{definition_context} and exists $_->{definition_context}{file}; + }); + $found ? $found->{definition_context} : {}; +} + sub find_constraining_type { my $self = shift; if ( $self->_is_null_constraint and $self->has_parent ) { @@ -1983,6 +2074,16 @@ Coderef to validate a value (C<< $_[0] >>) against the type constraint. This coderef is expected to also handle all validation for the parent type constraints. +=item C<< definition_context >> + +Hashref of information indicating where the type constraint was originally +defined. Type::Tiny will generate this based on C<caller> if you do not +supply it. The hashref will ordinarily contain keys C<"package">, C<"file">, +and C<"line">. + +For parameterized types and compound types (e.g. unions and intersections), +this may not be especially meaningful information. + =item C<< complementary_type >> A complementary type for this type. For example, the complementary type @@ -2626,7 +2727,7 @@ Thanks to Matt S Trout for advice on L<Moo> integration. =head1 COPYRIGHT AND LICENCE -This software is copyright (c) 2013-2014, 2017-2022 by Toby Inkster. +This software is copyright (c) 2013-2014, 2017-2023 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. |