Hello community, here is the log from the commit of package perl-Moo for openSUSE:Factory checked in at 2013-10-07 08:31:49 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Moo (Old) and /work/SRC/openSUSE:Factory/.perl-Moo.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Moo" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Moo/perl-Moo.changes 2013-07-29 17:49:53.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Moo.new/perl-Moo.changes 2013-10-07 08:31:50.000000000 +0200 @@ -1,0 +2,14 @@ +Fri Oct 4 09:15:28 UTC 2013 - [email protected] + +- updated to 1.003001 + - abbreviate class names from created by create_class_with_roles if they are + too long for perl to handle (RT#83248) + - prevent destructors from failing in global destruction for certain + combinations of Moo and Moose classes subclassing each other (RT#87810) + - clarify in docs that Sub::Quote's captured variables are copies, not aliases + - fix infinite recursion if an isa check fails due to another isa check + (RT#87575) + - fix Sub::Quote and Sub::Defer under threads (RT#87043) + - better diagnostics when bad parameters given to has + +------------------------------------------------------------------- Old: ---- Moo-1.003000.tar.gz New: ---- Moo-1.003001.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Moo.spec ++++++ --- /var/tmp/diff_new_pack.Bz23Et/_old 2013-10-07 08:31:50.000000000 +0200 +++ /var/tmp/diff_new_pack.Bz23Et/_new 2013-10-07 08:31:50.000000000 +0200 @@ -17,14 +17,14 @@ Name: perl-Moo -Version: 1.003000 +Version: 1.003001 Release: 0 %define cpan_name Moo Summary: Minimalist Object Orientation (with Moose compatibility) License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/Moo/ -Source: http://www.cpan.org/authors/id/H/HA/HAARG/%{cpan_name}-%{version}.tar.gz +Source: http://www.cpan.org/authors/id/M/MS/MSTROUT/%{cpan_name}-%{version}.tar.gz BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl @@ -33,7 +33,7 @@ BuildRequires: perl(Devel::GlobalDestruction) >= 0.11 BuildRequires: perl(Dist::CheckConflicts) >= 0.02 BuildRequires: perl(Module::Runtime) >= 0.012 -BuildRequires: perl(Role::Tiny) >= 1.003000 +BuildRequires: perl(Role::Tiny) >= 1.003002 BuildRequires: perl(Test::Fatal) >= 0.003 BuildRequires: perl(Test::More) >= 0.94 BuildRequires: perl(strictures) >= 1.004003 @@ -41,7 +41,7 @@ Requires: perl(Devel::GlobalDestruction) >= 0.11 Requires: perl(Dist::CheckConflicts) >= 0.02 Requires: perl(Module::Runtime) >= 0.012 -Requires: perl(Role::Tiny) >= 1.003000 +Requires: perl(Role::Tiny) >= 1.003002 Requires: perl(strictures) >= 1.004003 %{perl_requires} ++++++ Moo-1.003000.tar.gz -> Moo-1.003001.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/Changes new/Moo-1.003001/Changes --- old/Moo-1.003000/Changes 2013-07-15 19:25:29.000000000 +0200 +++ new/Moo-1.003001/Changes 2013-09-10 14:57:54.000000000 +0200 @@ -1,3 +1,14 @@ +1.003001 - 2013-09-10 + - abbreviate class names from created by create_class_with_roles if they are + too long for perl to handle (RT#83248) + - prevent destructors from failing in global destruction for certain + combinations of Moo and Moose classes subclassing each other (RT#87810) + - clarify in docs that Sub::Quote's captured variables are copies, not aliases + - fix infinite recursion if an isa check fails due to another isa check + (RT#87575) + - fix Sub::Quote and Sub::Defer under threads (RT#87043) + - better diagnostics when bad parameters given to has + 1.003000 - 2013-07-15 - fix composing roles that require methods provided by the other (RT#82711) - document optional use of Class::XSAccessor with caveats diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/MANIFEST new/Moo-1.003001/MANIFEST --- old/Moo-1.003000/MANIFEST 2013-07-15 19:25:54.000000000 +0200 +++ new/Moo-1.003001/MANIFEST 2013-09-10 14:59:04.000000000 +0200 @@ -20,8 +20,10 @@ maint/bump-version maint/fulltest maint/Makefile.PL.include +maint/mkfat +maint/travis-perlbrew Makefile.PL -MANIFEST This list of files +MANIFEST t/accessor-coerce.t t/accessor-default.t t/accessor-generator-extension.t @@ -78,11 +80,14 @@ t/not-both.t t/overloaded-coderefs.t t/sub-and-handles.t +t/sub-defer-threads.t t/sub-defer.t +t/sub-quote-threads.t t/sub-quote.t t/subconstructor.t t/undef-bug.t t/use-after-no.t +xt/global-destruct-jenga.t xt/handle_moose.t xt/implicit-moose-types.t xt/jenga.t @@ -115,6 +120,8 @@ xt/more-jenga.t xt/super-jenga.t xt/test-my-dependents.t +xt/type-inflate-coercion.t +xt/type-inflate.t xt/withautoclean.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/META.json new/Moo-1.003001/META.json --- old/Moo-1.003000/META.json 2013-07-15 19:25:54.000000000 +0200 +++ new/Moo-1.003001/META.json 2013-09-10 14:59:04.000000000 +0200 @@ -4,7 +4,7 @@ "mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560", + "generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.131560", "license" : [ "perl_5" ], @@ -30,13 +30,26 @@ "ExtUtils::MakeMaker" : "0" } }, + "develop" : { + "requires" : { + "Class::XSAccessor" : "0", + "Moose" : "0", + "MooseX::Types::Common::Numeric" : "0", + "Mouse" : "0", + "bareword::filehandles" : "0", + "indirect" : "0", + "multidimensional" : "0", + "namespace::autoclean" : "0", + "namespace::clean" : "0" + } + }, "runtime" : { "requires" : { "Class::Method::Modifiers" : "1.1", "Devel::GlobalDestruction" : "0.11", "Dist::CheckConflicts" : "0.02", "Module::Runtime" : "0.012", - "Role::Tiny" : "1.003", + "Role::Tiny" : "1.003002", "perl" : "v5.8.1", "strictures" : "1.004003" } @@ -51,8 +64,8 @@ "release_status" : "stable", "resources" : { "bugtracker" : { - "mailto" : "[email protected]", - "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Moo"; + "mailto" : "[email protected]", + "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Moo"; }, "license" : [ "http://dev.perl.org/licenses/"; @@ -64,7 +77,7 @@ }, "x_IRC" : "irc://irc.perl.org/#moose" }, - "version" : "1.003000", + "version" : "1.003001", "x_breaks" : { "HTML::Restrict" : "2.1.5" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/META.yml new/Moo-1.003001/META.yml --- old/Moo-1.003000/META.yml 2013-07-15 19:25:53.000000000 +0200 +++ new/Moo-1.003001/META.yml 2013-09-10 14:59:04.000000000 +0200 @@ -9,7 +9,7 @@ Dist::CheckConflicts: 0.02 ExtUtils::MakeMaker: 0 dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560' +generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.131560' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -25,14 +25,14 @@ Devel::GlobalDestruction: 0.11 Dist::CheckConflicts: 0.02 Module::Runtime: 0.012 - Role::Tiny: 1.003 + Role::Tiny: 1.003002 perl: v5.8.1 strictures: 1.004003 resources: IRC: irc://irc.perl.org/#moose - bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Moo + bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Moo license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/gitmo/Moo.git -version: 1.003000 +version: 1.003001 x_breaks: HTML::Restrict: 2.1.5 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/Makefile.PL new/Moo-1.003001/Makefile.PL --- old/Moo-1.003000/Makefile.PL 2013-07-15 05:48:24.000000000 +0200 +++ new/Moo-1.003001/Makefile.PL 2013-09-10 14:53:16.000000000 +0200 @@ -21,7 +21,7 @@ 'Class::Method::Modifiers' => 1.10, # or RT#80194 'strictures' => 1.004003, 'Module::Runtime' => 0.012, # for RT#74789 - 'Role::Tiny' => 1.003000, + 'Role::Tiny' => 1.003002, 'Devel::GlobalDestruction' => 0.11, # for RT#78617 'Dist::CheckConflicts' => 0.02, ); @@ -29,6 +29,7 @@ my %extra_info = ( 'meta-spec' => { version => 2 }, resources => { + # r/w: [email protected]:Moo.git repository => { url => 'git://git.shadowcat.co.uk/gitmo/Moo.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/Moo.git', @@ -36,8 +37,8 @@ }, x_IRC => 'irc://irc.perl.org/#moose', bugtracker => { - web => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Moo', - mailto => '[email protected]', + web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Moo', + mailto => '[email protected]', }, license => [ 'http://dev.perl.org/licenses/' ], }, @@ -46,6 +47,12 @@ build => { requires => { %BUILD_DEPS } }, test => { requires => { %TEST_DEPS } }, runtime => { requires => { %RUN_DEPS, perl => '5.8.1' } }, + develop => { requires => { map { $_ => 0 } qw( + Class::XSAccessor + indirect multidimensional bareword::filehandles + Moose Mouse namespace::clean namespace::autoclean + MooseX::Types::Common::Numeric + ) } }, }, ); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/README new/Moo-1.003001/README --- old/Moo-1.003000/README 2013-07-15 19:25:54.000000000 +0200 +++ new/Moo-1.003001/README 2013-09-10 14:59:04.000000000 +0200 @@ -315,7 +315,7 @@ is to do something like the following: coerce => sub { - $_[0] + 1 unless $_[0] % 2 + $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that Moo will always fire your coercion: this is to permit "isa" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Method/Generate/Accessor.pm new/Moo-1.003001/lib/Method/Generate/Accessor.pm --- old/Moo-1.003000/lib/Method/Generate/Accessor.pm 2013-07-11 19:14:42.000000000 +0200 +++ new/Moo-1.003001/lib/Method/Generate/Accessor.pm 2013-09-10 14:57:13.000000000 +0200 @@ -21,12 +21,14 @@ sub _SIGDIE { our ($CurrentAttribute, $OrigSigDie); - $OrigSigDie ||= sub { die $_[0] }; + my $sigdie = $OrigSigDie && $OrigSigDie != \&_SIGDIE + ? $OrigSigDie + : sub { die $_[0] }; - return $OrigSigDie->(@_) if ref($_[0]); + return $sigdie->(@_) if ref($_[0]); my $attr_desc = _attr_desc(@$CurrentAttribute{qw(name init_arg)}); - $OrigSigDie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]"); + $sigdie->("$CurrentAttribute->{step} for $attr_desc failed: $_[0]"); } sub _die_overwrite diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Moo/HandleMoose.pm new/Moo-1.003001/lib/Moo/HandleMoose.pm --- old/Moo-1.003000/lib/Moo/HandleMoose.pm 2013-07-11 03:12:47.000000000 +0200 +++ new/Moo-1.003001/lib/Moo/HandleMoose.pm 2013-09-10 14:57:13.000000000 +0200 @@ -192,6 +192,10 @@ $meta->find_method_by_name('new'), 'Moo::HandleMoose::FakeConstructor', ); + # a combination of Moo and Moose may bypass a Moo constructor but still + # use a Moo DEMOLISHALL. We need to make sure this is loaded before + # global destruction. + require Method::Generate::DemolishAll; } $meta->add_role(Class::MOP::class_of($_)) for grep !/\|/ && $_ ne $name, # reject Foo|Bar and same-role-as-self diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Moo/Role.pm new/Moo-1.003001/lib/Moo/Role.pm --- old/Moo-1.003000/lib/Moo/Role.pm 2013-07-15 05:26:52.000000000 +0200 +++ new/Moo-1.003001/lib/Moo/Role.pm 2013-09-10 14:57:13.000000000 +0200 @@ -5,6 +5,9 @@ use Role::Tiny (); use base qw(Role::Tiny); +our $VERSION = '1.003001'; +$VERSION = eval $VERSION; + require Moo::sification; BEGIN { *INFO = \%Role::Tiny::INFO } @@ -27,12 +30,18 @@ } $INFO{$target} ||= {}; # get symbol table reference - my $stash = do { no strict 'refs'; \%{"${target}::"} }; + my $stash = _getstash($target); _install_tracked $target => has => sub { - my ($name_proto, %spec) = @_; - my $name_isref = ref $name_proto eq 'ARRAY'; - foreach my $name ($name_isref ? @$name_proto : $name_proto) { - my $spec_ref = $name_isref ? +{%spec} : \%spec; + my $name_proto = shift; + my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; + if (@_ % 2 != 0) { + require Carp; + Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto) + . " attribute(s): even number of arguments expected, got " . scalar @_) + } + my %spec = @_; + foreach my $name (@name_proto) { + my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; ($INFO{$target}{accessor_maker} ||= do { require Method::Generate::Accessor; Method::Generate::Accessor->new @@ -231,9 +240,7 @@ sub create_class_with_roles { my ($me, $superclass, @roles) = @_; - my $new_name = join( - '__WITH__', $superclass, my $compose_name = join '__AND__', @roles - ); + my ($new_name, $compose_name) = $me->_composite_name($superclass, @roles); return $new_name if $Role::Tiny::COMPOSED{class}{$new_name}; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Moo.pm new/Moo-1.003001/lib/Moo.pm --- old/Moo-1.003000/lib/Moo.pm 2013-07-15 19:24:51.000000000 +0200 +++ new/Moo-1.003001/lib/Moo.pm 2013-09-10 14:57:13.000000000 +0200 @@ -5,7 +5,7 @@ use B 'perlstring'; use Sub::Defer (); -our $VERSION = '1.003000'; # 1.3.0 +our $VERSION = '1.003001'; $VERSION = eval $VERSION; require Moo::sification; @@ -37,12 +37,18 @@ $class->_maybe_reset_handlemoose($target); }; _install_tracked $target => has => sub { - my ($name_proto, %spec) = @_; - my $name_isref = ref $name_proto eq 'ARRAY'; - foreach my $name ($name_isref ? @$name_proto : $name_proto) { - # Note that when $name_proto is an arrayref, each attribute + my $name_proto = shift; + my @name_proto = ref $name_proto eq 'ARRAY' ? @$name_proto : $name_proto; + if (@_ % 2 != 0) { + require Carp; + Carp::croak("Invalid options for " . join(', ', map "'$_'", @name_proto) + . " attribute(s): even number of arguments expected, got " . scalar @_) + } + my %spec = @_; + foreach my $name (@name_proto) { + # Note that when multiple attributes specified, each attribute # needs a separate \%specs hashref - my $spec_ref = $name_isref ? +{%spec} : \%spec; + my $spec_ref = @name_proto > 1 ? +{%spec} : \%spec; $class->_constructor_maker_for($target) ->register_attribute_specs($name, $spec_ref); $class->_accessor_maker_for($target) @@ -135,27 +141,32 @@ } sub _constructor_maker_for { - my ($class, $target) = @_; + my ($class, $target, $select_super) = @_; return unless $MAKERS{$target}; $MAKERS{$target}{constructor} ||= do { require Method::Generate::Constructor; require Sub::Defer; my ($moo_constructor, $con); - my $t_new = $target->can('new'); - if ($t_new) { - if ($t_new == Moo::Object->can('new')) { - $moo_constructor = 1; - } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) { - my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); - if ($MAKERS{$pkg}) { + if ($select_super && $MAKERS{$select_super}) { + $moo_constructor = 1; + $con = $MAKERS{$select_super}{constructor}; + } else { + my $t_new = $target->can('new'); + if ($t_new) { + if ($t_new == Moo::Object->can('new')) { $moo_constructor = 1; - $con = $MAKERS{$pkg}{constructor}; + } elsif (my $defer_target = (Sub::Defer::defer_info($t_new)||[])->[0]) { + my ($pkg) = ($defer_target =~ /^(.*)::[^:]+$/); + if ($MAKERS{$pkg}) { + $moo_constructor = 1; + $con = $MAKERS{$pkg}{constructor}; + } } + } else { + $moo_constructor = 1; # no other constructor, make a Moo one } - } else { - $moo_constructor = 1; # no other constructor, make a Moo one - } + }; ($con ? ref($con) : 'Method::Generate::Constructor') ->new( package => $target, @@ -518,7 +529,7 @@ do something like the following: coerce => sub { - $_[0] + 1 unless $_[0] % 2 + $_[0] % 2 ? $_[0] : $_[0] + 1 }, Note that L<Moo> will always fire your coercion: this is to permit diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Sub/Defer.pm new/Moo-1.003001/lib/Sub/Defer.pm --- old/Moo-1.003000/lib/Sub/Defer.pm 2013-07-11 19:14:42.000000000 +0200 +++ new/Moo-1.003001/lib/Sub/Defer.pm 2013-09-10 14:57:13.000000000 +0200 @@ -3,6 +3,10 @@ use strictures 1; use base qw(Exporter); use Moo::_Utils; +use Scalar::Util qw(weaken); + +our $VERSION = '1.003001'; +$VERSION = eval $VERSION; our @EXPORT = qw(defer_sub undefer_sub); @@ -13,6 +17,8 @@ my ($target, $maker, $undeferred_ref) = @{ $DEFERRED{$deferred}||return $deferred }; + return ${$undeferred_ref} + if ${$undeferred_ref}; ${$undeferred_ref} = my $made = $maker->(); # make sure the method slot has not changed since deferral time @@ -23,7 +29,7 @@ # _install_coderef calls are not necessary --ribasushi *{_getglob($target)} = $made; } - push @{$DEFERRED{$made} = $DEFERRED{$deferred}}, $made; + weaken($DEFERRED{$made} = $DEFERRED{$deferred}); return $made; } @@ -36,16 +42,22 @@ sub defer_sub { my ($target, $maker) = @_; my $undeferred; - my $deferred_string; + my $deferred_info; my $deferred = sub { - goto &{$undeferred ||= undefer_sub($deferred_string)}; + $undeferred ||= undefer_sub($deferred_info->[3]); + goto &$undeferred; }; - $deferred_string = "$deferred"; - $DEFERRED{$deferred} = [ $target, $maker, \$undeferred ]; + $deferred_info = [ $target, $maker, \$undeferred, $deferred ]; + weaken($DEFERRED{$deferred} = $deferred_info); _install_coderef($target => $deferred) if defined $target; return $deferred; } +sub CLONE { + %DEFERRED = map { defined $_ ? ($_->[3] => $_) : () } values %DEFERRED; + weaken($_) for values %DEFERRED; +} + 1; =head1 NAME diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/lib/Sub/Quote.pm new/Moo-1.003001/lib/Sub/Quote.pm --- old/Moo-1.003000/lib/Sub/Quote.pm 2013-07-11 19:14:42.000000000 +0200 +++ new/Moo-1.003001/lib/Sub/Quote.pm 2013-09-10 14:57:13.000000000 +0200 @@ -9,6 +9,9 @@ use Scalar::Util qw(weaken); use base qw(Exporter); +our $VERSION = '1.003001'; +$VERSION = eval $VERSION; + our @EXPORT = qw(quote_sub unquote_sub quoted_from_sub); our %QUOTED; @@ -60,19 +63,18 @@ undef($captures) if $captures && !keys %$captures; my $code = pop; my $name = $_[0]; - my $outstanding; + my $quoted_info; my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub { - unquote_sub($outstanding); + unquote_sub($quoted_info->[4]); }; - $outstanding = "$deferred"; - $QUOTED{$outstanding} = [ $name, $code, $captures ]; - weaken($WEAK_REFS{$outstanding} = $deferred); + $quoted_info = [ $name, $code, $captures, undef, $deferred ]; + weaken($QUOTED{$deferred} = $quoted_info); return $deferred; } sub quoted_from_sub { my ($sub) = @_; - $WEAK_REFS{$sub||''} and $QUOTED{$sub||''}; + $QUOTED{$sub||''}; } sub unquote_sub { @@ -82,23 +84,22 @@ my $make_sub = "{\n"; - if (keys %$captures) { - $make_sub .= capture_unroll("\$_[1]", $captures, 2); - } + my %captures = $captures ? %$captures : (); + $captures{'$_QUOTED'} = \$QUOTED{$sub}; + $make_sub .= capture_unroll("\$_[1]", \%captures, 2); - my $o_quoted = perlstring $sub; $make_sub .= ( $name # disable the 'variable $x will not stay shared' warning since # we're not letting it escape from this scope anyway so there's # nothing trying to share it ? " no warnings 'closure';\n sub ${name} {\n" - : " \$Sub::Quote::QUOTED{${o_quoted}}[3] = sub {\n" + : " \$_QUOTED->[3] = sub {\n" ); $make_sub .= $code; $make_sub .= " }".($name ? '' : ';')."\n"; if ($name) { - $make_sub .= " \$Sub::Quote::QUOTED{${o_quoted}}[3] = \\&${name}\n"; + $make_sub .= " \$_QUOTED->[3] = \\&${name}\n"; } $make_sub .= "}\n1;\n"; $ENV{SUB_QUOTE_DEBUG} && warn $make_sub; @@ -106,7 +107,7 @@ local $@; no strict 'refs'; local *{$name} if $name; - unless (_clean_eval $make_sub, $captures) { + unless (_clean_eval $make_sub, \%captures) { die "Eval went very, very wrong:\n\n${make_sub}\n\n$@"; } } @@ -114,6 +115,11 @@ $QUOTED{$sub}[3]; } +sub CLONE { + %QUOTED = map { defined $_ ? ($_->[4] => $_) : () } values %QUOTED; + weaken($_) for values %QUOTED; +} + 1; =head1 NAME @@ -161,7 +167,10 @@ C<$code> is a string that will be turned into code. C<\%captures> is a hashref of variables that will be made available to the -code. See the L</SYNOPSIS>'s C<Silly::dagron> for an example using captures. +code. The keys should be the full name of the variable to be made available, +including the sigil. The values should be references to the values. The +variables will contain copies of the values. See the L</SYNOPSIS>'s +C<Silly::dagron> for an example using captures. =head3 options diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/maint/Makefile.PL.include new/Moo-1.003001/maint/Makefile.PL.include --- old/Moo-1.003000/maint/Makefile.PL.include 2013-07-13 13:15:30.000000000 +0200 +++ new/Moo-1.003001/maint/Makefile.PL.include 2013-09-10 14:53:16.000000000 +0200 @@ -1,6 +1,6 @@ BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; -use Distar; +use Distar 0.001; use ExtUtils::MakeMaker 6.57_10 (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/maint/bump-version new/Moo-1.003001/maint/bump-version --- old/Moo-1.003000/maint/bump-version 2013-01-12 22:06:35.000000000 +0100 +++ new/Moo-1.003001/maint/bump-version 2013-09-10 14:53:16.000000000 +0200 @@ -7,6 +7,9 @@ chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}')); my @parts = split /\./, $LATEST; +if (@parts == 2) { + @parts[1,2] = $parts[1] =~ /(\d{1,3})(\d{1,3})/; +} my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts); @@ -25,12 +28,18 @@ warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL\n"; -my $PM_FILE = 'lib/Moo.pm'; +for my $PM_FILE (qw( + lib/Moo.pm + lib/Moo/Role.pm + lib/Sub/Defer.pm + lib/Sub/Quote.pm +)) { + my $file = do { local (@ARGV, $/) = ($PM_FILE); <> }; -my $file = do { local (@ARGV, $/) = ($PM_FILE); <> }; + $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/ + or die "unable to bump version number in $PM_FILE"; -$file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/; + open my $out, '>', $PM_FILE; -open my $out, '>', $PM_FILE; - -print $out $file; + print $out $file; +} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/maint/mkfat new/Moo-1.003001/maint/mkfat --- old/Moo-1.003000/maint/mkfat 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/maint/mkfat 2012-11-12 19:13:08.000000000 +0100 @@ -0,0 +1,16 @@ +#!/bin/sh + +rm -rf fatlib + +mkdir -p fatlib/Class/Method fatlib/Module fatlib/Role fatlib/Devel fatlib/Sub/Exporter + +cp $(perldoc -l Class/Method/Modifiers.pm) fatlib/Class/Method/ +cp $(perldoc -l Module/Runtime.pm) fatlib/Module/ +cp $(perldoc -l Role/Tiny.pm) fatlib/Role/ +cp $(perldoc -l strictures.pm) fatlib/ +cp $(perldoc -l Devel/GlobalDestruction.pm) fatlib/Devel/ +cp $(perldoc -l Sub/Exporter/Progressive.pm) fatlib/Sub/Exporter/ + +(fatpack file; echo '$ENV{PERL_STRICTURES_EXTRA} = 0;'; echo "1;") >FatMoo.pm + +#rm -rf fatlib diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/maint/travis-perlbrew new/Moo-1.003001/maint/travis-perlbrew --- old/Moo-1.003000/maint/travis-perlbrew 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/maint/travis-perlbrew 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,15 @@ +BREWVER=${TRAVIS_PERL_VERSION/_*/} +BREWOPTS= +[[ "${TRAVIS_PERL_VERSION}_" =~ '_thr_' ]] && BREWOPTS="$BREWOPTS -Duseithreads" + +if ! perlbrew use | grep -q "Currently using $TRAVIS_PERL_VERSION"; then + echo "Building perl $TRAVIS_PERL_VERSION..." + PERLBUILD=$(perlbrew install --as $TRAVIS_PERL_VERSION --notest --noman --verbose $BREWOPTS -j 2 $BREWVER 2>&1) + perlbrew use $TRAVIS_PERL_VERSION + if ! perlbrew use | grep -q "Currently using $TRAVIS_PERL_VERSION"; then + echo "Unable to switch to $TRAVIS_PERL_VERSION - compilation failed...?" 1>&2 + echo "$PERLBUILD" 1>&2 + exit 1 + fi +fi +perlbrew install-cpanm -f diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/accessor-isa.t new/Moo-1.003001/t/accessor-isa.t --- old/Moo-1.003000/t/accessor-isa.t 2013-07-11 19:14:42.000000000 +0200 +++ new/Moo-1.003001/t/accessor-isa.t 2013-09-10 14:53:16.000000000 +0200 @@ -154,4 +154,18 @@ is($called, 1, '__DIE__ handler called if set') } +{ + package ClassWithDeadlyIsa; + use Moo; + has foo => (is => 'ro', isa => sub { die "nope" }); + + package ClassUsingDeadlyIsa; + use Moo; + has bar => (is => 'ro', coerce => sub { ClassWithDeadlyIsa->new(foo => $_[0]) }); +} + +like exception { ClassUsingDeadlyIsa->new(bar => 1) }, + qr/isa check for "foo" failed: nope/, + 'isa check within isa check produces correct exception'; + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/has-array.t new/Moo-1.003001/t/has-array.t --- old/Moo-1.003000/t/has-array.t 2013-01-12 22:06:35.000000000 +0100 +++ new/Moo-1.003001/t/has-array.t 2013-09-10 14:53:16.000000000 +0200 @@ -1,21 +1,19 @@ -use Test::More tests => 4; +use strictures; +use Test::More; +use Test::Fatal; -ok(eval { +is(exception { package Local::Test::Role1; use Moo::Role; has [qw/ attr1 attr2 /] => (is => 'ro'); - 1; -}, 'has \@attrs works in roles') - or diag "EVAL FAILED: $@"; +}, undef, 'has \@attrs works in roles'); -ok eval { +is(exception { package Local::Test::Class1; use Moo; with 'Local::Test::Role1'; has [qw/ attr3 attr4 /] => (is => 'ro'); - 1; -}, 'has \@attrs works in classes' - or diag "EVAL FAILED: $@"; +}, undef, 'has \@attrs works in classes'); my $obj = new_ok 'Local::Test::Class1' => [ attr1 => 1, @@ -28,3 +26,19 @@ $obj, qw( attr1 attr2 attr3 attr4 ), ); + +like(exception { + package Local::Test::Role2; + use Moo::Role; + has [qw/ attr1 attr2 /] => (is => 'ro', 'isa'); +}, qr/^Invalid options for 'attr1', 'attr2' attribute\(s\): even number of arguments expected, got 3/, + 'correct exception when has given bad parameters in role'); + +like(exception { + package Local::Test::Class2; + use Moo; + has [qw/ attr3 attr4 /] => (is => 'ro', 'isa'); +}, qr/^Invalid options for 'attr3', 'attr4' attribute\(s\): even number of arguments expected, got 3/, + 'correct exception when has given bad parameters in class'); + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/sub-defer-threads.t new/Moo-1.003001/t/sub-defer-threads.t --- old/Moo-1.003000/t/sub-defer-threads.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/t/sub-defer-threads.t 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,31 @@ +use Config; +BEGIN { + unless ($Config{useithreads}) { + print "1..0 # SKIP your perl does not support ithreads\n"; + exit 0; + } +} +use threads; +use strictures 1; +use Test::More; + +use Sub::Defer; + +my %made; + +my $one_defer = defer_sub 'Foo::one' => sub { + die "remade - wtf" if $made{'Foo::one'}; + $made{'Foo::one'} = sub { 'one' } +}; + +is(threads->create(sub { + my $info = Sub::Defer::defer_info($one_defer); + $info && $info->[0]; +})->join, 'Foo::one', 'able to retrieve info in thread'); + +is(threads->create(sub { + undefer_sub($one_defer); + $made{'Foo::one'} && $made{'Foo::one'} == \&Foo::one && 1234; +})->join, 1234, 'able to undefer in thread'); + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/sub-defer.t new/Moo-1.003001/t/sub-defer.t --- old/Moo-1.003000/t/sub-defer.t 2013-01-12 22:06:35.000000000 +0100 +++ new/Moo-1.003001/t/sub-defer.t 2013-09-10 14:53:16.000000000 +0200 @@ -1,5 +1,6 @@ use strictures 1; use Test::More; +use Test::Fatal; use Sub::Defer; my %made; @@ -29,6 +30,9 @@ is(my $two_made = undefer_sub($two_defer), $made{'Foo::two'}, 'make two'); +is exception { undefer_sub($two_defer) }, undef, + "repeated undefer doesn't regenerate"; + is($two_made, \&Foo::two, 'two installed'); is($two_defer->(), 'two', 'two (deferred) still runs'); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/sub-quote-threads.t new/Moo-1.003001/t/sub-quote-threads.t --- old/Moo-1.003000/t/sub-quote-threads.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/t/sub-quote-threads.t 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,47 @@ +use Config; +BEGIN { + unless ($Config{useithreads}) { + print "1..0 # SKIP your perl does not support ithreads\n"; + exit 0; + } +} +use threads; +use strictures 1; +use Test::More; + +use Sub::Quote; + +my $one = quote_sub my $one_code = q{ + BEGIN { $::EVALED{'one'} = 1 } + 42 +}; + +my $two = quote_sub q{ + BEGIN { $::EVALED{'two'} = 1 } + 3 + $x++ +} => { '$x' => \do { my $x = 0 } }; + +is(threads->create(sub { + my $quoted = quoted_from_sub($one); + $quoted && $quoted->[1]; +})->join, $one_code, 'able to retrieve quoted sub in thread'); + +my $u_one = unquote_sub $one; + +is(threads->create(sub { $one->() })->join, 42, 'One (quoted version)'); + +is(threads->create(sub { $u_one->() })->join, 42, 'One (unquoted version)'); + +my $r = threads->create(sub { + my @r; + push @r, $two->(); + push @r, unquote_sub($two)->(); + push @r, $two->(); + \@r; +})->join; + +is($r->[0], 3, 'Two in thread (quoted version)'); +is($r->[1], 4, 'Two in thread (unquoted version)'); +is($r->[2], 5, 'Two in thread (quoted version again)'); + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/t/sub-quote.t new/Moo-1.003001/t/sub-quote.t --- old/Moo-1.003000/t/sub-quote.t 2013-04-30 13:57:54.000000000 +0200 +++ new/Moo-1.003001/t/sub-quote.t 2013-09-10 14:53:16.000000000 +0200 @@ -47,4 +47,16 @@ 'exception contains correct name' ); +quote_sub 'Foo::four' => q{ + return 5; +}; + +my $quoted = quoted_from_sub(\&Foo::four); +like $quoted->[1], qr/return 5;/, + 'can get quoted from installed sub'; +Foo::four(); +my $quoted2 = quoted_from_sub(\&Foo::four); +is $quoted2->[1], undef, + "can't get quoted from installed sub after undefer"; + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/global-destruct-jenga.t new/Moo-1.003001/xt/global-destruct-jenga.t --- old/Moo-1.003000/xt/global-destruct-jenga.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/xt/global-destruct-jenga.t 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,7 @@ +use strictures 1; +use Test::More; + +my $out = `$^X xt/global-destruct-jenga-helper.pl 2>&1`; +is $out, '', 'no errors from global destruct of jenga object'; + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/moox-types-coercion.t new/Moo-1.003001/xt/moox-types-coercion.t --- old/Moo-1.003000/xt/moox-types-coercion.t 2013-07-15 05:30:17.000000000 +0200 +++ new/Moo-1.003001/xt/moox-types-coercion.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,35 +0,0 @@ -use strictures 1; -use Test::More; -use Test::Fatal; - -{ - package ClassWithTypes; - $INC{'ClassWithTypes.pm'} = __FILE__; - use Moo; - use MooX::Types::MooseLike::Base qw(ArrayRef); - - has split_comma => (is => 'ro', isa => ArrayRef, coerce => sub { [ split /,/, $_[0] ] } ); - has split_space => (is => 'ro', isa => ArrayRef, coerce => sub { [ split / /, $_[0] ] } ); - has bad_coerce => (is => 'ro', isa => ArrayRef, coerce => sub { $_[0] } ); -} - -my $o = ClassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); -is_deeply $o->split_comma, ['a','b c','d'], 'coerce with prebuilt type works'; -is_deeply $o->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; - -{ - package MooseSubclassWithTypes; - use Moose; - extends 'ClassWithTypes'; -} - -my $o2 = MooseSubclassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); -is_deeply $o2->split_comma, ['a','b c','d'], 'moose subclass has correct coercion'; -is_deeply $o2->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; - -like - exception { MooseSubclassWithTypes->new(bad_coerce => 1) }, - qr/Validation failed for 'ArrayRef' with value/, - 'inflated type has correct name'; - -done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/moox-types.t new/Moo-1.003001/xt/moox-types.t --- old/Moo-1.003000/xt/moox-types.t 2013-07-15 05:30:17.000000000 +0200 +++ new/Moo-1.003001/xt/moox-types.t 1970-01-01 01:00:00.000000000 +0100 @@ -1,58 +0,0 @@ -use strictures 1; -use Test::More; - -{ - package TypeOMatic; - - use Moo::Role; - use Sub::Quote; - use MooX::Types::MooseLike::Base qw(Str); - use MooX::Types::MooseLike::Numeric qw(PositiveInt); - - has named_type => ( - is => 'ro', - isa => Str, - ); - - has named_external_type => ( - is => 'ro', - isa => PositiveInt, - ); - - package TypeOMatic::Consumer; - - # do this as late as possible to simulate "real" behaviour - use Moo::HandleMoose; - use Moose; - with 'TypeOMatic'; -} - -my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); - -my ($str, $positive_int) - = map $meta->get_attribute($_)->type_constraint->name, - qw(named_type named_external_type); - -is($str, 'Str', 'Built-in Moose type ok'); -is( - $positive_int, 'MooseX::Types::Common::Numeric::PositiveInt', - 'External (MooseX::Types type) ok' -); - -local $@; -eval q { - package Fooble; - use Moo; - my $isa = sub { 1 }; - $Moo::HandleMoose::TYPE_MAP{$isa} = sub { $isa }; - has barble => (is => "ro", isa => $isa); - __PACKAGE__->meta->get_attribute("barble"); -}; - -like( - $@, - qr/^error inflating attribute 'barble' for package 'Fooble': \$TYPE_MAP\{CODE\(\w+?\)\} did not return a valid type constraint/, - 'error message for incorrect type constraint inflation', -); - -done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/test-my-dependents.t new/Moo-1.003001/xt/test-my-dependents.t --- old/Moo-1.003000/xt/test-my-dependents.t 2013-07-15 05:26:52.000000000 +0200 +++ new/Moo-1.003001/xt/test-my-dependents.t 2013-09-10 14:53:16.000000000 +0200 @@ -139,28 +139,14 @@ __DATA__ -# SKIP: no tests -AnyMerchant -CPAN-Mirror-Finder -Catmandu-AlephX -Device-Hue -Novel-Robot -Novel-Robot-Browser -Novel-Robot-Parser -Novel-Robot-Packer -Thrift-API-HiveClient -Tiezi-Robot-Parser -Tiezi-Robot-Packer -WWW-ORCID - # TODO: broken App-Presto -Catmandu-Store-Lucy Dancer2-Session-Sereal Dancer-Plugin-FontSubset -Data-Localize +Mail-GcalReminder # 0.1 +MooX-LvalueAttribute # 0.12 +Net-Docker # 0.002003 DBIx-Class-IndexSearch-Dezi -DBIx-FixtureLoader Message-Passing-ZeroMQ Tak @@ -169,40 +155,29 @@ App-OS-Detect-MachineCores # 0.038 - smartmatch Authen-HTTP-Signature # 0.02 - smartmatch DBICx-Backend-Move # 1.000010 - smartmatch -POEx-ZMQ3 # 0.060002 - smartmatch Ruby-VersionManager # 0.004003 - smartmatch Text-Keywords # 0.900 - smartmatch -Data-CloudWeights # v0.9.2 HTML-Zoom-Parser-HH5P # 0.002 Log-Message-Structured-Stringify-AsSereal # 0.10 - -# TODO: broken prereqs -App-Netdisco -DBIx-Table-TestDataGenerator -Perinci-CmdLine -Perinci-Sub-Gen-AccessTable-DBI +Text-CSV-Merge # 0.03 - smartmatch # TODO: broken prereqs (perl 5.18) App-Rssfilter # 0.03 - Data::Alias -App-Zapzi # 0.004 - HTTP::CookieJar -Code-Crypt # 0.001000 - Crypt::DES Data-Sah # 0.15 - Regexp::Grammars +Finance-Bank-ID-BCA # 0.26 - Perinci::CmdLine Language-Expr # 0.19 - Regexp::Grammars Net-Icecast2 # 0.005 - PHP::HTTPBuildQuery (hash order) Org-To-HTML # 0.07 - Language::Expr POE-Component-ProcTerminator # 0.03 - Log::Fu Perinci-Access-Simple-Server # 0.12 - Regexp::Grammars -Perinci-Sub-Gen-AccessTable # 0.19 - Regexp::Grammars +Perinci-CmdLine # 0.85 - Data::Sah +Perinci-To-Text # 0.22 - Data::Sah +Perinci-Sub-To-Text # 0.24 - Data::Sah Software-Release-Watch # 0.01 - Data::Sah, Perinci::CmdLine Software-Release-Watch-SW-wordpress # 0.01 - Software::Release::Watch -Tiezi-Robot # 0.12 - Data::Dump::Streamer, SOAP::Lite WebService-HabitRPG # 0.19 - Data::Alias # TODO: broken tests -Template-Flute -Uninets-Check-Modules-HTTP -Uninets-Check-Modules-MongoDB -Uninets-Check-Modules-Redis Net-OAuth-LP # pod coverage # SKIP: invalid prereqs @@ -210,10 +185,19 @@ Dancer2-Session-JSON # 0.001 - Dancer2 bad version requirement # SKIP: misc +GeoIP2 # 0.040000 - prereq Math::Int128 (requires gcc 4.4) +Graphics-Potrace # 0.72 - external dependency +GraphViz2 # 2.19 - external dependency Linux-AtaSmart # OS specific +MaxMind-DB-Reader # 0.040003 - prereq Math::Int128 (requires gcc 4.4) +MaxMind-DB-Common # 0.031002 - prereq Math::Int128 (requires gcc 4.4) Net-Works # 0.12 - prereq Math::Int128 (requires gcc 4.4) +PortageXS # 0.3.1 - external dependency and broken prereq (Shell::EnvImporter) XML-GrammarBase # v0.2.2 - prereq XML::LibXSLT (hard to install) Forecast-IO # 0.21 - interactive tests +Net-OpenVPN-Launcher # 0.1 - external dependency (and broken test) +App-PerlWatcher-Level # 0.13 - depends on Linux::Inotify2 +Graph-Easy-Marpa # 2.00 - GraphVis2 # TODO: broken by Moo change Math-Rational-Approx # RT#84035 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/type-inflate-coercion.t new/Moo-1.003001/xt/type-inflate-coercion.t --- old/Moo-1.003000/xt/type-inflate-coercion.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/xt/type-inflate-coercion.t 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,45 @@ +use strictures 1; +use Test::More; +use Test::Fatal; + +sub ArrayRef { + my $type = sub { + die unless ref $_[0] && ref $_[0] eq 'ARRAY'; + }; + $Moo::HandleMoose::TYPE_MAP{$type} = sub { + require Moose::Util::TypeConstraints; + Moose::Util::TypeConstraints::find_type_constraint("ArrayRef"); + }; + return ($type, @_); +} + +{ + package ClassWithTypes; + $INC{'ClassWithTypes.pm'} = __FILE__; + use Moo; + + has split_comma => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split /,/, $_[0] ] } ); + has split_space => (is => 'ro', isa => ::ArrayRef, coerce => sub { [ split / /, $_[0] ] } ); + has bad_coerce => (is => 'ro', isa => ::ArrayRef, coerce => sub { $_[0] } ); +} + +my $o = ClassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); +is_deeply $o->split_comma, ['a','b c','d'], 'coerce with prebuilt type works'; +is_deeply $o->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; + +{ + package MooseSubclassWithTypes; + use Moose; + extends 'ClassWithTypes'; +} + +my $o2 = MooseSubclassWithTypes->new(split_comma => 'a,b c,d', split_space => 'a,b c,d'); +is_deeply $o2->split_comma, ['a','b c','d'], 'moose subclass has correct coercion'; +is_deeply $o2->split_space, ['a,b','c,d'], ' ... and with different coercion on same type'; + +like + exception { MooseSubclassWithTypes->new(bad_coerce => 1) }, + qr/Validation failed for 'ArrayRef' with value/, + 'inflated type has correct name'; + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Moo-1.003000/xt/type-inflate.t new/Moo-1.003001/xt/type-inflate.t --- old/Moo-1.003000/xt/type-inflate.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Moo-1.003001/xt/type-inflate.t 2013-09-10 14:53:16.000000000 +0200 @@ -0,0 +1,80 @@ +use strictures 1; +use Test::More; + +{ + package TypeOMatic; + + use Moo::Role; + use Sub::Quote; + use Moo::HandleMoose (); + + sub Str { + my $type = sub { + die unless defined $_[0] && !ref $_[0]; + }; + $Moo::HandleMoose::TYPE_MAP{$type} = sub { + require Moose::Util::TypeConstraints; + Moose::Util::TypeConstraints::find_type_constraint("Str"); + }; + return ($type, @_); + } + sub PositiveInt { + my $type = sub { + die unless defined $_[0] && !ref $_[0] && $_[0] =~ /^-?\d+/; + }; + $Moo::HandleMoose::TYPE_MAP{$type} = sub { + require Moose::Util::TypeConstraints; + require MooseX::Types::Common::Numeric; + Moose::Util::TypeConstraints::find_type_constraint( + "MooseX::Types::Common::Numeric::PositiveInt"); + }; + return ($type, @_); + } + + has named_type => ( + is => 'ro', + isa => Str, + ); + + has named_external_type => ( + is => 'ro', + isa => PositiveInt, + ); + + package TypeOMatic::Consumer; + + # do this as late as possible to simulate "real" behaviour + use Moo::HandleMoose; + use Moose; + with 'TypeOMatic'; +} + +my $meta = Class::MOP::class_of('TypeOMatic::Consumer'); + +my ($str, $positive_int) + = map $meta->get_attribute($_)->type_constraint->name, + qw(named_type named_external_type); + +is($str, 'Str', 'Built-in Moose type ok'); +is( + $positive_int, 'MooseX::Types::Common::Numeric::PositiveInt', + 'External (MooseX::Types type) ok' +); + +local $@; +eval q { + package Fooble; + use Moo; + my $isa = sub { 1 }; + $Moo::HandleMoose::TYPE_MAP{$isa} = sub { $isa }; + has barble => (is => "ro", isa => $isa); + __PACKAGE__->meta->get_attribute("barble"); +}; + +like( + $@, + qr/^error inflating attribute 'barble' for package 'Fooble': \$TYPE_MAP\{CODE\(\w+?\)\} did not return a valid type constraint/, + 'error message for incorrect type constraint inflation', +); + +done_testing; -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
