CONTRIBUTING000664001750001750 531712234215345 15405 0ustar00taitai000000000000MooseX-XSAccessor-0.007NAME CONTRIBUTING DESCRIPTION If you're reading this document, that means you might be thinking about helping me out with this project. Thanks! Here's some ways you could help out: * Bug reports Found a bug? Great! (Well, not so great I suppose.) The place to report them is . Don't e-mail me about it, as your e-mail is more than likely to get lost amongst the spam. An example script clearly demonstrating the bug (preferably written using Test::More) would be greatly appreciated. * Patches If you've found a bug and written a fix for it, even better! Generally speaking you should check out the latest copy of the code from the source repository rather than using the CPAN distribution. The file META.yml should contain a link to the source repository. If not, then try or submit a bug report. (As far as I'm concerned the lack of a link is a bug.) Many of my distributions are also mirrored at . To submit the patch, do a pull request on GitHub or Bitbucket, or attach a diff file to a bug report. Unless otherwise stated, I'll assume that your contributions are licensed under the same terms as the rest of the project. (If using git, feel free to work in a branch. For Mercurial, I'd prefer bookmarks within the default branch.) * Documentation If there's anything unclear in the documentation, please submit this as a bug report or patch as above. Non-toy example scripts that I can bundle would also be appreciated. * Translation Translations of documentation would be welcome. For translations of error messages and other strings embedded in the code, check with me first. Sometimes the English strings may not in a stable state, so it would be a waste of time translating them. Coding Style I tend to write using something approximating the Allman style, using tabs for indentation and Unix-style line breaks. * * I nominally encode all source files as UTF-8, though in practice most of them use a 7-bit-safe ASCII-compatible subset of UTF-8. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE Copyright (c) 2012-2013 by Toby Inkster. CONTRIBUTING.pod is licensed under the Creative Commons Attribution-ShareAlike 2.0 UK: England & Wales License. To view a copy of this license, visit . COPYRIGHT000664001750001750 525512234215345 15047 0ustar00taitai000000000000MooseX-XSAccessor-0.007Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ Upstream-Name: MooseX-XSAccessor Upstream-Contact: Toby Inkster (TOBYINK) Source: https://metacpan.org/release/MooseX-XSAccessor Files: t/moose_accessor_context.t t/moose_accessor_inlining.t t/moose_accessor_override_method.t t/moose_accessor_overwrite_warning.t t/moose_attr_dereference_test.t t/moose_attribute_accessor_generation.t t/moose_attribute_custom_metaclass.t t/moose_attribute_delegation.t t/moose_attribute_does.t t/moose_attribute_inherited_slot_specs.t t/moose_attribute_lazy_initializer.t t/moose_attribute_names.t t/moose_attribute_reader_generation.t t/moose_attribute_required.t t/moose_attribute_traits.t t/moose_attribute_traits_n_meta.t t/moose_attribute_traits_parameterized.t t/moose_attribute_traits_registered.t t/moose_attribute_triggers.t t/moose_attribute_type_unions.t t/moose_attribute_without_any_methods.t t/moose_attribute_writer_generation.t t/moose_bad_coerce.t t/moose_chained_coercion.t t/moose_clone_weak.t t/moose_default_class_role_types.t t/moose_default_undef.t t/moose_delegation_and_modifiers.t t/moose_delegation_arg_aliasing.t t/moose_delegation_target_not_loaded.t t/moose_illegal_options_for_inheritance.t t/moose_inherit_lazy_build.t t/moose_lazy_no_default.t t/moose_method_generation_rules.t t/moose_misc_attribute_coerce_lazy.t t/moose_misc_attribute_tests.t t/moose_more_attr_delegation.t t/moose_no_init_arg.t t/moose_no_slot_access.t t/moose_non_alpha_attr_names.t t/moose_numeric_defaults.t t/moose_trigger_and_coerce.t Copyright: Copyright 2013 Infinity Interactive, Inc. License: GPL-1.0+ or Artistic-1.0 Files: CONTRIBUTING CREDITS Changes LICENSE Makefile.PL README doap.ttl Copyright: Copyright 1970 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: lib/MooseX/XSAccessor.pm lib/MooseX/XSAccessor/Trait/Attribute.pm t/01basic.t t/02accel.t t/03funky.t t/04chained.t t/05lvalue.t Copyright: This software is copyright (c) 2013 by Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: META.json META.yml dist.ini examples/bench.pl t/lib/MyMoose.pm t/lib/MyMoose/Role.pm Copyright: Copyright 2013 Toby Inkster. License: GPL-1.0+ or Artistic-1.0 Files: COPYRIGHT SIGNATURE Copyright: None License: public-domain Files: INSTALL Copyright: Unknown License: Unknown License: Artistic-1.0 This software is Copyright (c) 2013 by the copyright holder(s). This is free software, licensed under: The Artistic License 1.0 License: GPL-1.0 This software is Copyright (c) 2013 by the copyright holder(s). This is free software, licensed under: The GNU General Public License, Version 1, February 1989 CREDITS000664001750001750 26212234215336 14545 0ustar00taitai000000000000MooseX-XSAccessor-0.007Maintainer: - Toby Inkster (TOBYINK) Contributor: - Florian Ragwitz (FLORA) Thanks: - Dagfinn Ilmari MannsÃ¥ker (ILMARI) Changes000664001750001750 365612234215336 15052 0ustar00taitai000000000000MooseX-XSAccessor-0.007MooseX-XSAccessor ================= Created: 2013-06-13 Home page: Bug tracker: Maintainer: Toby Inkster (TOBYINK) 0.007 2013-10-30 [ Test Suite ] - Skip the new version of moose_bad_coerce.t if Moose version is too old. 0.006 2013-10-30 [ Test Suite ] - Avoid triggering silly deprecation warnings from MooseX::Attribute::Chained. - Pull latest attribute tests from Moose; the old versions of these test cases broke with Moose 2.11xx. 0.005 2013-08-27 - Added: Integration with MooseX::LvalueAttribute. 0.004 2013-06-17 - Added: Integration with MooseX::Attribute::Chained. Dagfinn Ilmari MannsÃ¥ker++ - Improved `is_xs` implementation. Florian Ragwitz++ 0.003 2013-06-17 [ Documentation ] - Document the circumstances under which predicates and clearers can be acceleated (respectively: if Class::XSAccessor is new enough, and never). [ Packaging ] - Since 0.002 we shouldn't need to skip test `t/moose_default_undef.t` anymore. 0.002 2013-06-16 [ Packaging ] - Support slightly older versions of Class::XSAccessor (back to 1.09). [ Other ] - Don't use Class::XSAccessor 1.16 and below to generate predicate methods, because their behaviour differs observably from Moose. If you want XS predicates, you'll need Class::XSAccessor 1.17 (which is not on CPAN yet). - Refactor overridden install_accessors into an 'after' method modifier, with the hope that this makes MooseX::XSAccessor play nicer with other MooseX modules. 0.001 2013-06-14 Stable release 0.000_02 2013-06-14 [ Bug Fixes ] - Work around some edge cases. [ Documentation ] - Better documentation. [ Packaging ] - Better test cases. [ Other ] - Added: MooseX::XSAccessor::is_xs function. 0.000_01 2013-06-14 Developer release INSTALL000664001750001750 172312234215334 14577 0ustar00taitai000000000000MooseX-XSAccessor-0.007 Installing MooseX-XSAccessor should be straightforward. INSTALLATION WITH CPANMINUS If you have cpanm, you only need one line: % cpanm MooseX::XSAccessor If you are installing into a system-wide directory, you may need to pass the "-S" flag to cpanm, which uses sudo to install the module: % cpanm -S MooseX::XSAccessor INSTALLATION WITH THE CPAN SHELL Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan MooseX::XSAccessor MANUAL INSTALLATION As a last resort, you can manually install it. Download the tarball and unpack it. Consult the file META.json for a list of pre-requisites. Install these first. To build MooseX-XSAccessor: % perl Makefile.PL % make && make test Then install it: % make install If you are installing into a system-wide directory, you may need to run: % sudo make install LICENSE000664001750001750 4365312234215335 14604 0ustar00taitai000000000000MooseX-XSAccessor-0.007This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. 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) 2013 by Toby Inkster. 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, Suite 500, Boston, MA 02110-1335 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. Copyright (C) 19yy 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. , 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) 2013 by Toby Inkster. 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 MANIFEST000664001750001750 317212234215345 14701 0ustar00taitai000000000000MooseX-XSAccessor-0.007CONTRIBUTING COPYRIGHT CREDITS Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README SIGNATURE dist.ini doap.ttl examples/bench.pl lib/MooseX/XSAccessor.pm lib/MooseX/XSAccessor/Trait/Attribute.pm t/01basic.t t/02accel.t t/03funky.t t/04chained.t t/05lvalue.t t/lib/MyMoose.pm t/lib/MyMoose/Role.pm t/moose_accessor_context.t t/moose_accessor_inlining.t t/moose_accessor_override_method.t t/moose_accessor_overwrite_warning.t t/moose_attr_dereference_test.t t/moose_attribute_accessor_generation.t t/moose_attribute_custom_metaclass.t t/moose_attribute_delegation.t t/moose_attribute_does.t t/moose_attribute_inherited_slot_specs.t t/moose_attribute_lazy_initializer.t t/moose_attribute_names.t t/moose_attribute_reader_generation.t t/moose_attribute_required.t t/moose_attribute_traits.t t/moose_attribute_traits_n_meta.t t/moose_attribute_traits_parameterized.t t/moose_attribute_traits_registered.t t/moose_attribute_triggers.t t/moose_attribute_type_unions.t t/moose_attribute_without_any_methods.t t/moose_attribute_writer_generation.t t/moose_bad_coerce.t t/moose_chained_coercion.t t/moose_clone_weak.t t/moose_default_class_role_types.t t/moose_default_undef.t t/moose_delegation_and_modifiers.t t/moose_delegation_arg_aliasing.t t/moose_delegation_target_not_loaded.t t/moose_illegal_options_for_inheritance.t t/moose_inherit_lazy_build.t t/moose_lazy_no_default.t t/moose_method_generation_rules.t t/moose_misc_attribute_coerce_lazy.t t/moose_misc_attribute_tests.t t/moose_more_attr_delegation.t t/moose_no_init_arg.t t/moose_no_slot_access.t t/moose_non_alpha_attr_names.t t/moose_numeric_defaults.t t/moose_trigger_and_coerce.t META.json000664001750001750 441012234215345 15165 0ustar00taitai000000000000MooseX-XSAccessor-0.007{ "abstract" : "use Class::XSAccessor to speed up Moose accessors", "author" : [ "Toby Inkster (TOBYINK) " ], "dynamic_config" : 0, "generated_by" : "Dist::Inkt::Profile::TOBYINK version 0.013, CPAN::Meta::Converter version 2.120921", "keywords" : [], "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "MooseX-XSAccessor", "no_index" : { "directory" : [ "eg", "examples", "inc", "t", "xt" ] }, "optional_features" : {}, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.17" } }, "runtime" : { "requires" : { "Class::XSAccessor" : "1.09", "Moose" : "2.0600" }, "suggests" : { "MooseX::Attribute::Chained" : "0", "MooseX::LvalueAttribute" : "0" } }, "test" : { "recommends" : { "MooseX::Attribute::Chained" : "0", "MooseX::LvalueAttribute" : "0" }, "requires" : { "Import::Into" : "1.001000", "Test::Fatal" : "0", "Test::Moose" : "0", "Test::More" : "0.96", "Test::Requires" : "0" } } }, "provides" : { "MooseX::XSAccessor" : { "file" : "lib/MooseX/XSAccessor.pm", "version" : "0.007" }, "MooseX::XSAccessor::Trait::Attribute" : { "file" : "lib/MooseX/XSAccessor/Trait/Attribute.pm", "version" : "0.007" } }, "release_status" : "stable", "resources" : { "X_identifier" : "http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project", "bugtracker" : { "web" : "http://rt.cpan.org/Dist/Display.html?Queue=MooseX-XSAccessor" }, "homepage" : "https://metacpan.org/release/MooseX-XSAccessor", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "web" : "https://github.com/tobyink/p5-moosex-xsaccessor" } }, "version" : "0.007", "x_contributors" : [ "Florian Ragwitz (FLORA) " ] } META.yml000664001750001750 240712234215345 15021 0ustar00taitai000000000000MooseX-XSAccessor-0.007--- abstract: 'use Class::XSAccessor to speed up Moose accessors' author: - 'Toby Inkster (TOBYINK) ' build_requires: Import::Into: 1.001000 Test::Fatal: 0 Test::Moose: 0 Test::More: 0.96 Test::Requires: 0 configure_requires: ExtUtils::MakeMaker: 6.17 dynamic_config: 0 generated_by: 'Dist::Inkt::Profile::TOBYINK version 0.013, CPAN::Meta::Converter version 2.120921' keywords: [] license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: MooseX-XSAccessor no_index: directory: - eg - examples - inc - t - xt optional_features: {} provides: MooseX::XSAccessor: file: lib/MooseX/XSAccessor.pm version: 0.007 MooseX::XSAccessor::Trait::Attribute: file: lib/MooseX/XSAccessor/Trait/Attribute.pm version: 0.007 requires: Class::XSAccessor: 1.09 Moose: 2.0600 resources: X_identifier: http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project bugtracker: http://rt.cpan.org/Dist/Display.html?Queue=MooseX-XSAccessor homepage: https://metacpan.org/release/MooseX-XSAccessor license: http://dev.perl.org/licenses/ repository: https://github.com/tobyink/p5-moosex-xsaccessor version: 0.007 x_contributors: - 'Florian Ragwitz (FLORA) ' Makefile.PL000664001750001750 1303612234215345 15542 0ustar00taitai000000000000MooseX-XSAccessor-0.007use strict; use ExtUtils::MakeMaker 6.17; my $EUMM = eval( $ExtUtils::MakeMaker::VERSION ); my $meta = { "abstract" => "use Class::XSAccessor to speed up Moose accessors", "author" => ["Toby Inkster (TOBYINK) "], "dynamic_config" => 0, "generated_by" => "Dist::Inkt::Profile::TOBYINK version 0.013, CPAN::Meta::Converter version 2.120921", "keywords" => [], "license" => ["perl_5"], "meta-spec" => { url => "http://search.cpan.org/perldoc?CPAN::Meta::Spec", version => 2, }, "name" => "MooseX-XSAccessor", "no_index" => { directory => ["eg", "examples", "inc", "t", "xt"] }, "prereqs" => { configure => { requires => { "ExtUtils::MakeMaker" => 6.17 } }, runtime => { requires => { "Class::XSAccessor" => 1.09, "Moose" => "2.0600" }, suggests => { "MooseX::Attribute::Chained" => 0, "MooseX::LvalueAttribute" => 0 }, }, test => { recommends => { "MooseX::Attribute::Chained" => 0, "MooseX::LvalueAttribute" => 0 }, requires => { "Import::Into" => "1.001000", "Test::Fatal" => 0, "Test::Moose" => 0, "Test::More" => 0.96, "Test::Requires" => 0, }, }, }, "provides" => { "MooseX::XSAccessor" => { file => "lib/MooseX/XSAccessor.pm", version => 0.007 }, "MooseX::XSAccessor::Trait::Attribute" => { file => "lib/MooseX/XSAccessor/Trait/Attribute.pm", version => 0.007, }, }, "release_status" => "stable", "resources" => { bugtracker => { web => "http://rt.cpan.org/Dist/Display.html?Queue=MooseX-XSAccessor", }, homepage => "https://metacpan.org/release/MooseX-XSAccessor", license => ["http://dev.perl.org/licenses/"], repository => { type => "git", web => "https://github.com/tobyink/p5-moosex-xsaccessor", }, X_identifier => "http://purl.org/NET/cpan-uri/dist/MooseX-XSAccessor/project", }, "version" => 0.007, "x_contributors" => ["Florian Ragwitz (FLORA) "], }; my %dynamic_config; my %WriteMakefileArgs = ( ABSTRACT => $meta->{abstract}, AUTHOR => ($EUMM >= 6.5702 ? $meta->{author} : $meta->{author}[0]), DISTNAME => $meta->{name}, VERSION => $meta->{version}, EXE_FILES => [ map $_->{file}, values %{ $meta->{x_provides_scripts} || {} } ], NAME => do { my $n = $meta->{name}; $n =~ s/-/::/g; $n }, %dynamic_config, ); $WriteMakefileArgs{LICENSE} = $meta->{license}[0] if $EUMM >= 6.3001; sub deps { my %r; for my $stage (@_) { for my $dep (keys %{$meta->{prereqs}{$stage}{requires}}) { next if $dep eq 'perl'; my $ver = $meta->{prereqs}{$stage}{requires}{$dep}; $r{$dep} = $ver if !exists($r{$dep}) || $ver >= $r{$dep}; } } \%r; } my ($build_requires, $configure_requires, $runtime_requires, $test_requires); if ($EUMM >= 6.6303) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{TEST_REQUIRES} ||= deps('test'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.5503) { $WriteMakefileArgs{BUILD_REQUIRES} ||= deps('build', 'test'); $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime'); } elsif ($EUMM >= 6.52) { $WriteMakefileArgs{CONFIGURE_REQUIRES} ||= deps('configure'); $WriteMakefileArgs{PREREQ_PM} ||= deps('runtime', 'build', 'test'); } else { $WriteMakefileArgs{PREREQ_PM} ||= deps('configure', 'build', 'test', 'runtime'); } { my ($minperl) = reverse sort( grep defined && /^[0-9]+(\.[0-9]+)?$/, map $meta->{prereqs}{$_}{requires}{perl}, qw( configure build runtime ) ); if (defined($minperl)) { die "Installing $meta->{name} requires Perl >= $minperl" unless $] >= $minperl; $WriteMakefileArgs{MIN_PERL_VERSION} ||= $minperl if $EUMM >= 6.48; } } sub FixMakefile { return unless -d 'inc'; my $file = shift; local *MAKEFILE; open MAKEFILE, "< $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; open MAKEFILE, "> $file" or die "FixMakefile: Couldn't open $file: $!; bailing out"; print MAKEFILE $makefile or die $!; close MAKEFILE or die $!; } my $mm = WriteMakefile(%WriteMakefileArgs); FixMakefile($mm->{FIRST_MAKEFILE} || 'Makefile'); exit(0); README000664001750001750 1231412234215335 14445 0ustar00taitai000000000000MooseX-XSAccessor-0.007NAME MooseX::XSAccessor - use Class::XSAccessor to speed up Moose accessors SYNOPSIS package MyClass; use Moose; use MooseX::XSAccessor; has foo => (...); DESCRIPTION This module accelerates Moose-generated accessor, reader, writer and predicate methods using Class::XSAccessor. You get a speed-up for no extra effort. It is automatically applied to every attribute in the class. The use of the following features of Moose attributes prevents a reader from being accelerated: * Lazy builder or lazy default. * Auto-deref. (Does anybody use this anyway??) The use of the following features prevents a writer from being accelerated: * Type constraints (except `Any`; `Any` is effectively a no-op). * Triggers * Weak references An `rw` accessor is effectively a reader and a writer glued together, so both of the above lists apply. Predicates can always be accelerated, provided you're using Class::XSAccessor 1.17 or above. Clearers can not be accelerated (as of current versions of Class::XSAccessor). Functions This module also provides one function, which is not exported so needs to be called by its full name. `MooseX::XSAccessor::is_xs($sub)` Returns a boolean indicating whether a sub is an XSUB. $sub may be a coderef, Class::MOP::Method object, or a qualified sub name as a string (e.g. "MyClass::foo"). Chained accessors and writers MooseX::XSAccessor can detect chained accessors and writers created using MooseX::Attribute::Chained, and can accelerate those too. package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; has foo => (traits => ["Chained"], is => "rw"); has bar => (traits => ["Chained"], is => "ro", writer => "_set_bar"); has baz => ( is => "rw"); # not chained my $obj = "Local::Class"->new; $obj->foo(1)->_set_bar(2); print $obj->dump; Lvalue accessors MooseX::XSAccessor will detect lvalue accessors created with MooseX::LvalueAttribute and, by default, skip accelerating them. However, by setting $MooseX::XSAccessor::LVALUE to true (preferably using the `local` Perl keyword), you can force it to accelerate those too. This introduces a visible change in behaviour though. MooseX::LvalueAttribute accessors normally allow two patterns for setting the value: $obj->foo = 42; # as an lvalue $obj->foo(42); # as a method call However, once accelerated, they may *only* be set as an lvalue. For this reason, setting $MooseX::XSAccessor::LVALUE to true is considered an experimental feature. HINTS * Make attributes read-only when possible. This means that type constraints and coercions will only apply to the constructor, not the accessors, enabling the accessors to be accelerated. * If you do need a read-write attribute, consider making the main accessor read-only, and having a separate writer method. (Like MooseX::SemiAffordanceAccessor.) * Make defaults eager instead of lazy when possible, allowing your readers to be accelerated. * If you need to accelerate just a specific attribute, apply the attribute trait directly: package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); * If you don't want to add a dependency on MooseX::XSAccessor, but do want to use it if it's available, the following code will use it optionally: package MyClass; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has foo => (...); CAVEATS * Calling a writer method without a parameter in Moose does not raise an exception: $person->set_name(); # sets name attribute to "undef" However, this is a fatal error in Class::XSAccessor. * MooseX::XSAccessor does not play nice with attribute traits that alter accessor behaviour, or define additional accessors for attributes. MooseX::SetOnce is an example thereof. MooseX::Attribute::Chained is handled as a special case. * MooseX::XSAccessor only works on blessed hash storage; not e.g. MooseX::ArrayRef or MooseX::InsideOut. MooseX::XSAccessor is usually able to detect such situations and silently switch itself off. BUGS Please report any bugs to . SEE ALSO MooseX::XSAccessor::Trait::Attribute. Moose, Moo, Class::XSAccessor. AUTHOR Toby Inkster . COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. DISCLAIMER OF WARRANTIES 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. SIGNATURE000664001750001750 1237212234215346 15057 0ustar00taitai000000000000MooseX-XSAccessor-0.007This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.70. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 294505f858f11dd062e9916e3f50d88210a9ef54 CONTRIBUTING SHA1 7acd5c32d0fc4f7963b747a34a6e8909fb7b5cb2 COPYRIGHT SHA1 3870f05f7dcb54ae836fc753a9771b588c39a063 CREDITS SHA1 7b5301b2f91626c4f55e3cd7a3e13a533e78da00 Changes SHA1 5bd5ff67308f23fb0125306d314d9500b790ccc9 INSTALL SHA1 ec5a7b4f3023f03ebf821b57690758f7e6f3ae2a LICENSE SHA1 b0fb093150fdd1e48ed0d78f92e38bcc2166cad0 MANIFEST SHA1 c7739609cf80ec6a4353411eeb5b593795d0302c META.json SHA1 429f514044364eb7f2d4c28dd04368d364587622 META.yml SHA1 6f7003b7e5c7741e0406acd58b082c1d7101b4f2 Makefile.PL SHA1 445b2ccdcbaedeea99f503f46378427100612089 README SHA1 9fc50b6f2608f43f5c4f2d0209433ffef4fa7ef7 dist.ini SHA1 9f8f7390b1c35ed60daf3fdb3f2235c6fce99492 doap.ttl SHA1 e905156d50c4731a1797619d0c76382d26674dd7 examples/bench.pl SHA1 51b50d3721402af36f374c8eba2a7ad71a88f429 lib/MooseX/XSAccessor.pm SHA1 4818a49b602b8b8ad0a843d53a9b4b0da0642925 lib/MooseX/XSAccessor/Trait/Attribute.pm SHA1 43ce0383eef7bf059cb475e46979a531904f2db4 t/01basic.t SHA1 353babc996b055918b2e074c31fad0481e7914b9 t/02accel.t SHA1 5c090461bbc7106471b8a67cb45cd36efc81f301 t/03funky.t SHA1 7ef7e84c1af0e63392b637c179572a6f40f27e03 t/04chained.t SHA1 11e13464b3d499ff292e06a1f5850525a6b5ed62 t/05lvalue.t SHA1 a5b87ba49becd72e5b62a8f3486881d551ea5812 t/lib/MyMoose.pm SHA1 cabd9f91338f8da01c58c9d9efd0abfef005046e t/lib/MyMoose/Role.pm SHA1 3e92a0119d7148b5033bdb19f82dfdf48cbdc65b t/moose_accessor_context.t SHA1 1a23a418f51380807fbe3de8582d5beb86039377 t/moose_accessor_inlining.t SHA1 dd72ce4f40f272ac9e4f9289a3888d31764072d4 t/moose_accessor_override_method.t SHA1 fc538496d21d63e5b4cdf5e3a9417a88791aa384 t/moose_accessor_overwrite_warning.t SHA1 2048b6edd3a8cd4e5c8887cbeb218747b514edcc t/moose_attr_dereference_test.t SHA1 e440aabfb734589cef39983fc3536b6906e06df9 t/moose_attribute_accessor_generation.t SHA1 3ed494f61394d972563617e4a7cce89ed888d1c3 t/moose_attribute_custom_metaclass.t SHA1 59f345c64a83cde8e26e059e5cd29018af444712 t/moose_attribute_delegation.t SHA1 50b4428b3690a458411d55a3aa653d897db007a7 t/moose_attribute_does.t SHA1 d24f1db18ccdb4c31028f476c1cb4f9e88ed3279 t/moose_attribute_inherited_slot_specs.t SHA1 f1b20467c13ab8bf70b5f3863c3c01ec1f3c6ec9 t/moose_attribute_lazy_initializer.t SHA1 4c49142c7b1c161632e3431d39e3a352a70fc427 t/moose_attribute_names.t SHA1 ad3c6bfde7004bc8bef470a0f380b38bd3bd3122 t/moose_attribute_reader_generation.t SHA1 85b1c77c72bc048e841adc44bab7722723f8a90b t/moose_attribute_required.t SHA1 65fdb41424d691b17c239e75fc4b098b9c158984 t/moose_attribute_traits.t SHA1 42cc5d6c42d4d570aaf0949b13999bfff2e618f3 t/moose_attribute_traits_n_meta.t SHA1 60d463d8552a80f3a3ae7f1793f5972ece656993 t/moose_attribute_traits_parameterized.t SHA1 6f0af58a48bef17fcd5b3bc7dd84aaa405bb8dff t/moose_attribute_traits_registered.t SHA1 2cf2b398d84d57814794201e8cc9746cbcd1b117 t/moose_attribute_triggers.t SHA1 88d7d5f2c54d793db36affb911ba59932e4ede28 t/moose_attribute_type_unions.t SHA1 f4f9abd400f72477ac733984410b3f0936aec409 t/moose_attribute_without_any_methods.t SHA1 ce6f7c140387a651b89f84c4964f4ebd51838a48 t/moose_attribute_writer_generation.t SHA1 51da5af759b6fb7e8783ee3c71377d4f43ecb22e t/moose_bad_coerce.t SHA1 323397c4afacee3370f4bfa16a37d7571e6a12b5 t/moose_chained_coercion.t SHA1 26800122026deb83f88b310fc12482c0ecd0990d t/moose_clone_weak.t SHA1 e12199444f599fbd908f2de7af5d47cfd5e8bfd6 t/moose_default_class_role_types.t SHA1 59c2fc6feb1e56d0d2f1f7ef88841d437885e69b t/moose_default_undef.t SHA1 69671fd681d0869ea95518586962f603a0643c54 t/moose_delegation_and_modifiers.t SHA1 aff174579b5dfe6b8c128ba611dcb825f66fb4e8 t/moose_delegation_arg_aliasing.t SHA1 9deeaaf2c1cf266b18e7d603c8cdbb9ecf492ddb t/moose_delegation_target_not_loaded.t SHA1 b08b9363facb7672764a87ca3dd056df4c6c4096 t/moose_illegal_options_for_inheritance.t SHA1 76496fd5b6aa79f8ac7fdce1bed8563d74f9cbb7 t/moose_inherit_lazy_build.t SHA1 b0bef53bda64e7a0105608824fd657c46edbc8d7 t/moose_lazy_no_default.t SHA1 1c37206777eb54ea79493bdbd4b2a7402fbe6f5e t/moose_method_generation_rules.t SHA1 0d14e0dc89606f4f97c1d16208e2e420c70f4491 t/moose_misc_attribute_coerce_lazy.t SHA1 ead202357379f0e8645a0e17f413f4cc06eb7c8a t/moose_misc_attribute_tests.t SHA1 06d978619bdd3deb749aa116649ad9777d0680fd t/moose_more_attr_delegation.t SHA1 6fbd1af8403a301e38de08fd8664f1469ebf7f03 t/moose_no_init_arg.t SHA1 69d286b800be8f96a26278dd939db6ee9dc4ec95 t/moose_no_slot_access.t SHA1 0e8b4539e03158d642f66fcd50a4a1ffd004157c t/moose_non_alpha_attr_names.t SHA1 8e06f32555a82dcffb0d799efc6639ca26db9bfe t/moose_numeric_defaults.t SHA1 0832ab063fe0337dbee3f020e8927f2b0208cfa6 t/moose_trigger_and_coerce.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.12 (GNU/Linux) iEYEARECAAYFAlJxGuYACgkQzr+BKGoqfTkUnwCdGaJ1YGaFyMconOPCiBXtDVmI qI4AoIPfIyIHfzeKXdw+UybnwZ9ggivM =SfHA -----END PGP SIGNATURE----- dist.ini000664001750001750 10312234215334 15161 0ustar00taitai000000000000MooseX-XSAccessor-0.007;;class='Dist::Inkt::Profile::TOBYINK' ;;name='MooseX-XSAccessor' doap.ttl000664001750001750 6267512234215345 15255 0ustar00taitai000000000000MooseX-XSAccessor-0.007@prefix cpan-uri: . @prefix dc: . @prefix doap: . @prefix doap-bugs: . @prefix doap-changeset: . @prefix doap-deps: . @prefix foaf: . @prefix nfo: . @prefix rdfs: . @prefix xsd: . a foaf:Organization; foaf:name "Infinity Interactive, Inc". dc:title "the same terms as the perl 5 programming language system itself". a doap:Project; dc:contributor ; doap-deps:runtime-requirement [ doap-deps:on "Class::XSAccessor 1.09"^^doap-deps:CpanId; ], [ doap-deps:on "Moose 2.0600"^^doap-deps:CpanId ]; doap-deps:runtime-suggestion [ doap-deps:on "MooseX::Attribute::Chained"^^doap-deps:CpanId; ], [ doap-deps:on "MooseX::LvalueAttribute"^^doap-deps:CpanId; ]; doap-deps:test-recommendation [ doap-deps:on "MooseX::LvalueAttribute"^^doap-deps:CpanId; ], [ doap-deps:on "MooseX::Attribute::Chained"^^doap-deps:CpanId; ]; doap-deps:test-requirement [ doap-deps:on "Import::Into 1.001000"^^doap-deps:CpanId; ], [ doap-deps:on "Test::More 0.96"^^doap-deps:CpanId ], [ doap-deps:on "Test::Fatal"^^doap-deps:CpanId ], [ doap-deps:on "Test::Moose"^^doap-deps:CpanId ], [ doap-deps:on "Test::Requires"^^doap-deps:CpanId ]; doap:bug-database ; doap:created "2013-06-13"^^xsd:date; doap:developer ; doap:download-page ; doap:homepage ; doap:license ; doap:maintainer ; doap:name "MooseX-XSAccessor"; doap:programming-language "Perl"; doap:release , , , , , , , , ; doap:repository [ a doap:GitRepository; doap:browse ; ]; doap:shortdesc "use Class::XSAccessor to speed up Moose accessors". a cpan-uri:DeveloperRelease, doap:Version; rdfs:label "Developer release"; dc:identifier "MooseX-XSAccessor-0.000_01"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_01"^^xsd:string. a cpan-uri:DeveloperRelease, doap:Version; dc:identifier "MooseX-XSAccessor-0.000_02"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "MooseX::XSAccessor::is_xs function."; ], [ a doap-changeset:Packaging; rdfs:label "Better test cases."; ], [ a doap-changeset:Documentation; rdfs:label "Better documentation."; ], [ a doap-changeset:Bugfix; rdfs:label "Work around some edge cases."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.000_02"^^xsd:string. a doap:Version; rdfs:label "Stable release"; dc:identifier "MooseX-XSAccessor-0.001"^^xsd:string; dc:issued "2013-06-14"^^xsd:date; doap-changeset:released-by ; doap:file-release ; doap:revision "0.001"^^xsd:string; rdfs:comment "No functional changes since 0.000_02.". a doap:Version; dc:identifier "MooseX-XSAccessor-0.002"^^xsd:string; dc:issued "2013-06-16"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Change; rdfs:label "Refactor overridden install_accessors into an 'after' method modifier, with the hope that this makes MooseX::XSAccessor play nicer with other MooseX modules."; ], [ a doap-changeset:Packaging; rdfs:label "Support slightly older versions of Class::XSAccessor (back to 1.09)."; ], [ a doap-changeset:Change; rdfs:label "Don't use Class::XSAccessor 1.16 and below to generate predicate methods, because their behaviour differs observably from Moose. If you want XS predicates, you'll need Class::XSAccessor 1.17 (which is not on CPAN yet)."; rdfs:seeAlso ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.002"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.003"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Documentation; rdfs:label "Document the circumstances under which predicates and clearers can be acceleated (respectively: if Class::XSAccessor is new enough, and never)."; ], [ a doap-changeset:Packaging; rdfs:label "Since 0.002 we shouldn't need to skip test `t/moose_default_undef.t` anymore."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.003"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.004"^^xsd:string; dc:issued "2013-06-17"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Integration with MooseX::Attribute::Chained."; doap-changeset:thanks ; rdfs:comment "This was ILMARI's idea."; ], [ rdfs:label "Improved `is_xs` implementation."; doap-changeset:blame ; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.004"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.005"^^xsd:string; dc:issued "2013-08-27"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Addition; rdfs:label "Integration with MooseX::LvalueAttribute."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.005"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.006"^^xsd:string; dc:issued "2013-10-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Avoid triggering silly deprecation warnings from MooseX::Attribute::Chained."; ], [ a doap-changeset:Tests; rdfs:label "Pull latest attribute tests from Moose; the old versions of these test cases broke with Moose 2.11xx."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.006"^^xsd:string. a doap:Version; dc:identifier "MooseX-XSAccessor-0.007"^^xsd:string; dc:issued "2013-10-30"^^xsd:date; doap-changeset:changeset [ doap-changeset:item [ a doap-changeset:Tests; rdfs:label "Skip the new version of moose_bad_coerce.t if Moose version is too old."; ]; ]; doap-changeset:released-by ; doap:file-release ; doap:revision "0.007"^^xsd:string. a foaf:Person; foaf:name "Florian Ragwitz"; foaf:nick "FLORA"; foaf:page . a foaf:Person; foaf:name "Dagfinn Ilmari Mannsåker"; foaf:nick "ILMARI"; foaf:page . a foaf:Person; foaf:name "Ingy döt Net"; foaf:nick "INGY"; foaf:page . a foaf:Person; foaf:mbox ; foaf:name "Toby Inkster"; foaf:nick "TOBYINK"; foaf:page . a doap-bugs:Issue; doap-bugs:id "86127"^^xsd:string; doap-bugs:page . [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CONTRIBUTING". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "CREDITS". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "Changes". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "LICENSE". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "doap.ttl". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "Makefile.PL"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject, nfo:TextDocument; dc:license ; dc:rightsHolder ; nfo:fileName "README". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "examples/bench.pl"; nfo:programmingLanguage "Perl". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/changes.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/doap.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/makefile.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/people.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "meta/rights.pret". [] a nfo:FileDataObject; dc:license ; dc:rightsHolder ; nfo:fileName "MANIFEST.SKIP". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/lib/MyMoose.pm"; nfo:programmingLanguage "Perl"; rdfs:comment "Shim for loading Moose and MooseX::XSAccessor simultaneously.". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/lib/MyMoose/Role.pm"; nfo:programmingLanguage "Perl"; rdfs:comment "Shim for loading Moose::Role and MooseX::XSAccessor simultaneously.". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_context.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_inlining.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_override_method.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_accessor_overwrite_warning.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attr_dereference_test.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_accessor_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_custom_metaclass.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_delegation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_does.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_inherited_slot_specs.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_lazy_initializer.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_names.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_reader_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_required.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_n_meta.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_parameterized.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits_registered.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_traits.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_triggers.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_type_unions.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_without_any_methods.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_attribute_writer_generation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_bad_coerce.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_chained_coercion.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_clone_weak.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_default_class_role_types.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_default_undef.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_and_modifiers.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_arg_aliasing.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_delegation_target_not_loaded.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_illegal_options_for_inheritance.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_inherit_lazy_build.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_lazy_no_default.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_method_generation_rules.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_misc_attribute_coerce_lazy.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_misc_attribute_tests.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_more_attr_delegation.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_no_init_arg.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_non_alpha_attr_names.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_no_slot_access.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_numeric_defaults.t". [] a nfo:FileDataObject, nfo:SourceCode; dc:license ; dc:rightsHolder ; nfo:fileName "t/moose_trigger_and_coerce.t". bench.pl000664001750001750 102012234215334 16766 0ustar00taitai000000000000MooseX-XSAccessor-0.007/examplesuse strict; use warnings; use Benchmark qw(cmpthese); { package Fast; use Moose; use MooseX::XSAccessor; has attr => (is => "rw", isa => "Any"); __PACKAGE__->meta->make_immutable; } { package Slow; use Moose; has attr => (is => "rw", isa => "Any"); __PACKAGE__->meta->make_immutable; } our $Fast = "Fast"->new(attr => 42); our $Slow = "Slow"->new(attr => 42); cmpthese(-1, { Fast => '$::Fast->attr', Slow => '$::Slow->attr', }); __END__ Rate Slow Fast Slow 504123/s -- -66% Fast 1487682/s 195% -- 01basic.t000664001750001750 75212234215334 15401 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor compiles. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; ok eval q{ package Foo; use Moose; use MooseX::XSAccessor; 1; }; done_testing; 02accel.t000664001750001750 301212234215334 15400 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor accelerates particular methods with XS. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Moose; { package Local::Class; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has thingy => (is => "rw", isa => "Any", predicate => "has_thingy"); has number => (is => "rw", isa => "Num", predicate => "has_number"); has numero => (is => "ro", isa => "Num", predicate => "has_numero"); has semi => (is => "ro", isa => "Str", predicate => "has_semi", writer => "set_semi"); has trig => (reader => "get_trig", writer => "set_trig", trigger => sub { 1 }); } my @expected_xsub = qw/ thingy numero semi get_trig /; my @expected_pp = qw/ new number set_semi set_trig /; my @maybe_xsub = qw/ has_thingy has_number has_numero has_semi /; push @{ (Class::XSAccessor->VERSION > 1.16) ? \@expected_xsub : \@expected_pp }, @maybe_xsub; with_immutable { my $im = "Local::Class"->meta->is_immutable ? "immutable" : "mutable"; ok( MooseX::XSAccessor::is_xs("Local::Class"->can($_)), "$_ is an XSUB ($im class)", ) for @expected_xsub; ok( !MooseX::XSAccessor::is_xs("Local::Class"->can($_)), "$_ is pure Perl ($im class)", ) for @expected_pp; } qw(Local::Class); done_testing; 03funky.t000664001750001750 232712234215334 15476 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with MooseX::FunkyAttributes. =head1 DEPENDENCIES MooseX::FunkyAttributes 0.002; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::FunkyAttributes" => "0.002" }; { package Local::Storage; use Moose; use MooseX::XSAccessor; has slot => (is => "rw"); } { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::FunkyAttributes; has storage => ( is => "ro", default => sub { "Local::Storage"->new }, ); has delegated => ( is => "rw", traits => [ DelegatedAttribute ], delegated_to => "storage", delegated_accessor => "slot", ); } my $o = "Local::Class"->new; $o->delegated(42); is_deeply( $o, bless( { storage => bless( { slot => 42, }, "Local::Storage", ), }, "Local::Class", ), ); done_testing; 04chained.t000664001750001750 270712234215334 15740 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with L. =head1 DEPENDENCIES MooseX::Attribute::Chained; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::Attribute::Chained" => "0" }; { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; my $Chained = ['MooseX::Traits::Attribute::Chained']; has foo => (is => "rw", traits => $Chained); has bar => (is => "ro", traits => $Chained, writer => "_set_bar"); has baz => (is => "rw"); sub quux { 42 }; } my $o = "Local::Class"->new(foo => 1, bar => 2); ok($o->meta->get_attribute('foo')->does('MooseX::XSAccessor::Trait::Attribute')); ok($o->meta->get_attribute('foo')->does('MooseX::Traits::Attribute::Chained')); is($o->foo(3)->quux, 42, 'accessor can be chained'); is($o->foo, 3, 'chaining set new value'); is($o->_set_bar(4)->quux, 42, 'writer can be chained'); is($o->bar, 4, 'chaining set new value'); is($o->baz(5), 5, 'non-chained accessor in a chained world'); ok( MooseX::XSAccessor::is_xs(Local::Class->can($_)), "$_ is XSUB" ) for qw(foo bar baz _set_bar); done_testing; 05lvalue.t000664001750001750 261712234215334 15636 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t=pod =encoding utf-8 =head1 PURPOSE Test that MooseX::XSAccessor works OK with L. =head1 DEPENDENCIES MooseX::Attribute::Chained; test skipped otherwise. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut use strict; use warnings; use Test::More; use Test::Requires { "MooseX::LvalueAttribute" => "0.980" }; { package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::LvalueAttribute; local $MooseX::XSAccessor::LVALUE = 1; has foo => (traits => ["Lvalue"], is => "rw"); has bar => ( is => "rw"); sub quux { 42 }; } my $o = "Local::Class"->new(foo => 1, bar => 2); ok($o->meta->get_attribute('foo')->does('MooseX::XSAccessor::Trait::Attribute')); ok($o->meta->get_attribute('foo')->does('MooseX::LvalueAttribute::Trait::Attribute')); ok($o->meta->get_attribute('bar')->does('MooseX::XSAccessor::Trait::Attribute')); ok(not $o->meta->get_attribute('bar')->does('MooseX::LvalueAttribute::Trait::Attribute')); is($o->foo, 1); is($o->bar, 2); $o->foo++; $o->bar($o->bar + 1); is($o->foo, 2); is($o->bar, 3); ok( MooseX::XSAccessor::is_xs(Local::Class->can($_)), "$_ is XSUB" ) for qw(foo bar); done_testing; moose_accessor_context.t000664001750001750 365612234215334 20755 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; is( exception { package My::Class; use MyMoose; has s_rw => ( is => 'rw', ); has s_ro => ( is => 'ro', ); has a_rw => ( is => 'rw', isa => 'ArrayRef', auto_deref => 1, ); has a_ro => ( is => 'ro', isa => 'ArrayRef', auto_deref => 1, ); has h_rw => ( is => 'rw', isa => 'HashRef', auto_deref => 1, ); has h_ro => ( is => 'ro', isa => 'HashRef', auto_deref => 1, ); }, undef, 'class definition' ); is( exception { my $o = My::Class->new(); is_deeply [scalar $o->s_rw], [undef], 'uninitialized scalar attribute/rw in scalar context'; is_deeply [$o->s_rw], [undef], 'uninitialized scalar attribute/rw in list context'; is_deeply [scalar $o->s_ro], [undef], 'uninitialized scalar attribute/ro in scalar context'; is_deeply [$o->s_ro], [undef], 'uninitialized scalar attribute/ro in list context'; is_deeply [scalar $o->a_rw], [undef], 'uninitialized ArrayRef attribute/rw in scalar context'; is_deeply [$o->a_rw], [], 'uninitialized ArrayRef attribute/rw in list context'; is_deeply [scalar $o->a_ro], [undef], 'uninitialized ArrayRef attribute/ro in scalar context'; is_deeply [$o->a_ro], [], 'uninitialized ArrayRef attribute/ro in list context'; is_deeply [scalar $o->h_rw], [undef], 'uninitialized HashRef attribute/rw in scalar context'; is_deeply [$o->h_rw], [], 'uninitialized HashRef attribute/rw in list context'; is_deeply [scalar $o->h_ro], [undef], 'uninitialized HashRef attribute/ro in scalar context'; is_deeply [$o->h_ro], [], 'uninitialized HashRef attribute/ro in list context'; }, undef, 'testing' ); done_testing; moose_accessor_inlining.t000664001750001750 116112234215334 21065 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; my $called; { package Foo::Meta::Instance; use MyMoose::Role; sub is_inlinable { 0 } after get_slot_value => sub { $called++ }; } { package Foo; use MyMoose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { instance => ['Foo::Meta::Instance'], }, ); has foo => (is => 'ro'); } my $foo = Foo->new(foo => 1); is($foo->foo, 1, "got the right value"); is($called, 1, "reader was called"); done_testing; moose_accessor_override_method.t000664001750001750 341612234215334 22442 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Requires { 'Test::Output' => '0.01', # skip all if not installed }; { package Foo; use MyMoose; sub get_a { } sub set_b { } sub has_c { } sub clear_d { } sub e { } sub stub; } my $foo_meta = Foo->meta; stderr_like( sub { $foo_meta->add_attribute( a => ( reader => 'get_a' ) ) }, qr/^You are overwriting a locally defined method \(get_a\) with an accessor/, 'reader overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( b => ( writer => 'set_b' ) ) }, qr/^You are overwriting a locally defined method \(set_b\) with an accessor/, 'writer overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( c => ( predicate => 'has_c' ) ) }, qr/^You are overwriting a locally defined method \(has_c\) with an accessor/, 'predicate overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( d => ( clearer => 'clear_d' ) ) }, qr/^You are overwriting a locally defined method \(clear_d\) with an accessor/, 'clearer overriding gives proper warning' ); stderr_like( sub { $foo_meta->add_attribute( e => ( is => 'rw' ) ) }, qr/^You are overwriting a locally defined method \(e\) with an accessor/, 'accessor overriding gives proper warning' ); stderr_is( sub { $foo_meta->add_attribute( stub => ( is => 'rw' ) ) }, q{}, 'overriding a stub with an accessor does not warn' ); stderr_like( sub { $foo_meta->add_attribute( has => ( is => 'rw' ) ) }, qr/^You are overwriting a locally defined function \(has\) with an accessor/, 'function overriding gives proper warning' ); done_testing; moose_accessor_overwrite_warning.t000664001750001750 113712234215334 23034 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Requires { 'Test::Output' => '0.01', }; { package Bar; use MyMoose; has has_attr => ( is => 'ro', ); ::stderr_like{ has attr => ( is => 'ro', predicate => 'has_attr', ) } qr/\QYou are overwriting an accessor (has_attr) for the has_attr attribute with a new accessor method for the attr attribute/, 'overwriting an accessor for another attribute causes a warning'; } done_testing; moose_attr_dereference_test.t000664001750001750 313212234215334 21734 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Customer; use MyMoose; package Firm; use MyMoose; use Moose::Util::TypeConstraints; ::is( ::exception { has 'customers' => ( is => 'ro', isa => subtype('ArrayRef' => where { (blessed($_) && $_->isa('Customer') || return) for @$_; 1 }), auto_deref => 1, ); }, undef, '... successfully created attr' ); } { my $customer = Customer->new; isa_ok($customer, 'Customer'); my $firm = Firm->new(customers => [ $customer ]); isa_ok($firm, 'Firm'); can_ok($firm, 'customers'); is_deeply( [ $firm->customers ], [ $customer ], '... got the right dereferenced value' ); } { my $firm = Firm->new(); isa_ok($firm, 'Firm'); can_ok($firm, 'customers'); is_deeply( [ $firm->customers ], [], '... got the right dereferenced value' ); } { package AutoDeref; use MyMoose; has 'bar' => ( is => 'rw', isa => 'ArrayRef[Int]', auto_deref => 1, ); } { my $autoderef = AutoDeref->new; isnt( exception { $autoderef->bar(1, 2, 3); }, undef, '... its auto-de-ref-ing, not auto-en-ref-ing' ); is( exception { $autoderef->bar([ 1, 2, 3 ]) }, undef, '... set the results of bar correctly' ); is_deeply [ $autoderef->bar ], [ 1, 2, 3 ], '... auto-dereffed correctly'; } done_testing; moose_attribute_accessor_generation.t000664001750001750 1307112234215334 23517 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Scalar::Util 'isweak'; { package Foo; use MyMoose; eval { has 'foo' => ( accessor => 'foo', ); }; ::ok(!$@, '... created the accessor method okay'); eval { has 'lazy_foo' => ( accessor => 'lazy_foo', lazy => 1, default => sub { 10 } ); }; ::ok(!$@, '... created the lazy accessor method okay'); eval { has 'foo_required' => ( accessor => 'foo_required', required => 1, ); }; ::ok(!$@, '... created the required accessor method okay'); eval { has 'foo_int' => ( accessor => 'foo_int', isa => 'Int', ); }; ::ok(!$@, '... created the accessor method with type constraint okay'); eval { has 'foo_weak' => ( accessor => 'foo_weak', weak_ref => 1 ); }; ::ok(!$@, '... created the accessor method with weak_ref okay'); eval { has 'foo_deref' => ( accessor => 'foo_deref', isa => 'ArrayRef', auto_deref => 1, ); }; ::ok(!$@, '... created the accessor method with auto_deref okay'); eval { has 'foo_deref_ro' => ( reader => 'foo_deref_ro', isa => 'ArrayRef', auto_deref => 1, ); }; ::ok(!$@, '... created the reader method with auto_deref okay'); eval { has 'foo_deref_hash' => ( accessor => 'foo_deref_hash', isa => 'HashRef', auto_deref => 1, ); }; ::ok(!$@, '... created the reader method with auto_deref okay'); } { my $foo = Foo->new(foo_required => 'required'); isa_ok($foo, 'Foo'); # regular accessor can_ok($foo, 'foo'); is($foo->foo(), undef, '... got an unset value'); is( exception { $foo->foo(100); }, undef, '... foo wrote successfully' ); is($foo->foo(), 100, '... got the correct set value'); ok(!isweak($foo->{foo}), '... it is not a weak reference'); # required writer isnt( exception { Foo->new; }, undef, '... cannot create without the required attribute' ); can_ok($foo, 'foo_required'); is($foo->foo_required(), 'required', '... got an unset value'); is( exception { $foo->foo_required(100); }, undef, '... foo_required wrote successfully' ); is($foo->foo_required(), 100, '... got the correct set value'); is( exception { $foo->foo_required(undef); }, undef, '... foo_required did not die with undef' ); is($foo->foo_required, undef, "value is undef"); ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); # lazy ok(!exists($foo->{lazy_foo}), '... no value in lazy_foo slot'); can_ok($foo, 'lazy_foo'); is($foo->lazy_foo(), 10, '... got an deferred value'); # with type constraint can_ok($foo, 'foo_int'); is($foo->foo_int(), undef, '... got an unset value'); is( exception { $foo->foo_int(100); }, undef, '... foo_int wrote successfully' ); is($foo->foo_int(), 100, '... got the correct set value'); isnt( exception { $foo->foo_int("Foo"); }, undef, '... foo_int died successfully' ); ok(!isweak($foo->{foo_int}), '... it is not a weak reference'); # with weak_ref my $test = []; can_ok($foo, 'foo_weak'); is($foo->foo_weak(), undef, '... got an unset value'); is( exception { $foo->foo_weak($test); }, undef, '... foo_weak wrote successfully' ); is($foo->foo_weak(), $test, '... got the correct set value'); ok(isweak($foo->{foo_weak}), '... it is a weak reference'); can_ok( $foo, 'foo_deref'); is_deeply( [$foo->foo_deref()], [], '... default default value'); my @list; is( exception { @list = $foo->foo_deref(); }, undef, "... doesn't deref undef value" ); is_deeply( \@list, [], "returns empty list in list context"); is( exception { $foo->foo_deref( [ qw/foo bar gorch/ ] ); }, undef, '... foo_deref wrote successfully' ); is( Scalar::Util::reftype( scalar $foo->foo_deref() ), "ARRAY", "returns an array reference in scalar context" ); is_deeply( scalar($foo->foo_deref()), [ qw/foo bar gorch/ ], "correct array" ); is( scalar( () = $foo->foo_deref() ), 3, "returns list in list context" ); is_deeply( [ $foo->foo_deref() ], [ qw/foo bar gorch/ ], "correct list" ); can_ok( $foo, 'foo_deref' ); is_deeply( [$foo->foo_deref_ro()], [], "... default default value" ); isnt( exception { $foo->foo_deref_ro( [] ); }, undef, "... read only" ); $foo->{foo_deref_ro} = [qw/la la la/]; is_deeply( scalar($foo->foo_deref_ro()), [qw/la la la/], "scalar context ro" ); is_deeply( [ $foo->foo_deref_ro() ], [qw/la la la/], "list context ro" ); can_ok( $foo, 'foo_deref_hash' ); is_deeply( { $foo->foo_deref_hash() }, {}, "... default default value" ); my %hash; is( exception { %hash = $foo->foo_deref_hash(); }, undef, "... doesn't deref undef value" ); is_deeply( \%hash, {}, "returns empty list in list context"); is( exception { $foo->foo_deref_hash( { foo => 1, bar => 2 } ); }, undef, '... foo_deref_hash wrote successfully' ); is_deeply( scalar($foo->foo_deref_hash), { foo => 1, bar => 2 }, "scalar context" ); %hash = $foo->foo_deref_hash; is_deeply( \%hash, { foo => 1, bar => 2 }, "list context"); } done_testing; moose_attribute_custom_metaclass.t000664001750001750 473512234215334 23037 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo::Meta::Attribute; use MyMoose; extends 'Moose::Meta::Attribute'; around 'new' => sub { my $next = shift; my $self = shift; my $name = shift; $next->($self, $name, (is => 'rw', isa => 'Foo'), @_); }; package Foo; use MyMoose; has 'foo' => (metaclass => 'Foo::Meta::Attribute'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $foo_attr = Foo->meta->get_attribute('foo'); isa_ok($foo_attr, 'Foo::Meta::Attribute'); isa_ok($foo_attr, 'Moose::Meta::Attribute'); is($foo_attr->name, 'foo', '... got the right name for our meta-attribute'); ok($foo_attr->has_accessor, '... our meta-attrubute created the accessor for us'); ok($foo_attr->has_type_constraint, '... our meta-attrubute created the type_constraint for us'); my $foo_attr_type_constraint = $foo_attr->type_constraint; isa_ok($foo_attr_type_constraint, 'Moose::Meta::TypeConstraint'); is($foo_attr_type_constraint->name, 'Foo', '... got the right type constraint name'); is($foo_attr_type_constraint->parent->name, 'Object', '... got the right type constraint parent name'); } { package Bar::Meta::Attribute; use MyMoose; extends 'Class::MOP::Attribute'; package Bar; use MyMoose; ::is( ::exception { has 'bar' => (metaclass => 'Bar::Meta::Attribute'); }, undef, '... the attribute metaclass need not be a Moose::Meta::Attribute as long as it behaves' ); } { package Moose::Meta::Attribute::Custom::Foo; sub register_implementation { 'Foo::Meta::Attribute' } package Moose::Meta::Attribute::Custom::Bar; use MyMoose; extends 'Moose::Meta::Attribute'; package Another::Foo; use MyMoose; ::is( ::exception { has 'foo' => (metaclass => 'Foo'); }, undef, '... the attribute metaclass alias worked correctly' ); ::is( ::exception { has 'bar' => (metaclass => 'Bar', is => 'bare'); }, undef, '... the attribute metaclass alias worked correctly' ); } { my $foo_attr = Another::Foo->meta->get_attribute('foo'); isa_ok($foo_attr, 'Foo::Meta::Attribute'); isa_ok($foo_attr, 'Moose::Meta::Attribute'); my $bar_attr = Another::Foo->meta->get_attribute('bar'); isa_ok($bar_attr, 'Moose::Meta::Attribute::Custom::Bar'); isa_ok($bar_attr, 'Moose::Meta::Attribute'); } done_testing; moose_attribute_delegation.t000664001750001750 3055312234215334 21621 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; # ------------------------------------------------------------------- # HASH handles # ------------------------------------------------------------------- # the canonical form of of the 'handles' # option is the hash ref mapping a # method name to the delegated method name { package Foo; use MyMoose; has 'bar' => (is => 'rw', default => 10); sub baz { 42 } package Bar; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo->new }, handles => { 'foo_bar' => 'bar', foo_baz => 'baz', 'foo_bar_to_20' => [ bar => 20 ], }, ); } my $bar = Bar->new; isa_ok($bar, 'Bar'); ok($bar->foo, '... we have something in bar->foo'); isa_ok($bar->foo, 'Foo'); my $meth = Bar->meta->get_method('foo_bar'); isa_ok($meth, 'Moose::Meta::Method::Delegation'); is($meth->associated_attribute->name, 'foo', 'associated_attribute->name for this method is foo'); is($bar->foo->bar, 10, '... bar->foo->bar returned the right default'); can_ok($bar, 'foo_bar'); is($bar->foo_bar, 10, '... bar->foo_bar delegated correctly'); # change the value ... $bar->foo->bar(30); # and make sure the delegation picks it up is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly'); # change the value through the delegation ... $bar->foo_bar(50); # and make sure everyone sees it is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo->new(bar => 25); isa_ok($foo, 'Foo'); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $bar->foo($foo); }, undef, '... assigned the new Foo to Bar->foo' ); is($bar->foo, $foo, '... assigned bar->foo with the new Foo'); is($bar->foo->bar, 25, '... bar->foo->bar returned the right result'); is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again'); # curried handles $bar->foo_bar_to_20; is($bar->foo_bar, 20, '... correctly curried a single argument'); # ------------------------------------------------------------------- # ARRAY handles # ------------------------------------------------------------------- # we also support an array based format # which assumes that the name is the same # on either end { package Engine; use MyMoose; sub go { 'Engine::go' } sub stop { 'Engine::stop' } package Car; use MyMoose; has 'engine' => ( is => 'rw', default => sub { Engine->new }, handles => [ 'go', 'stop' ] ); } my $car = Car->new; isa_ok($car, 'Car'); isa_ok($car->engine, 'Engine'); can_ok($car->engine, 'go'); can_ok($car->engine, 'stop'); is($car->engine->go, 'Engine::go', '... got the right value from ->engine->go'); is($car->engine->stop, 'Engine::stop', '... got the right value from ->engine->stop'); can_ok($car, 'go'); can_ok($car, 'stop'); is($car->go, 'Engine::go', '... got the right value from ->go'); is($car->stop, 'Engine::stop', '... got the right value from ->stop'); # ------------------------------------------------------------------- # REGEXP handles # ------------------------------------------------------------------- # and we support regexp delegation { package Baz; use MyMoose; sub foo { 'Baz::foo' } sub bar { 'Baz::bar' } sub boo { 'Baz::boo' } package Baz::Proxy1; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/.*/ ); package Baz::Proxy2; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/.oo/ ); package Baz::Proxy3; use MyMoose; has 'baz' => ( is => 'ro', isa => 'Baz', default => sub { Baz->new }, handles => qr/b.*/ ); } { my $baz_proxy = Baz::Proxy1->new; isa_ok($baz_proxy, 'Baz::Proxy1'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'foo'); can_ok($baz_proxy, 'bar'); can_ok($baz_proxy, 'boo'); is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } { my $baz_proxy = Baz::Proxy2->new; isa_ok($baz_proxy, 'Baz::Proxy2'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'foo'); can_ok($baz_proxy, 'boo'); is($baz_proxy->foo, 'Baz::foo', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } { my $baz_proxy = Baz::Proxy3->new; isa_ok($baz_proxy, 'Baz::Proxy3'); can_ok($baz_proxy, 'baz'); isa_ok($baz_proxy->baz, 'Baz'); can_ok($baz_proxy, 'bar'); can_ok($baz_proxy, 'boo'); is($baz_proxy->bar, 'Baz::bar', '... got the right proxied return value'); is($baz_proxy->boo, 'Baz::boo', '... got the right proxied return value'); } # ------------------------------------------------------------------- # ROLE handles # ------------------------------------------------------------------- { package Foo::Bar; use MyMoose::Role; requires 'foo'; requires 'bar'; package Foo::Baz; use MyMoose; sub foo { 'Foo::Baz::FOO' } sub bar { 'Foo::Baz::BAR' } sub baz { 'Foo::Baz::BAZ' } package Foo::Thing; use MyMoose; has 'thing' => ( is => 'rw', isa => 'Foo::Baz', handles => 'Foo::Bar', ); package Foo::OtherThing; use MyMoose; use Moose::Util::TypeConstraints; has 'other_thing' => ( is => 'rw', isa => 'Foo::Baz', handles => Moose::Util::TypeConstraints::find_type_constraint('Foo::Bar'), ); } { my $foo = Foo::Thing->new(thing => Foo::Baz->new); isa_ok($foo, 'Foo::Thing'); isa_ok($foo->thing, 'Foo::Baz'); ok($foo->meta->has_method('foo'), '... we have the method we expect'); ok($foo->meta->has_method('bar'), '... we have the method we expect'); ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); is($foo->thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } { my $foo = Foo::OtherThing->new(other_thing => Foo::Baz->new); isa_ok($foo, 'Foo::OtherThing'); isa_ok($foo->other_thing, 'Foo::Baz'); ok($foo->meta->has_method('foo'), '... we have the method we expect'); ok($foo->meta->has_method('bar'), '... we have the method we expect'); ok(!$foo->meta->has_method('baz'), '... we dont have the method we expect'); is($foo->foo, 'Foo::Baz::FOO', '... got the right value'); is($foo->bar, 'Foo::Baz::BAR', '... got the right value'); is($foo->other_thing->baz, 'Foo::Baz::BAZ', '... got the right value'); } # ------------------------------------------------------------------- # AUTOLOAD & handles # ------------------------------------------------------------------- { package Foo::Autoloaded; use MyMoose; sub AUTOLOAD { my $self = shift; my $name = our $AUTOLOAD; $name =~ s/.*://; # strip fully-qualified portion if (@_) { return $self->{$name} = shift; } else { return $self->{$name}; } } package Bar::Autoloaded; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => { 'foo_bar' => 'bar' } ); package Baz::Autoloaded; use MyMoose; has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => ['bar'] ); package Goorch::Autoloaded; use MyMoose; ::isnt( ::exception { has 'foo' => ( is => 'rw', default => sub { Foo::Autoloaded->new }, handles => qr/bar/ ); }, undef, '... you cannot delegate to AUTOLOADED class with regexp' ); } # check HASH based delegation w/ AUTOLOAD { my $bar = Bar::Autoloaded->new; isa_ok($bar, 'Bar::Autoloaded'); ok($bar->foo, '... we have something in bar->foo'); isa_ok($bar->foo, 'Foo::Autoloaded'); # change the value ... $bar->foo->bar(30); # and make sure the delegation picks it up is($bar->foo->bar, 30, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 30, '... bar->foo_bar delegated correctly'); # change the value through the delegation ... $bar->foo_bar(50); # and make sure everyone sees it is($bar->foo->bar, 50, '... bar->foo->bar returned the right (changed) value'); is($bar->foo_bar, 50, '... bar->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo::Autoloaded->new; isa_ok($foo, 'Foo::Autoloaded'); $foo->bar(25); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $bar->foo($foo); }, undef, '... assigned the new Foo to Bar->foo' ); is($bar->foo, $foo, '... assigned bar->foo with the new Foo'); is($bar->foo->bar, 25, '... bar->foo->bar returned the right result'); is($bar->foo_bar, 25, '... and bar->foo_bar delegated correctly again'); } # check ARRAY based delegation w/ AUTOLOAD { my $baz = Baz::Autoloaded->new; isa_ok($baz, 'Baz::Autoloaded'); ok($baz->foo, '... we have something in baz->foo'); isa_ok($baz->foo, 'Foo::Autoloaded'); # change the value ... $baz->foo->bar(30); # and make sure the delegation picks it up is($baz->foo->bar, 30, '... baz->foo->bar returned the right (changed) value'); is($baz->bar, 30, '... baz->foo_bar delegated correctly'); # change the value through the delegation ... $baz->bar(50); # and make sure everyone sees it is($baz->foo->bar, 50, '... baz->foo->bar returned the right (changed) value'); is($baz->bar, 50, '... baz->foo_bar delegated correctly'); # change the object we are delegating too my $foo = Foo::Autoloaded->new; isa_ok($foo, 'Foo::Autoloaded'); $foo->bar(25); is($foo->bar, 25, '... got the right foo->bar'); is( exception { $baz->foo($foo); }, undef, '... assigned the new Foo to Baz->foo' ); is($baz->foo, $foo, '... assigned baz->foo with the new Foo'); is($baz->foo->bar, 25, '... baz->foo->bar returned the right result'); is($baz->bar, 25, '... and baz->foo_bar delegated correctly again'); } # Check that removing attributes removes their handles methods also. { { package Quux; use MyMoose; has foo => ( isa => 'Foo', default => sub { Foo->new }, handles => { 'foo_bar' => 'bar' } ); } my $i = Quux->new; ok($i->meta->has_method('foo_bar'), 'handles method foo_bar is present'); $i->meta->remove_attribute('foo'); ok(!$i->meta->has_method('foo_bar'), 'handles method foo_bar is removed'); } # Make sure that a useful error message is thrown when the delegation target is # not an object { my $i = Bar->new(foo => undef); like( exception { $i->foo_bar }, qr/is not defined/, 'useful error from unblessed reference' ); my $j = Bar->new(foo => []); like( exception { $j->foo_bar }, qr/is not an object \(got 'ARRAY/, 'useful error from unblessed reference' ); my $k = Bar->new(foo => "Foo"); is( exception { $k->foo_baz }, undef, "but not for class name" ); } { package Delegator; use MyMoose; sub full { 1 } sub stub; ::like( ::exception{ has d1 => ( isa => 'X', handles => ['full'], ); }, qr/\QYou cannot overwrite a locally defined method (full) with a delegation/, 'got an error when trying to declare a delegation method that overwrites a local method' ); ::is( ::exception{ has d2 => ( isa => 'X', handles => ['stub'], ); }, undef, 'no error when trying to declare a delegation method that overwrites a stub method' ); } done_testing; moose_attribute_does.t000664001750001750 442512234215334 20417 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo::Role; use MyMoose::Role; use Moose::Util::TypeConstraints; # if does() exists on its own, then # we create a type constraint for # it, just as we do for isa() has 'bar' => (is => 'rw', does => 'Bar::Role'); has 'baz' => ( is => 'rw', does => role_type('Bar::Role') ); package Foo::Class; use MyMoose; with 'Foo::Role'; package Bar::Role; use MyMoose::Role; # if isa and does appear together, then see if Class->does(Role) # if it does work... then the does() check is actually not needed # since the isa() check will imply the does() check has 'foo' => (is => 'rw', isa => 'Foo::Class', does => 'Foo::Role'); package Bar::Class; use MyMoose; with 'Bar::Role'; } my $foo = Foo::Class->new; isa_ok($foo, 'Foo::Class'); my $bar = Bar::Class->new; isa_ok($bar, 'Bar::Class'); is( exception { $foo->bar($bar); }, undef, '... bar passed the type constraint okay' ); isnt( exception { $foo->bar($foo); }, undef, '... foo did not pass the type constraint okay' ); is( exception { $foo->baz($bar); }, undef, '... baz passed the type constraint okay' ); isnt( exception { $foo->baz($foo); }, undef, '... foo did not pass the type constraint okay' ); is( exception { $bar->foo($foo); }, undef, '... foo passed the type constraint okay' ); # some error conditions { package Baz::Class; use MyMoose; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::isnt( ::exception { has 'foo' => (isa => 'Foo::Class', does => 'Bar::Class'); }, undef, '... cannot have a does() which is not done by the isa()' ); } { package Bling; use strict; use warnings; sub bling { 'Bling::bling' } package Bling::Bling; use MyMoose; # if isa and does appear together, then see if Class->does(Role) # if it does not,.. we have a conflict... so we die loudly ::isnt( ::exception { has 'foo' => (isa => 'Bling', does => 'Bar::Class'); }, undef, '... cannot have a isa() which is cannot does()' ); } done_testing; moose_attribute_inherited_slot_specs.t000664001750001750 2373012234215334 23716 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Thing::Meta::Attribute; use MyMoose; extends 'Moose::Meta::Attribute'; around illegal_options_for_inheritance => sub { return (shift->(@_), qw/trigger/); }; package Thing; use MyMoose; sub hello { 'Hello World (from Thing)' } sub goodbye { 'Goodbye World (from Thing)' } package Foo; use MyMoose; use Moose::Util::TypeConstraints; subtype 'FooStr' => as 'Str' => where { /Foo/ }; coerce 'FooStr' => from ArrayRef => via { 'FooArrayRef' }; has 'bar' => (is => 'ro', isa => 'Str', default => 'Foo::bar'); has 'baz' => (is => 'rw', isa => 'Ref'); has 'foo' => (is => 'rw', isa => 'FooStr'); has 'gorch' => (is => 'ro'); has 'gloum' => (is => 'ro', default => sub {[]}); has 'fleem' => (is => 'ro'); has 'bling' => (is => 'ro', isa => 'Thing'); has 'blang' => (is => 'ro', isa => 'Thing', handles => ['goodbye']); has 'bunch_of_stuff' => (is => 'rw', isa => 'ArrayRef'); has 'one_last_one' => (is => 'rw', isa => 'Ref'); # this one will work here .... has 'fail' => (isa => 'CodeRef', is => 'bare'); has 'other_fail' => (metaclass => 'Thing::Meta::Attribute', is => 'bare', trigger => sub { }); package Bar; use MyMoose; use Moose::Util::TypeConstraints; extends 'Foo'; ::is( ::exception { has '+bar' => (default => 'Bar::bar'); }, undef, '... we can change the default attribute option' ); ::is( ::exception { has '+baz' => (isa => 'ArrayRef'); }, undef, '... we can add change the isa as long as it is a subtype' ); ::is( ::exception { has '+foo' => (coerce => 1); }, undef, '... we can change/add coerce as an attribute option' ); ::is( ::exception { has '+gorch' => (required => 1); }, undef, '... we can change/add required as an attribute option' ); ::is( ::exception { has '+gloum' => (lazy => 1); }, undef, '... we can change/add lazy as an attribute option' ); ::is( ::exception { has '+fleem' => (lazy_build => 1); }, undef, '... we can add lazy_build as an attribute option' ); ::is( ::exception { has '+bunch_of_stuff' => (isa => 'ArrayRef[Int]'); }, undef, '... extend an attribute with parameterized type' ); ::is( ::exception { has '+one_last_one' => (isa => subtype('Ref', where { blessed $_ eq 'CODE' })); }, undef, '... extend an attribute with anon-subtype' ); ::is( ::exception { has '+one_last_one' => (isa => 'Value'); }, undef, '... now can extend an attribute with a non-subtype' ); ::is( ::exception { has '+fleem' => (weak_ref => 1); }, undef, '... now allowed to add the weak_ref option via inheritance' ); ::is( ::exception { has '+bling' => (handles => ['hello']); }, undef, '... we can add the handles attribute option' ); # this one will *not* work here .... ::isnt( ::exception { has '+blang' => (handles => ['hello']); }, undef, '... we can not alter the handles attribute option' ); ::is( ::exception { has '+fail' => (isa => 'Ref'); }, undef, '... can now create an attribute with an improper subtype relation' ); ::isnt( ::exception { has '+other_fail' => (trigger => sub {}); }, undef, '... cannot create an attribute with an illegal option' ); ::like( ::exception { has '+does_not_exist' => (isa => 'Str'); }, qr/in Bar/, '... cannot extend a non-existing attribute' ); } my $foo = Foo->new; isa_ok($foo, 'Foo'); is($foo->foo, undef, '... got the right undef default value'); is( exception { $foo->foo('FooString') }, undef, '... assigned foo correctly' ); is($foo->foo, 'FooString', '... got the right value for foo'); isnt( exception { $foo->foo([]) }, undef, '... foo is not coercing (as expected)' ); is($foo->bar, 'Foo::bar', '... got the right default value'); isnt( exception { $foo->bar(10) }, undef, '... Foo::bar is a read/only attr' ); is($foo->baz, undef, '... got the right undef default value'); { my $hash_ref = {}; is( exception { $foo->baz($hash_ref) }, undef, '... Foo::baz accepts hash refs' ); is($foo->baz, $hash_ref, '... got the right value assigned to baz'); my $array_ref = []; is( exception { $foo->baz($array_ref) }, undef, '... Foo::baz accepts an array ref' ); is($foo->baz, $array_ref, '... got the right value assigned to baz'); my $scalar_ref = \(my $var); is( exception { $foo->baz($scalar_ref) }, undef, '... Foo::baz accepts scalar ref' ); is($foo->baz, $scalar_ref, '... got the right value assigned to baz'); is( exception { $foo->bunch_of_stuff([qw[one two three]]) }, undef, '... Foo::bunch_of_stuff accepts an array of strings' ); is( exception { $foo->one_last_one(sub { 'Hello World'}) }, undef, '... Foo::one_last_one accepts a code ref' ); my $code_ref = sub { 1 }; is( exception { $foo->baz($code_ref) }, undef, '... Foo::baz accepts a code ref' ); is($foo->baz, $code_ref, '... got the right value assigned to baz'); } isnt( exception { Bar->new; }, undef, '... cannot create Bar without required gorch param' ); my $bar = Bar->new(gorch => 'Bar::gorch'); isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); is($bar->foo, undef, '... got the right undef default value'); is( exception { $bar->foo('FooString') }, undef, '... assigned foo correctly' ); is($bar->foo, 'FooString', '... got the right value for foo'); is( exception { $bar->foo([]) }, undef, '... assigned foo correctly' ); is($bar->foo, 'FooArrayRef', '... got the right value for foo'); is($bar->gorch, 'Bar::gorch', '... got the right default value'); is($bar->bar, 'Bar::bar', '... got the right default value'); isnt( exception { $bar->bar(10) }, undef, '... Bar::bar is a read/only attr' ); is($bar->baz, undef, '... got the right undef default value'); { my $hash_ref = {}; isnt( exception { $bar->baz($hash_ref) }, undef, '... Bar::baz does not accept hash refs' ); my $array_ref = []; is( exception { $bar->baz($array_ref) }, undef, '... Bar::baz can accept an array ref' ); is($bar->baz, $array_ref, '... got the right value assigned to baz'); my $scalar_ref = \(my $var); isnt( exception { $bar->baz($scalar_ref) }, undef, '... Bar::baz does not accept a scalar ref' ); is( exception { $bar->bunch_of_stuff([1, 2, 3]) }, undef, '... Bar::bunch_of_stuff accepts an array of ints' ); isnt( exception { $bar->bunch_of_stuff([qw[one two three]]) }, undef, '... Bar::bunch_of_stuff does not accept an array of strings' ); my $code_ref = sub { 1 }; isnt( exception { $bar->baz($code_ref) }, undef, '... Bar::baz does not accept a code ref' ); } # check some meta-stuff ok(Bar->meta->has_attribute('foo'), '... Bar has a foo attr'); ok(Bar->meta->has_attribute('bar'), '... Bar has a bar attr'); ok(Bar->meta->has_attribute('baz'), '... Bar has a baz attr'); ok(Bar->meta->has_attribute('gorch'), '... Bar has a gorch attr'); ok(Bar->meta->has_attribute('gloum'), '... Bar has a gloum attr'); ok(Bar->meta->has_attribute('bling'), '... Bar has a bling attr'); ok(Bar->meta->has_attribute('bunch_of_stuff'), '... Bar does have a bunch_of_stuff attr'); ok(!Bar->meta->has_attribute('blang'), '... Bar has a blang attr'); ok(Bar->meta->has_attribute('fail'), '... Bar has a fail attr'); ok(!Bar->meta->has_attribute('other_fail'), '... Bar does not have an other_fail attr'); isnt(Foo->meta->get_attribute('foo'), Bar->meta->get_attribute('foo'), '... Foo and Bar have different copies of foo'); isnt(Foo->meta->get_attribute('bar'), Bar->meta->get_attribute('bar'), '... Foo and Bar have different copies of bar'); isnt(Foo->meta->get_attribute('baz'), Bar->meta->get_attribute('baz'), '... Foo and Bar have different copies of baz'); isnt(Foo->meta->get_attribute('gorch'), Bar->meta->get_attribute('gorch'), '... Foo and Bar have different copies of gorch'); isnt(Foo->meta->get_attribute('gloum'), Bar->meta->get_attribute('gloum'), '... Foo and Bar have different copies of gloum'); isnt(Foo->meta->get_attribute('bling'), Bar->meta->get_attribute('bling'), '... Foo and Bar have different copies of bling'); isnt(Foo->meta->get_attribute('bunch_of_stuff'), Bar->meta->get_attribute('bunch_of_stuff'), '... Foo and Bar have different copies of bunch_of_stuff'); ok(Bar->meta->get_attribute('bar')->has_type_constraint, '... Bar::bar inherited the type constraint too'); ok(Bar->meta->get_attribute('baz')->has_type_constraint, '... Bar::baz inherited the type constraint too'); is(Bar->meta->get_attribute('bar')->type_constraint->name, 'Str', '... Bar::bar inherited the right type constraint too'); is(Foo->meta->get_attribute('baz')->type_constraint->name, 'Ref', '... Foo::baz inherited the right type constraint too'); is(Bar->meta->get_attribute('baz')->type_constraint->name, 'ArrayRef', '... Bar::baz inherited the right type constraint too'); ok(!Foo->meta->get_attribute('gorch')->is_required, '... Foo::gorch is not a required attr'); ok(Bar->meta->get_attribute('gorch')->is_required, '... Bar::gorch is a required attr'); is(Foo->meta->get_attribute('bunch_of_stuff')->type_constraint->name, 'ArrayRef', '... Foo::bunch_of_stuff is an ArrayRef'); is(Bar->meta->get_attribute('bunch_of_stuff')->type_constraint->name, 'ArrayRef[Int]', '... Bar::bunch_of_stuff is an ArrayRef[Int]'); ok(!Foo->meta->get_attribute('gloum')->is_lazy, '... Foo::gloum is not a required attr'); ok(Bar->meta->get_attribute('gloum')->is_lazy, '... Bar::gloum is a required attr'); ok(!Foo->meta->get_attribute('foo')->should_coerce, '... Foo::foo should not coerce'); ok(Bar->meta->get_attribute('foo')->should_coerce, '... Bar::foo should coerce'); ok(!Foo->meta->get_attribute('bling')->has_handles, '... Foo::foo should not handles'); ok(Bar->meta->get_attribute('bling')->has_handles, '... Bar::foo should handles'); done_testing; moose_attribute_lazy_initializer.t000664001750001750 754112234215334 23051 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo' => ( reader => 'get_lazy_foo', lazy => 1, default => 10, initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_w_type' => ( reader => 'get_lazy_foo_w_type', isa => 'Int', lazy => 1, default => 20, initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_w_type', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_builder' => ( reader => 'get_lazy_foo_builder', builder => 'get_foo_builder', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_builder', '... got the right name'); $callback->($value * 2); }, ); has 'lazy_foo_builder_w_type' => ( reader => 'get_lazy_foo_builder_w_type', isa => 'Int', builder => 'get_foo_builder_w_type', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'lazy_foo_builder_w_type', '... got the right name'); $callback->($value * 2); }, ); sub get_foo_builder { 100 } sub get_foo_builder_w_type { 1000 } } { my $foo = Foo->new(foo => 10); isa_ok($foo, 'Foo'); is($foo->get_foo, 20, 'initial value set to 2x given value'); is($foo->get_lazy_foo, 20, 'initial lazy value set to 2x given value'); is($foo->get_lazy_foo_w_type, 40, 'initial lazy value with type set to 2x given value'); is($foo->get_lazy_foo_builder, 200, 'initial lazy value with builder set to 2x given value'); is($foo->get_lazy_foo_builder_w_type, 2000, 'initial lazy value with builder and type set to 2x given value'); } { package Bar; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->($value * 2); }, ); __PACKAGE__->meta->make_immutable; } { my $bar = Bar->new(foo => 10); isa_ok($bar, 'Bar'); is($bar->get_foo, 20, 'initial value set to 2x given value'); } { package Fail::Bar; use MyMoose; has 'foo' => ( reader => 'get_foo', writer => 'set_foo', isa => 'Int', initializer => sub { my ($self, $value, $callback, $attr) = @_; ::isa_ok($attr, 'Moose::Meta::Attribute'); ::is($attr->name, 'foo', '... got the right name'); $callback->("Hello $value World"); }, ); __PACKAGE__->meta->make_immutable; } isnt( exception { Fail::Bar->new(foo => 10) }, undef, '... this fails, because initializer returns a bad type' ); done_testing; moose_attribute_names.t000664001750001750 215412234215334 20565 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; my $exception_regex = qr/You must provide a name for the attribute/; { package My::Role; use MyMoose::Role; ::like( ::exception { has; }, $exception_regex, 'has; fails' ); ::like( ::exception { has undef; }, $exception_regex, 'has undef; fails' ); ::is( ::exception { has "" => ( is => 'bare', ); }, undef, 'has ""; works now' ); ::is( ::exception { has 0 => ( is => 'bare', ); }, undef, 'has 0; works now' ); } { package My::Class; use MyMoose; ::like( ::exception { has; }, $exception_regex, 'has; fails' ); ::like( ::exception { has undef; }, $exception_regex, 'has undef; fails' ); ::is( ::exception { has "" => ( is => 'bare', ); }, undef, 'has ""; works now' ); ::is( ::exception { has 0 => ( is => 'bare', ); }, undef, 'has 0; works now' ); } done_testing; moose_attribute_reader_generation.t000664001750001750 504612234215334 23142 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; eval { has 'foo' => ( reader => 'get_foo' ); }; ::ok(!$@, '... created the reader method okay'); eval { has 'lazy_foo' => ( reader => 'get_lazy_foo', lazy => 1, default => sub { 10 } ); }; ::ok(!$@, '... created the lazy reader method okay') or warn $@; eval { has 'lazy_weak_foo' => ( reader => 'get_lazy_weak_foo', lazy => 1, default => sub { our $AREF = [] }, weak_ref => 1, ); }; ::ok(!$@, '... created the lazy weak reader method okay') or warn $@; my $warn; eval { local $SIG{__WARN__} = sub { $warn = $_[0] }; has 'mtfnpy' => ( reder => 'get_mftnpy' ); }; ::ok($warn, '... got a warning for mispelled attribute argument'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); can_ok($foo, 'get_foo'); is($foo->get_foo(), undef, '... got an undefined value'); isnt( exception { $foo->get_foo(100); }, undef, '... get_foo is a read-only' ); ok(!exists($foo->{lazy_foo}), '... no value in get_lazy_foo slot'); can_ok($foo, 'get_lazy_foo'); is($foo->get_lazy_foo(), 10, '... got an deferred value'); isnt( exception { $foo->get_lazy_foo(100); }, undef, '... get_lazy_foo is a read-only' ); is($foo->get_lazy_weak_foo(), $Foo::AREF, 'got the right value'); ok($foo->meta->get_meta_instance->slot_value_is_weak($foo, 'lazy_weak_foo'), '... and it is weak'); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $attr = $foo->meta->find_attribute_by_name("lazy_foo"); isa_ok( $attr, "Moose::Meta::Attribute" ); ok( $attr->is_lazy, "it's lazy" ); is( $attr->get_raw_value($foo), undef, "raw value" ); is( $attr->get_value($foo), 10, "lazy value" ); is( $attr->get_raw_value($foo), 10, "raw value" ); my $lazy_weak_attr = $foo->meta->find_attribute_by_name("lazy_weak_foo"); is( $lazy_weak_attr->get_value($foo), $Foo::AREF, "it's the right value" ); ok( $foo->meta->get_meta_instance->slot_value_is_weak($foo, 'lazy_weak_foo'), "and it is weak"); } { my $foo = Foo->new(foo => 10, lazy_foo => 100); isa_ok($foo, 'Foo'); is($foo->get_foo(), 10, '... got the correct value'); is($foo->get_lazy_foo(), 100, '... got the correct value'); } done_testing; moose_attribute_required.t000664001750001750 333512234215334 21304 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'ro', required => 1); has 'baz' => (is => 'rw', default => 100, required => 1); has 'boo' => (is => 'rw', lazy => 1, default => 50, required => 1); } { my $foo = Foo->new(bar => 10, baz => 20, boo => 100); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 20, '... got the right baz'); is($foo->boo, 100, '... got the right boo'); } { my $foo = Foo->new(bar => 10, boo => 5); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 100, '... got the right baz'); is($foo->boo, 5, '... got the right boo'); } { my $foo = Foo->new(bar => 10); isa_ok($foo, 'Foo'); is($foo->bar, 10, '... got the right bar'); is($foo->baz, 100, '... got the right baz'); is($foo->boo, 50, '... got the right boo'); } #Yeah.. this doesn't work like this anymore, see below. (groditi) #throws_ok { # Foo->new(bar => 10, baz => undef); #} qr/^Attribute \(baz\) is required and cannot be undef/, '... must supply all the required attribute'; #throws_ok { # Foo->new(bar => 10, boo => undef); #} qr/^Attribute \(boo\) is required and cannot be undef/, '... must supply all the required attribute'; is( exception { Foo->new(bar => 10, baz => undef); }, undef, '... undef is a valid attribute value' ); is( exception { Foo->new(bar => 10, boo => undef); }, undef, '... undef is a valid attribute value' ); like( exception { Foo->new; }, qr/^Attribute \(bar\) is required/, '... must supply all the required attribute' ); done_testing; moose_attribute_traits.t000664001750001750 313412234215334 20767 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); has foo => ( is => "ro", default => "blah" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; } { package My::Class; use MyMoose; has 'bar' => ( traits => [qw/My::Attribute::Trait/], is => 'ro', isa => 'Int', alias_to => 'baz', ); has 'gorch' => ( is => 'ro', isa => 'Int', default => sub { 10 } ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); is($c->gorch, 10, '... got the right value for gorch'); can_ok($c, 'baz'); is($c->baz, 100, '... got the right value for baz'); my $bar_attr = $c->meta->get_attribute('bar'); does_ok($bar_attr, 'My::Attribute::Trait'); ok($bar_attr->has_applied_traits, '... got the applied traits'); is_deeply($bar_attr->applied_traits, [qw/My::Attribute::Trait/], '... got the applied traits'); is($bar_attr->foo, "blah", "attr initialized"); my $gorch_attr = $c->meta->get_attribute('gorch'); ok(!$gorch_attr->does('My::Attribute::Trait'), '... gorch doesnt do the trait'); ok(!$gorch_attr->has_applied_traits, '... no traits applied'); is($gorch_attr->applied_traits, undef, '... no traits applied'); done_testing; moose_attribute_traits_n_meta.t000664001750001750 266112234215334 22316 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Meta::Attribute::DefaultReadOnly; use MyMoose; extends 'Moose::Meta::Attribute'; around 'new' => sub { my $next = shift; my ($self, $name, %options) = @_; $options{is} = 'ro' unless exists $options{is}; $next->($self, $name, %options); }; } { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; } { package My::Class; use MyMoose; has 'bar' => ( metaclass => 'My::Meta::Attribute::DefaultReadOnly', traits => [qw/My::Attribute::Trait/], isa => 'Int', alias_to => 'baz', ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); can_ok($c, 'baz'); is($c->baz, 100, '... got the right value for baz'); isa_ok($c->meta->get_attribute('bar'), 'My::Meta::Attribute::DefaultReadOnly'); does_ok($c->meta->get_attribute('bar'), 'My::Attribute::Trait'); is($c->meta->get_attribute('bar')->_is_metadata, 'ro', '... got the right metaclass customization'); done_testing; moose_attribute_traits_parameterized.t000664001750001750 264012234215334 23704 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package My::Attribute::Trait; use MyMoose::Role; sub reversed_name { my $self = shift; scalar reverse $self->name; } } { package My::Class; use MyMoose; has foo => ( traits => [ 'My::Attribute::Trait' => { -alias => { reversed_name => 'eman', }, }, ], is => 'bare', ); } { package My::Other::Class; use MyMoose; has foo => ( traits => [ 'My::Attribute::Trait' => { -alias => { reversed_name => 'reversed', }, -excludes => 'reversed_name', }, ], is => 'bare', ); } my $attr = My::Class->meta->get_attribute('foo'); is($attr->eman, 'oof', 'the aliased method is in the attribute'); ok(!$attr->can('reversed'), "the method was not installed under the other class' alias"); my $other_attr = My::Other::Class->meta->get_attribute('foo'); is($other_attr->reversed, 'oof', 'the aliased method is in the attribute'); ok(!$other_attr->can('enam'), "the method was not installed under the other class' alias"); ok(!$other_attr->can('reversed_name'), "the method was not installed under the original name when that was excluded"); done_testing; moose_attribute_traits_registered.t000664001750001750 601412234215334 23204 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package My::Attribute::Trait; use MyMoose::Role; has 'alias_to' => (is => 'ro', isa => 'Str'); has foo => ( is => "ro", default => "blah" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( $self->alias_to, $self->get_read_method_ref ); }; package Moose::Meta::Attribute::Custom::Trait::Aliased; sub register_implementation { 'My::Attribute::Trait' } } { package My::Other::Attribute::Trait; use MyMoose::Role; my $method = sub { 42; }; has the_other_attr => ( isa => "Str", is => "rw", default => "oink" ); after 'install_accessors' => sub { my $self = shift; $self->associated_class->add_method( 'additional_method', $method ); }; package Moose::Meta::Attribute::Custom::Trait::Other; sub register_implementation { 'My::Other::Attribute::Trait' } } { package My::Class; use MyMoose; has 'bar' => ( traits => [qw/Aliased/], is => 'ro', isa => 'Int', alias_to => 'baz', ); } { package My::Derived::Class; use MyMoose; extends 'My::Class'; has '+bar' => ( traits => [qw/Other/], ); } my $c = My::Class->new(bar => 100); isa_ok($c, 'My::Class'); is($c->bar, 100, '... got the right value for bar'); can_ok($c, 'baz') and is($c->baz, 100, '... got the right value for baz'); my $bar_attr = $c->meta->get_attribute('bar'); does_ok($bar_attr, 'My::Attribute::Trait'); is($bar_attr->foo, "blah", "attr initialized"); ok(!$bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); ok($bar_attr->does('Aliased'), "attr->does uses aliases"); ok(!$bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); my $quux = My::Derived::Class->new(bar => 1000); is($quux->bar, 1000, '... got the right value for bar'); can_ok($quux, 'baz'); is($quux->baz, 1000, '... got the right value for baz'); my $derived_bar_attr = $quux->meta->get_attribute("bar"); does_ok($derived_bar_attr, 'My::Attribute::Trait' ); is( $derived_bar_attr->foo, "blah", "attr initialized" ); does_ok($derived_bar_attr, 'My::Other::Attribute::Trait' ); is($derived_bar_attr->the_other_attr, "oink", "attr initialized" ); ok(!$derived_bar_attr->meta->does_role('Aliased'), "does_role ignores aliases for sanity"); ok($derived_bar_attr->does('Aliased'), "attr->does uses aliases"); ok(!$derived_bar_attr->meta->does_role('Fictional'), "does_role returns false for nonexistent roles"); ok(!$derived_bar_attr->does('Fictional'), "attr->does returns false for nonexistent roles"); can_ok($quux, 'additional_method'); is(eval { $quux->additional_method }, 42, '... got the right value for additional_method'); done_testing; moose_attribute_triggers.t000664001750001750 1373312234215334 21335 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Scalar::Util 'isweak'; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'rw', isa => 'Maybe[Bar]', trigger => sub { my ($self, $bar) = @_; $bar->foo($self) if defined $bar; }); has 'baz' => (writer => 'set_baz', reader => 'get_baz', isa => 'Baz', trigger => sub { my ($self, $baz) = @_; $baz->foo($self); }); package Bar; use MyMoose; has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1); package Baz; use MyMoose; has 'foo' => (is => 'rw', isa => 'Foo', weak_ref => 1); } { my $foo = Foo->new; isa_ok($foo, 'Foo'); my $bar = Bar->new; isa_ok($bar, 'Bar'); my $baz = Baz->new; isa_ok($baz, 'Baz'); is( exception { $foo->bar($bar); }, undef, '... did not die setting bar' ); is($foo->bar, $bar, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); ok(isweak($bar->{foo}), '... bar.foo is a weak reference'); is( exception { $foo->bar(undef); }, undef, '... did not die un-setting bar' ); is($foo->bar, undef, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); # test the writer is( exception { $foo->set_baz($baz); }, undef, '... did not die setting baz' ); is($foo->get_baz, $baz, '... set the value foo.baz correctly'); is($baz->foo, $foo, '... which in turn set the value baz.foo correctly'); ok(isweak($baz->{foo}), '... baz.foo is a weak reference'); } { my $bar = Bar->new; isa_ok($bar, 'Bar'); my $baz = Baz->new; isa_ok($baz, 'Baz'); my $foo = Foo->new(bar => $bar, baz => $baz); isa_ok($foo, 'Foo'); is($foo->bar, $bar, '... set the value foo.bar correctly'); is($bar->foo, $foo, '... which in turn set the value bar.foo correctly'); ok(isweak($bar->{foo}), '... bar.foo is a weak reference'); is($foo->get_baz, $baz, '... set the value foo.baz correctly'); is($baz->foo, $foo, '... which in turn set the value baz.foo correctly'); ok(isweak($baz->{foo}), '... baz.foo is a weak reference'); } # some errors { package Bling; use MyMoose; ::isnt( ::exception { has('bling' => (is => 'rw', trigger => 'Fail')); }, undef, '... a trigger must be a CODE ref' ); ::isnt( ::exception { has('bling' => (is => 'rw', trigger => [])); }, undef, '... a trigger must be a CODE ref' ); } # Triggers do not fire on built values { package Blarg; use MyMoose; our %trigger_calls; our %trigger_vals; has foo => (is => 'rw', default => sub { 'default foo value' }, trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{foo}++; $trigger_vals{foo} = $val }); has bar => (is => 'rw', lazy_build => 1, trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{bar}++; $trigger_vals{bar} = $val }); sub _build_bar { return 'default bar value' } has baz => (is => 'rw', builder => '_build_baz', trigger => sub { my ($self, $val, $attr) = @_; $trigger_calls{baz}++; $trigger_vals{baz} = $val }); sub _build_baz { return 'default baz value' } } { my $blarg; is( exception { $blarg = Blarg->new; }, undef, 'Blarg->new() lives' ); ok($blarg, 'Have a $blarg'); foreach my $attr (qw/foo bar baz/) { is($blarg->$attr(), "default $attr value", "$attr has default value"); } is_deeply(\%Blarg::trigger_calls, {}, 'No triggers fired'); foreach my $attr (qw/foo bar baz/) { $blarg->$attr("Different $attr value"); } is_deeply(\%Blarg::trigger_calls, { map { $_ => 1 } qw/foo bar baz/ }, 'All triggers fired once on assign'); is_deeply(\%Blarg::trigger_vals, { map { $_ => "Different $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values'); is( exception { $blarg => Blarg->new( map { $_ => "Yet another $_ value" } qw/foo bar baz/ ) }, undef, '->new() with parameters' ); is_deeply(\%Blarg::trigger_calls, { map { $_ => 2 } qw/foo bar baz/ }, 'All triggers fired once on construct'); is_deeply(\%Blarg::trigger_vals, { map { $_ => "Yet another $_ value" } qw/foo bar baz/ }, 'All triggers given assigned values'); } # Triggers do not receive the meta-attribute as an argument, but do # receive the old value { package Foo; use MyMoose; our @calls; has foo => (is => 'rw', trigger => sub { push @calls, [@_] }); } { my $attr = Foo->meta->get_attribute('foo'); my $foo = Foo->new; $attr->set_value( $foo, 2 ); is_deeply( \@Foo::calls, [ [ $foo, 2 ] ], 'trigger called correctly on initial set via meta-API', ); @Foo::calls = (); $attr->set_value( $foo, 3 ); is_deeply( \@Foo::calls, [ [ $foo, 3, 2 ] ], 'trigger called correctly on second set via meta-API', ); @Foo::calls = (); $attr->set_raw_value( $foo, 4 ); is_deeply( \@Foo::calls, [ ], 'trigger not called using set_raw_value method', ); @Foo::calls = (); } { my $foo = Foo->new(foo => 2); is_deeply( \@Foo::calls, [ [ $foo, 2 ] ], 'trigger called correctly on construction', ); @Foo::calls = (); $foo->foo(3); is_deeply( \@Foo::calls, [ [ $foo, 3, 2 ] ], 'trigger called correctly on set (with old value)', ); @Foo::calls = (); Foo->meta->make_immutable, redo if Foo->meta->is_mutable; } done_testing; moose_attribute_type_unions.t000664001750001750 425012234215334 22035 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has 'bar' => (is => 'rw', isa => 'ArrayRef | HashRef'); } my $foo = Foo->new; isa_ok($foo, 'Foo'); is( exception { $foo->bar([]) }, undef, '... set bar successfully with an ARRAY ref' ); is( exception { $foo->bar({}) }, undef, '... set bar successfully with a HASH ref' ); isnt( exception { $foo->bar(100) }, undef, '... couldnt set bar successfully with a number' ); isnt( exception { $foo->bar(sub {}) }, undef, '... couldnt set bar successfully with a CODE ref' ); # check the constructor is( exception { Foo->new(bar => []) }, undef, '... created new Foo with bar successfully set with an ARRAY ref' ); is( exception { Foo->new(bar => {}) }, undef, '... created new Foo with bar successfully set with a HASH ref' ); isnt( exception { Foo->new(bar => 50) }, undef, '... didnt create a new Foo with bar as a number' ); isnt( exception { Foo->new(bar => sub {}) }, undef, '... didnt create a new Foo with bar as a CODE ref' ); { package Bar; use MyMoose; has 'baz' => (is => 'rw', isa => 'Str | CodeRef'); } my $bar = Bar->new; isa_ok($bar, 'Bar'); is( exception { $bar->baz('a string') }, undef, '... set baz successfully with a string' ); is( exception { $bar->baz(sub { 'a sub' }) }, undef, '... set baz successfully with a CODE ref' ); isnt( exception { $bar->baz(\(my $var1)) }, undef, '... couldnt set baz successfully with a SCALAR ref' ); isnt( exception { $bar->baz({}) }, undef, '... couldnt set bar successfully with a HASH ref' ); # check the constructor is( exception { Bar->new(baz => 'a string') }, undef, '... created new Bar with baz successfully set with a string' ); is( exception { Bar->new(baz => sub { 'a sub' }) }, undef, '... created new Bar with baz successfully set with a CODE ref' ); isnt( exception { Bar->new(baz => \(my $var2)) }, undef, '... didnt create a new Bar with baz as a number' ); isnt( exception { Bar->new(baz => {}) }, undef, '... didnt create a new Bar with baz as a HASH ref' ); done_testing; moose_attribute_without_any_methods.t000664001750001750 101512234215334 23552 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Moose (); use Moose::Meta::Class; my $meta = Moose::Meta::Class->create('Banana'); my $warn; $SIG{__WARN__} = sub { $warn = "@_" }; $meta->add_attribute('foo'); like $warn, qr/Attribute \(foo\) of class Banana has no associated methods/, 'correct error message'; $warn = ''; $meta->add_attribute('bar', is => 'bare'); is $warn, '', 'add attribute with no methods and is => "bare"'; done_testing; moose_attribute_writer_generation.t000664001750001750 606212234215334 23213 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Scalar::Util 'isweak'; { package Foo; use MyMoose; eval { has 'foo' => ( reader => 'get_foo', writer => 'set_foo', ); }; ::ok(!$@, '... created the writer method okay'); eval { has 'foo_required' => ( reader => 'get_foo_required', writer => 'set_foo_required', required => 1, ); }; ::ok(!$@, '... created the required writer method okay'); eval { has 'foo_int' => ( reader => 'get_foo_int', writer => 'set_foo_int', isa => 'Int', ); }; ::ok(!$@, '... created the writer method with type constraint okay'); eval { has 'foo_weak' => ( reader => 'get_foo_weak', writer => 'set_foo_weak', weak_ref => 1 ); }; ::ok(!$@, '... created the writer method with weak_ref okay'); } { my $foo = Foo->new(foo_required => 'required'); isa_ok($foo, 'Foo'); # regular writer can_ok($foo, 'set_foo'); is($foo->get_foo(), undef, '... got an unset value'); is( exception { $foo->set_foo(100); }, undef, '... set_foo wrote successfully' ); is($foo->get_foo(), 100, '... got the correct set value'); ok(!isweak($foo->{foo}), '... it is not a weak reference'); # required writer isnt( exception { Foo->new; }, undef, '... cannot create without the required attribute' ); can_ok($foo, 'set_foo_required'); is($foo->get_foo_required(), 'required', '... got an unset value'); is( exception { $foo->set_foo_required(100); }, undef, '... set_foo_required wrote successfully' ); is($foo->get_foo_required(), 100, '... got the correct set value'); isnt( exception { $foo->set_foo_required(); }, undef, '... set_foo_required died successfully with no value' ); is( exception { $foo->set_foo_required(undef); }, undef, '... set_foo_required did accept undef' ); ok(!isweak($foo->{foo_required}), '... it is not a weak reference'); # with type constraint can_ok($foo, 'set_foo_int'); is($foo->get_foo_int(), undef, '... got an unset value'); is( exception { $foo->set_foo_int(100); }, undef, '... set_foo_int wrote successfully' ); is($foo->get_foo_int(), 100, '... got the correct set value'); isnt( exception { $foo->set_foo_int("Foo"); }, undef, '... set_foo_int died successfully' ); ok(!isweak($foo->{foo_int}), '... it is not a weak reference'); # with weak_ref my $test = []; can_ok($foo, 'set_foo_weak'); is($foo->get_foo_weak(), undef, '... got an unset value'); is( exception { $foo->set_foo_weak($test); }, undef, '... set_foo_weak wrote successfully' ); is($foo->get_foo_weak(), $test, '... got the correct set value'); ok(isweak($foo->{foo_weak}), '... it is a weak reference'); } done_testing; moose_bad_coerce.t000664001750001750 154712234215334 17452 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { Moose => '2.1102' }; # error message changed { package Foo; use Moose; ::like(::exception { has foo => ( is => 'ro', isa => 'Str', coerce => 1, ); }, qr/\QYou cannot coerce an attribute (foo) unless its type (Str) has a coercion/, 'Cannot coerce unless the type has a coercion'); ::like(::exception { has bar => ( is => 'ro', isa => 'Str', coerce => 1, ); }, qr/\QYou cannot coerce an attribute (bar) unless its type (Str) has a coercion/, 'Cannot coerce unless the type has a coercion - different attribute'); } done_testing; moose_chained_coercion.t000664001750001750 163112234215334 20652 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Baz; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Baz' => from 'HashRef' => via { Baz->new($_) }; has 'hello' => ( is => 'ro', isa => 'Str', ); package Bar; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Bar' => from 'HashRef' => via { Bar->new($_) }; has 'baz' => ( is => 'ro', isa => 'Baz', coerce => 1 ); package Foo; use MyMoose; has 'bar' => ( is => 'ro', isa => 'Bar', coerce => 1, ); } my $foo = Foo->new(bar => { baz => { hello => 'World' } }); isa_ok($foo, 'Foo'); isa_ok($foo->bar, 'Bar'); isa_ok($foo->bar->baz, 'Baz'); is($foo->bar->baz->hello, 'World', '... this all worked fine'); done_testing; moose_clone_weak.t000664001750001750 761012234215334 17510 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; has bar => ( is => 'ro', weak_ref => 1, ); } { package MyScopeGuard; sub new { my ($class, $cb) = @_; bless { cb => $cb }, $class; } sub DESTROY { shift->{cb}->() } } { my $destroyed = 0; my $foo = do { my $bar = MyScopeGuard->new(sub { $destroyed++ }); my $foo = Foo->new({ bar => $bar }); my $clone = $foo->meta->clone_object($foo); is $destroyed, 0; $clone; }; isa_ok($foo, 'Foo'); is $foo->bar, undef; is $destroyed, 1; } { my $clone; { my $anon = Moose::Meta::Class->create_anon_class; my $foo = $anon->new_object; isa_ok($foo, $anon->name); ok(Class::MOP::class_of($foo), "has a metaclass"); $clone = $anon->clone_object($foo); isa_ok($clone, $anon->name); ok(Class::MOP::class_of($clone), "has a metaclass"); } ok(Class::MOP::class_of($clone), "still has a metaclass"); } { package Foo::Meta::Attr::Trait; use MyMoose::Role; has value_slot => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { shift->name }, ); has count_slot => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { '<>' . shift->name }, ); sub slots { my $self = shift; return ($self->value_slot, $self->count_slot); } sub _set_count { my $self = shift; my ($instance) = @_; my $mi = $self->associated_class->get_meta_instance; $mi->set_slot_value( $instance, $self->count_slot, ($mi->get_slot_value($instance, $self->count_slot) || 0) + 1, ); } sub _clear_count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->deinitialize_slot( $instance, $self->count_slot ); } sub has_count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->has_slot_value( $instance, $self->count_slot ); } sub count { my $self = shift; my ($instance) = @_; $self->associated_class->get_meta_instance->get_slot_value( $instance, $self->count_slot ); } after set_initial_value => sub { shift->_set_count(@_); }; after set_value => sub { shift->_set_count(@_); }; around _inline_instance_set => sub { my $orig = shift; my $self = shift; my ($instance) = @_; my $mi = $self->associated_class->get_meta_instance; return 'do { ' . $mi->inline_set_slot_value( $instance, $self->count_slot, $mi->inline_get_slot_value( $instance, $self->count_slot ) . ' + 1' ) . ';' . $self->$orig(@_) . '}'; }; after clear_value => sub { shift->_clear_count(@_); }; } { package Bar; use MyMoose; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { attribute => ['Foo::Meta::Attr::Trait'], }, ); has baz => ( is => 'rw' ); } SKIP: { skip "do not play nice with traits that change inlining behaviour", 3; my $attr = Bar->meta->find_attribute_by_name('baz'); my $bar = Bar->new(baz => 1); is($attr->count($bar), 1, "right count"); $bar->baz(2); is($attr->count($bar), 2, "right count"); my $clone = $bar->meta->clone_object($bar); is($attr->count($clone), $attr->count($bar), "right count"); } done_testing; moose_default_class_role_types.t000664001750001750 252712234215334 22461 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Moose::Util::TypeConstraints; { package Foo; use MyMoose; has unknown_class => ( is => 'ro', isa => 'UnknownClass', ); has unknown_role => ( is => 'ro', does => 'UnknownRole', ); } { my $meta = Foo->meta; my $class_tc = $meta->get_attribute('unknown_class')->type_constraint; isa_ok($class_tc, 'Moose::Meta::TypeConstraint::Class'); is($class_tc, find_type_constraint('UnknownClass'), "class type is registered"); like( exception { subtype 'UnknownClass', as 'Str'; }, qr/The type constraint 'UnknownClass' has already been created in Foo and cannot be created again in main/, "Can't redefine implicitly defined class types" ); my $role_tc = $meta->get_attribute('unknown_role')->type_constraint; isa_ok($role_tc, 'Moose::Meta::TypeConstraint::Role'); is($role_tc, find_type_constraint('UnknownRole'), "role type is registered"); like( exception { subtype 'UnknownRole', as 'Str'; }, qr/The type constraint 'UnknownRole' has already been created in Foo and cannot be created again in main/, "Can't redefine implicitly defined class types" ); } done_testing; moose_default_undef.t000664001750001750 64112234215334 20163 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package Foo; use MyMoose; has foo => ( is => 'ro', isa => 'Maybe[Int]', default => undef, predicate => 'has_foo', ); } with_immutable { is(Foo->new->foo, undef); ok(Foo->new->has_foo); } 'Foo'; done_testing; moose_delegation_and_modifiers.t000664001750001750 177512234215334 22405 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Bar; use MyMoose; sub baz { 'Bar::baz' } sub gorch { 'Bar::gorch' } package Foo; use MyMoose; has 'bar' => ( is => 'ro', isa => 'Bar', lazy => 1, default => sub { Bar->new }, handles => [qw[ baz gorch ]] ); package Foo::Extended; use MyMoose; extends 'Foo'; has 'test' => ( is => 'rw', isa => 'Bool', default => sub { 0 }, ); around 'bar' => sub { my $next = shift; my $self = shift; $self->test(1); $self->$next(); }; } my $foo = Foo::Extended->new; isa_ok($foo, 'Foo::Extended'); isa_ok($foo, 'Foo'); ok(!$foo->test, '... the test value has not been changed'); is($foo->baz, 'Bar::baz', '... got the right delegated method'); ok($foo->test, '... the test value has now been changed'); done_testing; moose_delegation_arg_aliasing.t000664001750001750 142512234215334 22212 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; sub aliased { my $self = shift; $_[1] = $_[0]; } } { package HasFoo; use MyMoose; has foo => ( is => 'ro', isa => 'Foo', handles => { foo_aliased => 'aliased', foo_aliased_curried => ['aliased', 'bar'], } ); } my $hasfoo = HasFoo->new(foo => Foo->new); my $x; $hasfoo->foo->aliased('foo', $x); is($x, 'foo', "direct aliasing works"); undef $x; $hasfoo->foo_aliased('foo', $x); is($x, 'foo', "delegated aliasing works"); undef $x; $hasfoo->foo_aliased_curried($x); is($x, 'bar', "delegated aliasing with currying works"); done_testing; moose_delegation_target_not_loaded.t000664001750001750 156512234215334 23255 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package X; use MyMoose; ::like( ::exception{ has foo => ( is => 'ro', isa => 'Foo', handles => qr/.*/, ) }, qr/\QThe foo attribute is trying to delegate to a class which has not been loaded - Foo/, 'cannot delegate to a class which is not yet loaded' ); ::like( ::exception{ has foo => ( is => 'ro', does => 'Role::Foo', handles => qr/.*/, ) }, qr/\QThe foo attribute is trying to delegate to a role which has not been loaded - Role::Foo/, 'cannot delegate to a role which is not yet loaded' ); } done_testing; moose_illegal_options_for_inheritance.t000664001750001750 366412234215334 24011 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; has foo => ( is => 'ro', ); has bar => ( clearer => 'clear_bar', ); } { package Foo::Sub; use MyMoose; extends 'Foo'; ::is( ::exception { has '+foo' => (is => 'rw') }, undef, "can override is" ); ::like( ::exception { has '+foo' => (reader => 'bar') }, qr/illegal/, "can't override reader" ); ::is( ::exception { has '+foo' => (clearer => 'baz') }, undef, "can override unspecified things" ); ::like( ::exception { has '+bar' => (clearer => 'quux') }, qr/illegal/, "can't override clearer" ); ::is( ::exception { has '+bar' => (predicate => 'has_bar') }, undef, "can override unspecified things" ); } { package Bar::Meta::Attribute; use MyMoose::Role; has my_illegal_option => (is => 'ro'); around illegal_options_for_inheritance => sub { return (shift->(@_), 'my_illegal_option'); }; } { package Bar; use MyMoose; ::is( ::exception { has bar => ( traits => ['Bar::Meta::Attribute'], my_illegal_option => 'FOO', is => 'bare', ); }, undef, "can use illegal options" ); has baz => ( traits => ['Bar::Meta::Attribute'], is => 'bare', ); } { package Bar::Sub; use MyMoose; extends 'Bar'; ::like( ::exception { has '+bar' => (my_illegal_option => 'BAR') }, qr/illegal/, "can't override illegal attribute" ); ::is( ::exception { has '+baz' => (my_illegal_option => 'BAR') }, undef, "can add illegal option if superclass doesn't set it" ); } my $bar_attr = Bar->meta->get_attribute('bar'); ok((grep { $_ eq 'my_illegal_option' } $bar_attr->illegal_options_for_inheritance) > 0, '... added my_illegal_option as illegal option for inheritance'); done_testing; moose_inherit_lazy_build.t000664001750001750 320712234215334 21257 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Parent; use MyMoose; has attr => ( is => 'rw', isa => 'Str' ); } { package Child; use MyMoose; extends 'Parent'; has '+attr' => ( lazy_build => 1 ); sub _build_attr { return 'value'; } } my $parent = Parent->new(); my $child = Child->new(); ok( !$parent->meta->get_attribute('attr')->is_lazy_build, 'attribute in parent does not have lazy_build trait' ); ok( !$parent->meta->get_attribute('attr')->is_lazy, 'attribute in parent does not have lazy trait' ); ok( !$parent->meta->get_attribute('attr')->has_builder, 'attribute in parent does not have a builder method' ); ok( !$parent->meta->get_attribute('attr')->has_clearer, 'attribute in parent does not have a clearer method' ); ok( !$parent->meta->get_attribute('attr')->has_predicate, 'attribute in parent does not have a predicate method' ); ok( $child->meta->get_attribute('attr')->is_lazy_build, 'attribute in child has the lazy_build trait' ); ok( $child->meta->get_attribute('attr')->is_lazy, 'attribute in child has the lazy trait' ); ok( $child->meta->get_attribute('attr')->has_builder, 'attribute in child has a builder method' ); ok( $child->meta->get_attribute('attr')->has_clearer, 'attribute in child has a clearer method' ); ok( $child->meta->get_attribute('attr')->has_predicate, 'attribute in child has a predicate method' ); is( $child->attr, 'value', 'attribute defined as lazy_build in child is properly built' ); done_testing; moose_lazy_no_default.t000664001750001750 74512234215334 20542 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use MyMoose; ::like( ::exception{ has foo => ( is => 'ro', lazy => 1, ); }, qr/\QYou cannot have a lazy attribute (foo) without specifying a default value for it/, 'lazy without a default or builder throws an error' ); } done_testing; moose_method_generation_rules.t000664001750001750 352312234215334 22305 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; =pod is => rw, writer => _foo # turns into (reader => foo, writer => _foo) is => ro, writer => _foo # turns into (reader => foo, writer => _foo) as before is => rw, accessor => _foo # turns into (accessor => _foo) is => ro, accessor => _foo # error, accesor is rw =cut sub make_class { my ($is, $attr, $class) = @_; eval "package $class; use MyMoose; has 'foo' => ( is => '$is', $attr => '_foo' );"; return $@ ? die $@ : $class; } my $obj; my $class; $class = make_class('rw', 'writer', 'Test::Class::WriterRW'); ok($class, "Can define attr with rw + writer"); $obj = $class->new(); can_ok($obj, qw/foo _foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->foo(), 1, "$class->foo is reader"); isnt( exception {$obj->foo(2)}, undef, "$class->foo is not writer" ); # this should fail ok(!defined $obj->_foo(undef), "$class->_foo is not reader"); $class = make_class('ro', 'writer', 'Test::Class::WriterRO'); ok($class, "Can define attr with ro + writer"); $obj = $class->new(); can_ok($obj, qw/foo _foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->foo(), 1, "$class->foo is reader"); isnt( exception {$obj->foo(1)}, undef, "$class->foo is not writer" ); isnt($obj->_foo(undef), 1, "$class->_foo is not reader"); $class = make_class('rw', 'accessor', 'Test::Class::AccessorRW'); ok($class, "Can define attr with rw + accessor"); $obj = $class->new(); can_ok($obj, qw/_foo/); is( exception {$obj->_foo(1)}, undef, "$class->_foo is writer" ); is($obj->_foo(), 1, "$class->foo is reader"); isnt( exception { make_class('ro', 'accessor', "Test::Class::AccessorRO"); }, undef, "Cant define attr with ro + accessor" ); done_testing; moose_misc_attribute_coerce_lazy.t000664001750001750 165712234215334 23003 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; { package HTTPHeader; use MyMoose; has 'array' => (is => 'ro'); has 'hash' => (is => 'ro'); } { package Request; use MyMoose; use Moose::Util::TypeConstraints; subtype Header => => as Object => where { $_->isa('HTTPHeader') }; coerce Header => from ArrayRef => via { HTTPHeader->new(array => $_[0]) } => from HashRef => via { HTTPHeader->new(hash => $_[0]) }; has 'headers' => ( is => 'rw', isa => 'Header', coerce => 1, lazy => 1, default => sub { [ 'content-type', 'text/html' ] } ); } my $r = Request->new; isa_ok($r, 'Request'); is( exception { $r->headers; }, undef, '... this coerces and passes the type constraint even with lazy' ); done_testing; moose_misc_attribute_tests.t000664001750001750 1623112234215334 21660 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; use Test::Requires { Moose => '2.1102' }; # error message changed { { package Test::Attribute::Inline::Documentation; use MyMoose; has 'foo' => ( documentation => q{ The 'foo' attribute is my favorite attribute in the whole wide world. }, is => 'bare', ); } my $foo_attr = Test::Attribute::Inline::Documentation->meta->get_attribute('foo'); ok($foo_attr->has_documentation, '... the foo has docs'); is($foo_attr->documentation, q{ The 'foo' attribute is my favorite attribute in the whole wide world. }, '... got the foo docs'); } { { package Test::For::Lazy::TypeConstraint; use MyMoose; use Moose::Util::TypeConstraints; has 'bad_lazy_attr' => ( is => 'rw', isa => 'ArrayRef', lazy => 1, default => sub { "test" }, ); has 'good_lazy_attr' => ( is => 'rw', isa => 'ArrayRef', lazy => 1, default => sub { [] }, ); } my $test = Test::For::Lazy::TypeConstraint->new; isa_ok($test, 'Test::For::Lazy::TypeConstraint'); isnt( exception { $test->bad_lazy_attr; }, undef, '... this does not work' ); is( exception { $test->good_lazy_attr; }, undef, '... this does not work' ); } { { package Test::Arrayref::Attributes; use MyMoose; has [qw(foo bar baz)] => ( is => 'rw', ); } my $test = Test::Arrayref::Attributes->new; isa_ok($test, 'Test::Arrayref::Attributes'); can_ok($test, qw(foo bar baz)); } { { package Test::Arrayref::RoleAttributes::Role; use MyMoose::Role; has [qw(foo bar baz)] => ( is => 'rw', ); } { package Test::Arrayref::RoleAttributes; use MyMoose; with 'Test::Arrayref::RoleAttributes::Role'; } my $test = Test::Arrayref::RoleAttributes->new; isa_ok($test, 'Test::Arrayref::RoleAttributes'); can_ok($test, qw(foo bar baz)); } { { package Test::UndefDefault::Attributes; use MyMoose; has 'foo' => ( is => 'ro', isa => 'Str', default => sub { return } ); } isnt( exception { Test::UndefDefault::Attributes->new; }, undef, '... default must return a value which passes the type constraint' ); } { { package OverloadedStr; use MyMoose; use overload '""' => sub { 'this is *not* a string' }; has 'a_str' => ( isa => 'Str' , is => 'rw' ); } my $moose_obj = OverloadedStr->new; is($moose_obj->a_str( 'foobar' ), 'foobar', 'setter took string'); ok($moose_obj, 'this is a *not* a string'); like( exception { $moose_obj->a_str( $moose_obj ) }, qr/Attribute \(a_str\) does not pass the type constraint because\: Validation failed for 'Str' with value .*OverloadedStr/, '... dies without overloading the string' ); } { { package OverloadBreaker; use MyMoose; has 'a_num' => ( isa => 'Int' , is => 'rw', default => 7.5 ); } like( exception { OverloadBreaker->new; }, qr/Attribute \(a_num\) does not pass the type constraint because\: Validation failed for 'Int' with value 7\.5/, '... this doesnt trip overload to break anymore ' ); is( exception { OverloadBreaker->new(a_num => 5); }, undef, '... this works fine though' ); } { { package Test::Builder::Attribute; use MyMoose; has 'foo' => ( required => 1, builder => 'build_foo', is => 'ro'); sub build_foo { return "works" }; } my $meta = Test::Builder::Attribute->meta; my $foo_attr = $meta->get_attribute("foo"); ok($foo_attr->is_required, "foo is required"); ok($foo_attr->has_builder, "foo has builder"); is($foo_attr->builder, "build_foo", ".. and it's named build_foo"); my $instance = Test::Builder::Attribute->new; is($instance->foo, 'works', "foo builder works"); } { { package Test::Builder::Attribute::Broken; use MyMoose; has 'foo' => ( required => 1, builder => 'build_foo', is => 'ro'); } isnt( exception { Test::Builder::Attribute::Broken->new; }, undef, '... no builder, wtf' ); } { { package Test::LazyBuild::Attribute; use MyMoose; has 'foo' => ( lazy_build => 1, is => 'ro'); has '_foo' => ( lazy_build => 1, is => 'ro'); has 'fool' => ( lazy_build => 1, is => 'ro'); sub _build_foo { return "works" }; sub _build__foo { return "works too" }; } my $meta = Test::LazyBuild::Attribute->meta; my $foo_attr = $meta->get_attribute("foo"); my $_foo_attr = $meta->get_attribute("_foo"); ok($foo_attr->is_lazy, "foo is lazy"); ok($foo_attr->is_lazy_build, "foo is lazy_build"); ok($foo_attr->has_clearer, "foo has clearer"); is($foo_attr->clearer, "clear_foo", ".. and it's named clear_foo"); ok($foo_attr->has_builder, "foo has builder"); is($foo_attr->builder, "_build_foo", ".. and it's named build_foo"); ok($foo_attr->has_predicate, "foo has predicate"); is($foo_attr->predicate, "has_foo", ".. and it's named has_foo"); ok($_foo_attr->is_lazy, "_foo is lazy"); ok(!$_foo_attr->is_required, "lazy_build attributes are no longer automatically required"); ok($_foo_attr->is_lazy_build, "_foo is lazy_build"); ok($_foo_attr->has_clearer, "_foo has clearer"); is($_foo_attr->clearer, "_clear_foo", ".. and it's named _clear_foo"); ok($_foo_attr->has_builder, "_foo has builder"); is($_foo_attr->builder, "_build__foo", ".. and it's named _build_foo"); ok($_foo_attr->has_predicate, "_foo has predicate"); is($_foo_attr->predicate, "_has_foo", ".. and it's named _has_foo"); my $instance = Test::LazyBuild::Attribute->new; ok(!$instance->has_foo, "noo foo value yet"); ok(!$instance->_has_foo, "noo _foo value yet"); is($instance->foo, 'works', "foo builder works"); is($instance->_foo, 'works too', "foo builder works too"); like( exception { $instance->fool }, qr/Test::LazyBuild::Attribute does not support builder method \'_build_fool\' for attribute \'fool\'/, "Correct error when a builder method is not present" ); } { package OutOfClassTest; use MyMoose; } is( exception { OutOfClassTest::has('foo', is => 'bare'); }, undef, 'create attr via direct sub call' ); is( exception { OutOfClassTest->can('has')->('bar', is => 'bare'); }, undef, 'create attr via can' ); ok(OutOfClassTest->meta->get_attribute('foo'), 'attr created from sub call'); ok(OutOfClassTest->meta->get_attribute('bar'), 'attr created from can'); { { package Foo; use MyMoose; ::like( ::exception { has 'foo' => ( 'ro', isa => 'Str' ) }, qr/\QYou must pass an even number of attribute options/, 'has throws error with odd number of attribute options' ); } } done_testing; moose_more_attr_delegation.t000664001750001750 1552512234215334 21614 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Fatal; =pod This tests the more complex delegation cases and that they do not fail at compile time. =cut { package ChildASuper; use MyMoose; sub child_a_super_method { "as" } package ChildA; use MyMoose; extends "ChildASuper"; sub child_a_method_1 { "a1" } sub child_a_method_2 { Scalar::Util::blessed($_[0]) . " a2" } package ChildASub; use MyMoose; extends "ChildA"; sub child_a_method_3 { "a3" } package ChildB; use MyMoose; sub child_b_method_1 { "b1" } sub child_b_method_2 { "b2" } sub child_b_method_3 { "b3" } package ChildC; use MyMoose; sub child_c_method_1 { "c1" } sub child_c_method_2 { "c2" } sub child_c_method_3_la { "c3" } sub child_c_method_4_la { "c4" } package ChildD; use MyMoose; sub child_d_method_1 { "d1" } sub child_d_method_2 { "d2" } package ChildE; # no Moose sub new { bless {}, shift } sub child_e_method_1 { "e1" } sub child_e_method_2 { "e2" } package ChildF; # no Moose sub new { bless {}, shift } sub child_f_method_1 { "f1" } sub child_f_method_2 { "f2" } $INC{'ChildF.pm'} = __FILE__; package ChildG; use MyMoose; sub child_g_method_1 { "g1" } package ChildH; use MyMoose; sub child_h_method_1 { "h1" } sub parent_method_1 { "child_parent_1" } package ChildI; use MyMoose; sub child_i_method_1 { "i1" } sub parent_method_1 { "child_parent_1" } package Parent; use MyMoose; sub parent_method_1 { "parent_1" } ::can_ok('Parent', 'parent_method_1'); ::isnt( ::exception { has child_a => ( is => "ro", default => sub { ChildA->new }, handles => qr/.*/, ); }, undef, "all_methods requires explicit isa" ); ::is( ::exception { has child_a => ( isa => "ChildA", is => "ro", default => sub { ChildA->new }, handles => qr/.*/, ); }, undef, "allow all_methods with explicit isa" ); ::is( ::exception { has child_b => ( is => 'ro', default => sub { ChildB->new }, handles => [qw/child_b_method_1/], ); }, undef, "don't need to declare isa if method list is predefined" ); ::is( ::exception { has child_c => ( isa => "ChildC", is => "ro", default => sub { ChildC->new }, handles => qr/_la$/, ); }, undef, "can declare regex collector" ); ::isnt( ::exception { has child_d => ( is => "ro", default => sub { ChildD->new }, handles => sub { my ( $class, $delegate_class ) = @_; } ); }, undef, "can't create attr with generative handles parameter and no isa" ); ::is( ::exception { has child_d => ( isa => "ChildD", is => "ro", default => sub { ChildD->new }, handles => sub { my ( $class, $delegate_class ) = @_; return; } ); }, undef, "can't create attr with generative handles parameter and no isa" ); ::is( ::exception { has child_e => ( isa => "ChildE", is => "ro", default => sub { ChildE->new }, handles => ["child_e_method_2"], ); }, undef, "can delegate to non moose class using explicit method list" ); my $delegate_class; ::is( ::exception { has child_f => ( isa => "ChildF", is => "ro", default => sub { ChildF->new }, handles => sub { $delegate_class = $_[1]->name; return; }, ); }, undef, "subrefs on non moose class give no meta" ); ::is( $delegate_class, "ChildF", "plain classes are handed down to subs" ); ::is( ::exception { has child_g => ( isa => "ChildG", default => sub { ChildG->new }, handles => ["child_g_method_1"], ); }, undef, "can delegate to object even without explicit reader" ); ::can_ok('Parent', 'parent_method_1'); ::isnt( ::exception { has child_h => ( isa => "ChildH", is => "ro", default => sub { ChildH->new }, handles => sub { map { $_, $_ } $_[1]->get_all_method_names }, ); }, undef, "Can't override exisiting class method in delegate" ); ::can_ok('Parent', 'parent_method_1'); ::is( ::exception { has child_i => ( isa => "ChildI", is => "ro", default => sub { ChildI->new }, handles => sub { map { $_, $_ } grep { !/^parent_method_1|meta$/ } $_[1]->get_all_method_names; }, ); }, undef, "Test handles code ref for skipping predefined methods" ); sub parent_method { "p" } } # sanity isa_ok( my $p = Parent->new, "Parent" ); isa_ok( $p->child_a, "ChildA" ); isa_ok( $p->child_b, "ChildB" ); isa_ok( $p->child_c, "ChildC" ); isa_ok( $p->child_d, "ChildD" ); isa_ok( $p->child_e, "ChildE" ); isa_ok( $p->child_f, "ChildF" ); isa_ok( $p->child_i, "ChildI" ); ok(!$p->can('child_g'), '... no child_g accessor defined'); ok(!$p->can('child_h'), '... no child_h accessor defined'); is( $p->parent_method, "p", "parent method" ); is( $p->child_a->child_a_super_method, "as", "child supermethod" ); is( $p->child_a->child_a_method_1, "a1", "child method" ); can_ok( $p, "child_a_super_method" ); can_ok( $p, "child_a_method_1" ); can_ok( $p, "child_a_method_2" ); ok( !$p->can( "child_a_method_3" ), "but not subclass of delegate class" ); is( $p->child_a_method_1, $p->child_a->child_a_method_1, "delegate behaves the same" ); is( $p->child_a_method_2, "ChildA a2", "delegates are their own invocants" ); can_ok( $p, "child_b_method_1" ); ok( !$p->can("child_b_method_2"), "but not ChildB's unspecified siblings" ); ok( !$p->can($_), "none of ChildD's methods ($_)" ) for grep { /^child/ } map { $_->name } ChildD->meta->get_all_methods(); can_ok( $p, "child_c_method_3_la" ); can_ok( $p, "child_c_method_4_la" ); is( $p->child_c_method_3_la, "c3", "ChildC method delegated OK" ); can_ok( $p, "child_e_method_2" ); ok( !$p->can("child_e_method_1"), "but not child_e_method_1"); is( $p->child_e_method_2, "e2", "delegate to non moose class (child_e_method_2)" ); can_ok( $p, "child_g_method_1" ); is( $p->child_g_method_1, "g1", "delegate to moose class without reader (child_g_method_1)" ); can_ok( $p, "child_i_method_1" ); is( $p->parent_method_1, "parent_1", "delegate doesn't override existing method" ); done_testing; moose_no_init_arg.t000664001750001750 103212234215334 17661 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Foo; use MyMoose; eval { has 'foo' => ( is => "rw", init_arg => undef, ); }; ::ok(!$@, '... created the attr okay'); } { my $foo = Foo->new( foo => "bar" ); isa_ok($foo, 'Foo'); is( $foo->foo, undef, "field is not set via init arg" ); $foo->foo("blah"); is( $foo->foo, "blah", "field is set via setter" ); } done_testing; moose_no_slot_access.t000664001750001750 353512234215334 20401 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; { package SomeAwesomeDB; sub new_row { } sub read { } sub write { } } { package MooseX::SomeAwesomeDBFields; # implementation of methods not called in the example deliberately # omitted use MyMoose::Role; sub inline_create_instance { my ( $self, $classvar ) = @_; "bless SomeAwesomeDB::new_row(), $classvar"; } sub inline_get_slot_value { my ( $self, $invar, $slot ) = @_; "SomeAwesomeDB::read($invar, \"$slot\")"; } sub inline_set_slot_value { my ( $self, $invar, $slot, $valexp ) = @_; "SomeAwesomeDB::write($invar, \"$slot\", $valexp)"; } sub inline_is_slot_initialized { my ( $self, $invar, $slot ) = @_; "1"; } sub inline_initialize_slot { my ( $self, $invar, $slot ) = @_; ""; } sub inline_slot_access { die "inline_slot_access should not have been used"; } } { package Toy; use MyMoose; use Moose::Util::MetaRole; use Test::More; use Test::Fatal; Moose::Util::MetaRole::apply_metaroles( for => __PACKAGE__, class_metaroles => { instance => ['MooseX::SomeAwesomeDBFields'] }, ); is( exception { has lazy_attr => ( is => 'ro', isa => 'Bool', lazy => 1, default => sub {0}, ); }, undef, "Adding lazy accessor does not use inline_slot_access" ); is( exception { has rw_attr => ( is => 'rw', ); }, undef, "Adding read-write accessor does not use inline_slot_access" ); is( exception { __PACKAGE__->meta->make_immutable; }, undef, "Inling constructor does not use inline_slot_access" ); done_testing; } moose_non_alpha_attr_names.t000664001750001750 302512234215334 21551 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; { package Foo; use MyMoose; has 'type' => ( required => 0, reader => 'get_type', default => 1, ); # Assigning types to these non-alpha attrs exposed a bug in Moose. has '@type' => ( isa => 'Str', required => 0, reader => 'get_at_type', writer => 'set_at_type', default => 'at type', ); has 'has spaces' => ( isa => 'Int', required => 0, reader => 'get_hs', default => 42, ); has '!req' => ( required => 1, reader => 'req' ); no Moose; } with_immutable { ok( Foo->meta->has_attribute($_), "Foo has '$_' attribute" ) for 'type', '@type', 'has spaces'; my $foo = Foo->new( '!req' => 42 ); is( $foo->get_type, 1, q{'type' attribute default is 1} ); is( $foo->get_at_type, 'at type', q{'@type' attribute default is 1} ); is( $foo->get_hs, 42, q{'has spaces' attribute default is 42} ); $foo = Foo->new( type => 'foo', '@type' => 'bar', 'has spaces' => 200, '!req' => 84, ); isa_ok( $foo, 'Foo' ); is( $foo->get_at_type, 'bar', q{reader for '@type'} ); is( $foo->get_hs, 200, q{reader for 'has spaces'} ); $foo->set_at_type(99); is( $foo->get_at_type, 99, q{writer for '@type' worked} ); } 'Foo'; done_testing; moose_numeric_defaults.t000664001750001750 576012234215334 20736 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; use Test::Moose; use B; { package Foo; use MyMoose; has foo => (is => 'ro', default => 100); sub bar { 100 } } with_immutable { my $foo = Foo->new; for my $meth (qw(foo bar)) { my $val = $foo->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Foo'; { package Bar; use MyMoose; has foo => (is => 'ro', lazy => 1, default => 100); sub bar { 100 } } with_immutable { my $bar = Bar->new; for my $meth (qw(foo bar)) { my $val = $bar->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Bar'; { package Baz; use MyMoose; has foo => (is => 'ro', isa => 'Int', lazy => 1, default => 100); sub bar { 100 } } with_immutable { my $baz = Baz->new; for my $meth (qw(foo bar)) { my $val = $baz->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_IOK || $flags & B::SVp_IOK, "it's an int"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Baz'; { package Foo2; use MyMoose; has foo => (is => 'ro', default => 10.5); sub bar { 10.5 } } with_immutable { my $foo2 = Foo2->new; for my $meth (qw(foo bar)) { my $val = $foo2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Foo2'; { package Bar2; use MyMoose; has foo => (is => 'ro', lazy => 1, default => 10.5); sub bar { 10.5 } } with_immutable { my $bar2 = Bar2->new; for my $meth (qw(foo bar)) { my $val = $bar2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); ok(!($flags & B::SVf_POK), "not a string"); } } 'Bar2'; { package Baz2; use MyMoose; has foo => (is => 'ro', isa => 'Num', lazy => 1, default => 10.5); sub bar { 10.5 } } with_immutable { my $baz2 = Baz2->new; for my $meth (qw(foo bar)) { my $val = $baz2->$meth; my $b = B::svref_2object(\$val); my $flags = $b->FLAGS; ok($flags & B::SVf_NOK || $flags & B::SVp_NOK, "it's a num"); # it's making sure that the Num value doesn't get converted to a string for regex matching # this is the reason for using a temporary variable, $val for regex matching, # instead of $_[1] in Num implementation in lib/Moose/Util/TypeConstraints/Builtins.pm ok(!($flags & B::SVf_POK), "not a string"); } } 'Baz2'; done_testing; moose_trigger_and_coerce.t000664001750001750 233512234215334 21205 0ustar00taitai000000000000MooseX-XSAccessor-0.007/tuse lib "t/lib"; use lib "moose/lib"; use lib "lib"; ## skip Test::Tabs use strict; use warnings; use Test::More; { package Fake::DateTime; use MyMoose; has 'string_repr' => ( is => 'ro' ); package Mortgage; use MyMoose; use Moose::Util::TypeConstraints; coerce 'Fake::DateTime' => from 'Str' => via { Fake::DateTime->new( string_repr => $_ ) }; has 'closing_date' => ( is => 'rw', isa => 'Fake::DateTime', coerce => 1, trigger => sub { my ( $self, $val ) = @_; ::pass('... trigger is being called'); ::isa_ok( $self->closing_date, 'Fake::DateTime' ); ::isa_ok( $val, 'Fake::DateTime' ); } ); } { my $mtg = Mortgage->new( closing_date => 'yesterday' ); isa_ok( $mtg, 'Mortgage' ); # check that coercion worked isa_ok( $mtg->closing_date, 'Fake::DateTime' ); } Mortgage->meta->make_immutable; ok( Mortgage->meta->is_immutable, '... Mortgage is now immutable' ); { my $mtg = Mortgage->new( closing_date => 'yesterday' ); isa_ok( $mtg, 'Mortgage' ); # check that coercion worked isa_ok( $mtg->closing_date, 'Fake::DateTime' ); } done_testing; XSAccessor.pm000664001750001750 1370112234215334 20120 0ustar00taitai000000000000MooseX-XSAccessor-0.007/lib/MooseXpackage MooseX::XSAccessor; use 5.008; use strict; use warnings; use Moose 2.0600 (); use MooseX::XSAccessor::Trait::Attribute (); use Scalar::Util qw(blessed); BEGIN { $MooseX::XSAccessor::AUTHORITY = 'cpan:TOBYINK'; $MooseX::XSAccessor::VERSION = '0.007'; } our $LVALUE; use Moose::Exporter; "Moose::Exporter"->setup_import_methods; sub init_meta { shift; my %p = @_; Moose::Util::MetaRole::apply_metaroles( for => $p{for_class}, class_metaroles => { attribute => [qw( MooseX::XSAccessor::Trait::Attribute )], }, ); } sub is_xs { my $sub = $_[0]; if (blessed($sub) and $sub->isa("Class::MOP::Method")) { $sub = $sub->body; } elsif (not ref $sub) { no strict "refs"; $sub = \&{$sub}; } require B; !! B::svref_2object($sub)->XSUB; } 1; __END__ =pod =for stopwords Auto-deref Mouse/Class::XSAccessor =encoding utf-8 =head1 NAME MooseX::XSAccessor - use Class::XSAccessor to speed up Moose accessors =head1 SYNOPSIS package MyClass; use Moose; use MooseX::XSAccessor; has foo => (...); =head1 DESCRIPTION This module accelerates L-generated accessor, reader, writer and predicate methods using L. You get a speed-up for no extra effort. It is automatically applied to every attribute in the class. =begin private =item init_meta =end private The use of the following features of Moose attributes prevents a reader from being accelerated: =over =item * Lazy builder or lazy default. =item * Auto-deref. (Does anybody use this anyway??) =back The use of the following features prevents a writer from being accelerated: =over =item * Type constraints (except C; C is effectively a no-op). =item * Triggers =item * Weak references =back An C accessor is effectively a reader and a writer glued together, so both of the above lists apply. Predicates can always be accelerated, provided you're using Class::XSAccessor 1.17 or above. Clearers can not be accelerated (as of current versions of Class::XSAccessor). =head2 Functions This module also provides one function, which is not exported so needs to be called by its full name. =over =item C<< MooseX::XSAccessor::is_xs($sub) >> Returns a boolean indicating whether a sub is an XSUB. C<< $sub >> may be a coderef, L object, or a qualified sub name as a string (e.g. C<< "MyClass::foo" >>). =back =head2 Chained accessors and writers L can detect chained accessors and writers created using L, and can accelerate those too. package Local::Class; use Moose; use MooseX::XSAccessor; use MooseX::Attribute::Chained; has foo => (traits => ["Chained"], is => "rw"); has bar => (traits => ["Chained"], is => "ro", writer => "_set_bar"); has baz => ( is => "rw"); # not chained my $obj = "Local::Class"->new; $obj->foo(1)->_set_bar(2); print $obj->dump; =head2 Lvalue accessors L will detect lvalue accessors created with L and, by default, skip accelerating them. However, by setting C<< $MooseX::XSAccessor::LVALUE >> to true (preferably using the C Perl keyword), you can force it to accelerate those too. This introduces a visible change in behaviour though. L accessors normally allow two patterns for setting the value: $obj->foo = 42; # as an lvalue $obj->foo(42); # as a method call However, once accelerated, they may I be set as an lvalue. For this reason, setting C<< $MooseX::XSAccessor::LVALUE >> to true is considered an experimental feature. =head1 HINTS =over =item * Make attributes read-only when possible. This means that type constraints and coercions will only apply to the constructor, not the accessors, enabling the accessors to be accelerated. =item * If you do need a read-write attribute, consider making the main accessor read-only, and having a separate writer method. (Like L.) =item * Make defaults eager instead of lazy when possible, allowing your readers to be accelerated. =item * If you need to accelerate just a specific attribute, apply the attribute trait directly: package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); =item * If you don't want to add a dependency on MooseX::XSAccessor, but do want to use it if it's available, the following code will use it optionally: package MyClass; use Moose; BEGIN { eval "use MooseX::XSAccessor" }; has foo => (...); =back =head1 CAVEATS =over =item * Calling a writer method without a parameter in Moose does not raise an exception: $person->set_name(); # sets name attribute to "undef" However, this is a fatal error in Class::XSAccessor. =item * MooseX::XSAccessor does not play nice with attribute traits that alter accessor behaviour, or define additional accessors for attributes. L is an example thereof. L is handled as a special case. =item * MooseX::XSAccessor only works on blessed hash storage; not e.g. L or L. MooseX::XSAccessor is usually able to detect such situations and silently switch itself off. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES 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. MyMoose.pm000664001750001750 32112234215334 16456 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t/libpackage MyMoose; use Import::Into; use Moose (); use MooseX::XSAccessor (); sub import { shift; my $caller = caller; "Moose"->import::into($caller, @_); "MooseX::XSAccessor"->import::into($caller); } 1;Role.pm000664001750001750 34312234215334 17363 0ustar00taitai000000000000MooseX-XSAccessor-0.007/t/lib/MyMoosepackage MyMoose::Role; use Import::Into; use Moose::Role (); use MooseX::XSAccessor (); sub import { shift; my $caller = caller; "Moose::Role"->import::into($caller, @_); "MooseX::XSAccessor"->import::into($caller); } 1;Attribute.pm000664001750001750 1142312234215334 23145 0ustar00taitai000000000000MooseX-XSAccessor-0.007/lib/MooseX/XSAccessor/Traitpackage MooseX::XSAccessor::Trait::Attribute; use 5.008; use strict; use warnings; use Class::XSAccessor 1.09 (); use Scalar::Util qw(reftype); use B qw(perlstring); BEGIN { $MooseX::XSAccessor::Trait::Attribute::AUTHORITY = 'cpan:TOBYINK'; $MooseX::XSAccessor::Trait::Attribute::VERSION = '0.007'; } # Map Moose terminology to Class::XSAccessor options. my %cxsa_opt = ( accessor => "accessors", reader => "getters", writer => "setters", ); $cxsa_opt{predicate} = "exists_predicates" if Class::XSAccessor->VERSION > 1.16; use Moose::Role; sub accessor_is_simple { my $self = shift; return !!0 if $self->has_type_constraint && $self->type_constraint ne "Any"; return !!0 if $self->should_coerce; return !!0 if $self->has_trigger; return !!0 if $self->is_weak_ref; return !!0 if $self->is_lazy; return !!0 if $self->should_auto_deref; !!1; } sub reader_is_simple { my $self = shift; return !!0 if $self->is_lazy; return !!0 if $self->should_auto_deref; !!1; } sub writer_is_simple { my $self = shift; return !!0 if $self->has_type_constraint && $self->type_constraint ne "Any"; return !!0 if $self->should_coerce; return !!0 if $self->has_trigger; return !!0 if $self->is_weak_ref; !!1; } sub predicate_is_simple { my $self = shift; !!1; } # Class::XSAccessor doesn't do clearers sub clearer_is_simple { !!0; } after install_accessors => sub { my $self = shift; my $slot = $self->name; my $class = $self->associated_class; my $classname = $class->name; # Don't attempt to do anything with instances that are not blessed hashes. my $is_hash = reftype($class->get_meta_instance->create_instance) eq q(HASH); return unless $is_hash && $class->get_meta_instance->is_inlinable; # Use inlined get method as a heuristic to detect weird shit. my $inline_get = $self->_inline_instance_get('$X'); return unless $inline_get eq sprintf('$X->{%s}', perlstring $slot); # Detect use of MooseX::Attribute::Chained my $is_chained = $self->does('MooseX::Traits::Attribute::Chained'); # Detect use of MooseX::LvalueAttribute my $is_lvalue = $self->does('MooseX::LvalueAttribute::Trait::Attribute'); for my $type (qw/ accessor reader writer predicate clearer /) { # Only accelerate methods if CXSA can deal with them next unless exists $cxsa_opt{$type}; # Only accelerate methods that exist! next unless $self->${\"has_$type"}; # Check to see they're simple (no type constraint checks, etc) next unless $self->${\"$type\_is_simple"}; my $methodname = $self->$type; my $metamethod = $class->get_method($methodname); # Perform the actual acceleration if ($type eq 'accessor' and $is_lvalue) { next if $is_chained; next if !$MooseX::XSAccessor::LVALUE; "Class::XSAccessor"->import( class => $classname, replace => 1, lvalue_accessors => +{ $methodname => $slot }, ); } else { "Class::XSAccessor"->import( class => $classname, replace => 1, chained => $is_chained, $cxsa_opt{$type} => +{ $methodname => $slot }, ); } # Naughty stuff!!! # We've overwritten a Moose-generated accessor, so now we need to # inform Moose's metathingies about the new coderef. # $metamethod->body is read-only, so dive straight into the blessed # hash. no strict "refs"; $metamethod->{"body"} = \&{"$classname\::$methodname"}; } return; }; 1; __END__ =pod =for stopwords booleans =encoding utf-8 =head1 NAME MooseX::XSAccessor::Trait::Attribute - get the Class::XSAccessor effect for a single attribute =head1 SYNOPSIS package MyClass; use Moose; has foo => ( traits => ["MooseX::XSAccessor::Trait::Attribute"], ..., ); say __PACKAGE__->meta->get_attribute("foo")->accessor_is_simple; =head1 DESCRIPTION Attributes with this trait have the following additional methods, which each return booleans: =over =item C<< accessor_is_simple >> =item C<< reader_is_simple >> =item C<< writer_is_simple >> =item C<< predicate_is_simple >> =item C<< clearer_is_simple >> =back What is meant by simple? Simple enough for L to take over the accessor's duties. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE This software is copyright (c) 2013 by Toby Inkster. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =head1 DISCLAIMER OF WARRANTIES 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.