Hello community, here is the log from the commit of package perl-Role-Tiny for openSUSE:Factory checked in at 2019-10-14 12:32:12 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-Role-Tiny (Old) and /work/SRC/openSUSE:Factory/.perl-Role-Tiny.new.2352 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-Role-Tiny" Mon Oct 14 12:32:12 2019 rev:16 rq:737513 version:2.001003 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-Role-Tiny/perl-Role-Tiny.changes 2019-08-15 15:42:35.607206642 +0200 +++ /work/SRC/openSUSE:Factory/.perl-Role-Tiny.new.2352/perl-Role-Tiny.changes 2019-10-14 12:32:13.752155107 +0200 @@ -1,0 +2,37 @@ +Thu Oct 10 08:58:45 UTC 2019 - <[email protected]> + +- updated to 2.001003 + see /usr/share/doc/packages/perl-Role-Tiny/Changes + + 2.001003 - 2019-10-09 + - releasing as stable + + 2.001_002 - 2019-10-06 + - fix methods from roles composed via create_class_with_roles being treated + differently from roles composed directly (RT#128470) + - fix constants being included in the methods provided by a role if they + were created before importing Role::Tiny but used after importing + - fix prototype handling test on cperl + +------------------------------------------------------------------- +Fri Oct 4 09:34:44 UTC 2019 - <[email protected]> + +- updated to 2.001001 + see /usr/share/doc/packages/perl-Role-Tiny/Changes + + 2.001001 - 2019-10-01 + - added tests for make_role + + 2.001_000 - 2019-09-19 + - refactored method tracking to allow easier extending (such as by Moo) + - added make_role method to make a package into a role, but without + exporting any subs into it + - refactored sub exporting to allow extensions to do different things with + the subs + + 2.000_009 - 2019-09-06 + - fix composing roles into packages that have stub subs in them + - treat constants consistently with all other subs, no matter where they are + defined + +------------------------------------------------------------------- Old: ---- Role-Tiny-2.000008.tar.gz New: ---- Role-Tiny-2.001003.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Role-Tiny.spec ++++++ --- /var/tmp/diff_new_pack.lCVIEo/_old 2019-10-14 12:32:14.372153492 +0200 +++ /var/tmp/diff_new_pack.lCVIEo/_new 2019-10-14 12:32:14.380153471 +0200 @@ -17,7 +17,7 @@ Name: perl-Role-Tiny -Version: 2.000008 +Version: 2.001003 Release: 0 %define cpan_name Role-Tiny Summary: Roles: a nouvelle cuisine portion size slice of Moose ++++++ Role-Tiny-2.000008.tar.gz -> Role-Tiny-2.001003.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/Changes new/Role-Tiny-2.001003/Changes --- old/Role-Tiny-2.000008/Changes 2019-08-05 13:08:14.000000000 +0200 +++ new/Role-Tiny-2.001003/Changes 2019-10-09 17:39:09.000000000 +0200 @@ -1,5 +1,30 @@ Revision history for Role-Tiny +2.001003 - 2019-10-09 + - releasing as stable + +2.001_002 - 2019-10-06 + - fix methods from roles composed via create_class_with_roles being treated + differently from roles composed directly (RT#128470) + - fix constants being included in the methods provided by a role if they + were created before importing Role::Tiny but used after importing + - fix prototype handling test on cperl + +2.001001 - 2019-10-01 + - added tests for make_role + +2.001_000 - 2019-09-19 + - refactored method tracking to allow easier extending (such as by Moo) + - added make_role method to make a package into a role, but without + exporting any subs into it + - refactored sub exporting to allow extensions to do different things with + the subs + +2.000_009 - 2019-09-06 + - fix composing roles into packages that have stub subs in them + - treat constants consistently with all other subs, no matter where they are + defined + 2.000008 - 2019-08-05 - reverting all changes from 2.000007 due to failures on some perl versions and a number of downstream users. The changes will be reintroduced in a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/MANIFEST new/Role-Tiny-2.001003/MANIFEST --- old/Role-Tiny-2.000008/MANIFEST 2019-08-05 13:08:45.000000000 +0200 +++ new/Role-Tiny-2.001003/MANIFEST 2019-10-09 17:39:26.000000000 +0200 @@ -11,8 +11,10 @@ t/lib/FalseModule.pm t/lib/TrackLoad.pm t/load-module.t +t/make-role.t t/method-conflicts.t t/overload.t +t/proto.t t/role-basic-basic.t t/role-basic-bugs.t t/role-basic-composition.t @@ -23,6 +25,7 @@ t/role-tiny-with.t t/role-tiny.t t/role-with-inheritance.t +t/stub.t t/subclass.t xt/around-does.t xt/compose-modifiers.t diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/META.json new/Role-Tiny-2.001003/META.json --- old/Role-Tiny-2.000008/META.json 2019-08-05 13:08:45.000000000 +0200 +++ new/Role-Tiny-2.001003/META.json 2019-10-09 17:39:25.000000000 +0200 @@ -4,7 +4,7 @@ "mst - Matt S. Trout (cpan:MSTROUT) <[email protected]>" ], "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -60,6 +60,6 @@ }, "x_IRC" : "irc://irc.perl.org/#moose" }, - "version" : "2.000008", - "x_serialization_backend" : "JSON::PP version 4.00" + "version" : "2.001003", + "x_serialization_backend" : "JSON::PP version 4.04" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/META.yml new/Role-Tiny-2.001003/META.yml --- old/Role-Tiny-2.000008/META.yml 2019-08-05 13:08:44.000000000 +0200 +++ new/Role-Tiny-2.001003/META.yml 2019-10-09 17:39:25.000000000 +0200 @@ -5,7 +5,7 @@ build_requires: Test::More: '0.88' dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.38, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -25,5 +25,5 @@ bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny license: http://dev.perl.org/licenses/ repository: git://github.com/moose/Role-Tiny.git -version: '2.000008' +version: '2.001003' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/README new/Role-Tiny-2.001003/README --- old/Role-Tiny-2.000008/README 2019-08-05 13:08:45.000000000 +0200 +++ new/Role-Tiny-2.001003/README 2019-10-09 17:39:25.000000000 +0200 @@ -135,6 +135,11 @@ hierarchy provides "DOES", then Role::Tiny will not override it. METHODS + make_role + Role::Tiny->make_role('Some::Role'); + + Makes a package into a role, but does not export any subs into it. + apply_roles_to_package Role::Tiny->apply_roles_to_package( 'Some::Package', 'Some::Role', 'Some::Other::Role' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/lib/Role/Tiny/With.pm new/Role-Tiny-2.001003/lib/Role/Tiny/With.pm --- old/Role-Tiny-2.000008/lib/Role/Tiny/With.pm 2019-08-05 13:06:20.000000000 +0200 +++ new/Role-Tiny-2.001003/lib/Role/Tiny/With.pm 2019-10-09 17:38:22.000000000 +0200 @@ -3,7 +3,7 @@ use strict; use warnings; -our $VERSION = '2.000008'; +our $VERSION = '2.001003'; $VERSION =~ tr/_//d; use Role::Tiny (); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/lib/Role/Tiny.pm new/Role-Tiny-2.001003/lib/Role/Tiny.pm --- old/Role-Tiny-2.000008/lib/Role/Tiny.pm 2019-08-05 13:06:20.000000000 +0200 +++ new/Role-Tiny-2.001003/lib/Role/Tiny.pm 2019-10-09 17:38:22.000000000 +0200 @@ -1,12 +1,8 @@ package Role::Tiny; - -sub _getglob { \*{$_[0]} } -sub _getstash { \%{"$_[0]::"} } - use strict; use warnings; -our $VERSION = '2.000008'; +our $VERSION = '2.001003'; $VERSION =~ tr/_//d; our %INFO; @@ -23,8 +19,12 @@ = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) ? sub(){1} : sub(){0}; *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"}; + *_CONSTANTS_DEFLATE = "$]" >= 5.012 && "$]" < 5.020 ? sub(){1} : sub(){0}; } +sub _getglob { no strict 'refs'; \*{$_[0]} } +sub _getstash { no strict 'refs'; \%{"$_[0]::"} } + sub croak { require Carp; no warnings 'redefine'; @@ -54,22 +54,47 @@ return 1; } +sub _all_subs { + my ($me, $package) = @_; + my $stash = _getstash($package); + return { + map {; + no strict 'refs'; + # this is an ugly hack to populate the scalar slot of any globs, to + # prevent perl from converting constants back into scalar refs in the + # stash when they are used (perl 5.12 - 5.18). scalar slots on their own + # aren't detectable through pure perl, so this seems like an acceptable + # compromise. + ${"${package}::${_}"} = ${"${package}::${_}"} + if _CONSTANTS_DEFLATE; + $_ => \&{"${package}::${_}"} + } + grep exists &{"${package}::${_}"}, + grep !/::\z/, + keys %$stash + }; +} + sub import { my $target = caller; my $me = shift; strict->import; warnings->import; - $me->_install_subs($target); - return if $me->is_role($target); # already exported into this package + $me->_install_subs($target, @_); + $me->make_role($target); + return; +} + +sub make_role { + my ($me, $target) = @_; + + return if $me->is_role($target); $INFO{$target}{is_role} = 1; - # get symbol table reference - my $stash = _getstash($target); - # 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) with a map to the coderefs in - # case of copying or re-use - my @not_methods = map +(ref $_ eq 'CODE' ? $_ : ref $_ ? () : *$_{CODE}||()), values %$stash; - @{$INFO{$target}{not_methods}={}}{@not_methods} = @not_methods; + + my $non_methods = $me->_all_subs($target); + delete @{$non_methods}{grep /\A\(/, keys %$non_methods}; + $INFO{$target}{non_methods} = $non_methods; + # a role does itself $APPLIED_TO{$target} = { $target => undef }; foreach my $hook (@ON_ROLE_CREATE) { @@ -80,21 +105,31 @@ sub _install_subs { my ($me, $target) = @_; return if $me->is_role($target); - # install before/after/around subs - foreach my $type (qw(before after around)) { - *{_getglob "${target}::${type}"} = sub { - push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; + my %install = $me->_gen_subs($target); + *{_getglob("${target}::${_}")} = $install{$_} + for sort keys %install; + return; +} + +sub _gen_subs { + my ($me, $target) = @_; + ( + (map {; + my $type = $_; + $type => sub { + push @{$INFO{$target}{modifiers}||=[]}, [ $type => @_ ]; + return; + }; + } qw(before after around)), + requires => sub { + push @{$INFO{$target}{requires}||=[]}, @_; return; - }; - } - *{_getglob "${target}::requires"} = sub { - push @{$INFO{$target}{requires}||=[]}, @_; - return; - }; - *{_getglob "${target}::with"} = sub { - $me->apply_roles_to_package($target, @_); - return; - }; + }, + with => sub { + $me->apply_roles_to_package($target, @_); + return; + }, + ); } sub role_application_steps { @@ -342,49 +377,75 @@ } } +sub _non_methods { + my ($me, $role) = @_; + my $info = $INFO{$role} or return {}; + + my %non_methods = %{ $info->{non_methods} || {} }; + + # this is only for backwards compatibility with older Moo, which + # reimplements method tracking rather than calling our method + my %not_methods = reverse %{ $info->{not_methods} || {} }; + return \%non_methods unless keys %not_methods; + + my $subs = $me->_all_subs($role); + for my $sub (grep !/\A\(/, keys %$subs) { + my $code = $subs->{$sub}; + if (exists $not_methods{$code}) { + $non_methods{$sub} = $code; + } + } + + return \%non_methods; +} + sub _concrete_methods_of { my ($me, $role) = @_; my $info = $INFO{$role}; - # grab role symbol table - my $stash = _getstash($role); - # reverse so our keys become the values (captured coderefs) in case - # they got copied or re-used since - my $not_methods = { reverse %{$info->{not_methods}||{}} }; - $info->{methods} ||= +{ - # grab all code entries that aren't in the not_methods list - map {; - no strict 'refs'; - my $code = exists &{"${role}::$_"} ? \&{"${role}::$_"} : undef; - ( ! $code or exists $not_methods->{$code} ) ? () : ($_ => $code) - } grep +(!ref($stash->{$_}) || ref($stash->{$_}) eq 'CODE'), keys %$stash - }; + + return $info->{methods} + if $info && $info->{methods}; + + my $non_methods = $me->_non_methods($role); + + my $subs = $me->_all_subs($role); + for my $sub (keys %$subs) { + if ( exists $non_methods->{$sub} && $non_methods->{$sub} == $subs->{$sub} ) { + delete $subs->{$sub}; + } + } + + if ($info) { + $info->{methods} = $subs; + } + return $subs; } sub methods_provided_by { my ($me, $role) = @_; croak "${role} is not a Role::Tiny" unless $me->is_role($role); - (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]}); + sort (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]}); } sub _install_methods { my ($me, $to, $role) = @_; - my $info = $INFO{$role}; - my $methods = $me->_concrete_methods_of($role); - # grab target symbol table - my $stash = _getstash($to); + my %existing_methods; + for my $package ($to, grep $_ ne $role, keys %{$APPLIED_TO{$to}}) { + @existing_methods{keys %{ $me->_concrete_methods_of($package) }} = ();; + } - # determine already extant methods of target - my %has_methods; - @has_methods{grep - +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}), - keys %$stash - } = (); + # _concrete_methods_of caches its result on roles. that cache needs to be + # invalidated after applying roles + delete $INFO{$to}{methods} if $INFO{$to}; + + + foreach my $i (keys %$methods) { + next + if exists $existing_methods{$i}; - foreach my $i (grep !exists $has_methods{$_}, keys %$methods) { - no warnings 'once'; my $glob = _getglob "${to}::${i}"; *$glob = $methods->{$i}; @@ -395,7 +456,7 @@ && ((defined &overload::nil && $methods->{$i} == \&overload::nil) || (defined &overload::_nil && $methods->{$i} == \&overload::_nil)); - my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} }; + my $overload = ${ _getglob "${role}::${i}" }; next unless defined $overload; @@ -473,7 +534,7 @@ sub is_role { my ($me, $role) = @_; - return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods})); + return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods} || $INFO{$role}{non_methods})); } 1; @@ -638,6 +699,12 @@ =head1 METHODS +=head2 make_role + + Role::Tiny->make_role('Some::Role'); + +Makes a package into a role, but does not export any subs into it. + =head2 apply_roles_to_package Role::Tiny->apply_roles_to_package( diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/concrete-methods.t new/Role-Tiny-2.001003/t/concrete-methods.t --- old/Role-Tiny-2.000008/t/concrete-methods.t 2019-08-05 12:54:33.000000000 +0200 +++ new/Role-Tiny-2.001003/t/concrete-methods.t 2019-10-06 14:38:51.000000000 +0200 @@ -2,16 +2,58 @@ use warnings; use Test::More; -{ +BEGIN { package MyRole1; - sub before_role {} + our $before_scalar = 1; + sub before_sub {} + sub before_sub_blessed {} + sub before_stub; + sub before_stub_proto ($); + use constant before_constant => 1; + use constant before_constant_list => (4, 5); + use constant before_constant_glob => 1; + our $before_constant_glob = 1; + use constant before_constant_inflate => 1; + use constant before_constant_list_inflate => (4, 5); + use constant before_constant_deflate => 1; + + # subs stored directly in the stash are meant to be supported in perl 5.22+, + # but until 5.26.1 they have a risk of segfaulting. perl itself won't ever + # install subs in exactly this form, so we're safe to just dodge the issue + # in the test and not account for it in Role::Tiny itself. + BEGIN { + if ("$]" >= 5.026001) { + $MyRole1::{'blorf'} = sub { 'blorf' }; + } + } use Role::Tiny; no warnings 'once'; - our $GLOBAL1 = 1; - sub after_role {} + our $after_scalar = 1; + sub after_sub {} + sub after_sub_blessed {} + sub after_stub; + sub after_stub_proto ($); + use constant after_constant => 1; + use constant after_constant_list => (4, 5); + use constant after_constant_glob => 1; + our $after_constant_glob = 1; + use constant after_constant_inflate => (my $f = 1); + use constant after_constant_list_inflate => (4, 5); + + for ( + \&before_constant_inflate, + \&before_constant_list_inflate, + \&after_constant_inflate, + \&after_constant_list_inflate, + ) {} + + my $deflated = before_constant_deflate; + + bless \&before_sub_blessed; + bless \&after_sub_blessed; } { @@ -22,12 +64,30 @@ sub method {} } +my @methods = qw( + after_sub + after_sub_blessed + after_stub + after_stub_proto + after_constant + after_constant_list + after_constant_glob + after_constant_inflate + after_constant_list_inflate +); + +my $type = ref $MyRole1::{'blorf'}; + my $role_methods = Role::Tiny->_concrete_methods_of('MyRole1'); -is_deeply([sort keys %$role_methods], ['after_role'], +is_deeply([sort keys %$role_methods], [sort @methods], 'only subs after Role::Tiny import are methods' ); +# only created on 5.26, but types will still match +is ref $MyRole1::{'blorf'}, $type, + '_concrete_methods_of does not inflate subrefs in stash'; + my @role_method_list = Role::Tiny->methods_provided_by('MyRole1'); -is_deeply(\@role_method_list, ['after_role'], +is_deeply([sort @role_method_list], [sort @methods], 'methods_provided_by gives method list' ); my $class_methods = Role::Tiny->_concrete_methods_of('MyClass1'); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/make-role.t new/Role-Tiny-2.001003/t/make-role.t --- old/Role-Tiny-2.000008/t/make-role.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-2.001003/t/make-role.t 2019-09-20 03:31:23.000000000 +0200 @@ -0,0 +1,22 @@ +use strict; +use warnings; +use Test::More; + +use Role::Tiny (); + +Role::Tiny->make_role('Foo'); +{ + no warnings 'once'; + *Foo::foo = sub {42}; +} + +ok( Role::Tiny->is_role('Foo'), 'Foo is_role'); + +for my $m (qw(requires with before around after)) { + ok( !Foo->can($m), "Foo cannot '$m'" ); +} + +Role::Tiny->apply_roles_to_package('FooFoo', 'Foo'); +can_ok 'FooFoo', 'foo'; + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/proto.t new/Role-Tiny-2.001003/t/proto.t --- old/Role-Tiny-2.000008/t/proto.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-2.001003/t/proto.t 2019-10-03 16:22:52.000000000 +0200 @@ -0,0 +1,58 @@ +use strict; +use warnings; +use Test::More; + +my $invalid_prototypes; + +BEGIN { + package TestExporter1; + $INC{"TestExporter1.pm"} = 1; + use Exporter; + our @ISA = qw(Exporter); + our @EXPORT = qw(guff welp farb tube truck); + + sub guff { rand(1) } + sub welp () { rand(1) } + sub farb ($) { rand(1) } + + no warnings; + + eval q{ + sub tube (plaf) { rand(1) } + sub truck (-1) { rand(1) } + 1; + } and $invalid_prototypes = 1; +} + +BEGIN { + package TestRole1; + use Role::Tiny; + use TestExporter1; +} + +BEGIN { + package SomeClass; + use Role::Tiny::With; + use TestExporter1; + with 'TestRole1'; + eval { guff }; + ::is $@, '', + 'composing matching function with no prototype works'; + eval { welp }; + ::is $@, '', + 'composing matching function with empty prototype works'; + eval { farb 1 }; + ::is $@, '', + 'composing matching function with ($) prototype works'; + + if ($invalid_prototypes) { + eval { &tube }; + ::is $@, '', + 'composing matching function with invalid prototype works'; + eval { &truck }; + ::is $@, '', + 'composing matching function with invalid -1 prototype works'; + } +} + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/role-tiny-composition.t new/Role-Tiny-2.001003/t/role-tiny-composition.t --- old/Role-Tiny-2.000008/t/role-tiny-composition.t 2019-08-05 12:54:33.000000000 +0200 +++ new/Role-Tiny-2.001003/t/role-tiny-composition.t 2019-09-06 15:55:59.000000000 +0200 @@ -32,6 +32,11 @@ qr/^Method name conflict for 'foo' between roles 'R1' and 'R2', cannot apply these simultaneously to an object/, 'apply conflicting roles to object'; +eval { Role::Tiny->apply_roles_to_object(X->new); 1 } + or $@ ||= "false exception!"; +like $@, + qr/^No roles supplied!/, + 'apply no roles to object'; done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/role-tiny-with.t new/Role-Tiny-2.001003/t/role-tiny-with.t --- old/Role-Tiny-2.000008/t/role-tiny-with.t 2019-08-05 12:50:08.000000000 +0200 +++ new/Role-Tiny-2.001003/t/role-tiny-with.t 2019-09-06 15:55:59.000000000 +0200 @@ -49,7 +49,9 @@ } is $@, '', 'stub composed without error'; -ok exists &ClassConsumeStub::bar && !defined &ClassConsumeStub::bar, +ok exists &ClassConsumeStub::bar, 'stub exists in consuming class'; +ok !defined &ClassConsumeStub::bar, + 'stub consumed as stub'; done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/role-tiny.t new/Role-Tiny-2.001003/t/role-tiny.t --- old/Role-Tiny-2.000008/t/role-tiny.t 2019-08-05 12:54:33.000000000 +0200 +++ new/Role-Tiny-2.001003/t/role-tiny.t 2019-10-03 12:20:50.000000000 +0200 @@ -73,6 +73,9 @@ ok(!MyClass->does('IntermediaryRole'), 'class does not do non-applied role'); ok(!MyClass->does('Random'), 'class does not do non-role'); +like try_apply_to(bless {}, 'MyClass'), qr/This is apply_role_to_package/, + 'error apply_role_to_package on object'; + like(try_apply_to('NoMethods'), qr/req1, req2/, 'error for both methods'); like(try_apply_to('OneMethod'), qr/req2/, 'error for one method'); @@ -83,6 +86,11 @@ } or $@ ||= "false exception!"; is $@, '', 'No errors applying roles'; +eval { + Role::Tiny->apply_role_to_package('MyClass', 'ExtraClass'); +}; +like $@, qr/ExtraClass is not a Role::Tiny/, 'No errors applying roles'; + ok(ExtraClass->does('MyRole'), 'ExtraClass does MyRole'); ok(ExtraClass->does('IntermediaryRole'), 'ExtraClass does IntermediaryRole'); is(ExtraClass->bar, 'role bar', 'method from role'); @@ -97,6 +105,20 @@ isa_ok($new_class, 'MyClass'); is($new_class->extra1, 'role extra', 'method from role'); +eval { + Role::Tiny->create_class_with_roles('MyClass'); + 1; +} or $@ ||= "false exception!"; +like $@, qr/^No roles supplied!/, + 'error on no roles to create_class_with_roles'; + +eval { + Role::Tiny->create_class_with_roles('MyClass', 'ExtraClass'); + 1; +} or $@ ||= "false exception!"; +like $@, qr/^ExtraClass is not a Role::Tiny/, + 'error on non-role to create_class_with_roles'; + ok(Role::Tiny->is_role('MyRole'), 'is_role true for roles'); ok(!Role::Tiny->is_role('MyClass'), 'is_role false for classes'); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/stub.t new/Role-Tiny-2.001003/t/stub.t --- old/Role-Tiny-2.000008/t/stub.t 1970-01-01 01:00:00.000000000 +0100 +++ new/Role-Tiny-2.001003/t/stub.t 2019-09-06 15:55:59.000000000 +0200 @@ -0,0 +1,61 @@ +use strict; +use warnings; +use Test::More; + +use Role::Tiny (); + +{ + eval q{ + package RoleWithMatchingSub; + use Role::Tiny; + sub stubsub { "stubsub" } + 1; + } or die $@; + + my $e; + if (!eval q{ + package ClassWithStub; + use Role::Tiny::With; + + sub stubsub; + + with 'RoleWithMatchingSub'; + 1; + }) { + $e = $@; + } + + is $e, undef, + 'no error composing role in class with stub'; + + ok exists &ClassWithStub::stubsub && !defined &ClassWithStub::stubsub, + 'stub sub prevents composing matching sub'; +} + +{ + eval q{ + package RoleWithStub; + use Role::Tiny; + sub stubsub; + 1; + } or die $@; + + my $e; + if (!eval q{ + package ComposeStub; + use Role::Tiny::With; + + with 'RoleWithStub'; + 1; + }) { + $e = $@; + } + + is $e, undef, + 'no error composing role with stub'; + + ok exists &ComposeStub::stubsub && !defined &ComposeStub::stubsub, + 'composing role includes stub subs'; +} + +done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/t/subclass.t new/Role-Tiny-2.001003/t/subclass.t --- old/Role-Tiny-2.000008/t/subclass.t 2017-10-16 17:09:41.000000000 +0200 +++ new/Role-Tiny-2.001003/t/subclass.t 2019-10-06 15:02:38.000000000 +0200 @@ -107,4 +107,34 @@ 'requires checked properly during create_class_with_roles'; } +{ + package SimpleRole1; + use Role::Tiny; + sub role_method { __PACKAGE__ } +} + +{ + package SimpleRole2; + use Role::Tiny; + sub role_method { __PACKAGE__ } +} + +{ + package SomeEmptyClass; + $INC{'SomeEmptyClass.pm'} ||= __FILE__; +} + +{ + my $create_class = Role::Tiny->create_class_with_roles('SomeEmptyClass', 'SimpleRole1'); + Role::Tiny->apply_roles_to_package( $create_class, 'SimpleRole2' ); + + my $manual_extend = 'ManualExtend'; + @ManualExtend::ISA = qw(SomeEmptyClass); + Role::Tiny->apply_roles_to_package( $manual_extend, 'SimpleRole1' ); + Role::Tiny->apply_roles_to_package( $manual_extend, 'SimpleRole2' ); + + is $create_class->role_method, $manual_extend->role_method, + 'methods added by create_class_with_roles treated equal to those added with apply_roles_to_package'; +} + done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/Role-Tiny-2.000008/xt/dependents.t new/Role-Tiny-2.001003/xt/dependents.t --- old/Role-Tiny-2.000008/xt/dependents.t 2019-01-22 11:20:22.000000000 +0100 +++ new/Role-Tiny-2.001003/xt/dependents.t 2019-09-09 11:26:04.000000000 +0200 @@ -9,9 +9,16 @@ use Cwd qw(abs_path); use Config; +# this won't run by default anyway, so just display the full content so Travis +# doesn't abort due to lack of output. +my $v = 1; # grep /\A(?:-v|--verbose)\z/, @ARGV; + delete $ENV{AUTHOR_TESTING}; delete $ENV{EXTENDED_TESTING}; delete $ENV{RELEASE_TESTING}; +$ENV{NONINTERACTIVE_TESTING} = 1; +$ENV{PERL_MM_USE_DEFAULT} = 1; +delete $ENV{HARNESS_PERL_SWITCHES}; # tests in Moo-0.009002 are sensitive to hash key order. force one that # works, since we still want to run the rest of the tests. @@ -38,12 +45,21 @@ 'HAARG/Moo-2.000000.tar.gz', 'HAARG/Moo-2.001000.tar.gz', 'Moo', + 'namespace::autoclean', + 'Dancer2', ) { + note "Testing $dist ..."; + my $name = $dist; $name =~ s{$ext$}{} if $name =~ m{/}; my $pid = open3 $in, my $out, undef, $^X, '-MCPAN', '-e', 'test @ARGV', $dist; - my $output = do { local $/; <$out> }; + my $output = ''; + while (my $line = <$out>) { + $output .= $line; + diag $line + if $v; + } close $out; waitpid $pid, 0; @@ -54,8 +70,9 @@ and $name = "$3 (latest)"; } - like $output, qr/--\s*OK\s*\z/, - "$name passed tests"; + ok $output =~ /--\s*OK\s*\z/ && $output !~ /--\s*NOT\s+OK\s*\z/, + "$name passed tests" + or (!$v and diag $output); } done_testing;
