This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.043_03
in repository libtype-tiny-perl.

commit aa38236f88ad3b09b939c40a268e207c21bedf7b
Author: Toby Inkster <m...@tobyinkster.co.uk>
Date:   Sat Apr 26 16:18:20 2014 +0100

    some initial my_method stuff
---
 lib/Type/Tiny.pm                      |  11 ++++
 lib/Types/Standard.pm                 | 120 ++++++++++++++++++++++++++++++++++
 t/20-unit/Types-Standard/structured.t |  95 +++++++++++++++++++++++++++
 3 files changed, 226 insertions(+)

diff --git a/lib/Type/Tiny.pm b/lib/Type/Tiny.pm
index 295e669..caa17c3 100644
--- a/lib/Type/Tiny.pm
+++ b/lib/Type/Tiny.pm
@@ -180,6 +180,17 @@ sub new
        
        $self->{type_constraints} ||= undef;
        
+       if ($params{my_methods} and eval { require Sub::Name })
+       {
+               for my $key (keys %{$params{my_methods}})
+               {
+                       Sub::Name::subname(
+                               sprintf("%s::my_%s", $self->qualified_name, 
$key),
+                               $params{my_methods}{$key},
+                       );
+               }
+       }
+       
        return $self;
 }
 
diff --git a/lib/Types/Standard.pm b/lib/Types/Standard.pm
index d3ff007..15b92fb 100644
--- a/lib/Types/Standard.pm
+++ b/lib/Types/Standard.pm
@@ -297,6 +297,24 @@ my $_hash = $meta->add_type({
        inline_generator     => LazyLoad(HashRef => 'inline_generator'),
        deep_explanation     => LazyLoad(HashRef => 'deep_explanation'),
        coercion_generator   => LazyLoad(HashRef => 'coercion_generator'),
+       my_methods => {
+               hashref_allows_key => sub {
+                       my $self = shift;
+                       Str()->check($_[0]);
+               },
+               hashref_allows_value => sub {
+                       my $self = shift;
+                       my ($key, $value) = @_;
+                       
+                       return !!0 unless $self->my_hashref_allows_key($key);
+                       return !!1 if $self==HashRef();
+                       
+                       my $href  = $self->find_parent(sub { $_->has_parent && 
$_->parent==HashRef() });
+                       my $param = $href->type_parameter;
+                       
+                       Str()->check($key) and $param->check($value);
+               },
+       },
 });
 
 $meta->add_type({
@@ -372,6 +390,32 @@ my $_map = $meta->add_type({
        inline_generator     => LazyLoad(Map => 'inline_generator'),
        deep_explanation     => LazyLoad(Map => 'deep_explanation'),
        coercion_generator   => LazyLoad(Map => 'coercion_generator'),
+       my_methods => {
+               hashref_allows_key => sub {
+                       my $self = shift;
+                       my ($key) = @_;
+                       
+                       return Str()->check($key) if $self==Map();
+                       
+                       my $map = $self->find_parent(sub { $_->has_parent && 
$_->parent==Map() });
+                       my ($kcheck, $vcheck) = @{ $map->parameters };
+                       
+                       ($kcheck or Any())->check($key);
+               },
+               hashref_allows_value => sub {
+                       my $self = shift;
+                       my ($key, $value) = @_;
+                       
+                       return !!0 unless $self->my_hashref_allows_key($key);
+                       return !!1 if $self==Map();
+                       
+                       my $map = $self->find_parent(sub { $_->has_parent && 
$_->parent==Map() });
+                       my ($kcheck, $vcheck) = @{ $map->parameters };
+                       
+                       ($kcheck or Any())->check($key)
+                               and ($vcheck or Any())->check($value);
+               },
+       },
 });
 
 my $_Optional = $meta->add_type({
@@ -447,6 +491,82 @@ $meta->add_type({
        inline_generator     => LazyLoad(Dict => 'inline_generator'),
        deep_explanation     => LazyLoad(Dict => 'deep_explanation'),
        coercion_generator   => LazyLoad(Dict => 'coercion_generator'),
+       my_methods => {
+               dict_is_slurpy => sub
+               {
+                       my $self = shift;
+                       
+                       return !!0 if $self==Dict();
+                       
+                       my $dict = $self->find_parent(sub { $_->has_parent && 
$_->parent==Dict() });
+                       ref($dict->parameters->[-1]) eq q(HASH)
+                               ? $dict->parameters->[-1]{slurpy}
+                               : !!0
+               },
+               hashref_allows_key => sub
+               {
+                       my $self = shift;
+                       my ($key) = @_;
+                       
+                       return Str()->check($key) if $self==Dict();
+                       
+                       my $dict = $self->find_parent(sub { $_->has_parent && 
$_->parent==Dict() });
+                       my %params;
+                       my $slurpy = $dict->my_dict_is_slurpy;
+                       if ($slurpy)
+                       {
+                               my @args = @{$dict->parameters};
+                               pop @args;
+                               %params = @args;
+                       }
+                       else
+                       {
+                               %params = @{ $dict->parameters }
+                       }
+                       
+                       return !!1
+                               if exists($params{$key});
+                       return !!0
+                               if !$slurpy;
+                       return Str()->check($key)
+                               if $slurpy==Any() || $slurpy==Item() || 
$slurpy==Defined() || $slurpy==Ref();
+                       return $slurpy->my_hashref_allows_key($key)
+                               if $slurpy->is_a_type_of(HashRef());
+                       return !!0;
+               },
+               hashref_allows_value => sub
+               {
+                       my $self = shift;
+                       my ($key, $value) = @_;
+                       
+                       return !!0 unless $self->my_hashref_allows_key($key);
+                       return !!1 if $self==Dict();
+                       
+                       my $dict = $self->find_parent(sub { $_->has_parent && 
$_->parent==Dict() });
+                       my %params;
+                       my $slurpy = $dict->my_dict_is_slurpy;
+                       if ($slurpy)
+                       {
+                               my @args = @{$dict->parameters};
+                               pop @args;
+                               %params = @args;
+                       }
+                       else
+                       {
+                               %params = @{ $dict->parameters }
+                       }
+                       
+                       return !!1
+                               if exists($params{$key}) && 
$params{$key}->check($value);
+                       return !!0
+                               if !$slurpy;
+                       return !!1
+                               if $slurpy==Any() || $slurpy==Item() || 
$slurpy==Defined() || $slurpy==Ref();
+                       return $slurpy->my_hashref_allows_value($key, $value)
+                               if $slurpy->is_a_type_of(HashRef());
+                       return !!0;
+               },
+       },
 });
 
 use overload ();
diff --git a/t/20-unit/Types-Standard/structured.t 
b/t/20-unit/Types-Standard/structured.t
index 3df25d3..0f8b814 100644
--- a/t/20-unit/Types-Standard/structured.t
+++ b/t/20-unit/Types-Standard/structured.t
@@ -162,5 +162,100 @@ should_fail({ foo => 4.2, bar => 6.66, baz => "x" }, 
$gazetteer);
 should_fail({ foo => undef, baz => "x" }, $gazetteer);
 should_fail({ baz => "x" }, $gazetteer);
 
+subtest my_dict_is_slurpy => sub
+{
+       ok(!$struct5->my_dict_is_slurpy, 'On a non-slurpy Dict');
+       ok($gazetteer->my_dict_is_slurpy, 'On a slurpy Dict');
+       ok(!$struct5->create_child_type->my_dict_is_slurpy, 'On a child of a 
non-slurpy Dict');
+       ok($gazetteer->create_child_type->my_dict_is_slurpy, 'On a child of a 
slurpy Dict');
+};
+
+subtest my_hashref_allows_key => sub
+{
+       ok(HashRef->my_hashref_allows_key('foo'), 'HashRef allows key "foo"');
+       ok(!HashRef->my_hashref_allows_key(undef), 'HashRef disallows key 
undef');
+       ok(!HashRef->my_hashref_allows_key([]), 'HashRef disallows key []');
+       ok((HashRef[Int])->my_hashref_allows_key('foo'), 'HashRef[Int] allows 
key "foo"');
+       ok(!(HashRef[Int])->my_hashref_allows_key(undef), 'HashRef[Int] 
disallows key undef');
+       ok(!(HashRef[Int])->my_hashref_allows_key([]), 'HashRef[Int] disallows 
key []');
+       ok(Map->my_hashref_allows_key('foo'), 'Map allows key "foo"');
+       ok(!Map->my_hashref_allows_key(undef), 'Map disallows key undef');
+       ok(!Map->my_hashref_allows_key([]), 'Map disallows key []');
+       ok(!(Map[Int,Int])->my_hashref_allows_key('foo'), 'Map[Int,Int] 
disallows key "foo"');
+       ok(!(Map[Int,Int])->my_hashref_allows_key(undef), 'Map[Int,Int] 
disallows key undef');
+       ok(!(Map[Int,Int])->my_hashref_allows_key([]), 'Map[Int,Int] disallows 
key []');
+       ok((Map[Int,Int])->my_hashref_allows_key('42'), 'Map[Int,Int] allows 
key "42"');
+       ok(Dict->my_hashref_allows_key('foo'), 'Dict allows key "foo"');
+       ok(!Dict->my_hashref_allows_key(undef), 'Dict disallows key undef');
+       ok(!Dict->my_hashref_allows_key([]), 'Dict disallows key []');
+       ok(!(Dict[])->my_hashref_allows_key('foo'), 'Dict[] disallows key 
"foo"');
+       ok(!(Dict[])->my_hashref_allows_key(undef), 'Dict[] disallows key 
undef');
+       ok(!(Dict[])->my_hashref_allows_key([]), 'Dict[] disallows key []');
+       ok(!(Dict[bar=>Int])->my_hashref_allows_key('foo'), 'Dict[bar=>Int] 
disallows key "foo"');
+       ok((Dict[bar=>Int])->my_hashref_allows_key('bar'), 'Dict[bar=>Int] 
allows key "bar"');
+       ok(!(Dict[bar=>Int])->my_hashref_allows_key(undef), 'Dict[bar=>Int] 
disallows key undef');
+       ok(!(Dict[bar=>Int])->my_hashref_allows_key([]), 'Dict[bar=>Int] 
disallows key []');
+       ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('foo'), 
'Dict[bar=>Int,slurpy Any] allows key "foo"');
+       ok((Dict[bar=>Int, slurpy Any])->my_hashref_allows_key('bar'), 
'Dict[bar=>Int,slurpy Any] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key(undef), 
'Dict[bar=>Int,slurpy Any] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy Any])->my_hashref_allows_key([]), 
'Dict[bar=>Int,slurpy Any] disallows key []');
+       ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('foo'), 
'Dict[bar=>Int,slurpy Ref] allows key "foo"');
+       ok((Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key('bar'), 
'Dict[bar=>Int,slurpy Ref] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key(undef), 
'Dict[bar=>Int,slurpy Ref] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy Ref])->my_hashref_allows_key([]), 
'Dict[bar=>Int,slurpy Ref] disallows key []');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->my_hashref_allows_key('foo'), 'Dict[bar=>Int,slurpy 
Map[Int,Int]] disallows key "foo"');
+       ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('bar'), 
'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->my_hashref_allows_key(undef), 'Dict[bar=>Int,slurpy 
Map[Int,Int]] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key([]), 
'Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []');
+       ok((Dict[bar=>Int, slurpy Map[Int,Int]])->my_hashref_allows_key('42'), 
'Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"');
+       ok(HashRef->create_child_type->my_hashref_allows_key('foo'), 'A child 
of HashRef allows key "foo"');
+       ok(!HashRef->create_child_type->my_hashref_allows_key(undef), 'A child 
of HashRef disallows key undef');
+       ok(!HashRef->create_child_type->my_hashref_allows_key([]), 'A child of 
HashRef disallows key []');
+       ok((HashRef[Int])->create_child_type->my_hashref_allows_key('foo'), 'A 
child of HashRef[Int] allows key "foo"');
+       ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key(undef), 'A 
child of HashRef[Int] disallows key undef');
+       ok(!(HashRef[Int])->create_child_type->my_hashref_allows_key([]), 'A 
child of HashRef[Int] disallows key []');
+       ok(Map->create_child_type->my_hashref_allows_key('foo'), 'A child of 
Map allows key "foo"');
+       ok(!Map->create_child_type->my_hashref_allows_key(undef), 'A child of 
Map disallows key undef');
+       ok(!Map->create_child_type->my_hashref_allows_key([]), 'A child of Map 
disallows key []');
+       ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key('foo'), 'A 
child of Map[Int,Int] disallows key "foo"');
+       ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key(undef), 'A 
child of Map[Int,Int] disallows key undef');
+       ok(!(Map[Int,Int])->create_child_type->my_hashref_allows_key([]), 'A 
child of Map[Int,Int] disallows key []');
+       ok((Map[Int,Int])->create_child_type->my_hashref_allows_key('42'), 'A 
child of Map[Int,Int] allows key "42"');
+       ok(Dict->create_child_type->my_hashref_allows_key('foo'), 'A child of 
Dict allows key "foo"');
+       ok(!Dict->create_child_type->my_hashref_allows_key(undef), 'A child of 
Dict disallows key undef');
+       ok(!Dict->create_child_type->my_hashref_allows_key([]), 'A child of 
Dict disallows key []');
+       ok(!(Dict[])->create_child_type->my_hashref_allows_key('foo'), 'A child 
of Dict[] disallows key "foo"');
+       ok(!(Dict[])->create_child_type->my_hashref_allows_key(undef), 'A child 
of Dict[] disallows key undef');
+       ok(!(Dict[])->create_child_type->my_hashref_allows_key([]), 'A child of 
Dict[] disallows key []');
+       ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key('foo'), 
'A child of Dict[bar=>Int] disallows key "foo"');
+       ok((Dict[bar=>Int])->create_child_type->my_hashref_allows_key('bar'), 
'A child of Dict[bar=>Int] allows key "bar"');
+       ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key(undef), 
'A child of Dict[bar=>Int] disallows key undef');
+       ok(!(Dict[bar=>Int])->create_child_type->my_hashref_allows_key([]), 'A 
child of Dict[bar=>Int] disallows key []');
+       ok((Dict[bar=>Int, slurpy 
Any])->create_child_type->my_hashref_allows_key('foo'), 'A child of 
Dict[bar=>Int,slurpy Any] allows key "foo"');
+       ok((Dict[bar=>Int, slurpy 
Any])->create_child_type->my_hashref_allows_key('bar'), 'A child of 
Dict[bar=>Int,slurpy Any] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy 
Any])->create_child_type->my_hashref_allows_key(undef), 'A child of 
Dict[bar=>Int,slurpy Any] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy 
Any])->create_child_type->my_hashref_allows_key([]), 'A child of 
Dict[bar=>Int,slurpy Any] disallows key []');
+       ok((Dict[bar=>Int, slurpy 
Ref])->create_child_type->my_hashref_allows_key('foo'), 'A child of 
Dict[bar=>Int,slurpy Ref] allows key "foo"');
+       ok((Dict[bar=>Int, slurpy 
Ref])->create_child_type->my_hashref_allows_key('bar'), 'A child of 
Dict[bar=>Int,slurpy Ref] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy 
Ref])->create_child_type->my_hashref_allows_key(undef), 'A child of 
Dict[bar=>Int,slurpy Ref] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy 
Ref])->create_child_type->my_hashref_allows_key([]), 'A child of 
Dict[bar=>Int,slurpy Ref] disallows key []');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_key('foo'), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "foo"');
+       ok((Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_key('bar'), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar"');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_key(undef), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] disallows key undef');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_key([]), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] disallows key []');
+       ok((Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_key('42'), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] allows key "42"');
+};
+
+# This could probably be expanded...
+subtest my_hashref_allows_value => sub
+{
+       ok(HashRef->my_hashref_allows_value(foo => "bar"), 'HashRef allows key 
"foo" with value "bar"');
+       ok(HashRef->my_hashref_allows_value(foo => undef), 'HashRef allows key 
"foo" with value undef');
+       ok(!HashRef->my_hashref_allows_value(undef, "bar"), 'HashRef disallows 
key undef with value "bar"');
+       ok(!(HashRef[Int])->my_hashref_allows_value(foo => "bar"), 
'HashRef[Int] disallows key "foo" with value "bar"');
+       ok((Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_value(bar => 42), 'A child 
of Dict[bar=>Int,slurpy Map[Int,Int]] allows key "bar" with value 42');
+       ok((Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_value(21, 42), 'A child of 
Dict[bar=>Int,slurpy Map[Int,Int]] allows key "21" with value 42');
+       ok(!(Dict[bar=>Int, slurpy 
Map[Int,Int]])->create_child_type->my_hashref_allows_value(baz => 42), 'A child 
of Dict[bar=>Int,slurpy Map[Int,Int]] disallows key "baz" with value 42');
+};
 
 done_testing;

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libtype-tiny-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to