Hello community, here is the log from the commit of package perl-Role-Tiny for openSUSE:Factory checked in at 2013-07-29 17:50:36 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Role-Tiny (Old) and /work/SRC/openSUSE:Factory/.perl-Role-Tiny.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Role-Tiny" Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Role-Tiny/perl-Role-Tiny.changes 2013-06-28 11:54:20.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Role-Tiny.new/perl-Role-Tiny.changes 2013-07-29 17:50:38.000000000 +0200 @@ -1,0 +2,12 @@ +Fri Jul 26 05:36:47 UTC 2013 - [email protected] + +- updated to 1.003001 + - allow composing roles simultaneously that mutually require each other + (RT#82711) + - Fix _concrete_methods_of returning non-CODE entries + - fix broken implementation of method conflict resolution + (Perlmonks#1041015) + - add is_role method for checking if a given package is a role + - drop minimum perl version - code tests just fine on 5.6.1 and 5.6.2 + +------------------------------------------------------------------- Old: ---- Role-Tiny-1.002005.tar.gz New: ---- Role-Tiny-1.003001.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Role-Tiny.spec ++++++ --- /var/tmp/diff_new_pack.BE7a49/_old 2013-07-29 17:50:39.000000000 +0200 +++ /var/tmp/diff_new_pack.BE7a49/_new 2013-07-29 17:50:39.000000000 +0200 @@ -17,14 +17,14 @@ Name: perl-Role-Tiny -Version: 1.002005 +Version: 1.003001 Release: 0 %define cpan_name Role-Tiny -Summary: Roles. Like a nouvelle cuisine portion size slice of Moose +Summary: Roles. Like a nouvelle cuisine portion size slice of Moose. License: Artistic-1.0 or GPL-1.0+ Group: Development/Libraries/Perl Url: http://search.cpan.org/dist/Role-Tiny/ -Source: http://www.cpan.org/authors/id/M/MS/MSTROUT/%{cpan_name}-%{version}.tar.gz +Source: http://www.cpan.org/authors/id/H/HA/HAARG/%{cpan_name}-%{version}.tar.gz BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build BuildRequires: perl ++++++ Role-Tiny-1.002005.tar.gz -> Role-Tiny-1.003001.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/Changes new/Role-Tiny-1.003001/Changes --- old/Role-Tiny-1.002005/Changes 2013-02-01 20:03:28.000000000 +0100 +++ new/Role-Tiny-1.003001/Changes 2013-07-15 05:59:09.000000000 +0200 @@ -1,3 +1,15 @@ +1.003001 - 2013-07-14 + - fix test accidentally requiring Class::Method::Modifiers + +1.003000 - 2013-07-14 + - allow composing roles simultaneously that mutually require each other + (RT#82711) + - Fix _concrete_methods_of returning non-CODE entries + - fix broken implementation of method conflict resolution + (Perlmonks#1041015) + - add is_role method for checking if a given package is a role + - drop minimum perl version - code tests just fine on 5.6.1 and 5.6.2 + 1.002005 - 2013-02-01 - complain loudly if Class::Method::Modifiers is too old (and skip tests) - don't use $_ as loop variable when calling arbitrary code diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/MANIFEST new/Role-Tiny-1.003001/MANIFEST --- old/Role-Tiny-1.002005/MANIFEST 2013-02-01 20:04:02.000000000 +0100 +++ new/Role-Tiny-1.003001/MANIFEST 2013-07-15 05:59:27.000000000 +0200 @@ -4,13 +4,14 @@ maint/bump-version maint/Makefile.PL.include Makefile.PL -MANIFEST +MANIFEST This list of files t/around-does.t t/compose-modifiers.t -t/does-Moo.t +t/concrete-methods.t t/does.t t/lib/Bar.pm t/lib/Baz.pm +t/method-conflicts.t t/modifiers.t t/namespace-clean.t t/role-basic-00-load.t @@ -28,6 +29,7 @@ t/role-tiny-with.t t/role-tiny.t t/role-with-inheritance.t +t/subclass.t xt/does-Moo.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/Role-Tiny-1.002005/META.json new/Role-Tiny-1.003001/META.json --- old/Role-Tiny-1.002005/META.json 2013-02-01 20:04:00.000000000 +0100 +++ new/Role-Tiny-1.003001/META.json 2013-07-15 05:59:27.000000000 +0200 @@ -4,7 +4,7 @@ "mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560", "license" : [ "perl_5" ], @@ -42,5 +42,5 @@ "url" : "git://git.shadowcat.co.uk/gitmo/Role-Tiny.git" } }, - "version" : "1.002005" + "version" : "1.003001" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/META.yml new/Role-Tiny-1.003001/META.yml --- old/Role-Tiny-1.002005/META.yml 2013-02-01 20:04:00.000000000 +0100 +++ new/Role-Tiny-1.003001/META.yml 2013-07-15 05:59:27.000000000 +0200 @@ -8,7 +8,7 @@ configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.131560' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -22,4 +22,4 @@ requires: {} resources: repository: git://git.shadowcat.co.uk/gitmo/Role-Tiny.git -version: 1.002005 +version: 1.003001 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/Makefile.PL new/Role-Tiny-1.003001/Makefile.PL --- old/Role-Tiny-1.002005/Makefile.PL 2012-12-16 17:58:03.000000000 +0100 +++ new/Role-Tiny-1.003001/Makefile.PL 2013-07-11 13:42:21.000000000 +0200 @@ -1,6 +1,6 @@ use strict; use warnings FATAL => 'all'; -use 5.008001; +use 5.006; use ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/README new/Role-Tiny-1.003001/README --- old/Role-Tiny-1.002005/README 2013-02-01 20:04:02.000000000 +0100 +++ new/Role-Tiny-1.003001/README 2013-07-15 05:59:27.000000000 +0200 @@ -127,7 +127,7 @@ Additionally, Role::Tiny will override the standard Perl "DOES" method for your class. However, if "any" class in your class' inheritance - heirarchy provides "DOES", then Role::Tiny will not override it. + hierarchy provides "DOES", then Role::Tiny will not override it. METHODS apply_roles_to_package @@ -149,6 +149,11 @@ Creates a new class based on base, with the roles composed into it in order. New class is returned. + is_role + Role::Tiny->is_role('Some::Role1') + + Returns true if the given package is a role. + SEE ALSO Role::Tiny is the attribute-less subset of Moo::Role; Moo::Role is a meta-protocol-less subset of the king of role systems, Moose::Role. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/lib/Role/Tiny.pm new/Role-Tiny-1.003001/lib/Role/Tiny.pm --- old/Role-Tiny-1.002005/lib/Role/Tiny.pm 2013-02-01 20:03:27.000000000 +0100 +++ new/Role-Tiny-1.003001/lib/Role/Tiny.pm 2013-07-15 05:57:57.000000000 +0200 @@ -6,7 +6,7 @@ use strict; use warnings FATAL => 'all'; -our $VERSION = '1.002005'; # 1.2.5 +our $VERSION = '1.003001'; # 1.3.1 $VERSION = eval $VERSION; our %INFO; @@ -44,6 +44,7 @@ strict->import; warnings->import(FATAL => 'all'); return if $INFO{$target}; # already exported into this package + $INFO{$target}{is_role} = 1; # get symbol table reference my $stash = _getstash($target); # install before/after/around subs @@ -64,28 +65,33 @@ }; # grab all *non-constant* (stash slot is not a scalarref) subs present # in the symbol table and store their refaddrs (no need to forcibly - # inflate constant subs into real subs) - also add '' to here (this - # is used later) with a map to the coderefs in case of copying or re-use - my @not_methods = ('', map { *$_{CODE}||() } grep !ref($_), values %$stash); + # inflate constant subs into real subs) with a map to the coderefs in + # case of copying or re-use + my @not_methods = (map { *$_{CODE}||() } grep !ref($_), values %$stash); @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; # a role does itself $APPLIED_TO{$target} = { $target => undef }; } +sub role_application_steps { + qw(_install_methods _check_requires _install_modifiers _copy_applied_list); +} + sub apply_single_role_to_package { my ($me, $to, $role) = @_; _load_module($role); die "This is apply_role_to_package" if ref($to); - die "${role} is not a Role::Tiny" unless my $info = $INFO{$role}; - - $me->_check_requires($to, $role, @{$info->{requires}||[]}); + die "${role} is not a Role::Tiny" unless $INFO{$role}; - $me->_install_methods($to, $role); - - $me->_install_modifiers($to, $info->{modifiers}); + foreach my $step ($me->role_application_steps) { + $me->$step($to, $role); + } +} +sub _copy_applied_list { + my ($me, $to, $role) = @_; # copy our role list into the target's @{$APPLIED_TO{$to}||={}}{keys %{$APPLIED_TO{$role}}} = (); } @@ -129,7 +135,8 @@ require MRO::Compat; } - my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}}; + my $composite_info = $me->_composite_info_for(@roles); + my %conflicts = %{$composite_info->{conflicts}}; if (keys %conflicts) { my $fail = join "\n", @@ -143,15 +150,22 @@ my @composable = map $me->_composable_package_for($_), reverse @roles; - *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ]; - - my @info = map $INFO{$_}, @roles; + # some methods may not exist in the role, but get generated by + # _composable_package_for (Moose accessors via Moo). filter out anything + # provided by the composable packages, excluding the subs we generated to + # make modifiers work. + my @requires = grep { + my $method = $_; + !grep $_->can($method) && !$COMPOSED{role}{$_}{modifiers_only}{$method}, + @composable + } @{$composite_info->{requires}}; $me->_check_requires( - $new_name, $compose_name, - do { my %h; @h{map @{$_->{requires}||[]}, @info} = (); keys %h } + $superclass, $compose_name, \@requires ); + *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ]; + @{$APPLIED_TO{$new_name}||={}}{ map keys %{$APPLIED_TO{$_}}, @roles } = (); @@ -171,7 +185,7 @@ return $me->apply_role_to_package($to, $roles[0]) if @roles == 1; my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}}; - delete $conflicts{$_} for $me->_concrete_methods_of($to); + delete $conflicts{$_} for keys %{ $me->_concrete_methods_of($to) }; if (keys %conflicts) { my $fail = join "\n", @@ -190,8 +204,27 @@ delete $INFO{$to}{methods}; # reset since we're about to add methods } - foreach my $role (@roles) { - $me->apply_single_role_to_package($to, $role); + # backcompat: allow subclasses to use apply_single_role_to_package + # to apply changes. set a local var so ours does nothing. + our %BACKCOMPAT_HACK; + if($me ne __PACKAGE__ + and exists $BACKCOMPAT_HACK{$me} ? $BACKCOMPAT_HACK{$me} : + $BACKCOMPAT_HACK{$me} = + $me->can('role_application_steps') + == \&role_application_steps + && $me->can('apply_single_role_to_package') + != \&apply_single_role_to_package + ) { + foreach my $role (@roles) { + $me->apply_single_role_to_package($to, $role); + } + } + else { + foreach my $step ($me->role_application_steps) { + foreach my $role (@roles) { + $me->$step($to, $role); + } + } } $APPLIED_TO{$to}{join('|',@roles)} = 1; } @@ -207,8 +240,11 @@ my $this_methods = $me->_concrete_methods_of($role); $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods; } + my %requires; + @requires{map @{$INFO{$_}{requires}||[]}, @roles} = (); + delete $requires{$_} for keys %methods; delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods; - +{ conflicts => \%methods } + +{ conflicts => \%methods, requires => [keys %requires] } }; } @@ -218,6 +254,8 @@ return $composed_name if $COMPOSED{role}{$composed_name}; $me->_install_methods($composed_name, $role); my $base_name = $composed_name.'::_BASE'; + # force stash to exist so ->can doesn't complain + _getstash($base_name); # Not using _getglob, since setting @ISA via the typeglob breaks # inheritance on 5.10.0 if the stash has previously been accessed an # then a method called on the class (in that order!), which @@ -225,9 +263,9 @@ { no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); } my $modifiers = $INFO{$role}{modifiers}||[]; my @mod_base; - foreach my $modified ( - do { my %h; @h{map $_->[1], @$modifiers} = (); keys %h } - ) { + my @modifiers = grep !$composed_name->can($_), + do { my %h; @h{map @{$_}[1..$#$_-1], @$modifiers} = (); keys %h }; + foreach my $modified (@modifiers) { push @mod_base, "sub ${modified} { shift->next::method(\@_) }"; } my $e; @@ -237,13 +275,16 @@ $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@; } die $e if $e; - $me->_install_modifiers($composed_name, $modifiers); - $COMPOSED{role}{$composed_name} = 1; + $me->_install_modifiers($composed_name, $role); + $COMPOSED{role}{$composed_name} = { + modifiers_only => { map { $_ => 1 } @modifiers }, + }; return $composed_name; } sub _check_requires { - my ($me, $to, $name, @requires) = @_; + my ($me, $to, $name, $requires) = @_; + return unless my @requires = @{$requires||$INFO{$name}{requires}||[]}; if (my @requires_fail = grep !$to->can($_), @requires) { # role -> role, add to requires, role -> class, error out if (my $to_info = $INFO{$to}) { @@ -266,8 +307,7 @@ # grab all code entries that aren't in the not_methods list map { my $code = *{$stash->{$_}}{CODE}; - # rely on the '' key we added in import for "no code here" - exists $not_methods->{$code||''} ? () : ($_ => $code) + ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) } grep !ref($stash->{$_}), keys %$stash }; } @@ -304,7 +344,8 @@ } sub _install_modifiers { - my ($me, $to, $modifiers) = @_; + my ($me, $to, $name) = @_; + return unless my $modifiers = $INFO{$name}{modifiers}; if (my $info = $INFO{$to}) { push @{$info->{modifiers}}, @{$modifiers||[]}; } else { @@ -362,8 +403,15 @@ return 0; } +sub is_role { + my ($me, $role) = @_; + return !!$INFO{$role}; +} + 1; +=encoding utf-8 + =head1 NAME Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose. @@ -511,7 +559,7 @@ Additionally, Role::Tiny will override the standard Perl C<DOES> method for your class. However, if C<any> class in your class' inheritance -heirarchy provides C<DOES>, then Role::Tiny will not override it. +hierarchy provides C<DOES>, then Role::Tiny will not override it. =head1 METHODS @@ -537,6 +585,12 @@ Creates a new class based on base, with the roles composed into it in order. New class is returned. +=head2 is_role + + Role::Tiny->is_role('Some::Role1') + +Returns true if the given package is a role. + =head1 SEE ALSO L<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/compose-modifiers.t new/Role-Tiny-1.003001/t/compose-modifiers.t --- old/Role-Tiny-1.002005/t/compose-modifiers.t 2013-02-01 20:02:53.000000000 +0100 +++ new/Role-Tiny-1.003001/t/compose-modifiers.t 2013-07-15 03:48:43.000000000 +0200 @@ -16,7 +16,7 @@ around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Four; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; - package Base; sub foo { __PACKAGE__ } + package BaseClass; sub foo { __PACKAGE__ } } foreach my $combo ( @@ -24,14 +24,39 @@ [ qw(Two Four Three) ], [ qw(One Two) ] ) { - my $combined = Role::Tiny->create_class_with_roles('Base', @$combo); + my $combined = Role::Tiny->create_class_with_roles('BaseClass', @$combo); is_deeply( - [ $combined->foo ], [ reverse(@$combo), 'Base' ], + [ $combined->foo ], [ reverse(@$combo), 'BaseClass' ], "${combined} ok" ); - my $object = bless({}, 'Base'); + my $object = bless({}, 'BaseClass'); Role::Tiny->apply_roles_to_object($object, @$combo); is(ref($object), $combined, 'Object reblessed into correct class'); } +{ + package Five; use Role::Tiny; + requires 'bar'; + around bar => sub { my $orig = shift; $orig->(@_) }; +} +{ + is eval { + package WithFive; + use Role::Tiny::With; + use base 'BaseClass'; + with 'Five'; + }, undef, + "composing an around modifier fails when method doesn't exist"; + like $@, qr/Can't apply Five to WithFive - missing bar/, + ' ... with correct error message'; +} +{ + is eval { + Role::Tiny->create_class_with_roles('BaseClass', 'Five'); + }, undef, + "composing an around modifier fails when method doesn't exist"; + like $@, qr/Can't apply Five to .* - missing bar/, + ' ... with correct error message'; +} + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/concrete-methods.t new/Role-Tiny-1.003001/t/concrete-methods.t --- old/Role-Tiny-1.002005/t/concrete-methods.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-1.003001/t/concrete-methods.t 2013-07-11 13:42:21.000000000 +0200 @@ -0,0 +1,34 @@ +use strict; +use warnings FATAL => 'all'; +use Test::More; +use Test::Fatal; + +{ + package MyRole1; + + sub before_role {} + + use Role::Tiny; + no warnings 'once'; + + our $GLOBAL1 = 1; + sub after_role {} +} + +{ + package MyClass1; + no warnings 'once'; + + our $GLOBAL1 = 1; + sub method {} +} + +my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1'); +is_deeply([sort keys %$role_methods], ['after_role'], + 'only subs after Role::Tiny import are methods' ); + +my $class_methods = Role::Tiny->_concrete_methods_of('MyClass1'); +is_deeply([sort keys %$class_methods], ['method'], + 'only subs from non-Role::Tiny packages are methods' ); + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/method-conflicts.t new/Role-Tiny-1.003001/t/method-conflicts.t --- old/Role-Tiny-1.002005/t/method-conflicts.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-1.003001/t/method-conflicts.t 2013-07-11 09:56:09.000000000 +0200 @@ -0,0 +1,54 @@ +use strict; +use warnings; + +use Test::More; + +{ + package Local::R1; + use Role::Tiny; + sub method { 1 }; +} + +{ + package Local::R2; + use Role::Tiny; + sub method { 2 }; +} + +# Need to use stringy eval, so not Test::Fatal +$@ = undef; +ok( + !eval(q{ + package Local::C1; + use Role::Tiny::With; + with qw(Local::R1 Local::R2); + 1; + }), + 'method conflict dies', +); + +like( + $@, + qr{^Due to a method name conflict between roles 'Local::R. and Local::R.', the method 'method' must be implemented by 'Local::C1'}, + '... with correct error message', +); + +$@ = undef; +ok( + eval(q{ + package Local::C2; + use Role::Tiny::With; + with qw(Local::R1 Local::R2); + sub method { 3 }; + 1; + }), + '... but can be resolved', +); + +is( + "Local::C2"->method, + 3, + "... which works properly", +); + +done_testing; \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-basic-basic.t new/Role-Tiny-1.003001/t/role-basic-basic.t --- old/Role-Tiny-1.002005/t/role-basic-basic.t 2012-04-10 22:33:26.000000000 +0200 +++ new/Role-Tiny-1.003001/t/role-basic-basic.t 2013-07-15 05:13:41.000000000 +0200 @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - use Test::More tests => 3; use lib 'lib', 't/role-basic/lib'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-basic-bugs.t new/Role-Tiny-1.003001/t/role-basic-bugs.t --- old/Role-Tiny-1.002005/t/role-basic-bugs.t 2012-10-16 00:10:54.000000000 +0200 +++ new/Role-Tiny-1.003001/t/role-basic-bugs.t 2013-07-15 05:13:41.000000000 +0200 @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - use lib 'lib', 't/role-basic/lib', 't/lib'; use MyTests; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-basic-composition.t new/Role-Tiny-1.003001/t/role-basic-composition.t --- old/Role-Tiny-1.002005/t/role-basic-composition.t 2013-02-01 19:52:32.000000000 +0100 +++ new/Role-Tiny-1.003001/t/role-basic-composition.t 2013-07-15 05:13:41.000000000 +0200 @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - use lib 'lib', 't/role-basic/lib'; use MyTests; require Role::Tiny; @@ -123,4 +121,84 @@ } } +{ + { + package Method::Role1; + use Role::Tiny; + sub method1 { } + requires 'method2'; + } + + { + package Method::Role2; + use Role::Tiny; + sub method2 { } + requires 'method1'; + } + my $success = eval q{ + package Class; + use Role::Tiny::With; + with 'Method::Role1', 'Method::Role2'; + 1; + }; + is $success, 1, 'composed mutually dependent methods successfully' or diag "Error: $@"; +} + +SKIP: { + skip "Class::Method::Modifiers not installed or too old", 1 + unless eval "use Class::Method::Modifiers 1.05; 1"; + { + package Modifier::Role1; + use Role::Tiny; + sub foo { + } + before 'bar', sub {}; + } + + { + package Modifier::Role2; + use Role::Tiny; + sub bar { + } + before 'foo', sub {}; + } + my $success = eval q{ + package Class; + use Role::Tiny::With; + with 'Modifier::Role1', 'Modifier::Role2'; + 1; + }; + is $success, 1, 'composed mutually dependent modifiers successfully' or diag "Error: $@"; +} + +{ + { + package Base::Role; + use Role::Tiny; + requires qw/method1 method2/; + } + + { + package Sub::Role1; + use Role::Tiny; + with 'Base::Role'; + sub method1 {} + } + + { + package Sub::Role2; + use Role::Tiny; + with 'Base::Role'; + sub method2 {} + } + + my $success = eval q{ + package Diamant::Class; + use Role::Tiny::With; + with qw/Sub::Role1 Sub::Role2/; + 1; + }; + is $success, 1, 'composed diamantly dependent roles successfully' or diag "Error: $@"; +} + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-basic-exceptions.t new/Role-Tiny-1.003001/t/role-basic-exceptions.t --- old/Role-Tiny-1.002005/t/role-basic-exceptions.t 2012-04-10 22:33:26.000000000 +0200 +++ new/Role-Tiny-1.003001/t/role-basic-exceptions.t 2013-07-15 05:13:41.000000000 +0200 @@ -1,5 +1,3 @@ -#!/usr/bin/env perl - use lib 'lib', 't/role-basic/lib'; use MyTests; require Role::Tiny; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-duplication.t new/Role-Tiny-1.003001/t/role-duplication.t --- old/Role-Tiny-1.002005/t/role-duplication.t 2012-05-05 21:29:55.000000000 +0200 +++ new/Role-Tiny-1.003001/t/role-duplication.t 2013-07-15 03:48:43.000000000 +0200 @@ -5,10 +5,10 @@ { package Role; use Role::Tiny; sub foo { my $orig = shift; 1 + $orig->(@_) }; - package Base; sub foo { 1 } + package BaseClass; sub foo { 1 } } -eval { Role::Tiny->create_class_with_roles('Base', qw(Role Role)); }; +eval { Role::Tiny->create_class_with_roles('BaseClass', qw(Role Role)); }; like $@, qr/Duplicated/, 'duplicate role detected'; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/role-tiny.t new/Role-Tiny-1.003001/t/role-tiny.t --- old/Role-Tiny-1.002005/t/role-tiny.t 2012-04-10 22:33:26.000000000 +0200 +++ new/Role-Tiny-1.003001/t/role-tiny.t 2013-07-11 09:56:09.000000000 +0200 @@ -92,5 +92,9 @@ isa_ok($new_class, 'MyClass'); is($new_class->extra1, 'role extra', 'method from role'); +ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles'); +ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes'); + + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-1.002005/t/subclass.t new/Role-Tiny-1.003001/t/subclass.t --- old/Role-Tiny-1.002005/t/subclass.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-1.003001/t/subclass.t 2013-07-15 05:55:55.000000000 +0200 @@ -0,0 +1,111 @@ +use strict; +use warnings FATAL => 'all'; +use Test::More; +use Test::Fatal; + +my $backcompat_called; +{ + package RoleExtension; + use base 'Role::Tiny'; + + sub apply_single_role_to_package { + my $me = shift; + $me->SUPER::apply_single_role_to_package(@_); + $backcompat_called++; + } +} +{ + package RoleExtension2; + use base 'Role::Tiny'; + + sub role_application_steps { + $_[0]->SUPER::role_application_steps; + } + + sub apply_single_role_to_package { + my $me = shift; + $me->SUPER::apply_single_role_to_package(@_); + $backcompat_called++; + } + +} + +{ + package Role1; + $INC{'Role1.pm'} = __FILE__; + use Role::Tiny; + sub sub1 {} +} + +{ + package Role2; + $INC{'Role2.pm'} = __FILE__; + use Role::Tiny; + sub sub2 {} +} + +{ + package Class1; + RoleExtension->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2'); +} + +is $backcompat_called, 2, + 'overridden apply_single_role_to_package called for backcompat'; + +$backcompat_called = 0; +{ + package Class2; + RoleExtension2->apply_roles_to_package(__PACKAGE__, 'Role1', 'Role2'); +} +is $backcompat_called, 0, + 'overridden role_application_steps prevents backcompat attempt'; + +{ + package RoleExtension3; + use base 'Role::Tiny'; + + sub _composable_package_for { + my ($self, $role) = @_; + my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; + return $composed_name if $Role::Tiny::COMPOSED{role}{$composed_name}; + no strict 'refs'; + *{"${composed_name}::extra_sub"} = sub {}; + $self->SUPER::_composable_package_for($role); + } +} + +{ + package Class2; + sub foo {} +} +{ + package Role3; + $INC{'Role3.pm'} = __FILE__; + use Role::Tiny; + requires 'extra_sub'; +} +ok eval { RoleExtension3->create_class_with_roles('Class2', 'Role3') }, + 'requires is satisfied by subs generated by _composable_package_for'; + +{ + package Role4; + $INC{'Role4.pm'} = __FILE__; + use Role::Tiny; + requires 'extra_sub2'; +} +ok !eval { RoleExtension3->create_class_with_roles('Class2', 'Role4'); }, + 'requires checked properly during create_class_with_roles'; + +SKIP: { + skip "Class::Method::Modifiers not installed or too old", 1 + unless eval "use Class::Method::Modifiers 1.05; 1"; + package Role5; + $INC{'Role5.pm'} = __FILE__; + use Role::Tiny; + around extra_sub2 => sub { my $orig = shift; $orig->(@_); }; + + ::ok !eval { RoleExtension3->create_class_with_roles('Class3', 'Role4'); }, + 'requires checked properly during create_class_with_roles'; +} + +done_testing; -- To unsubscribe, e-mail: [email protected] For additional commands, e-mail: [email protected]
