Role-Tiny-2.000006/000755 000765 000024 00000000000 13200453741 014043 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/Changes000644 000765 000024 00000016250 13200453723 015342 0ustar00gknopstaff000000 000000 Revision history for Role-Tiny 2.000006 - 2017-11-08 - account for code references stored directly in stash (for perl 5.28) - work around hint leakage when loading modules in perl 5.8 and 5.10.1 2.000005 - 2016-11-01 - revert change to MRO::Compat usage 2.000004 - 2016-10-31 - Fix consuming stubs from roles (RT#116674). - Fix error message when applying conflicting roles to an object. - Drop prerequisite on MRO::Compat on perl 5.8. 2.000003 - 2016-04-21 - don't install subs if importing into a package that is already a role. This can happen if the module previously imported Moo::Role. 2.000002 - 2016-04-19 - restore compatibility with Moo versions pre 1.004_003 - delay loading Class::Method::Modifiers until applying modifiers to a package - use croak rather than die for reporting errors - apply method modifiers only once, even if they are applied via multiple composition paths (RT#106668) 2.000001 - 2015-04-24 - fix generating invalid package names with single colons when abbreviating long package names (RT#103310) - don't run module interaction tests for user installs 2.000000 - 2015-02-26 * Incompatible Changes - Role::Tiny no longer applies fatal warnings to roles created with it. strict and non-fatal warnings will continue to be applied. 1.003004 - 2014-10-22 - allow does_role to be overridden by Moo::Role 1.003003 - 2014-03-15 - overloads specified as method names rather than subrefs are now applied properly - allow superclass to provide conflicting methods (RT#91054) - use ->is_role internally to check if a package is a role - document that Role::Tiny applies strict and fatal warnings 1.003002 - 2013-09-04 - abbreviate generated package names if they are longer than perl can handle (RT#83248) - add explicit dependency on the version of Exporter that added 'import' 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 1.002004 - 2012-11-02 - remove accidentally-introduced strictures.pm usage 1.002003 - 2012-10-29 - fix method modifier breakage on 5.10.0 1.002002 - 2012-10-28 - skip t/around-does.t when Class::Method::Modifiers is not installed (RT#80310) 1.002001 - 2012-10-26 - t/does-Moo.t moved to 'xt' (RT#80290) - don't die when looking for 'DOES' on perl < 5.10 (RT#80402) 1.002000 - 2012-10-19 - load class in addition to roles when using create_class_from_roles - fix module name in Makefile.PL (RT#78591) - when classes consume roles, override their DOES method (RT#79747) - method modifiers can be used for 'does' and 'DOES' 1.001005 - 2012-07-18 - localize UNIVERSAL::can change to avoid confusing TB2 - properly report roles consumed by superclasses 1.001004 - 2012-07-12 - remove strictures.pm from the test supplied by mmcleric so we install again - when applying runtime roles include roles from original class in new class ( fixes ::does_role checks) 1.001003 - 2012-06-19 - correctly apply modifiers with role composition - check for conflicts during role-to-object application (test from mmcleric) - add an explicit return to all exported subs so people don't accidentally rely on the return value - store coderefs as well as their refaddrs to protect against crazy 1.001002 - 2012-05-05 - alter duplication test to not provoke Class::Method::Modifiers loading 1.001001 - 2012-04-27 - remove strictures from one last test file 1.001000 - 2012-04-27 - Documentation improvements, no code changes 1.000_901 - 2012-04-12 - Fix MANIFEST inclusion of Role::Basic composition 1.000_900 - 2012-04-11 - Add composition with tests stolen from Role::Basic 1.000001 - 2012-04-03 - Document that Class::Method::Modifiers must be depended on separately - Update tests so that they skip correctly without C::M::M - Add a SEE ALSO section 1.000000 - 2012-03-29 - Remove redundant code in create_class_with_roles - Minor doc fix to does_role - Split Role::Tiny out into its own dist Changes below this line are from when Role::Tiny was still bundled with Moo: - Fix a bug where coercions weren't called on lazy default/builder returns - Switch Moo::Utils to using Module::Runtime, and add the 5.8 %INC leakage fix into Role::Tiny's _load_module to provide partial parity - Update incompatibilities with Moose documentation - Remove Sub::Quote's outstanding queue since it doesn't actually slow things down to do it this way and makes debugging easier. - Revert 'local $@' around require calls to avoid triggering Unknown Error - Explicitly require Role::Tiny in Role::Tiny::With (RT#70446) - Fix spurious 'once' warnings under perl -w 0.009013 - 2011-12-23 - fix up Class::XSAccessor version check to be more robust - improved documentation - fix failures on perls < 5.8.3 - fix test failures on cygwin 0.009012 - 2011-11-15 - make Method::Generate::Constructor handle $obj->new - fix bug where constants containing a reference weren't handled correctly (ref(\[]) is 'REF' not 'SCALAR', ref(\v1) is 'VSTRING') 0.009011 - 2011-10-03 - add support for DEMOLISH - add support for BUILDARGS 0.009010 - 2011-07-20 - missing new files for Role::Tiny::With 0.009009 - 2011-07-20 - remove the big scary warning because we seem to be mostly working now - perl based getter dies if @_ > 1 (XSAccessor already did) - add Role::Tiny::With for use in classes - automatically generate constructors in subclasses when required so that subclasses with a BUILD method but no attributes get it honoured - add coerce handling 0.009008 - 2011-06-03 - transfer fix to _load_module to Role::Tiny and make a note it's an inline - Bring back 5.8.1 compat 0.009007 - 2011-02-25 - I botched the copyright. re-disting. 0.009006 - 2011-02-25 - handle non-lazy default and builder when init_arg is undef - add copyright and license info for downstream packagers - weak ref checking for Sub::Quote to avoid bugs on refaddr reuse - Switch composed role names to be a valid package name 0.9.5 Tue Jan 11 2011 - Fix clobberage of runtime-installed wrappers by Sub::Defer - Fix nonMoo constructor firing through multiple layers of Moo - Fix bug where nonMoo is mistakenly detected given a Moo superclass with no attributes (and hence no own constructor) 0.9.4 Mon Dec 13 2010 - Automatic detection on non-Moo superclasses 0.9.3 Sun Dec 5 2010 - Fix _load_module to deal with pre-existing subpackages 0.9.2 Wed Nov 17 2010 - Add explanation of Moo's existence - Change @ISA setting mechanism to deal with a big in 5.10.0's get_linear_isa - Change 5.10 checks to >= to not try and load MRO::Compat on 5.10.0 - Make 'perl -Moo' DTRT 0.9.1 Tue Nov 16 2010 - Initial release Role-Tiny-2.000006/MANIFEST000644 000765 000024 00000001562 13200453741 015200 0ustar00gknopstaff000000 000000 Changes lib/Role/Tiny.pm lib/Role/Tiny/With.pm maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/concrete-methods.t t/create-hook.t t/does.t t/lib/BrokenModule.pm t/lib/FalseModule.pm t/lib/TrackLoad.pm t/load-module.t t/method-conflicts.t t/overload.t t/role-basic-basic.t t/role-basic-bugs.t t/role-basic-composition.t t/role-basic-exceptions.t t/role-duplication.t t/role-long-package-name.t t/role-tiny-composition.t t/role-tiny-with.t t/role-tiny.t t/role-with-inheritance.t t/subclass.t xt/around-does.t xt/compose-modifiers.t xt/dependents.t xt/does-Moo.t xt/modifiers.t xt/namespace-clean.t xt/recompose-modifier.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Role-Tiny-2.000006/t/000755 000765 000024 00000000000 13200453741 014306 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/xt/000755 000765 000024 00000000000 13200453741 014476 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/README000644 000765 000024 00000014724 13200453741 014733 0ustar00gknopstaff000000 000000 NAME Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose. SYNOPSIS package Some::Role; use Role::Tiny; sub foo { ... } sub bar { ... } around baz => sub { ... }; 1; elsewhere package Some::Class; use Role::Tiny::With; # bar gets imported, but not foo with 'Some::Role'; sub foo { ... } # baz is wrapped in the around modifier by Class::Method::Modifiers sub baz { ... } 1; If you wanted attributes as well, look at Moo::Role. DESCRIPTION "Role::Tiny" is a minimalist role composition tool. ROLE COMPOSITION Role composition can be thought of as much more clever and meaningful multiple inheritance. The basics of this implementation of roles is: * If a method is already defined on a class, that method will not be composed in from the role. A method inherited by a class gets overridden by the role's method of the same name, though. * If a method that the role "requires" to be implemented is not implemented, role application will fail loudly. Unlike Class::C3, where the last class inherited from "wins," role composition is the other way around, where the class wins. If multiple roles are applied in a single call (single with statement), then if any of their provided methods clash, an exception is raised unless the class provides a method since this conflict indicates a potential problem. IMPORTED SUBROUTINES requires requires qw(foo bar); Declares a list of methods that must be defined to compose role. with with 'Some::Role1'; with 'Some::Role1', 'Some::Role2'; Composes another role into the current role (or class via Role::Tiny::With). If you have conflicts and want to resolve them in favour of Some::Role1 you can instead write: with 'Some::Role1'; with 'Some::Role2'; If you have conflicts and want to resolve different conflicts in favour of different roles, please refactor your codebase. before before foo => sub { ... }; See "before method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. around around foo => sub { ... }; See "around method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. after after foo => sub { ... }; See "after method(s) => sub { ... }" in Class::Method::Modifiers for full documentation. Note that since you are not required to use method modifiers, Class::Method::Modifiers is lazily loaded and we do not declare it as a dependency. If your Role::Tiny role uses modifiers you must depend on both Class::Method::Modifiers and Role::Tiny. Strict and Warnings In addition to importing subroutines, using "Role::Tiny" applies strict and warnings to the caller. SUBROUTINES does_role if (Role::Tiny::does_role($foo, 'Some::Role')) { ... } Returns true if class has been composed with role. This subroutine is also installed as ->does on any class a Role::Tiny is composed into unless that class already has an ->does method, so if ($foo->does('Some::Role')) { ... } will work for classes but to test a role, one must use ::does_role directly. Additionally, Role::Tiny will override the standard Perl "DOES" method for your class. However, if "any" class in your class' inheritance hierarchy provides "DOES", then Role::Tiny will not override it. METHODS apply_roles_to_package Role::Tiny->apply_roles_to_package( 'Some::Package', 'Some::Role', 'Some::Other::Role' ); Composes role with package. See also Role::Tiny::With. apply_roles_to_object Role::Tiny->apply_roles_to_object($foo, qw(Some::Role1 Some::Role2)); Composes roles in order into object directly. Object is reblessed into the resulting class. Note that the object's methods get overridden by the role's ones with the same names. create_class_with_roles Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2)); 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. CAVEATS * On perl 5.8.8 and earlier, applying a role to an object won't apply any overloads from the role to other copies of the object. * On perl 5.16 and earlier, applying a role to a class won't apply any overloads from the role to any existing instances of the class. 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. Ovid's Role::Basic provides roles with a similar scope, but without method modifiers, and having some extra usage restrictions. AUTHOR mst - Matt S. Trout (cpan:MSTROUT) CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) COPYRIGHT Copyright (c) 2010-2012 the Role::Tiny "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. Role-Tiny-2.000006/META.yml000644 000765 000024 00000001500 13200453741 015310 0ustar00gknopstaff000000 000000 --- abstract: 'Roles. Like a nouvelle cuisine portion size slice of Moose.' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::More: '0.88' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Role-Tiny no_index: directory: - t - xt recommends: Class::Method::Modifiers: '1.05' requires: Exporter: '5.57' perl: '5.006' resources: IRC: irc://irc.perl.org/#moose 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.000006' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Role-Tiny-2.000006/lib/000755 000765 000024 00000000000 13200453741 014611 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/Makefile.PL000644 000765 000024 00000005220 13006117121 016005 0ustar00gknopstaff000000 000000 use strict; use warnings; use 5.006; my %META = ( name => 'Role-Tiny', prereqs => { test => { requires => { 'Test::More' => '0.88', } }, runtime => { requires => { 'perl' => '5.006', 'Exporter' => '5.57', }, recommends => { 'Class::Method::Modifiers' => '1.05', }, }, develop => { recommends => { 'Class::Method::Modifiers' => '1.05', 'namespace::autoclean' => 0, 'Moo' => 0, } }, }, resources => { repository => { url => 'git://github.com/moose/Role-Tiny.git', web => 'https://github.com/moose/Role-Tiny', type => 'git', }, bugtracker => { mailto => 'bug-Role-Tiny@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny', }, x_IRC => 'irc://irc.perl.org/#moose', license => [ 'http://dev.perl.org/licenses/' ], }, no_index => { directory => [ 't', 'xt' ] }, ); my %MM_ARGS = ( PREREQ_PM => { ($] >= 5.010 ? () : ('MRO::Compat' => 0)), }, ); ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; (do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### Role-Tiny-2.000006/maint/000755 000765 000024 00000000000 13200453741 015153 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/META.json000644 000765 000024 00000003221 13200453741 015462 0ustar00gknopstaff000000 000000 { "abstract" : "Roles. Like a nouvelle cuisine portion size slice of Moose.", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Role-Tiny", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : {}, "configure" : {}, "develop" : { "recommends" : { "Class::Method::Modifiers" : "1.05", "Moo" : "0", "namespace::autoclean" : "0" } }, "runtime" : { "recommends" : { "Class::Method::Modifiers" : "1.05" }, "requires" : { "Exporter" : "5.57", "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Role-Tiny@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Role-Tiny" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/moose/Role-Tiny.git", "web" : "https://github.com/moose/Role-Tiny" }, "x_IRC" : "irc://irc.perl.org/#moose" }, "version" : "2.000006", "x_serialization_backend" : "JSON::PP version 2.94" } Role-Tiny-2.000006/maint/Makefile.PL.include000644 000765 000024 00000000447 12766335420 020565 0ustar00gknopstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker; ExtUtils::MakeMaker->VERSION(6.68) unless $ENV{CONTINUOUS_INTEGRATION}; author 'mst - Matt S. Trout (cpan:MSTROUT) '; 1; Role-Tiny-2.000006/lib/Role/000755 000765 000024 00000000000 13200453741 015512 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/lib/Role/Tiny.pm000644 000765 000024 00000050207 13200453717 017002 0ustar00gknopstaff000000 000000 package Role::Tiny; sub _getglob { \*{$_[0]} } sub _getstash { \%{"$_[0]::"} } use strict; use warnings; our $VERSION = '2.000006'; $VERSION =~ tr/_//d; our %INFO; our %APPLIED_TO; our %COMPOSED; our %COMPOSITE_INFO; our @ON_ROLE_CREATE; # Module state workaround totally stolen from Zefram's Module::Runtime. BEGIN { *_WORK_AROUND_BROKEN_MODULE_STATE = "$]" < 5.009 ? sub(){1} : sub(){0}; *_WORK_AROUND_HINT_LEAKAGE = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001) ? sub(){1} : sub(){0}; *_MRO_MODULE = "$]" < 5.010 ? sub(){"MRO/Compat.pm"} : sub(){"mro.pm"}; } sub croak { require Carp; no warnings 'redefine'; *croak = \&Carp::croak; goto &Carp::croak; } sub Role::Tiny::__GUARD__::DESTROY { delete $INC{$_[0]->[0]} if @{$_[0]}; } sub _load_module { my ($module) = @_; (my $file = "$module.pm") =~ s{::}{/}g; return 1 if $INC{$file}; # can't just ->can('can') because a sub-package Foo::Bar::Baz # creates a 'Baz::' key in Foo::Bar's symbol table return 1 if grep !/::\z/, keys %{_getstash($module)}; my $guard = _WORK_AROUND_BROKEN_MODULE_STATE && bless([ $file ], 'Role::Tiny::__GUARD__'); local %^H if _WORK_AROUND_HINT_LEAKAGE; require $file; pop @$guard if _WORK_AROUND_BROKEN_MODULE_STATE; return 1; } 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 $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; # a role does itself $APPLIED_TO{$target} = { $target => undef }; foreach my $hook (@ON_ROLE_CREATE) { $hook->($target); } } 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 => @_ ]; return; }; } *{_getglob "${target}::requires"} = sub { push @{$INFO{$target}{requires}||=[]}, @_; return; }; *{_getglob "${target}::with"} = sub { $me->apply_roles_to_package($target, @_); return; }; } 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); croak "This is apply_role_to_package" if ref($to); croak "${role} is not a Role::Tiny" unless $me->is_role($role); 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}}} = (); } sub apply_roles_to_object { my ($me, $object, @roles) = @_; croak "No roles supplied!" unless @roles; my $class = ref($object); # on perl < 5.8.9, magic isn't copied to all ref copies. bless the parameter # directly, so at least the variable passed to us will get any magic applied bless($_[1], $me->create_class_with_roles($class, @roles)); } my $role_suffix = 'A000'; sub _composite_name { my ($me, $superclass, @roles) = @_; my $new_name = join( '__WITH__', $superclass, my $compose_name = join '__AND__', @roles ); if (length($new_name) > 252) { $new_name = $COMPOSED{abbrev}{$new_name} ||= do { my $abbrev = substr $new_name, 0, 250 - length $role_suffix; $abbrev =~ s/(?_composite_name($superclass, @roles); return $new_name if $COMPOSED{class}{$new_name}; foreach my $role (@roles) { _load_module($role); croak "${role} is not a Role::Tiny" unless $me->is_role($role); } require(_MRO_MODULE); my $composite_info = $me->_composite_info_for(@roles); my %conflicts = %{$composite_info->{conflicts}}; if (keys %conflicts) { my $fail = join "\n", map { "Method name conflict for '$_' between roles " ."'".join("' and '", sort values %{$conflicts{$_}})."'" .", cannot apply these simultaneously to an object." } keys %conflicts; croak $fail; } my @composable = map $me->_composable_package_for($_), reverse @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( $superclass, $compose_name, \@requires ); *{_getglob("${new_name}::ISA")} = [ @composable, $superclass ]; @{$APPLIED_TO{$new_name}||={}}{ map keys %{$APPLIED_TO{$_}}, @roles } = (); $COMPOSED{class}{$new_name} = 1; return $new_name; } # preserved for compat, and apply_roles_to_package calls it to allow an # updated Role::Tiny to use a non-updated Moo::Role sub apply_role_to_package { shift->apply_single_role_to_package(@_) } sub apply_roles_to_package { my ($me, $to, @roles) = @_; return $me->apply_role_to_package($to, $roles[0]) if @roles == 1; my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}}; my @have = grep $to->can($_), keys %conflicts; delete @conflicts{@have}; if (keys %conflicts) { my $fail = join "\n", map { "Due to a method name conflict between roles " ."'".join(' and ', sort values %{$conflicts{$_}})."'" .", the method '$_' must be implemented by '${to}'" } keys %conflicts; croak $fail; } # conflicting methods are supposed to be treated as required by the # composed role. we don't have an actual composed role, but because # we know the target class already provides them, we can instead # pretend that the roles don't do for the duration of application. my @role_methods = map $me->_concrete_methods_of($_), @roles; # separate loops, since local ..., delete ... for ...; creates a scope local @{$_}{@have} for @role_methods; delete @{$_}{@have} for @role_methods; # the if guard here is essential since otherwise we accidentally create # a $INFO for something that isn't a Role::Tiny (or Moo::Role) because # autovivification hates us and wants us to die() if ($INFO{$to}) { delete $INFO{$to}{methods}; # reset since we're about to add methods } # 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; } sub _composite_info_for { my ($me, @roles) = @_; $COMPOSITE_INFO{join('|', sort @roles)} ||= do { foreach my $role (@roles) { _load_module($role); } my %methods; foreach my $role (@roles) { 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, requires => [keys %requires] } }; } sub _composable_package_for { my ($me, $role) = @_; my $composed_name = 'Role::Tiny::_COMPOSABLE::'.$role; 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 # ->_install_methods (with the help of ->_install_does) ends up doing. { no strict 'refs'; @{"${composed_name}::ISA"} = ( $base_name ); } my $modifiers = $INFO{$role}{modifiers}||[]; my @mod_base; 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; { local $@; eval(my $code = join "\n", "package ${base_name};", @mod_base); $e = "Evaling failed: $@\nTrying to eval:\n${code}" if $@; } die $e if $e; $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) = @_; 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}) { push @{$to_info->{requires}||=[]}, @requires_fail; } else { croak "Can't apply ${name} to ${to} - missing ".join(', ', @requires_fail); } } } 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 }; } 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}||[]}); } 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); # determine already extant methods of target my %has_methods; @has_methods{grep +(ref($stash->{$_}) || *{$stash->{$_}}{CODE}), keys %$stash } = (); foreach my $i (grep !exists $has_methods{$_}, keys %$methods) { no warnings 'once'; my $glob = _getglob "${to}::${i}"; *$glob = $methods->{$i}; # overloads using method names have the method stored in the scalar slot # and &overload::nil in the code slot. next unless $i =~ /^\(/ && ((defined &overload::nil && $methods->{$i} == \&overload::nil) || (defined &overload::_nil && $methods->{$i} == \&overload::_nil)); my $overload = ${ *{_getglob "${role}::${i}"}{SCALAR} }; next unless defined $overload; *$glob = \$overload; } $me->_install_does($to); } sub _install_modifiers { my ($me, $to, $name) = @_; return unless my $modifiers = $INFO{$name}{modifiers}; my $info = $INFO{$to}; my $existing = ($info ? $info->{modifiers} : $COMPOSED{modifiers}{$to}) ||= []; my @modifiers = grep { my $modifier = $_; !grep $_ == $modifier, @$existing; } @{$modifiers||[]}; push @$existing, @modifiers; if (!$info) { foreach my $modifier (@modifiers) { $me->_install_single_modifier($to, @$modifier); } } } my $vcheck_error; sub _install_single_modifier { my ($me, @args) = @_; defined($vcheck_error) or $vcheck_error = do { local $@; eval { require Class::Method::Modifiers; Class::Method::Modifiers->VERSION(1.05); 1; } ? 0 : $@; }; $vcheck_error and die $vcheck_error; Class::Method::Modifiers::install_modifier(@args); } my $FALLBACK = sub { 0 }; sub _install_does { my ($me, $to) = @_; # only add does() method to classes return if $me->is_role($to); my $does = $me->can('does_role'); # add does() only if they don't have one *{_getglob "${to}::does"} = $does unless $to->can('does'); return if $to->can('DOES') and $to->can('DOES') != (UNIVERSAL->can('DOES') || 0); my $existing = $to->can('DOES') || $to->can('isa') || $FALLBACK; my $new_sub = sub { my ($proto, $role) = @_; $proto->$does($role) or $proto->$existing($role); }; no warnings 'redefine'; return *{_getglob "${to}::DOES"} = $new_sub; } sub does_role { my ($proto, $role) = @_; require(_MRO_MODULE); foreach my $class (@{mro::get_linear_isa(ref($proto)||$proto)}) { return 1 if exists $APPLIED_TO{$class}{$role}; } return 0; } sub is_role { my ($me, $role) = @_; return !!($INFO{$role} && ($INFO{$role}{is_role} || $INFO{$role}{not_methods})); } 1; __END__ =encoding utf-8 =head1 NAME Role::Tiny - Roles. Like a nouvelle cuisine portion size slice of Moose. =head1 SYNOPSIS package Some::Role; use Role::Tiny; sub foo { ... } sub bar { ... } around baz => sub { ... }; 1; elsewhere package Some::Class; use Role::Tiny::With; # bar gets imported, but not foo with 'Some::Role'; sub foo { ... } # baz is wrapped in the around modifier by Class::Method::Modifiers sub baz { ... } 1; If you wanted attributes as well, look at L. =head1 DESCRIPTION C is a minimalist role composition tool. =head1 ROLE COMPOSITION Role composition can be thought of as much more clever and meaningful multiple inheritance. The basics of this implementation of roles is: =over 2 =item * If a method is already defined on a class, that method will not be composed in from the role. A method inherited by a class gets overridden by the role's method of the same name, though. =item * If a method that the role L to be implemented is not implemented, role application will fail loudly. =back Unlike L, where the B class inherited from "wins," role composition is the other way around, where the class wins. If multiple roles are applied in a single call (single with statement), then if any of their provided methods clash, an exception is raised unless the class provides a method since this conflict indicates a potential problem. =head1 IMPORTED SUBROUTINES =head2 requires requires qw(foo bar); Declares a list of methods that must be defined to compose role. =head2 with with 'Some::Role1'; with 'Some::Role1', 'Some::Role2'; Composes another role into the current role (or class via L). If you have conflicts and want to resolve them in favour of Some::Role1 you can instead write: with 'Some::Role1'; with 'Some::Role2'; If you have conflicts and want to resolve different conflicts in favour of different roles, please refactor your codebase. =head2 before before foo => sub { ... }; See L<< Class::Method::Modifiers/before method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 around around foo => sub { ... }; See L<< Class::Method::Modifiers/around method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 after after foo => sub { ... }; See L<< Class::Method::Modifiers/after method(s) => sub { ... } >> for full documentation. Note that since you are not required to use method modifiers, L is lazily loaded and we do not declare it as a dependency. If your L role uses modifiers you must depend on both L and L. =head2 Strict and Warnings In addition to importing subroutines, using C applies L and L to the caller. =head1 SUBROUTINES =head2 does_role if (Role::Tiny::does_role($foo, 'Some::Role')) { ... } Returns true if class has been composed with role. This subroutine is also installed as ->does on any class a Role::Tiny is composed into unless that class already has an ->does method, so if ($foo->does('Some::Role')) { ... } will work for classes but to test a role, one must use ::does_role directly. Additionally, Role::Tiny will override the standard Perl C method for your class. However, if C class in your class' inheritance hierarchy provides C, then Role::Tiny will not override it. =head1 METHODS =head2 apply_roles_to_package Role::Tiny->apply_roles_to_package( 'Some::Package', 'Some::Role', 'Some::Other::Role' ); Composes role with package. See also L. =head2 apply_roles_to_object Role::Tiny->apply_roles_to_object($foo, qw(Some::Role1 Some::Role2)); Composes roles in order into object directly. Object is reblessed into the resulting class. Note that the object's methods get overridden by the role's ones with the same names. =head2 create_class_with_roles Role::Tiny->create_class_with_roles('Some::Base', qw(Some::Role1 Some::Role2)); 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 CAVEATS =over 4 =item * On perl 5.8.8 and earlier, applying a role to an object won't apply any overloads from the role to other copies of the object. =item * On perl 5.16 and earlier, applying a role to a class won't apply any overloads from the role to any existing instances of the class. =back =head1 SEE ALSO L is the attribute-less subset of L; L is a meta-protocol-less subset of the king of role systems, L. Ovid's L provides roles with a similar scope, but without method modifiers, and having some extra usage restrictions. =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS dg - David Leadbeater (cpan:DGL) frew - Arthur Axel "fREW" Schmidt (cpan:FREW) hobbs - Andrew Rodland (cpan:ARODLAND) jnap - John Napiorkowski (cpan:JJNAPIORK) ribasushi - Peter Rabbitson (cpan:RIBASUSHI) chip - Chip Salzenberg (cpan:CHIPS) ajgb - Alex J. G. Burzyński (cpan:AJGB) doy - Jesse Luehrs (cpan:DOY) perigrin - Chris Prather (cpan:PERIGRIN) Mithaldu - Christian Walde (cpan:MITHALDU) ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) tobyink - Toby Inkster (cpan:TOBYINK) haarg - Graham Knop (cpan:HAARG) =head1 COPYRIGHT Copyright (c) 2010-2012 the Role::Tiny L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut Role-Tiny-2.000006/lib/Role/Tiny/000755 000765 000024 00000000000 13200453741 016435 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/lib/Role/Tiny/With.pm000644 000765 000024 00000001356 13200453717 017716 0ustar00gknopstaff000000 000000 package Role::Tiny::With; use strict; use warnings; our $VERSION = '2.000006'; $VERSION = eval $VERSION; use Role::Tiny (); use Exporter 'import'; our @EXPORT = qw( with ); sub with { my $target = caller; Role::Tiny->apply_roles_to_package($target, @_) } 1; =head1 NAME Role::Tiny::With - Neat interface for consumers of Role::Tiny roles =head1 SYNOPSIS package Some::Class; use Role::Tiny::With; with 'Some::Role'; # The role is now mixed in =head1 DESCRIPTION C is a minimalist role composition tool. C provides a C function to compose such roles. =head1 AUTHORS See L for authors. =head1 COPYRIGHT AND LICENSE See L for the copyright and license. =cut Role-Tiny-2.000006/xt/modifiers.t000644 000765 000024 00000002603 12657345111 016653 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Class::Method::Modifiers 1.05 (); BEGIN { package MyRole; use Role::Tiny; around foo => sub { my $orig = shift; join ' ', 'role foo', $orig->(@_) }; } BEGIN { package ExtraRole; use Role::Tiny; } BEGIN { package MyClass; sub foo { 'class foo' } } BEGIN { package ExtraClass; use Role::Tiny::With; with qw(MyRole ExtraRole); sub foo { 'class foo' } } BEGIN { package BrokenRole; use Role::Tiny; around 'broken modifier' => sub { my $orig = shift; $orig->(@_) }; } BEGIN { package MyRole2; use Role::Tiny; with 'MyRole'; } BEGIN { package ExtraClass2; use Role::Tiny::With; with 'MyRole2'; sub foo { 'class foo' } } sub try_apply_to { my $to = shift; eval { Role::Tiny->apply_role_to_package($to, 'MyRole'); 1 } and return undef; return $@ if $@; die "false exception caught!"; } is(try_apply_to('MyClass'), undef, 'role applies cleanly'); is(MyClass->foo, 'role foo class foo', 'method modifier'); is(ExtraClass->foo, 'role foo class foo', 'method modifier with composition'); is(ExtraClass2->foo, 'role foo class foo', 'method modifier with role composed into role'); eval { Role::Tiny->create_class_with_roles('MyClass', 'BrokenRole'); 1; } or $@ ||= 'false exception!'; like $@, qr/Evaling failed:/, 'exception caught creating class with broken modifier in a role'; done_testing; Role-Tiny-2.000006/xt/namespace-clean.t000644 000765 000024 00000000534 12510134146 017677 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use namespace::autoclean (); BEGIN { package Local::Role; use Role::Tiny; sub foo { 1 }; } BEGIN { package Local::Class; use namespace::autoclean; use Role::Tiny::With; with qw( Local::Role ); }; can_ok 'Local::Class', 'foo'; can_ok 'Local::Class', 'does'; done_testing(); Role-Tiny-2.000006/xt/dependents.t000644 000765 000024 00000002431 12705510276 017022 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More !($ENV{EXTENDED_TESTING} || grep $_ eq '--doit', @ARGV) ? (skip_all => 'Set EXTENDED_TESTING to enable dependents testing') : (); use IPC::Open3; use File::Spec; use Cwd qw(abs_path); use Config; my @extra_libs = do { my @libs = `"$^X" -le"print for \@INC"`; chomp @libs; my %libs; @libs{@libs} = (); map { Cwd::abs_path($_) } grep { !exists $libs{$_} } @INC; }; $ENV{PERL5LIB} = join($Config{path_sep}, @extra_libs, $ENV{PERL5LIB}||()); open my $in, '<', File::Spec->devnull or die "can't open devnull: $!"; my $ext = qr{\.(?:t(?:ar\.)?(?:bz2|xz|gz)|tar|zip)}; for my $dist ( 'MSTROUT/Moo-0.009002.tar.gz', # earliest working version 'MSTROUT/Moo-1.000000.tar.gz', 'MSTROUT/Moo-1.000008.tar.gz', 'HAARG/Moo-1.007000.tar.gz', 'HAARG/Moo-2.000000.tar.gz', 'HAARG/Moo-2.001000.tar.gz', 'Moo', ) { 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> }; close $out; waitpid $pid, 0; my $status = $?; if ($dist !~ m{/}) { $output =~ m{^Configuring (.)/(\1.)/(\2.*)$ext\s}m and $name = "$3 (latest)"; } like $output, qr/--\s*OK\s*\z/, "$name passed tests"; } done_testing; Role-Tiny-2.000006/xt/around-does.t000644 000765 000024 00000001142 12510134303 017072 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Class::Method::Modifiers 1.05; my $pass; my $pass2; BEGIN { package Local::Role; use Role::Tiny; around does => sub { my ($orig, $self, @args) = @_; $pass++; return $self->$orig(@args); }; around DOES => sub { my ($orig, $self, @args) = @_; $pass2++; return $self->$orig(@args); }; } BEGIN { package Local::Class; use Role::Tiny::With; with 'Local::Role'; } ok(Local::Class->does('Local::Role')); ok($pass); ok(Local::Class->DOES('Local::Role')); ok($pass2); done_testing(); Role-Tiny-2.000006/xt/does-Moo.t000644 000765 000024 00000001753 12510134430 016345 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Moo (); use Moo::Role (); BEGIN { package Local::Role1; use Moo::Role; } BEGIN { package Local::Role2; use Moo::Role; } BEGIN { package Local::Class1; use Moo; with qw( Local::Role1 Local::Role2 ); } BEGIN { package Local::Class2; use Moo; with qw( Local::Role1 ); with qw( Local::Role2 ); } BEGIN { package Local::Class3; use Moo; with qw( Local::Role1 ); with qw( Local::Role2 ); sub DOES { my ($proto, $role) = @_; return 1 if $role eq 'Local::Role3'; return $proto->does($role); } } for my $c (1 .. 3) { my $class = "Local::Class$c"; for my $r (1 .. 2) { my $role = "Local::Role$r"; ok($class->does($role), "$class\->does($role)"); ok($class->DOES($role), "$class\->DOES($role)"); } } { my $class = "Local::Class3"; my $role = "Local::Role3"; ok( ! $class->does($role), "$class\->does($role)"); ok( $class->DOES($role), "$class\->DOES($role)"); } done_testing; Role-Tiny-2.000006/xt/compose-modifiers.t000644 000765 000024 00000003145 12510134146 020310 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Class::Method::Modifiers 1.05 (); { package One; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Two; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Three; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package Four; use Role::Tiny; around foo => sub { my $orig = shift; (__PACKAGE__, $orig->(@_)) }; package BaseClass; sub foo { __PACKAGE__ } } foreach my $combo ( [ qw(One Two Three Four) ], [ qw(Two Four Three) ], [ qw(One Two) ] ) { my $combined = Role::Tiny->create_class_with_roles('BaseClass', @$combo); is_deeply( [ $combined->foo ], [ reverse(@$combo), 'BaseClass' ], "${combined} ok" ); 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; Role-Tiny-2.000006/xt/recompose-modifier.t000644 000765 000024 00000002246 12705212102 020450 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package ModifierRole; use Role::Tiny; sub method { 0 } around method => sub { my $orig = shift; my $self = shift; $self->$orig(@_) + 1; }; } { package Role1; use Role::Tiny; with 'ModifierRole'; } { package Role2; use Role::Tiny; with 'ModifierRole'; } { package ComposingClass1; use Role::Tiny::With; with qw(Role1 Role2); } is +ComposingClass1->method, 1, 'recomposed modifier called once'; { package ComposingClass2; use Role::Tiny::With; with 'Role1'; with 'Role2'; } is +ComposingClass2->method, 1, 'recomposed modifier called once (separately composed)'; { package DoubleRole; use Role::Tiny; with qw(Role1 Role2); } { package ComposingClass3; use Role::Tiny::With; with 'DoubleRole'; } is +ComposingClass3->method, 1, 'recomposed modifier called once (via composing role)'; { package DoubleRoleSeparate; use Role::Tiny; with 'Role1'; with 'Role2'; } { package ComposingClass4; use Role::Tiny::With; with qw(DoubleRoleSeparate); } is +ComposingClass4->method, 1, 'recomposed modifier called once (via separately composing role)'; done_testing; Role-Tiny-2.000006/t/does.t000644 000765 000024 00000002007 12506422664 015434 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package Local::Role1; use Role::Tiny; } BEGIN { package Local::Role2; use Role::Tiny; } BEGIN { package Local::Class1; use Role::Tiny::With; with qw( Local::Role1 Local::Role2 ); } BEGIN { package Local::Class2; use Role::Tiny::With; with qw( Local::Role1 ); with qw( Local::Role2 ); } BEGIN { package Local::Class3; use Role::Tiny::With; with qw( Local::Role1 ); with qw( Local::Role2 ); sub DOES { my ($proto, $role) = @_; return 1 if $role eq 'Local::Role3'; return $proto->Role::Tiny::does_role($role); } } for my $c (1 .. 3) { my $class = "Local::Class$c"; for my $r (1 .. 2) { my $role = "Local::Role$r"; ok($class->does($role), "$class\->does($role)"); ok($class->DOES($role), "$class\->DOES($role)"); } } { my $class = "Local::Class3"; my $role = "Local::Role3"; ok( ! $class->does($role), "$class\->does($role)"); ok( $class->DOES($role), "$class\->DOES($role)"); } done_testing; Role-Tiny-2.000006/t/role-tiny-composition.t000644 000765 000024 00000000771 13005556225 020767 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package R1; use Role::Tiny; sub foo {} $INC{"R1.pm"} = __FILE__; } { package R2; use Role::Tiny; sub foo {} $INC{"R2.pm"} = __FILE__; } { package X; sub new { bless {} => shift } } eval { Role::Tiny->apply_roles_to_object(X->new, "R1", "R2") }; like $@, qr/^Method name conflict for 'foo' between roles 'R1' and 'R2', cannot apply these simultaneously to an object/, 'apply conflicting roles to object'; done_testing; Role-Tiny-2.000006/t/concrete-methods.t000644 000765 000024 00000001627 12621557333 017754 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { 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 @role_method_list = Role::Tiny->methods_provided_by('MyRole1'); is_deeply(\@role_method_list, ['after_role'], 'methods_provided_by gives method list' ); 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' ); eval { Role::Tiny->methods_provided_by('MyClass1') }; like $@, qr/is not a Role::Tiny/, 'methods_provided_by refuses to work on classes'; done_testing; Role-Tiny-2.000006/t/role-basic-bugs.t000644 000765 000024 00000004313 12766335361 017467 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; # multiple roles with the same role { package RoleC; use Role::Tiny; sub baz { 'baz' } package RoleB; use Role::Tiny; with 'RoleC'; sub bar { 'bar' } package RoleA; use Role::Tiny; with 'RoleC'; sub foo { 'foo' } package Foo; use strict; use warnings; use Role::Tiny 'with'; eval { with 'RoleA', 'RoleB'; 1; } or $@ ||= 'unknown error'; ::is $@, '', 'Composing multiple roles which use the same role should not have conflicts'; sub new { bless {} => shift } my $object = Foo->new; foreach my $method (qw/foo bar baz/) { ::can_ok $object, $method; ::is $object->$method, $method, '... and all methods should be composed in correctly'; } } { no warnings 'redefine'; local *UNIVERSAL::can = sub { 1 }; eval <<' END'; package Can::Can; use Role::Tiny 'with'; with 'A::NonExistent::Role'; END } { my $error = $@ || ''; like $error, qr{^Can't locate A/NonExistent/Role.pm}, 'If ->can always returns true, we should still not think we loaded the role' or diag "Error found: $error"; } { package Role1; use Role::Tiny; package Role2; use Role::Tiny; package Frew; use strict; use warnings; sub new { bless {} => shift } my $object = Frew->new; ::ok(!Role::Tiny::does_role($object, 'Role1'), 'no Role1 yet'); ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet'); Role::Tiny->apply_roles_to_object($object, 'Role1'); ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed'); ::ok(!Role::Tiny::does_role($object, 'Role2'), 'no Role2 yet'); Role::Tiny->apply_roles_to_object($object, 'Role2'); ::ok(Role::Tiny::does_role($object, "Role1"), 'Role1 consumed'); ::ok(Role::Tiny::does_role($object, 'Role2'), 'Role2 consumed'); } BEGIN { package Bar; $INC{'Bar.pm'} = __FILE__; sub new { bless {} => shift } sub bar { 1 } } BEGIN { package Baz; $INC{'Baz.pm'} = __FILE__; use Role::Tiny; sub baz { 1 } } can_ok(Role::Tiny->create_class_with_roles(qw(Bar Baz))->new, qw(bar baz)); done_testing; Role-Tiny-2.000006/t/role-duplication.t000644 000765 000024 00000000615 12657345112 017756 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package Role1; use Role::Tiny; sub foo1 { 1 } } { package Role2; use Role::Tiny; sub foo2 { 2 } } { package BaseClass; sub foo { 0 } } eval { Role::Tiny->create_class_with_roles( 'BaseClass', qw(Role2 Role1 Role1 Role2 Role2), ); }; like $@, qr/\ADuplicated roles: Role1, Role2 /, 'duplicate roles detected'; done_testing; Role-Tiny-2.000006/t/create-hook.t000644 000765 000024 00000000561 12472706642 016711 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Role::Tiny (); my $last_role; push @Role::Tiny::ON_ROLE_CREATE, sub { ($last_role) = @_; }; eval q{ package MyRole; use Role::Tiny; }; is $last_role, 'MyRole', 'role create hook was run'; eval q{ package MyRole2; use Role::Tiny; }; is $last_role, 'MyRole2', 'role create hook was run again'; done_testing; Role-Tiny-2.000006/t/overload.t000644 000765 000024 00000003632 12621557205 016320 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package MyRole; use Role::Tiny; sub as_string { "welp" } sub as_num { 219 } use overload '""' => \&as_string, '0+' => 'as_num', bool => sub(){0}, fallback => 1; } BEGIN { package MyClass; use Role::Tiny::With; with 'MyRole'; sub new { bless {}, shift } } BEGIN { package MyClass2; use overload fallback => 0, '""' => 'class_string', '0+' => sub { 42 }, ; use Role::Tiny::With; with 'MyRole'; sub new { bless {}, shift } sub class_string { 'yarp' } } BEGIN { package MyClass3; sub new { bless {}, shift } } { my $o = MyClass->new; is "$o", 'welp', 'subref overload'; is sprintf('%d', $o), 219, 'method name overload'; ok !$o, 'anon subref overload'; } { my $o = MyClass2->new; eval { my $f = 0+$o }; like $@, qr/no method found/, 'fallback value not overwritten'; is "$o", 'yarp', 'method name overload not overwritten'; is sprintf('%d', $o), 42, 'subref overload not overwritten'; } { my $orig = MyClass3->new; my $copy = $orig; Role::Tiny->apply_roles_to_object($orig, 'MyRole'); for my $o ($orig, $copy) { my $copied = \$o == \$copy ? ' copy' : ''; local $TODO = 'magic not applied to all ref copies on perl < 5.8.9' if $copied && $] < 5.008009; is "$o", 'welp', 'subref overload applied to instance'.$copied; is sprintf('%d', $o), 219, 'method name overload applied to instance'.$copied; ok !$o, 'anon subref overload applied to instance'.$copied; } } { my $o = MyClass3->new; Role::Tiny->apply_roles_to_package('MyClass3', 'MyRole'); local $TODO = 'magic not applied to existing objects on perl < 5.18' if $] < 5.018; is "$o", 'welp', 'subref overload applied to class with instance'; is sprintf('%d', $o), 219, 'method name overload applied to class with instance'; ok !$o, 'anon subref overload applied to class with instance'; } done_testing; Role-Tiny-2.000006/t/role-basic-basic.t000644 000765 000024 00000001217 12766335000 017576 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package My::Does::Basic; $INC{'My/Does/Basic.pm'} = 1; use Role::Tiny; requires 'turbo_charger'; sub no_conflict { return "My::Does::Basic::no_conflict"; } } BEGIN { package My::Example; $INC{'My/Example.pm'} = 1; use Role::Tiny 'with'; with 'My::Does::Basic'; sub new { bless {} => shift } sub turbo_charger {} $My::Example::foo = 1; sub foo() {} } use My::Example; can_ok 'My::Example', 'no_conflict'; is +My::Example->no_conflict, 'My::Does::Basic::no_conflict', '... and it should return the correct value'; done_testing; Role-Tiny-2.000006/t/role-with-inheritance.t000644 000765 000024 00000001007 13006117121 020663 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; { package R1; use Role::Tiny; } { package R2; use Role::Tiny; } { package C1; use Role::Tiny::With; with 'R1'; } { package C2; use Role::Tiny::With; our @ISA=('C1'); with 'R2'; } ok Role::Tiny::does_role('C1','R1'), "Parent does own role"; ok !Role::Tiny::does_role('C1','R2'), "Parent does not do child's role"; ok Role::Tiny::does_role('C2','R1'), "Child does base's role"; ok Role::Tiny::does_role('C2','R2'), "Child does own role"; done_testing(); Role-Tiny-2.000006/t/role-basic-exceptions.t000644 000765 000024 00000003127 12766335372 020714 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; require Role::Tiny; { package My::Does::Basic; use Role::Tiny; requires 'turbo_charger'; sub conflict { return "My::Does::Basic::conflict"; } } eval <<'END_PACKAGE'; package My::Bad::Requirement; use Role::Tiny::With; with 'My::Does::Basic'; # requires turbo_charger END_PACKAGE like $@, qr/missing turbo_charger/, 'Trying to use a role without providing required methods should fail'; { { package My::Conflict; use Role::Tiny; sub conflict {}; } eval <<' END_PACKAGE'; package My::Bad::MethodConflicts; use Role::Tiny::With; with qw(My::Does::Basic My::Conflict); sub turbo_charger {} END_PACKAGE like $@, qr/.*/, 'Trying to use multiple roles with the same method should fail'; } { { package Role1; use Role::Tiny; requires 'missing_method'; sub method1 { 'method1' } } { package Role2; use Role::Tiny; with 'Role1'; sub method2 { 'method2' } } eval <<" END"; package My::Class::Missing1; use Role::Tiny::With; with 'Role2'; END like $@, qr/missing missing_method/, 'Roles composed from roles should propogate requirements upwards'; } { { package Role3; use Role::Tiny; requires qw(this that); } eval <<" END"; package My::Class::Missing2; use Role::Tiny::With; with 'Role3'; END like $@, qr/missing this, that/, 'Roles should be able to require multiple methods'; } done_testing; Role-Tiny-2.000006/t/role-long-package-name.t000644 000765 000024 00000002465 12510132574 020710 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; # using Role::Tiny->apply_roles_to_object with too many roles, # It makes 'Identifier too long' error in string 'eval'. # And, Moo uses string eval. { package R::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA; use Role::Tiny; package R::BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB; use Role::Tiny; package R::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC; use Role::Tiny; package R::DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD; use Role::Tiny; package R::EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE; use Role::Tiny; } # test various lengths so abbreviation cuts off double colon for my $pack (qw( Foo Fooo Foooo Fooooo Foooooo Fooooooo Foooooooo )) { { no strict 'refs'; *{"${pack}::new"} = sub { bless {}, $_[0] }; } my $o = $pack->new; for (qw( R::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA R::BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB R::CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC R::DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD R::EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE )) { Role::Tiny->apply_roles_to_object($o, $_); } my $pkg = ref $o; eval "package $pkg;"; is $@, '', 'package name usable by perl' or diag "package: $pkg"; } done_testing; Role-Tiny-2.000006/t/method-conflicts.t000644 000765 000024 00000001454 12621557611 017750 0ustar00gknopstaff000000 000000 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 }; } ok( !eval { 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', ); ok( eval { 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; Role-Tiny-2.000006/t/role-tiny-with.t000644 000765 000024 00000001433 12763644672 017411 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package MyRole; use Role::Tiny; sub bar { 'role bar' } sub baz { 'role baz' } } BEGIN { package MyClass; use Role::Tiny::With; with 'MyRole'; sub foo { 'class foo' } sub baz { 'class baz' } } is(MyClass->foo, 'class foo', 'method from class no override'); is(MyClass->bar, 'role bar', 'method from role'); is(MyClass->baz, 'class baz', 'method from class'); BEGIN { package RoleWithStub; use Role::Tiny; sub foo { 'role foo' } sub bar ($$); } { package ClassConsumeStub; use Role::Tiny::With; eval { with 'RoleWithStub'; }; } is $@, '', 'stub composed without error'; ok exists &ClassConsumeStub::bar && !defined &ClassConsumeStub::bar, 'stub exists in consuming class'; done_testing; Role-Tiny-2.000006/t/role-tiny.t000644 000765 000024 00000004372 12621561065 016430 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package MyRole; use Role::Tiny; requires qw(req1 req2); sub bar { 'role bar' } sub baz { 'role baz' } } BEGIN { package MyClass; use constant SIMPLE => 'simple'; use constant REF_CONST => [ 'ref_const' ]; use constant VSTRING_CONST => v1; sub req1 { } sub req2 { } sub foo { 'class foo' } sub baz { 'class baz' } } BEGIN { package ExtraClass; sub req1 { } sub req2 { } sub req3 { } sub foo { } sub baz { 'class baz' } } BEGIN { package IntermediaryRole; use Role::Tiny; requires 'req3'; } BEGIN { package NoMethods; package OneMethod; sub req1 { } } BEGIN { package ExtraRole; use Role::Tiny; sub extra1 { 'role extra' } } sub try_apply_to { my $to = shift; eval { Role::Tiny->apply_role_to_package($to, 'MyRole'); 1 } and return undef; return $@ if $@; die "false exception caught!"; } is(try_apply_to('MyClass'), undef, 'role applies cleanly'); is(MyClass->bar, 'role bar', 'method from role'); is(MyClass->baz, 'class baz', 'method from class'); ok(MyClass->does('MyRole'), 'class does role'); 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('NoMethods'), qr/req1, req2/, 'error for both methods'); like(try_apply_to('OneMethod'), qr/req2/, 'error for one method'); eval { Role::Tiny->apply_role_to_package('IntermediaryRole', 'MyRole'); Role::Tiny->apply_role_to_package('ExtraClass', 'IntermediaryRole'); 1; } or $@ ||= "false exception!"; is $@, '', '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'); is(ExtraClass->baz, 'class baz', 'method from class'); my $new_class; eval { $new_class = Role::Tiny->create_class_with_roles('MyClass', 'ExtraRole'); } or $@ ||= "false exception!"; is $@, '', 'No errors creating class with roles'; 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; Role-Tiny-2.000006/t/lib/000755 000765 000024 00000000000 13200453741 015054 5ustar00gknopstaff000000 000000 Role-Tiny-2.000006/t/subclass.t000644 000765 000024 00000004535 12616464576 016343 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; 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; Role-Tiny-2.000006/t/load-module.t000644 000765 000024 00000001344 12616464576 016721 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; use Role::Tiny (); use lib 't/lib'; { package TrackLoad; our $LOADED = 0; } Role::Tiny::_load_module('TrackLoad'); is $TrackLoad::LOADED, 0, 'modules not loaded if symbol table entries exist'; eval { Role::Tiny::_load_module('BrokenModule') }; like "$@", qr/Compilation failed/, 'broken modules throw errors'; eval { require BrokenModule }; like "$@", qr/Compilation failed/, ' ... and still fail if required again'; eval { Role::Tiny::_load_module('FalseModule') }; like "$@", qr/did not return a true value/, 'modules returning false throw errors'; eval { require FalseModule }; like "$@", qr/did not return a true value/, ' ... and still fail if required again'; done_testing; Role-Tiny-2.000006/t/role-basic-composition.t000644 000765 000024 00000013557 12766335366 021111 0ustar00gknopstaff000000 000000 use strict; use warnings; use Test::More; require Role::Tiny; { package My::Does::Basic1; use Role::Tiny; requires 'turbo_charger'; sub method { return __PACKAGE__ . " method"; } } { package My::Does::Basic2; use Role::Tiny; requires 'turbo_charger'; sub method2 { return __PACKAGE__ . " method2"; } } eval <<'END_PACKAGE'; package My::Class1; use Role::Tiny 'with'; with qw( My::Does::Basic1 My::Does::Basic2 ); sub turbo_charger {} END_PACKAGE ok !$@, 'We should be able to use two roles with the same requirements' or die $@; { package My::Does::Basic3; use Role::Tiny; with 'My::Does::Basic2'; sub method3 { return __PACKAGE__ . " method3"; } } eval <<'END_PACKAGE'; package My::Class2; use Role::Tiny 'with'; with qw( My::Does::Basic3 ); sub new { bless {} => shift } sub turbo_charger {} END_PACKAGE ok !$@, 'We should be able to use roles which consume roles' or die $@; can_ok 'My::Class2', 'method2'; is My::Class2->method2, 'My::Does::Basic2 method2', '... and it should be the correct method'; can_ok 'My::Class2', 'method3'; is My::Class2->method3, 'My::Does::Basic3 method3', '... and it should be the correct method'; ok My::Class2->Role::Tiny::does_role('My::Does::Basic3'), 'A class DOES roles which it consumes'; ok My::Class2->Role::Tiny::does_role('My::Does::Basic2'), '... and should do roles which its roles consumes'; ok !My::Class2->Role::Tiny::does_role('My::Does::Basic1'), '... but not roles which it never consumed'; my $object = My::Class2->new; ok $object->Role::Tiny::does_role('My::Does::Basic3'), 'An instance DOES roles which its class consumes'; ok $object->Role::Tiny::does_role('My::Does::Basic2'), '... and should do roles which its roles consumes'; ok !$object->Role::Tiny::does_role('My::Does::Basic1'), '... but not roles which it never consumed'; { package GenAccessors; BEGIN { $INC{'GenAccessors.pm'} = __FILE__ } sub import { my ( $class, @methods ) = @_; my $target = caller; foreach my $method (@methods) { no strict 'refs'; *{"${target}::${method}"} = sub { @_ > 1 ? $_[0]->{$method} = $_[1] : $_[0]->{$method}; }; } } } { { package Role::Which::Imports; use Role::Tiny; use GenAccessors qw(this that); } { package Class::With::ImportingRole; use Role::Tiny 'with'; with 'Role::Which::Imports'; sub new { bless {} => shift } } my $o = Class::With::ImportingRole->new; foreach my $method (qw/this that/) { can_ok $o, $method; ok $o->$method($method), '... and calling "allow"ed methods should succeed'; is $o->$method, $method, '... and it should function correctly'; } } { { package Role::WithImportsOnceRemoved; use Role::Tiny; with 'Role::Which::Imports'; } { package Class::With::ImportingRole2; use Role::Tiny 'with'; $ENV{DEBUG} = 1; with 'Role::WithImportsOnceRemoved'; sub new { bless {} => shift } } ok my $o = Class::With::ImportingRole2->new, 'We should be able to use roles which compose roles which import'; foreach my $method (qw/this that/) { can_ok $o, $method; ok $o->$method($method), '... and calling "allow"ed methods should succeed'; is $o->$method, $method, '... and it should function correctly'; } } { { 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: $@"; } { { package My::Does::Conflict; use Role::Tiny; sub method { return __PACKAGE__ . " method"; } } { package My::Class::Base; sub turbo_charger { return __PACKAGE__ . " turbo charger"; } sub method { return __PACKAGE__ . " method"; } } my $success = eval q{ package My::Class::Child; use base 'My::Class::Base'; use Role::Tiny::With; with qw/My::Does::Basic1 My::Does::Conflict/; 1; }; is $success, 1, 'role conflict resolved by superclass method' or diag "Error: $@"; can_ok 'My::Class::Child', 'method'; is My::Class::Child->method, 'My::Class::Base method', 'inherited method prevails'; } done_testing; Role-Tiny-2.000006/t/lib/TrackLoad.pm000644 000765 000024 00000000056 12462614104 017260 0ustar00gknopstaff000000 000000 package TrackLoad; our $LOADED; $LOADED++; 1; Role-Tiny-2.000006/t/lib/BrokenModule.pm000644 000765 000024 00000000103 12462614104 017773 0ustar00gknopstaff000000 000000 package BrokenModule; use strict; use warnings; my $f = blorp; 1; Role-Tiny-2.000006/t/lib/FalseModule.pm000644 000765 000024 00000000031 12462614104 017605 0ustar00gknopstaff000000 000000 package FalseModule; 0;