--- /dev/null
+Revision history for Role-Tiny
+
+2.002004 - 2021-01-24
+ - restore requiring base class when using create_class_with_roles, which was
+ accidentally lost in 2.002_000 (RT#134075)
+
+2.002003 - 2021-01-11
+ - set dynamic_config to 0 and x_static_install to 1
+ - fixed filenames in dependents author test to not use colons
+ - removed MRO::Compat from prereqs as it is no longer used
+ - marked Class::Method::Modifiers as a hard developer dependency rather than
+ a recommended developer dependency
+ - rewrote test for namespace cleaning to not require namespace::clean, and
+ moved it from an author test to a normal test
+ - removed namespace::autoclean from developer prereqs
+
+2.002_002 - 2021-01-03
+ - refactored some internals for subclasses to use
+ - methods_provided_by will ensure the module is loaded before checking for
+ methods
+
+2.002_001 - 2020-12-27
+ - fix tests when Class::Method::Modifiers is not installed
+
+2.002_000 - 2020-12-23
+ - Refactored create_class_with_roles to not use "composable packages". This
+ was an optimization for when a role is used in many different uses of
+ create_class_with_roles, but required an entirely separate implementation,
+ which did not have fully compatible behavior. It would also result in
+ methods using modifiers being slower.
+ - Add documentation for what methods will be composed from a role
+ (RT#133363)
+ - Fix backwards compatibility with older versions of Moo when interacting
+ with Moose.
+ - Treat modifiers as required methods during create_class_with_roles.
+ - Fixed methods being no longer composed after they participated in an
+ allowed conflict.
+ - Dropped use of MRO::Compat.
+ - Test cleanups for checking requires during create_class_with_roles.
+ - Additional tests to confirm internal role application steps can be fully
+ qualified.
+ - Fix Pod links to Class::Method::Modifiers
+ - Tweaks to author tests
+ - Additional tests for working with older Moo versions
+ - Additional tests for module loading
+ - Allow method modifiers to be specified with an array reference of method
+ names, rather than a list. This now matches how the corresponding
+ Class::Method::Modifiers subs can be called.
+
+2.001004 - 2019-10-25
+ - fix methods being excluded from composition if they previously existed in
+ the composing role (RT#130811)
+ - fix role application overwriting subs that are not considered methods
+ - fix helper subs created by a Role::Tiny extension (like Moo::Role)
+ sometimes being teated as methods
+
+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
+ fixed form in a future version.
+
+2.000007 - 2019-07-31
+ - fix composing roles into packages that have stub subs in them
+ - exclude all constant subs from method list
+
+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
--- /dev/null
+Terms of the Perl programming language system itself
+
+a) the GNU General Public License as published by the Free
+ Software Foundation; either version 1, or (at your option) any
+ later version, or
+b) the "Artistic License"
+
+--- The GNU General Public License, Version 1, February 1989 ---
+
+This software is Copyright (c) 2021 by mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>.
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 1, February 1989
+
+ GNU GENERAL PUBLIC LICENSE
+ Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The license agreements of most software companies try to keep users
+at the mercy of those companies. By contrast, our General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. The
+General Public License applies to the Free Software Foundation's
+software and to any other program whose authors commit to using it.
+You can use it for your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Specifically, the General Public License is designed to make
+sure that you have the freedom to give away or sell copies of free
+software, that you receive source code or can get it if you want it,
+that you can change the software or use pieces of it in new free
+programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of a such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must tell them their rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any program or other work which
+contains a notice placed by the copyright holder saying it may be
+distributed under the terms of this General Public License. The
+"Program", below, refers to any such program or work, and a "work based
+on the Program" means either the Program or any work containing the
+Program or a portion of it, either verbatim or with modifications. Each
+licensee is addressed as "you".
+
+ 1. You may copy and distribute verbatim copies of the Program's source
+code as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+General Public License and to the absence of any warranty; and give any
+other recipients of the Program a copy of this General Public License
+along with the Program. You may charge a fee for the physical act of
+transferring a copy.
+
+ 2. You may modify your copy or copies of the Program or any portion of
+it, and copy and distribute such modifications under the terms of Paragraph
+1 above, provided that you also do the following:
+
+ a) cause the modified files to carry prominent notices stating that
+ you changed the files and the date of any change; and
+
+ b) cause the whole of any work that you distribute or publish, that
+ in whole or in part contains the Program or any part thereof, either
+ with or without modifications, to be licensed at no charge to all
+ third parties under the terms of this General Public License (except
+ that you may choose to grant warranty protection to some or all
+ third parties, at your option).
+
+ c) If the modified program normally reads commands interactively when
+ run, you must cause it, when started running for such interactive use
+ in the simplest and most usual way, to print or display an
+ announcement including an appropriate copyright notice and a notice
+ that there is no warranty (or else, saying that you provide a
+ warranty) and that users may redistribute the program under these
+ conditions, and telling the user how to view a copy of this General
+ Public License.
+
+ d) You may charge a fee for the physical act of transferring a
+ copy, and you may at your option offer warranty protection in
+ exchange for a fee.
+
+Mere aggregation of another independent work with the Program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other work under the scope of these terms.
+
+ 3. You may copy and distribute the Program (or a portion or derivative of
+it, under Paragraph 2) in object code or executable form under the terms of
+Paragraphs 1 and 2 above provided that you also do one of the following:
+
+ a) accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ b) accompany it with a written offer, valid for at least three
+ years, to give any third party free (except for a nominal charge
+ for the cost of distribution) a complete machine-readable copy of the
+ corresponding source code, to be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ c) accompany it with the information you received as to where the
+ corresponding source code may be obtained. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form alone.)
+
+Source code for a work means the preferred form of the work for making
+modifications to it. For an executable file, complete source code means
+all the source code for all modules it contains; but, as a special
+exception, it need not include source code for modules which are standard
+libraries that accompany the operating system on which the executable
+file runs, or for standard header files or definitions files that
+accompany that operating system.
+
+ 4. You may not copy, modify, sublicense, distribute or transfer the
+Program except as expressly provided under this General Public License.
+Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+the Program is void, and will automatically terminate your rights to use
+the Program under this License. However, parties who have received
+copies, or rights to use copies, from you under this General Public
+License will not have their licenses terminated so long as such parties
+remain in full compliance.
+
+ 5. By copying, distributing or modifying the Program (or any work based
+on the Program) you indicate your acceptance of this license to do so,
+and all its terms and conditions.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these
+terms and conditions. You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein.
+
+ 7. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of the license which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+the license, you may choose any version ever published by the Free Software
+Foundation.
+
+ 8. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ Appendix: How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to humanity, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+ To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19xx name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License. Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ program `Gnomovision' (a program to direct compilers to make passes
+ at assemblers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+That's all there is to it!
+
+
+--- The Artistic License 1.0 ---
+
+This software is Copyright (c) 2021 by mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>.
+
+This is free software, licensed under:
+
+ The Artistic License 1.0
+
+The Artistic License
+
+Preamble
+
+The intent of this document is to state the conditions under which a Package
+may be copied, such that the Copyright Holder maintains some semblance of
+artistic control over the development of the package, while giving the users of
+the package the right to use and distribute the Package in a more-or-less
+customary fashion, plus the right to make reasonable modifications.
+
+Definitions:
+
+ - "Package" refers to the collection of files distributed by the Copyright
+ Holder, and derivatives of that collection of files created through
+ textual modification.
+ - "Standard Version" refers to such a Package if it has not been modified,
+ or has been modified in accordance with the wishes of the Copyright
+ Holder.
+ - "Copyright Holder" is whoever is named in the copyright or copyrights for
+ the package.
+ - "You" is you, if you're thinking about copying or distributing this Package.
+ - "Reasonable copying fee" is whatever you can justify on the basis of media
+ cost, duplication charges, time of people involved, and so on. (You will
+ not be required to justify it to the Copyright Holder, but only to the
+ computing community at large as a market that must bear the fee.)
+ - "Freely Available" means that no fee is charged for the item itself, though
+ there may be fees involved in handling the item. It also means that
+ recipients of the item may redistribute it under the same conditions they
+ received it.
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications derived
+from the Public Domain or from the Copyright Holder. A Package modified in such
+a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided that
+you insert a prominent notice in each changed file stating how and when you
+changed that file, and provided that you do at least ONE of the following:
+
+ a) place your modifications in the Public Domain or otherwise make them
+ Freely Available, such as by posting said modifications to Usenet or an
+ equivalent medium, or placing the modifications on a major archive site
+ such as ftp.uu.net, or by allowing the Copyright Holder to include your
+ modifications in the Standard Version of the Package.
+
+ b) use the modified Package only within your corporation or organization.
+
+ c) rename any non-standard executables so the names do not conflict with
+ standard executables, which must also be provided, and provide a separate
+ manual page for each non-standard executable that clearly documents how it
+ differs from the Standard Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or executable
+form, provided that you do at least ONE of the following:
+
+ a) distribute a Standard Version of the executables and library files,
+ together with instructions (in the manual page or equivalent) on where to
+ get the Standard Version.
+
+ b) accompany the distribution with the machine-readable source of the Package
+ with your modifications.
+
+ c) accompany any non-standard executables with their corresponding Standard
+ Version executables, giving the non-standard executables non-standard
+ names, and clearly documenting the differences in manual pages (or
+ equivalent), together with instructions on where to get the Standard
+ Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package. You may charge any fee you choose for support of this Package. You
+may not charge a fee for this Package itself. However, you may distribute this
+Package in aggregate with other (possibly commercial) programs as part of a
+larger (possibly commercial) software distribution provided that you do not
+advertise this Package as a product of your own.
+
+6. The scripts and library files supplied as input to or produced as output
+from the programs of this Package do not automatically fall under the copyright
+of this Package, but belong to whomever generated them, and may be sold
+commercially, and may be aggregated with this Package.
+
+7. C or perl subroutines supplied by you and linked into this Package shall not
+be considered part of this Package.
+
+8. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+The End
+
--- /dev/null
+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/extend-role-tiny.t
+t/extend.t
+t/lib/BrokenModule.pm
+t/lib/ExistingModule.pm
+t/lib/FalseModule.pm
+t/lib/TrueModule.pm
+t/load-module.t
+t/make-role.t
+t/method-conflicts.t
+t/namespace-clean.t
+t/overload.t
+t/proto.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/stub.t
+t/subclass.t
+xt/around-does.t
+xt/compose-modifiers.t
+xt/dependents.t
+xt/dependents/Moo-isa-assign.patch
+xt/dependents/Moo-sort-sub-quote.patch
+xt/modifiers.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)
+LICENSE LICENSE file (added by Distar)
--- /dev/null
+{
+ "abstract" : "Roles: a nouvelle cuisine portion size slice of Moose",
+ "author" : [
+ "mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010",
+ "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" : {
+ "requires" : {
+ "Class::Method::Modifiers" : "1.05"
+ }
+ },
+ "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.002004",
+ "x_serialization_backend" : "JSON::PP version 4.04",
+ "x_static_install" : 1
+}
--- /dev/null
+---
+abstract: 'Roles: a nouvelle cuisine portion size slice of Moose'
+author:
+ - 'mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>'
+build_requires:
+ Test::More: '0.88'
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 7.58, CPAN::Meta::Converter version 2.150010'
+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.002004'
+x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
+x_static_install: 1
--- /dev/null
+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 => {
+ requires => {
+ 'Class::Method::Modifiers' => '1.05',
+ },
+ },
+ },
+ 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' ]
+ },
+ dynamic_config => 0,
+ x_static_install => 1,
+);
+
+my $xt = $ENV{EXTENDED_TESTING} && do {
+ my %x_prereqs = (
+ %{ $META{prereqs}{develop}{requires} },
+ );
+ local $@;
+ !grep !eval {
+ my $module = $_;
+ my $v = $x_prereqs{$module};
+ (my $file = "$module.pm") =~ s{::}{/}g;
+ require $file;
+ $module->VERSION($v)
+ if $v;
+ 1;
+ }, sort keys %x_prereqs;
+};
+
+my %MM_ARGS = (
+ ($xt ? (
+ test => { TESTS => 't/*.t xt/*.t' },
+ ):()),
+);
+
+## 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 ###########################################################
--- /dev/null
+NAME
+ Role::Tiny - Roles: 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.
+
+ ROLE METHODS
+ All subs created after importing Role::Tiny will be considered methods
+ to be composed. For example:
+
+ package MyRole;
+ use List::Util qw(min);
+ sub mysub { }
+ use Role::Tiny;
+ use List::Util qw(max);
+ sub mymethod { }
+
+ In this role, "max" and "mymethod" will be included when composing
+ MyRole, and "min" and "mysub" will not. For additional control,
+ namespace::clean can be used to exclude undesired subs from roles.
+
+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
+ 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'
+ );
+
+ 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) <mst@shadowcat.co.uk>
+
+CONTRIBUTORS
+ dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
+
+ frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
+
+ hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
+
+ jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
+
+ ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
+
+ chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
+
+ ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
+
+ doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
+
+ perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
+
+ Mithaldu - Christian Walde (cpan:MITHALDU)
+ <walde.christian@googlemail.com>
+
+ ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
+
+ tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
+
+ haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
+
+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.
+
--- /dev/null
+package Role::Tiny;
+use strict;
+use warnings;
+
+our $VERSION = '2.002004';
+$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};
+ *_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';
+ *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 _require_module {
+ _load_module($_[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;
+ my $non_methods = $me->_non_methods($target);
+ $me->_install_subs($target, @_);
+ $me->make_role($target);
+ $me->_mark_new_non_methods($target, $non_methods)
+ if $non_methods && %$non_methods;
+ return;
+}
+
+sub _mark_new_non_methods {
+ my ($me, $target, $old_non_methods) = @_;
+
+ my $non_methods = $INFO{$target}{non_methods};
+
+ my $subs = $me->_all_subs($target);
+ for my $sub (keys %$subs) {
+ if ( exists $old_non_methods->{$sub} && $non_methods->{$sub} != $subs->{$sub} ) {
+ $non_methods->{$sub} = $subs->{$sub};
+ }
+ }
+
+ return;
+}
+
+sub make_role {
+ my ($me, $target) = @_;
+
+ return if $me->is_role($target);
+ $INFO{$target}{is_role} = 1;
+
+ 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) {
+ $hook->($target);
+ }
+}
+
+sub _install_subs {
+ my ($me, $target) = @_;
+ return if $me->is_role($target);
+ 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 {
+ my $code = pop;
+ my @names = ref $_[0] eq 'ARRAY' ? @{ $_[0] } : @_;
+ push @{$INFO{$target}{modifiers}||=[]}, [ $type, @names, $code ];
+ return;
+ };
+ } qw(before after around)),
+ requires => sub {
+ push @{$INFO{$target}{requires}||=[]}, @_;
+ return;
+ },
+ with => sub {
+ $me->apply_roles_to_package($target, @_);
+ return;
+ },
+ );
+}
+
+sub role_application_steps {
+ qw(
+ _install_methods
+ _check_requires
+ _install_modifiers
+ _copy_applied_list
+ );
+}
+
+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) = @_;
+ 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 = $superclass . '__WITH__' . 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/(?<!:):$//;
+ $abbrev.'__'.$role_suffix++;
+ };
+ }
+ return $new_name;
+}
+
+sub create_class_with_roles {
+ my ($me, $superclass, @roles) = @_;
+
+ $me->_require_module($superclass);
+ $me->_check_roles(@roles);
+
+ my $new_name = $me->_composite_name($superclass, @roles);
+
+ return $new_name
+ if $COMPOSED{class}{$new_name};
+
+ return $me->_build_class_with_roles($new_name, $superclass, @roles);
+}
+
+sub _build_class_with_roles {
+ my ($me, $new_name, $superclass, @roles) = @_;
+
+ $COMPOSED{base}{$new_name} = $superclass;
+ @{*{_getglob("${new_name}::ISA")}} = ( $superclass );
+ $me->apply_roles_to_package($new_name, @roles);
+ $COMPOSED{class}{$new_name} = 1;
+ return $new_name;
+}
+
+sub _check_roles {
+ my ($me, @roles) = @_;
+ croak "No roles supplied!" unless @roles;
+
+ my %seen;
+ if (my @dupes = grep 1 == $seen{$_}++, @roles) {
+ croak "Duplicated roles: ".join(', ', @dupes);
+ }
+
+ foreach my $role (@roles) {
+ $me->_require_module($role);
+ croak "${role} is not a ${me}" unless $me->is_role($role);
+ }
+}
+
+our %BACKCOMPAT_HACK;
+$BACKCOMPAT_HACK{+__PACKAGE__} = 0;
+sub _want_backcompat_hack {
+ my $me = shift;
+ return $BACKCOMPAT_HACK{$me}
+ if exists $BACKCOMPAT_HACK{$me};
+ no warnings 'uninitialized';
+ $BACKCOMPAT_HACK{$me} =
+ $me->can('apply_single_role_to_package') != \&apply_single_role_to_package
+ && $me->can('role_application_steps') == \&role_application_steps
+}
+
+our $IN_APPLY_ROLES;
+sub apply_single_role_to_package {
+ return
+ if $IN_APPLY_ROLES;
+ local $IN_APPLY_ROLES = 1;
+
+ my ($me, $to, $role) = @_;
+ $me->apply_roles_to_package($to, $role);
+}
+
+sub apply_role_to_package {
+ my ($me, $to, $role) = @_;
+ $me->apply_roles_to_package($to, $role);
+}
+
+sub apply_roles_to_package {
+ my ($me, $to, @roles) = @_;
+ croak "Can't apply roles to object with apply_roles_to_package"
+ if ref $to;
+
+ $me->_check_roles(@roles);
+
+ my @have_conflicts;
+ my %role_methods;
+
+ if (@roles > 1) {
+ my %conflicts = %{$me->_composite_info_for(@roles)->{conflicts}};
+ @have_conflicts = grep $to->can($_), keys %conflicts;
+ delete @conflicts{@have_conflicts};
+
+ if (keys %conflicts) {
+ my $class = $COMPOSED{base}{$to} || $to;
+ my $fail =
+ join "\n",
+ map {
+ "Due to a method name conflict between roles "
+ .join(' and ', map "'$_'", sort values %{$conflicts{$_}})
+ .", the method '$_' must be implemented by '$class'"
+ } sort keys %conflicts;
+ croak $fail;
+ }
+
+ %role_methods = map +($_ => $me->_concrete_methods_of($_)), @roles;
+ }
+
+ if (!$IN_APPLY_ROLES and _want_backcompat_hack($me)) {
+ local $IN_APPLY_ROLES = 1;
+ foreach my $role (@roles) {
+ $me->apply_single_role_to_package($to, $role);
+ }
+ }
+
+ my $role_methods;
+ foreach my $step ($me->role_application_steps) {
+ foreach my $role (@roles) {
+ # 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.
+ $role_methods = $role_methods{$role} and (
+ (local @{$role_methods}{@have_conflicts}),
+ (delete @{$role_methods}{@have_conflicts}),
+ );
+
+ $me->$step($to, $role);
+ }
+ }
+ $APPLIED_TO{$to}{join('|',@roles)} = 1;
+}
+
+sub _composite_info_for {
+ my ($me, @roles) = @_;
+ $COMPOSITE_INFO{join('|', sort @roles)} ||= do {
+ my %methods;
+ foreach my $role (@roles) {
+ my $this_methods = $me->_concrete_methods_of($role);
+ $methods{$_}{$this_methods->{$_}} = $role for keys %$this_methods;
+ }
+ delete $methods{$_} for grep keys(%{$methods{$_}}) == 1, keys %methods;
+ +{ conflicts => \%methods }
+ };
+}
+
+sub _check_requires {
+ my ($me, $to, $name, $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 _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};
+
+ 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) = @_;
+ $me->_require_module($role);
+ croak "${role} is not a ${me}" unless $me->is_role($role);
+ sort (keys %{$me->_concrete_methods_of($role)}, @{$INFO{$role}->{requires}||[]});
+}
+
+sub _install_methods {
+ my ($me, $to, $role) = @_;
+
+ my $methods = $me->_concrete_methods_of($role);
+
+ my %existing_methods;
+ @existing_methods{keys %{ $me->_all_subs($to) }} = ();
+
+ # _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};
+
+ 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}" };
+ 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;
+}
+
+# optimize for newer perls
+require mro
+ if "$]" >= 5.009_005;
+
+if (defined &mro::get_linear_isa) {
+ *_linear_isa = \&mro::get_linear_isa;
+}
+else {
+ my $e;
+ {
+ local $@;
+# this routine is simplified and not fully compatible with mro::get_linear_isa
+# but for our use the order doesn't matter, so we don't need to care
+ eval <<'END_CODE' or $e = $@;
+sub _linear_isa($;$) {
+ if (defined &mro::get_linear_isa) {
+ no warnings 'redefine', 'prototype';
+ *_linear_isa = \&mro::get_linear_isa;
+ goto &mro::get_linear_isa;
+ }
+
+ my @check = shift;
+ my @lin;
+
+ my %found;
+ while (defined(my $check = shift @check)) {
+ push @lin, $check;
+ no strict 'refs';
+ unshift @check, grep !$found{$_}++, @{"$check\::ISA"};
+ }
+
+ return \@lin;
+}
+
+1;
+END_CODE
+ }
+ die $e if defined $e;
+}
+
+sub does_role {
+ my ($proto, $role) = @_;
+ foreach my $class (@{_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}
+ # these are for backward compatibility with older Moo that overrode some
+ # methods without calling the originals, thus not getting is_role set
+ || $INFO{$role}{requires}
+ || $INFO{$role}{not_methods}
+ || $INFO{$role}{non_methods}
+ ));
+}
+
+1;
+__END__
+
+=encoding utf-8
+
+=head1 NAME
+
+Role::Tiny - Roles: 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<Moo::Role>.
+
+=head1 DESCRIPTION
+
+C<Role::Tiny> 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</requires> to be implemented is not implemented,
+role application will fail loudly.
+
+=back
+
+Unlike L<Class::C3>, where the B<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.
+
+=head2 ROLE METHODS
+
+All subs created after importing Role::Tiny will be considered methods to be
+composed. For example:
+
+ package MyRole;
+ use List::Util qw(min);
+ sub mysub { }
+ use Role::Tiny;
+ use List::Util qw(max);
+ sub mymethod { }
+
+In this role, C<max> and C<mymethod> will be included when composing MyRole,
+and C<min> and C<mysub> will not. For additional control, L<namespace::clean>
+can be used to exclude undesired subs from roles.
+
+=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<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.
+
+=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<Class::Method::Modifiers> is lazily loaded and we do not declare it as
+a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
+both L<Class::Method::Modifiers> and L<Role::Tiny>.
+
+=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<Class::Method::Modifiers> is lazily loaded and we do not declare it as
+a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
+both L<Class::Method::Modifiers> and L<Role::Tiny>.
+
+=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<Class::Method::Modifiers> is lazily loaded and we do not declare it as
+a dependency. If your L<Role::Tiny> role uses modifiers you must depend on
+both L<Class::Method::Modifiers> and L<Role::Tiny>.
+
+=head2 Strict and Warnings
+
+In addition to importing subroutines, using C<Role::Tiny> applies L<strict> and
+L<warnings> 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<DOES> method
+for your class. However, if C<any> class in your class' inheritance
+hierarchy provides C<DOES>, then Role::Tiny will not override it.
+
+=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(
+ 'Some::Package', 'Some::Role', 'Some::Other::Role'
+ );
+
+Composes role with package. See also L<Role::Tiny::With>.
+
+=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<Role::Tiny> is the attribute-less subset of L<Moo::Role>; L<Moo::Role> is
+a meta-protocol-less subset of the king of role systems, L<Moose::Role>.
+
+Ovid's L<Role::Basic> provides roles with a similar scope, but without method
+modifiers, and having some extra usage restrictions.
+
+=head1 AUTHOR
+
+mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+dg - David Leadbeater (cpan:DGL) <dgl@dgl.cx>
+
+frew - Arthur Axel "fREW" Schmidt (cpan:FREW) <frioux@gmail.com>
+
+hobbs - Andrew Rodland (cpan:ARODLAND) <arodland@cpan.org>
+
+jnap - John Napiorkowski (cpan:JJNAPIORK) <jjn1056@yahoo.com>
+
+ribasushi - Peter Rabbitson (cpan:RIBASUSHI) <ribasushi@cpan.org>
+
+chip - Chip Salzenberg (cpan:CHIPS) <chip@pobox.com>
+
+ajgb - Alex J. G. Burzyński (cpan:AJGB) <ajgb@cpan.org>
+
+doy - Jesse Luehrs (cpan:DOY) <doy at tozt dot net>
+
+perigrin - Chris Prather (cpan:PERIGRIN) <chris@prather.org>
+
+Mithaldu - Christian Walde (cpan:MITHALDU) <walde.christian@googlemail.com>
+
+ilmari - Dagfinn Ilmari Mannsåker (cpan:ILMARI) <ilmari@ilmari.org>
+
+tobyink - Toby Inkster (cpan:TOBYINK) <tobyink@cpan.org>
+
+haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010-2012 the Role::Tiny L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
+
+=cut
--- /dev/null
+package Role::Tiny::With;
+
+use strict;
+use warnings;
+
+our $VERSION = '2.002004';
+$VERSION =~ tr/_//d;
+
+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<Role::Tiny> is a minimalist role composition tool. C<Role::Tiny::With>
+provides a C<with> function to compose such roles.
+
+=head1 AUTHORS
+
+See L<Role::Tiny> for authors.
+
+=head1 COPYRIGHT AND LICENSE
+
+See L<Role::Tiny> for the copyright and license.
+
+=cut
+
+
--- /dev/null
+BEGIN { -e 'Distar' or system qw(git clone https://github.com/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) <mst@shadowcat.co.uk>';
+
+manifest_include 'xt/dependents', '.patch';
+
+1;
--- /dev/null
+use strict;
+use warnings;
+no warnings 'once';
+use Test::More;
+
+BEGIN {
+ package MyRole1;
+
+ 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 $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;
+}
+
+{
+ package MyClass1;
+ no warnings 'once';
+
+ our $GLOBAL1 = 1;
+ 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], [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([sort @role_method_list], [sort @methods],
+ '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';
+
+{
+ package Look::Out::Here::Comes::A::Role;
+ use Role::Tiny;
+ sub its_a_method { 1 }
+}
+
+{
+ package And::Another::One;
+ sub its_a_method { 2 }
+ use Role::Tiny;
+
+ my @warnings;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
+ with 'Look::Out::Here::Comes::A::Role';
+ ::is join('', @warnings), '',
+ 'non-methods not overwritten by role composition';
+}
+
+{
+ package RoleLikeOldMoo;
+ use Role::Tiny;
+ sub not_a_method { 1 }
+
+ # simulate what older versions of Moo do to mark non-methods
+ $Role::Tiny::INFO{+__PACKAGE__}{not_methods}{$_} = $_
+ for \¬_a_method;
+}
+
+is_deeply [Role::Tiny->methods_provided_by('RoleLikeOldMoo')], [],
+ 'subs marked in not_methods (like old Moo) are excluded from method list';
+
+done_testing;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ package My::Role::Tiny::Extension;
+ $INC{'My/Role/Tiny/Extension.pm'} = __FILE__;
+ use Role::Tiny ();
+ our @ISA = qw(Role::Tiny);
+
+ my %lie;
+
+ sub _install_subs {
+ my $me = shift;
+ my ($role) = @_;
+ local $lie{$role} = 1;
+ $me->SUPER::_install_subs(@_);
+ }
+
+ sub is_role {
+ my ($me, $role) = @_;
+ return 0
+ if $lie{$role};
+ $me->SUPER::is_role($role);
+ }
+}
+
+my @warnings;
+BEGIN {
+ package My::Thing::Using::Extended::Role;
+ My::Role::Tiny::Extension->import;
+ local $SIG{__WARN__} = sub { push @warnings, @_ };
+ My::Role::Tiny::Extension->import;
+}
+
+my $methods = My::Role::Tiny::Extension->_concrete_methods_of('My::Thing::Using::Extended::Role');
+is join(', ', sort keys %$methods), '',
+ 'subs installed when creating a role are not methods';
+
+# there will be warnings but we don't care about them
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+my %apply_steps;
+BEGIN {
+ package MyRoleTinyExtension;
+ use Role::Tiny ();
+ our @ISA = qw(Role::Tiny);
+
+ sub role_application_steps {
+ my $self = shift;
+ return (
+ 'role_apply_before',
+ $self->SUPER::role_application_steps(@_),
+ 'Fully::Qualified::role_apply_after',
+ );
+ };
+
+ sub role_apply_before {
+ my ($self, $to, $role) = @_;
+ ::ok !Role::Tiny::does_role($to, $role),
+ "$role not applied to $to yet";
+ $apply_steps{$to}{$role}{before}++;
+ }
+ sub Fully::Qualified::role_apply_after {
+ my ($self, $to, $role) = @_;
+ ::ok +Role::Tiny::does_role($to, $role),
+ "$role applied to $to";
+ $apply_steps{$to}{$role}{after}++;
+ }
+}
+
+{
+ package ExtendedRole;
+ MyRoleTinyExtension->import;
+
+ sub added_sub {}
+}
+
+{
+ package ApplyTo;
+ MyRoleTinyExtension->apply_role_to_package(__PACKAGE__, 'ExtendedRole');
+}
+
+is $apply_steps{'ApplyTo'}{'ExtendedRole'}{before}, 1,
+ 'before step was run';
+
+is $apply_steps{'ApplyTo'}{'ExtendedRole'}{after}, 1,
+ 'after step was run';
+
+done_testing;
--- /dev/null
+package BrokenModule;
+use strict;
+use warnings;
+
+my $f = blorp;
+1;
--- /dev/null
+package ExistingModule;
+our $LOADED;
+$LOADED++;
+1;
--- /dev/null
+package FalseModule;
+
+0;
--- /dev/null
+package TrueModule;
+our $LOADED;
+$LOADED++;
+1;
--- /dev/null
+use strict;
+use warnings;
+no warnings 'once';
+use Test::More;
+use Role::Tiny ();
+
+use lib 't/lib';
+
+Role::Tiny::_load_module('TrueModule');
+
+is do {
+ no strict 'refs';
+ ${"TrueModule::LOADED"}
+}, 1, 'normal module loaded properly';
+
+{
+ package ExistingModule;
+ our $LOADED = 0;
+}
+
+Role::Tiny::_load_module('ExistingModule');
+is do {
+ no strict 'refs';
+ ${"ExistingModule::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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+use B ();
+
+sub is_method {
+ my ($ns, $sub) = @_;
+ no strict 'refs';
+ my $cv = B::svref_2object(\&{"${ns}::${sub}"});
+ return
+ if !$cv->isa('B::CV');
+ my $gv = $cv->GV;
+ return
+ if $gv->isa('B::SPECIAL');
+
+ my $pack = $gv->STASH->NAME
+ or return;
+
+ return (
+ $pack eq $ns
+ || ($pack eq 'constant' && $gv->name eq '__ANON__')
+ );
+}
+
+BEGIN {
+ package Local::Role;
+ use Role::Tiny;
+ sub foo { 1 };
+}
+
+BEGIN {
+ package Local::Class;
+ use Role::Tiny::With;
+ with qw( Local::Role );
+
+ BEGIN {
+ # poor man's namespace::autoclean
+ no strict 'refs';
+ my @subs = grep defined &$_, keys %Local::Class::;
+ my @imports = grep !::is_method(__PACKAGE__, $_), @subs;
+ delete @Local::Class::{@imports};
+ }
+}
+
+ok !defined &Local::Class::with, 'imports are cleaned';
+
+can_ok 'Local::Class', 'foo';
+can_ok 'Local::Class', 'does';
+
+BEGIN {
+ package Local::Role2;
+ use Role::Tiny;
+
+ # poor man's namespace::clean
+ my @subs;
+ BEGIN {
+ no strict 'refs';
+ @subs = grep defined &$_, keys %Local::Role2::
+ }
+ delete @Local::Role2::{@subs};
+
+ sub foo { 1 };
+}
+
+BEGIN {
+ package Local::Role2;
+ use Role::Tiny;
+}
+
+# this may not be ideal, but we'll test it since it is done explicitly
+ok !defined &Local::Role2::with, 'subs are not re-exported';
+
+done_testing;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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;
--- /dev/null
+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';
+}
+
+{
+ 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;
--- /dev/null
+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';
+ 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';
+
+ $success = eval q{
+ package My::Class::Child2;
+ use base 'My::Class::Base';
+ use Role::Tiny::With;
+ with qw/My::Does::Basic1/;
+ 1;
+ };
+ is $success, 1, 'role composed after conflict resolution' or diag "Error: $@";
+ can_ok 'My::Class::Child2', 'method';
+ is My::Class::Child2->method, 'My::Does::Basic1 method', 'role method applied';
+}
+
+done_testing;
--- /dev/null
+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;
--- /dev/null
+use strict;
+use warnings;
+use Test::More;
+
+BEGIN {
+ package Role1; use Role::Tiny;
+ sub foo1 { 1 }
+}
+BEGIN {
+ package Role2; use Role::Tiny;
+ sub foo2 { 2 }
+}
+BEGIN {
+ 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';
+
+BEGIN {
+ package AnotherRole;
+ use Role::Tiny;
+ with 'Role1';
+}
+
+BEGIN {
+ package AnotherClass;
+ use Role::Tiny::With;
+ with 'AnotherRole';
+ delete $AnotherClass::{foo1};
+ with 'AnotherRole';
+}
+
+ok +AnotherClass->can('foo1'),
+ 'reapplying roles re-adds missing methods';
+
+done_testing;
--- /dev/null
+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;
--- /dev/null
+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/^Due to a method name conflict between roles 'R1' and 'R2', the method 'foo' must be implemented by 'X'/,
+ '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;
--- /dev/null
+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,
+ 'stub exists in consuming class';
+ok !defined &ClassConsumeStub::bar,
+ 'stub consumed as stub';
+
+done_testing;
--- /dev/null
+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(bless {}, 'MyClass'), qr/\ACan't apply roles to object/,
+ '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');
+
+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';
+
+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');
+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');
+
+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');
+
+
+done_testing;
--- /dev/null
+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();
--- /dev/null
+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;
--- /dev/null
+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 ClassWithoutExtraMethod;
+ sub foo {}
+}
+{
+ package RoleWithRequires;
+ use Role::Tiny;
+ requires 'extra_sub';
+}
+eval { Role::Tiny->create_class_with_roles('ClassWithoutExtraMethod', 'RoleWithRequires') };
+like $@, qr/extra_sub/,
+ '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 RoleWithAround;
+ use Role::Tiny;
+ around extra_sub => sub { my $orig = shift; $orig->(@_); };
+ }
+
+ eval { Role::Tiny->create_class_with_roles('ClassWithoutExtraMethod', 'RoleWithAround') };
+ like $@, qr/extra_sub/,
+ 'requires for modifiers 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';
+}
+
+SKIP: {
+ skip "Class::Method::Modifiers not installed or too old", 1
+ unless eval "use Class::Method::Modifiers 1.05; 1";
+ {
+ package CreateMITest::Top;
+ sub method { return __PACKAGE__ }
+
+ package CreateMITest::Left;
+ our @ISA = qw(CreateMITest::Top);
+
+ package CreateMITest::Right;
+ our @ISA = qw(CreateMITest::Top);
+ sub method { return (__PACKAGE__, $_[0]->SUPER::method); }
+
+ package CreateMITest::Bottom;
+ our @ISA = qw(CreateMITest::Left CreateMITest::Right);
+ }
+
+ {
+ package CreateMITest::MyRole;
+ use Role::Tiny;
+ around method => sub {
+ my ($orig, $self) = (shift, shift);
+ return (__PACKAGE__, $self->$orig);
+ };
+ }
+
+ {
+ package CreateMITest::MyChild;
+ use Role::Tiny::With;
+ our @ISA = qw(CreateMITest::Bottom);
+ with 'CreateMITest::MyRole';
+ }
+
+ my $child_with = 'CreateMITest::MyChild';
+ my $child_gen = Role::Tiny->create_class_with_roles('CreateMITest::Bottom', 'CreateMITest::MyRole');
+
+ my @want = $child_with->method;
+ my @got = $child_gen->method;
+
+ is join(', ', @got), join(', ', @want),
+ 'create_class_with_roles follows same MRO as equivalent using with';
+}
+
+done_testing;
--- /dev/null
+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();
--- /dev/null
+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;
+ requires 'foo';
+ 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 BaseClassNoFoo;
+ sub bar { __PACKAGE__ }
+}
+
+{
+ is eval {
+ package WithFour;
+ use Role::Tiny::With;
+ use base 'BaseClassNoFoo';
+ with 'Four';
+ }, undef,
+ "composing an around modifier fails when method doesn't exist";
+ like $@, qr/Can't apply Four to WithFour - missing foo/,
+ ' ... with correct error message';
+}
+{
+ is eval {
+ Role::Tiny->create_class_with_roles('BaseClassNoFoo', 'Four');
+ }, undef,
+ "composing an around modifier fails when method doesn't exist";
+ like $@, qr/Can't apply Four to .* - missing foo/,
+ ' ... with correct error message';
+}
+
+{
+ package WrapsMultiple;
+ use Role::Tiny;
+ around 'method1', 'method2', sub {
+ my $orig = shift;
+ return (__PACKAGE__, $orig->(@_));
+ };
+ around [ 'method3', 'method4' ], sub {
+ my $orig = shift;
+ return (__PACKAGE__, $orig->(@_));
+ };
+}
+
+{
+ package ClassToWrapMultiple;
+ use Role::Tiny::With;
+ sub method1 { __PACKAGE__ }
+ sub method2 { __PACKAGE__ }
+ sub method3 { __PACKAGE__ }
+ sub method4 { __PACKAGE__ }
+ with 'WrapsMultiple';
+}
+
+for my $method (qw(method1 method2)) {
+ is_deeply(
+ [ ClassToWrapMultiple->$method ], [ 'WrapsMultiple', 'ClassToWrapMultiple' ],
+ 'wrapping multiple methods using list works',
+ );
+}
+
+for my $method (qw(method3 method4)) {
+ is_deeply(
+ [ ClassToWrapMultiple->$method ], [ 'WrapsMultiple', 'ClassToWrapMultiple' ],
+ 'wrapping multiple methods using arrayref works',
+ );
+}
+
+done_testing;
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More;
+use IPC::Open3;
+use File::Spec;
+use Cwd qw(abs_path);
+use Config ();
+use File::Temp;
+use Cwd ();
+use File::Basename ();
+use Data::Dumper ();
+use Getopt::Long qw(:config gnu_getopt);
+
+my $v = 0;
+sub cpan {
+ my $cmd = shift;
+ open my $in, '<', File::Spec->devnull
+ or die "can't open devnull: $!";
+ my $pid = open3 $in, my $out, undef, $^X, '-MCPAN', '-e', "$cmd(\@ARGV)", @_;
+ my $output = '';
+ while (my $line = <$out>) {
+ $output .= $line;
+ if ($v || $line =~ /^Running / || $line =~ / --( NOT)? OK$/) {
+ diag $line;
+ }
+ }
+ close $out;
+ waitpid $pid, 0;
+ my $status = $?;
+ return wantarray ? ($output, $status) : $output;
+}
+
+my $prefs = do {
+ my $xt = sub {
+ my ($dist, $extra) = @_;
+ my $config = {
+ %$extra,
+ match => {
+ distribution => $dist,
+ env => { MOO_XT => 1 },
+ },
+ test => {
+ args => [ 'TEST_FILES=t/*.t xt/*.t' ],
+ },
+ };
+ return $config;
+ };
+ {
+ 'Moo' => [
+ {
+ match => { distribution => '\\bMoo-0\\.009001\\b' },
+ patches => [
+ 'Moo-isa-assign.patch',
+ 'Moo-sort-sub-quote.patch'
+ ],
+ },
+ {
+ match => { distribution => '\\bMoo-0\\.00900[2-7]\\b' },
+ patches => [
+ 'Moo-sort-sub-quote.patch'
+ ],
+ },
+ {
+ match => { distribution => '\\bMoo-0\\.009_?(00[8-9]|01[0-4])\\b' },
+ },
+ $xt->('\\bMoo-0\\.(009_?01[5-9]|091_?00[012])', {
+ depends => {
+ requires => {
+ 'MooX::Types::MooseLike::Base' => 0,
+ 'MooX::Types::MooseLike::Numeric' => 0,
+ 'Moose' => 0,
+ 'MooseX::Types::Common::Numeric' => 0
+ }
+ },
+ }),
+ $xt->('\\bMoo-0\\.091003', {
+ depends => {
+ requires => {
+ 'MooX::Types::MooseLike::Base' => 0,
+ 'MooX::Types::MooseLike::Numeric' => 0,
+ 'Moose' => 0,
+ 'MooseX::Types::Common::Numeric' => 0,
+ 'namespace::autoclean' => 0
+ }
+ },
+ }),
+ $xt->('\\bMoo-(0\\.091_?(00[4-9]|01[0-4])|1.00[012]|1.003000)', {
+ depends => {
+ requires => {
+ 'MooX::Types::MooseLike::Base' => 0,
+ 'MooX::Types::MooseLike::Numeric' => 0,
+ 'Moose' => 0,
+ 'MooseX::Types::Common::Numeric' => 0,
+ 'namespace::autoclean' => 0,
+ 'namespace::clean' => 0
+ }
+ },
+ }),
+ $xt->('\\bMoo-1.0', {
+ depends => {
+ requires => {
+ 'Moose' => 0,
+ 'MooseX::Types::Common::Numeric' => 0,
+ 'Mouse' => 0,
+ 'namespace::autoclean' => 0,
+ 'namespace::clean' => 0
+ }
+ },
+ }),
+ $xt->('\\bMoo-(1|2.00[0-3])', {
+ depends => {
+ requires => {
+ 'Class::Tiny' => 0,
+ 'Moose' => 0,
+ 'MooseX::Types::Common::Numeric' => 0,
+ 'Mouse' => 0,
+ 'Type::Tiny' => 0,
+ 'namespace::autoclean' => 0,
+ 'namespace::clean' => 0
+ }
+ },
+ }),
+ $xt->('\\bMoo-v?[0-9]', {
+ pl => {
+ env => { EXTENDED_TESTING => 1 },
+ },
+ }),
+ ],
+ 'Role-Tiny' => [
+ {
+ match => { distribution => "\\bRole-Tiny-\\b" },
+ install => { commandline => 'echo "skipped"' },
+ },
+ ],
+ };
+};
+
+GetOptions(
+ 'verbose|v' => sub { $v++ },
+ 'quiet|q' => sub { $v-- },
+ 'doit' => \(my $doit = $ENV{EXTENDED_TESTING}),
+) or die 'Bad parameters!';
+
+$v = 0
+ if $v < 0;
+
+my @dists = @ARGV;
+if (!@dists && $doit) {
+ @dists = qw(
+ MSTROUT/Moo-0.009001.tar.gz
+ MSTROUT/Moo-0.091011.tar.gz
+ 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
+ namespace::autoclean
+ Dancer2
+ MooX::Options
+ MooX::ClassAttribute
+ );
+}
+
+plan skip_all => 'Set EXTENDED_TESTING to enable dependents testing'
+ if !@dists;
+
+plan tests => scalar @dists;
+
+my $path_sep = $Config::Config{path_sep};
+my $archname = $Config::Config{archname};
+my $version = $Config::Config{version};
+
+my $temp_home = File::Temp::tempdir('Role-Tiny-XXXXXX', TMPDIR => 1, CLEANUP => 1);
+
+my $local_lib = "$temp_home/perl5";
+mkdir "$local_lib";
+mkdir "$local_lib/bin";
+mkdir "$local_lib/lib";
+mkdir "$local_lib/lib/perl5";
+mkdir "$local_lib/lib/perl5/$version";
+mkdir "$local_lib/lib/perl5/$version/$archname";
+mkdir "$local_lib/lib/perl5/$archname";
+mkdir "$local_lib/man";
+mkdir "$local_lib/man1";
+mkdir "$local_lib/man3";
+
+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;
+};
+
+my $cpan_home = "$temp_home/.cpan";
+mkdir $cpan_home;
+mkdir "$cpan_home/CPAN";
+my $prefs_dir = "$cpan_home/prefs";
+mkdir $prefs_dir;
+
+my $patch_dir = Cwd::realpath(File::Basename::dirname(__FILE__) . '/dependents');
+
+delete $ENV{HARNESS_PERL_SWITCHES};
+delete $ENV{AUTHOR_TESTING};
+delete $ENV{EXTENDED_TESTING};
+delete $ENV{RELEASE_TESTING};
+$ENV{NONINTERACTIVE_TESTING} = 1;
+$ENV{PERL_MM_USE_DEFAULT} = 1;
+$ENV{HOME} = $temp_home;
+$ENV{PERL5LIB} = join $path_sep, "$local_lib/lib/perl5", @extra_libs, $ENV{PERL5LIB}||();
+$ENV{PERL_MM_OPT} = qq{INSTALL_BASE="$local_lib"};
+$ENV{PERL_MB_OPT} = qq{--install_base "$local_lib"};
+$ENV{PERL_LOCAL_LIB_ROOT} = join $path_sep, $local_lib, $ENV{PERL_LOCAL_LIB_ROOT}||();
+
+my $config_file = "$cpan_home/CPAN/MyConfig.pm";
+{
+ open my $fh, '>', $config_file
+ or die;
+
+ my $config = do {
+ local $Data::Dumper::Terse = 0;
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Indent = 1;
+ Data::Dumper->Dump([{
+ allow_installing_module_downgrades => 'yes',
+ allow_installing_outdated_dists => 'yes',
+ auto_commit => 0,
+ build_requires_install_policy => 'yes',
+ connect_to_internet_ok => 1,
+ cpan_home => $cpan_home,
+ inhibit_startup_message => 1,
+ prefs_dir => $prefs_dir,
+ patches_dir => $patch_dir,
+ prerequisites_policy => 'follow',
+ recommends_policy => 0,
+ suggests_policy => 0,
+ urllist => [ 'http://cpan.metacpan.org/' ],
+ use_sqlite => 0,
+ }], ['$CPAN::Config']);
+ };
+ print { $fh } $config . "1;\n__END__\n";
+ close $fh;
+}
+
+cpan('CPAN::Shell->o', 'conf');
+
+{
+
+ local $CPAN::Config;
+ require $config_file;
+
+ my $yaml = $CPAN::Config->{yaml_module};
+ if ($yaml) {
+ (my $mod = "$yaml.pm") =~ s{::}{/}g;
+ eval { require $mod }
+ or undef $yaml;
+ }
+
+ for my $dist (keys %$prefs) {
+ my $prefs = $prefs->{$dist};
+
+ if ($yaml) {
+ open my $fh, '>', "$prefs_dir/$dist.yml";
+ print { $fh } $yaml->can('Dump')->(@$prefs);
+ close $fh;
+ }
+
+ local $Data::Dumper::Sortkeys = 1;
+ local $Data::Dumper::Indent = 1;
+ open my $fh, '>', "$prefs_dir/$dist.dd";
+ print { $fh } Data::Dumper::Dumper(@$prefs);
+ close $fh;
+ }
+}
+
+my $ext = qr{\.(?:t(?:ar\.)?(?:bz2|xz|gz)|tar|zip)};
+for my $dist (@dists) {
+ my $name = $dist;
+ $name =~ s{$ext$}{}
+ if $name =~ m{/};
+
+ note "Testing $dist ...";
+
+ local $ENV{MOO_XT} = $dist =~ /\bMoo\b/ ? '1' : '0';
+
+ my $prereq_output = cpan('notest', 'install', $dist);
+
+ # in case Role::Tiny got installed somehow
+ unlink "$local_lib/lib/perl5/Role/Tiny.pm";
+ unlink "$local_lib/lib/perl5/Role/Tiny/With.pm";
+
+ my $test_output = cpan('test', $dist);
+
+ if ($dist !~ m{/}) {
+ $test_output =~ m{^Configuring (.)/(\1.)/(\2.*)$ext\s}m
+ and $name = "$3 (latest)";
+ }
+
+ my $passed = $test_output =~ /--\s*OK\s*\z/ && $test_output !~ /--\s*NOT\s+OK\s*\z/;
+ ok $passed, "$name passed tests";
+ diag "$prereq_output$test_output"
+ if !$passed && !$v;
+}
+
+done_testing;
+
+__DATA__
--- /dev/null
+--- i/lib/Moo.pm
++++ w/lib/Moo.pm
+@@ -15,7 +15,7 @@ sub import {
+ return if $MAKERS{$target}; # already exported into this package
+ *{_getglob("${target}::extends")} = sub {
+ _load_module($_) for @_;
+- *{_getglob("${target}::ISA")} = \@_;
++ *{_getglob("${target}::ISA")} = [@_];
+ };
+ *{_getglob("${target}::with")} = sub {
+ require Moo::Role;
--- /dev/null
+--- i/t/sub-quote.t
++++ w/t/sub-quote.t
+@@ -21,7 +21,7 @@ ok(!keys %EVALED, 'Nothing evaled yet');
+ my $u_one = unquote_sub $one;
+
+ is_deeply(
+- [ keys %EVALED ], [ qw(one two) ],
++ [ sort keys %EVALED ], [ qw(one two) ],
+ 'Both subs evaled'
+ );
--- /dev/null
+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/broken modifier/,
+ 'exception caught creating class with broken modifier in a role';
+
+done_testing;
--- /dev/null
+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;
projects / platform / upstream / perl-Role-Tiny.git / commitdiff