Browse files

Merge branch 'master' into mx_types_introspection

* master: (29 commits)
  Stop mentioning the deprecated MX::Method, as requested by its author.
  Remove a dead code path.
  Hakim contributed some tests.
  UnTODO passing tests.
  "does coerce" is the documented way of coercing params.
  added test for hashref default
  test that optional params really are optional
  Fix reporting of previous compile time errors
  Reduce bug down to test that fails with just MXMS
  Add test case that generates 'BEGIN not safe after errors' with no other message
  Testing that eval works with semicolon insertion (e.g. EndOfScope hook)
  Update prereqs.
  Version 0.10.
  Refer to Method::Signatures::Simple.
  Allow method names to be quoted strings with possible variable interpolations.
  use style;
  Move generation of injectable code into the meta method.
  Remove dummy method body.
  Steffen provided valuable feedback and testing.
  Don't construct the meta method twice.
  ...

Conflicts:
	lib/MooseX/Method/Signatures.pm
  • Loading branch information...
2 parents 8446696 + 1794b8e commit 17f656295587c39bce12e529bc7e3d7354b95dac @rafl committed Mar 3, 2009
Showing with 497 additions and 228 deletions.
  1. +10 −0 Changes
  2. +1 −0 MANIFEST.SKIP
  3. +2 −0 Makefile.PL
  4. +97 −182 lib/MooseX/Method/Signatures.pm
  5. +258 −19 lib/MooseX/Method/Signatures/Meta/Method.pm
  6. +12 −0 t/errors.t
  7. +12 −5 t/eval.t
  8. +18 −0 t/lib/InvalidCase01.pm
  9. +32 −0 t/meta.t
  10. +13 −0 t/quoted_name.t
  11. +22 −22 t/signatures.t
  12. +20 −0 t/sigs-optional.t
View
10 Changes
@@ -1,3 +1,13 @@
+0.10 Sat, 28 Feb 2009 19:04:02 +0100
+ * Mention all contributors.
+ * Update copyright notice for 2009.
+ * Refer to Method::Signatures::Simple.
+ * Move most of the actual functionality into the method metaclass.
+ * Allow adding methods with signature validation without the
+ Devel::Declare sugar.
+ * Allow method names to be quoted strings with possible variable
+ interpolations.
+
0.09 Mon, 23 Feb 2009 08:07:47 +0100
* Port to MX::Types::Structured.
+ Much more useful error messages, including backtraces.
View
1 MANIFEST.SKIP
@@ -7,3 +7,4 @@
^cover_db\b
blib\b
^issues\b
+^t/sigs-optional.t$
View
2 Makefile.PL
@@ -15,6 +15,8 @@ requires 'MooseX::Types' => '0.09';
requires 'MooseX::Types::Moose';
requires 'MooseX::Types::Structured' => '0.07';
requires 'namespace::clean';
+requires 'Task::Weaken';
+requires 'Text::Balanced';
test_requires 'Test::Exception';
View
279 lib/MooseX/Method/Signatures.pm
@@ -4,31 +4,18 @@ use warnings;
package MooseX::Method::Signatures;
use Moose;
-use Carp qw/croak/;
use Devel::Declare ();
-use Parse::Method::Signatures;
+use B::Hooks::EndOfScope;
use Moose::Meta::Class;
-use Moose::Util::TypeConstraints;
-use Moose::Util qw/does_role/;
-use MooseX::Types::Util qw/has_available_type_export/;
-use MooseX::Types::Moose qw/Str Defined Maybe Object ArrayRef/;
-use MooseX::Types::Structured qw/Dict Tuple Optional/;
-use aliased 'Parse::Method::Signatures::Param::Named';
+use Text::Balanced qw/extract_quotelike/;
use MooseX::Method::Signatures::Meta::Method;
use namespace::clean -except => 'meta';
-our $VERSION = '0.09';
+our $VERSION = '0.10';
extends qw/Moose::Object Devel::Declare::MethodInstaller::Simple/;
-has target => (
- is => 'ro',
- isa => Str,
- init_arg => 'into',
- required => 1,
-);
-
sub import {
my ($class) = @_;
my $caller = caller();
@@ -38,200 +25,108 @@ sub import {
sub setup_for {
my ($class, $pkg) = @_;
- $class->install_methodhandler(
- into => $pkg,
- name => 'method',
- );
-
- return;
-}
-
-sub param_to_spec {
- my ($self, $param) = @_;
-
- my $tc = Defined;
- $tc = $param->meta_type_constraint
- if $param->has_type_constraints;
-
- if ($param->has_constraints) {
- my $cb = join ' && ', map { "sub {${_}}->(\\\@_)" } $param->constraints;
- my $code = eval "sub {${cb}}";
- $tc = subtype($tc, $code);
- }
-
- my %spec;
- $spec{tc} = $param->required
- ? $tc
- : does_role($param, Named)
- ? Optional[$tc]
- : Maybe[$tc];
+ my $ctx = $class->new(into => $pkg);
- $spec{default} = $param->default_value
- if $param->has_default_value;
+ Devel::Declare->setup_for($pkg, {
+ method => { const => sub { $ctx->parser(@_) } },
+ });
- if ($param->has_traits) {
- for my $trait (@{ $param->param_traits }) {
- next unless $trait->[1] eq 'coerce';
- $spec{coerce} = 1;
- }
+ {
+ no strict 'refs';
+ *{ "${pkg}::method" } = sub {};
}
- return \%spec;
+ return;
}
-sub parse_proto {
- my ($self, $proto) = @_;
- $proto ||= '';
-
- my $vars = q{};
- my (@named, @positional);
-
- my $sig = Parse::Method::Signatures->signature(
- input => "(${proto})",
- type_constraint_callback => sub {
- my ($tc, $name) = @_;
- return has_available_type_export($self->target, $name)
- || $tc->find_registered_constraint($name);
- },
- );
- croak "Invalid method signature (${proto})"
- unless $sig;
-
- if ($sig->has_invocant) {
- my $invocant = $sig->invocant;
- $vars .= $invocant->variable_name . q{,};
- push @positional, $self->param_to_spec($invocant);
- }
- else {
- $vars .= '$self,';
- push @positional, { tc => Object };
- }
-
- if ($sig->has_positional_params) {
- for my $param ($sig->positional_params) {
- $vars .= $param->variable_name . q{,};
- push @positional, $self->param_to_spec($param);
- }
- }
-
- if ($sig->has_named_params) {
- for my $param ($sig->named_params) {
- $vars .= $param->variable_name . q{,};
- push @named, $param->label => $self->param_to_spec($param);
- }
- }
-
- my $tc = Tuple[
- Tuple[ map { $_->{tc} } @positional ],
- Dict[ map { ref $_ ? $_->{tc} : $_ } @named ],
- ];
+override strip_name => sub {
+ my ($self) = @_;
+ my $ret = super;
+ return $ret if defined $ret;
- my $coerce_param = sub {
- my ($spec, $value) = @_;
- return $value unless exists $spec->{coerce};
- return $spec->{tc}->coerce($value);
- };
+ my $line = $self->get_linestr;
+ my $offset = $self->offset;
+ my ($str) = extract_quotelike(substr($line, $offset));
+ return unless defined $str;
- my %named = @named;
-
- coerce $tc,
- from ArrayRef,
- via {
- my (@positional_args, %named_args);
-
- my $i = 0;
- for my $param (@positional) {
- push @positional_args,
- $#{ $_ } < $i
- ? (exists $param->{default} ? $param->{default} : ())
- : $coerce_param->($param, $_->[$i]);
- $i++;
- }
-
- unless ($#{ $_ } < $i) {
- my %rest = @{ $_ }[$i .. $#{ $_ }];
- while (my ($key, $spec) = each %named) {
- if (exists $rest{$key}) {
- $named_args{$key} = $coerce_param->($spec, delete $rest{$key});
- next;
- }
-
- if (exists $spec->{default}) {
- $named_args{$key} = $spec->{default};
- }
- }
-
- @named_args{keys %rest} = values %rest;
- }
-
- return [\@positional_args, \%named_args];
- };
-
- return ($sig, $vars, [@positional, @named], $tc);
-}
+ substr($line, $offset, length $str) = '';
+ $self->set_linestr($line);
-sub inject_parsed_proto {
- my ($self, $vars) = @_;
- return "my (${vars}) = \@_;";
-}
+ return \$str;
+};
sub parser {
+ local $@; # Keep any previous compile errors from getting stepped on.
my $self = shift;
$self->init(@_);
$self->skip_declarator;
my $name = $self->strip_name;
my $proto = $self->strip_proto;
- my $attrs = $self->strip_attrs;
- my ($sig, $vars, $param_spec, $tc) = $self->parse_proto($proto);
- my $inject = $self->inject_parsed_proto($vars);
+ my $attrs = $self->strip_attrs || '';
- if (defined $name) {
- $inject = $self->scope_injector_call() . $inject;
- }
+ my $method = MooseX::Method::Signatures::Meta::Method->wrap(
+ signature => q{(} . ($proto || '') . q{)},
+ );
- $self->inject_if_block($inject, $attrs ? "sub ${attrs} " : '');
+ my $after_block = q{, };
+ $after_block .= ref $name ? ${$name} : qq{q[${name}]}
+ if defined $name;
+ $after_block .= q{;};
- my $pkg;
- my $meth_name = defined $name
- ? $name
- : '__ANON__';
+ my $inject = $method->injectable_code;
+ $inject = $self->scope_injector_call($after_block) . $inject
+ if defined $name;
- if ($meth_name =~ /::/) {
- ($pkg, $meth_name) = $meth_name =~ /^(.*)::([^:]+)$/;
- }
- else {
- $pkg = $self->get_curstash_name;
- }
+ $self->inject_if_block($inject, "sub ${attrs} ");
+
+ my $compile_stash = $self->get_curstash_name;
my $create_meta_method = sub {
- my ($code) = @_;
- return MooseX::Method::Signatures::Meta::Method->wrap(
- _signature => $sig,
- _param_spec => $param_spec,
- body => $code,
- package_name => $pkg,
- name => $meth_name,
- type_constraint => $tc,
- );
+ my ($code, $pkg, $meth_name) = @_;
+ $method->_set_actual_body($code);
+ $method->_set_package_name($pkg);
+ $method->_set_name($meth_name);
+ return $method;
};
if (defined $name) {
- $self->shadow(sub (&) {
- my ($code) = @_;
- my $meth = $create_meta_method->($code);
+ $self->shadow(sub {
+ my ($code, $name) = @_;
+
+ my $pkg = $compile_stash;
+ ($pkg, $name) = $name =~ /^(.*)::([^:]+)$/
+ if $name =~ /::/;
+
+ my $meth = $create_meta_method->($code, $pkg, $name);
my $meta = Moose::Meta::Class->initialize($pkg);
- $meta->add_method($meth_name => $meth);
+ $meta->add_method($name => $meth);
return;
});
}
else {
- $self->shadow(sub (&) {
- return $create_meta_method->(shift);
+ $self->shadow(sub {
+ return $create_meta_method->(shift, $compile_stash, '__ANON__');
});
}
}
+sub scope_injector_call {
+ my ($self, $code) = @_;
+ return qq[BEGIN { ${\ref $self}->inject_scope('${code}') }];
+}
+
+sub inject_scope {
+ my ($class, $inject) = @_;
+ on_scope_end {
+ my $line = Devel::Declare::get_linestr();
+ return unless defined $line;
+ my $offset = Devel::Declare::get_linestr_offset();
+ substr($line, $offset, 0) = $inject;
+ Devel::Declare::set_linestr($line);
+ };
+}
+
__PACKAGE__->meta->make_immutable;
1;
@@ -494,9 +389,9 @@ method/subroutine within a role.
=head1 SEE ALSO
-L<Method::Signatures>
+L<Method::Signatures::Simple>
-L<MooseX::Method>
+L<Method::Signatures>
L<Perl6::Subs>
@@ -506,18 +401,38 @@ L<Parse::Method::Signatures>
L<Moose>
+=head1 AUTHOR
+
+Florian Ragwitz E<lt>rafl@debian.orgE<gt>
+
+With contributions from:
+
+=over 4
+
+=item Hakim Cassimally E<lt>hakim.cassimally@gmail.comE<gt>
+
+=item Jonathan Scott Duff E<lt>duff@pobox.comE<gt>
+
+=item Kent Fredric E<lt>kentfredric@gmail.comE<gt>
+
+=item Rhesa Rozendaal E<lt>rhesa@cpan.orgE<gt>
+
+=item Ricardo SIGNES E<lt>rjbs@cpan.orgE<gt>
+
+=item Steffen Schwigon E<lt>ss5@renormalist.netE<gt>
+
+=item Yanick Champoux E<lt>yanick@babyl.dyndns.orgE<gt>
+
+=back
+
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2008 Florian Ragwitz
+Copyright (c) 2008, 2009 Florian Ragwitz
Code based on the tests for L<Devel::Declare>.
Documentation based on L<MooseX::Method> and L<Method::Signatures>.
Licensed under the same terms as Perl itself.
-=head1 AUTHOR
-
-Florian Ragwitz E<lt>rafl@debian.orgE<gt>
-
=cut
View
277 lib/MooseX/Method/Signatures/Meta/Method.pm
@@ -1,50 +1,289 @@
package MooseX::Method::Signatures::Meta::Method;
use Moose;
-use MooseX::Types::Moose qw/ArrayRef/;
+use Parse::Method::Signatures;
+use Scalar::Util qw/weaken/;
+use Moose::Util qw/does_role/;
+use Moose::Util::TypeConstraints;
+use MooseX::Types::Util qw/has_available_type_export/;
+use MooseX::Types::Structured qw/Tuple Dict Optional/;
+use MooseX::Types::Moose qw/ArrayRef Str Maybe Object Defined CodeRef/;
+use aliased 'Parse::Method::Signatures::Param::Named';
use namespace::clean -except => 'meta';
extends 'Moose::Meta::Method';
-has _signature => (
+has signature => (
is => 'ro',
- isa => 'Parse::Method::Signatures::Sig',
+ isa => Maybe[Str],
required => 1,
);
-has _param_spec => (
- is => 'ro',
- isa => ArrayRef,
- required => 1,
- auto_deref => 1,
+has _parsed_signature => (
+ is => 'ro',
+ isa => class_type('Parse::Method::Signatures::Sig'),
+ lazy => 1,
+ builder => '_build__parsed_signature',
+);
+
+has _lexicals => (
+ is => 'ro',
+ isa => ArrayRef[Str],
+ lazy => 1,
+ builder => '_build__lexicals',
+);
+
+has injectable_code => (
+ is => 'ro',
+ isa => Str,
+ lazy => 1,
+ builder => '_build_injectable_code',
+);
+
+has _positional_args => (
+ is => 'ro',
+ isa => ArrayRef,
+ lazy => 1,
+ builder => '_build__positional_args',
+);
+
+has _named_args => (
+ is => 'ro',
+ isa => ArrayRef,
+ lazy => 1,
+ builder => '_build__named_args',
);
has type_constraint => (
- is => 'ro',
- required => 1,
+ is => 'ro',
+ lazy => 1,
+ builder => '_build_type_constraint',
);
-around wrap => sub {
- my ($orig, $class, %args) = @_;
+has actual_body => (
+ is => 'ro',
+ isa => CodeRef,
+ writer => '_set_actual_body',
+ predicate => '_has_actual_body',
+);
+
+before actual_body => sub {
+ my ($self) = @_;
+ confess "method doesn't have an actual body yet"
+ unless $self->_has_actual_body;
+};
+
+around package_name => sub {
+ my ($next, $self) = @_;
+ my $ret = $self->$next;
+ confess "method doesn't have a package_name yet"
+ unless defined $ret;
+ return $ret;
+};
+
+around name => sub {
+ my ($next, $self) = @_;
+ my $ret = $self->$next;
+ confess "method doesn't have a name yet"
+ unless defined $ret;
+ return $ret;
+};
+
+sub _set_name {
+ my ($self, $name) = @_;
+ $self->{name} = $name;
+}
+
+sub _set_package_name {
+ my ($self, $package_name) = @_;
+ $self->{package_name} = $package_name;
+}
+
+sub wrap {
+ my ($class, %args) = @_;
+
+ $args{actual_body} = delete $args{body}
+ if exists $args{body};
+
my $self;
- $self = $orig->($class, %args, body => sub {
+ $self = $class->_new(%args, body => sub {
@_ = $self->validate(\@_);
- goto $args{body};
+ goto &{ $self->actual_body };
});
+
+ weaken($self->{associated_metaclass})
+ if $self->{associated_metaclass};
+
return $self;
};
+sub _build__parsed_signature {
+ my ($self) = @_;
+ return Parse::Method::Signatures->signature(
+ input => $self->signature,
+ type_constraint_callback => sub {
+ my ($tc, $name) = @_;
+ return has_available_type_export($self->package_name, $name)
+ || $tc->find_registered_constraint($name);
+ },
+ );
+}
+
+sub _param_to_spec {
+ my ($self, $param) = @_;
+
+ my $tc = Defined;
+ $tc = $param->meta_type_constraint
+ if $param->has_type_constraints;
+
+ if ($param->has_constraints) {
+ my $cb = join ' && ', map { "sub {${_}}->(\\\@_)" } $param->constraints;
+ my $code = eval "sub {${cb}}";
+ $tc = subtype($tc, $code);
+ }
+
+ my %spec;
+ $spec{tc} = $param->required
+ ? $tc
+ : does_role($param, Named)
+ ? Optional[$tc]
+ : Maybe[$tc];
+
+ $spec{default} = $param->default_value
+ if $param->has_default_value;
+
+ if ($param->has_traits) {
+ for my $trait (@{ $param->param_traits }) {
+ next unless $trait->[1] eq 'coerce';
+ $spec{coerce} = 1;
+ }
+ }
+
+ return \%spec;
+}
+
+sub _build__lexicals {
+ my ($self) = @_;
+ my ($sig) = $self->_parsed_signature;
+
+ my @lexicals;
+ push @lexicals, $sig->has_invocant
+ ? $sig->invocant->variable_name
+ : '$self';
+
+ if ($sig->has_positional_params) {
+ push @lexicals, $_->variable_name for $sig->positional_params;
+ }
+
+ if ($sig->has_named_params) {
+ push @lexicals, $_->variable_name for $sig->named_params;
+ }
+
+ return \@lexicals;
+}
+
+sub _build_injectable_code {
+ my ($self) = @_;
+ my $vars = join q{,}, @{ $self->_lexicals };
+ return "my (${vars}) = \@_;";
+}
+
+sub _build__positional_args {
+ my ($self) = @_;
+ my $sig = $self->_parsed_signature;
+
+ my @positional;
+
+ push @positional, $sig->has_invocant
+ ? $self->_param_to_spec($sig->invocant)
+ : { tc => Object };
+
+ if ($sig->has_positional_params) {
+ for my $param ($sig->positional_params) {
+ push @positional, $self->_param_to_spec($param);
+ }
+ }
+
+ return \@positional;
+}
+
+sub _build__named_args {
+ my ($self) = @_;
+ my $sig = $self->_parsed_signature;
+
+ my @named;
+
+ if ($sig->has_named_params) {
+ for my $param ($sig->named_params) {
+ push @named, $param->label => $self->_param_to_spec($param);
+ }
+ }
+
+ return \@named;
+}
+
+sub _build_type_constraint {
+ my ($self) = @_;
+ my ($positional, $named) = map { $self->$_ } map { "_${_}_args" } qw/positional named/;
+
+ my $tc = Tuple[
+ Tuple[ map { $_->{tc} } @{ $positional } ],
+ Dict[ map { ref $_ ? $_->{tc} : $_ } @{ $named } ],
+ ];
+
+ my $coerce_param = sub {
+ my ($spec, $value) = @_;
+ return $value unless exists $spec->{coerce};
+ return $spec->{tc}->coerce($value);
+ };
+
+ my %named = @{ $named };
+
+ coerce $tc,
+ from ArrayRef,
+ via {
+ my (@positional_args, %named_args);
+
+ my $i = 0;
+ for my $param (@{ $positional }) {
+ push @positional_args,
+ $#{ $_ } < $i
+ ? (exists $param->{default} ? $param->{default} : ())
+ : $coerce_param->($param, $_->[$i]);
+ $i++;
+ }
+
+ unless ($#{ $_ } < $i) {
+ my %rest = @{ $_ }[$i .. $#{ $_ }];
+ while (my ($key, $spec) = each %named) {
+ if (exists $rest{$key}) {
+ $named_args{$key} = $coerce_param->($spec, delete $rest{$key});
+ next;
+ }
+
+ if (exists $spec->{default}) {
+ $named_args{$key} = $spec->{default};
+ }
+ }
+
+ @named_args{keys %rest} = values %rest;
+ }
+
+ return [\@positional_args, \%named_args];
+ };
+
+ return $tc;
+}
+
sub validate {
my ($self, $args) = @_;
- my @param_spec = $self->_param_spec;
- my @named = grep { !ref $_ } @param_spec;
+ my @named = grep { !ref $_ } @{ $self->_named_args };
my $coerced = $self->type_constraint->coerce($args);
- if ($coerced == $args) {
- confess 'failed to coerce';
- }
+ confess 'failed to coerce'
+ if $coerced == $args;
if (defined (my $msg = $self->type_constraint->validate($coerced))) {
confess $msg;
View
12 t/errors.t
@@ -0,0 +1,12 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+use Test::Exception;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+eval "use InvalidCase01;";
+ok($@, "Got an error");
+unlike($@, qr/^BEGIN not safe after errors--compilation aborted/s, "Sane error message")
+ and diag $@;
View
17 t/eval.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 1; # last test to print
+use Test::More tests => 3; # last test to print
use MooseX::Method::Signatures;
@@ -18,13 +18,20 @@ ok(
},
'Basic Eval Moose'
);
+
+my $foo = foo->new({});
+is ($foo->example (), 1, 'First method declared');
+is ($foo->example2(), 2, 'Second method declared (after injected semicolon)');
+
__DATA__
{
- package foo;
+ package foo;
- use Moose;
+ use Moose;
use MooseX::Method::Signatures;
- method example {
- }
+ method example { 1 } # look Ma, no semicolon!
+ method example2 { 2 }
}
1;
+
+
View
18 t/lib/InvalidCase01.pm
@@ -0,0 +1,18 @@
+use MooseX::Method::Signatures;
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+
+method meth1{
+ croak "Binary operator $op expects 2 children, got " . $#$_
+ if @{$_} > 3;
+}
+
+method meth2{ {
+ "a" "b"
+}
+
+method meth3 {}
+1;
+
View
32 t/meta.t
@@ -0,0 +1,32 @@
+use strict;
+use warnings;
+use Test::More tests => 3;
+use Test::Exception;
+
+use MooseX::Method::Signatures::Meta::Method;
+
+{
+ package Foo;
+ use metaclass;
+
+ my $method = MooseX::Method::Signatures::Meta::Method->wrap(
+ signature => '($class: Int :$foo, Str :$bar)',
+ package_name => 'Foo',
+ name => 'bar',
+ body => sub {
+ my ($class, $foo, $bar) = @_;
+ return $bar x $foo;
+ },
+ );
+ ::isa_ok($method, 'Moose::Meta::Method');
+
+ Foo->meta->add_method(bar => $method);
+}
+
+lives_and(sub {
+ is(Foo->bar(foo => 3, bar => 'baz'), 'bazbazbaz');
+});
+
+dies_ok(sub {
+ Foo->bar(foo => 'moo', bar => 'baz');
+});
View
13 t/quoted_name.t
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More tests => 2;
+
+use MooseX::Method::Signatures;
+
+my $foo = 'bar';
+
+method "$foo" ($class:) { $foo }
+
+my $meth = __PACKAGE__->can($foo);
+ok($meth);
+is(__PACKAGE__->$meth, $foo);
View
44 t/signatures.t
@@ -49,48 +49,48 @@ my @signatures;
[ 0, '$arg does coerce', 'COERCE Postional ' ], # 20
# coerce is tests
- [ 0, 'Str $arg is coerce', 'COERCE_IS Positional String Type' ], #21
- [ 0, 'Int $arg is coerce ', 'COERCE_IS Positional Int Type' ],
- [ 0, 'Bar::Foo $arg is coerce', 'COERCE_IS Positi Class Type' ],
- [ 0, 'Str :$arg is coerce', 'COERCE_IS Named String Type' ],
- [ 0, 'Int :$arg is coerce', 'COERCE_IS Named Int Type' ],
- [ 0, 'Bar::Foo :$arg is coerce', 'COERCE_IS Named Class Type' ],
- [ 0, ':$arg is coerce', 'COERCE_IS Named ' ],
- [ 0, '$arg is coerce', 'COERCE_IS Postional ' ], # 28
+ [ 0, 'Str $arg does coerce', 'COERCE_IS Positional String Type' ], #21
+ [ 0, 'Int $arg does coerce ', 'COERCE_IS Positional Int Type' ],
+ [ 0, 'Bar::Foo $arg does coerce', 'COERCE_IS Positi Class Type' ],
+ [ 0, 'Str :$arg does coerce', 'COERCE_IS Named String Type' ],
+ [ 0, 'Int :$arg does coerce', 'COERCE_IS Named Int Type' ],
+ [ 0, 'Bar::Foo :$arg does coerce', 'COERCE_IS Named Class Type' ],
+ [ 0, ':$arg does coerce', 'COERCE_IS Named ' ],
+ [ 0, '$arg does coerce', 'COERCE_IS Postional ' ], # 28
# coerce is where tests
[
- $ISTODO,
- 'Str $arg is coerce where { 1 } ',
+ 0,
+ 'Str $arg does coerce where { 1 } ',
'COERCE_WHERE Positional String Type'
], #29
[
- $ISTODO,
- 'Int $arg is coerce where { 1 } ',
+ 0,
+ 'Int $arg does coerce where { 1 } ',
'COERCE_WHERE Positional Int Type'
],
[
- $ISTODO,
- 'Bar::Foo $arg is coerce where { 1 }',
+ 0,
+ 'Bar::Foo $arg does coerce where { 1 }',
'COERCE_WHERE Positi Class Type'
],
[
- $ISTODO,
- 'Str :$arg is coerce where { 1 }',
+ 0,
+ 'Str :$arg does coerce where { 1 }',
'COERCE_WHERE Named String Type'
],
[
- $ISTODO,
- 'Int :$arg is coerce where { 1 }',
+ 0,
+ 'Int :$arg does coerce where { 1 }',
'COERCE_WHERE Named Int Type'
],
[
- $ISTODO,
- 'Bar::Foo :$arg is coerce where { 1 }',
+ 0,
+ 'Bar::Foo :$arg does coerce where { 1 }',
'COERCE_WHERE Named Class Type'
],
- [ $ISTODO, ':$arg is coerce where { 1 } ', 'COERCE_WHERE Named ' ],
- [ $ISTODO, '$arg is coerce where { 1 }', 'COERCE_WHERE Postional ' ], # 36
+ [ 0, ':$arg does coerce where { 1 } ', 'COERCE_WHERE Named ' ],
+ [ 0, '$arg does coerce where { 1 }', 'COERCE_WHERE Postional ' ], # 36
# where tests
[ 0, 'Str $arg where { 1 } ', 'WHERE Positional String Type' ], #37
View
20 t/sigs-optional.t
@@ -0,0 +1,20 @@
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+{
+ package Optional;
+ use MooseX::Method::Signatures;
+ method foo ($class: $arg?) {
+ $arg;
+ }
+
+ method bar ($class: $hr = {}) {
+ ++$hr->{bar};
+ }
+}
+
+is( Optional->foo(), undef);
+is( Optional->foo(1), 1);
+is( Optional->bar(), 1);
+is( Optional->bar({bar=>1}), 2);

0 comments on commit 17f6562

Please sign in to comment.