Test-MockObject-1.20161202/0000775000175000017500000000000013020377752015561 5ustar chromaticchromaticTest-MockObject-1.20161202/dist.ini0000644000175000017500000000213613020377752017225 0ustar chromaticchromaticname = Test-MockObject author = chromatic license = Perl_5 copyright_holder = chromatic@wgz.org copyright_year = 2016 [MetaResources] bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-MockObject bugtracker.mailto = bug-test-mockobject@rt.cpan.org repository.url = https://github.com/chromatic/Test-MockObject.git repository.web = https://github.com/chromatic/Test-MockObject repository.type = git [AutoVersion] format = {{ cldr('1.yyyyMMdd') }} [Prereqs] UNIVERSAL::isa = 1.20110614 UNIVERSAL::can = 1.20110617 [Prereqs / TestRequires] CGI = 4.15 Test::More = 0.98 Test::Exception = 0.31 Test::Warn = 0.23 [AutoPrereqs] [@Basic] [PkgVersion] [NextRelease] [@Git] changelog = Changes ; this is the default allow_dirty = dist.ini ; see Git::Check... allow_dirty = Changes ; ... and Git::Commit commit_msg = v%v%n%n%c ; see Git::Commit tag_format = %v ; see Git::Tag tag_message = %v ; see Git::Tag push_to = origin ; see Git::Push Test-MockObject-1.20161202/Changes0000644000175000017500000001763213020377752017063 0ustar chromaticchromaticRevision history for Perl extension Test::MockObject. 1.20161202 2016-12-02 15:12:41-08:00 America/Los_Angeles - renamed README.pod to README (RT #118831) 1.20150527 2015-05-27 08:33:52-07:00 America/Los_Angeles - improved dependencies (build/run/requires), (Olivier Mengué, GH PR #10) - improved runtime loading (Olivier Mengué, GH PR #11) 1.20150521 2015-05-21 09:09:19-07:00 America/Los_Angeles - updated CGI dependency - improved README for GitHub (Rob Van Dam, GH PR #9) 1.20140408 2014-04-07 17:38:44-07:00 America/Los_Angeles - enabled Travis CI (no user-visible changes) - improved fields-based object support (Olivier Mengué, Maxime Soulé) 1.20140328 2014-03-28 16:17:59-07:00 America/Los_Angeles - support added for fields-based objects (Gavin Mogan, RT #84535) 1.20120301 2012-03-01 13:17:20 America/Los_Angeles - updated dependencies to latest versions of UNIVERSAL::isa and UNIVERSAL::can 1.20110612 2011-06-11 23:53:50 America/Los_Angeles - removed Module::Build detritus - improved Test::Warn testing dependency - Added -debug flag to load UNIVERSAL::isa and UNIVERSAL::can on demand, rather than in all situations. 1.20110606 Sun Jun 04 2011 - converted to Dist::Zilla - posted to GitHub 1.09 Tue May 27 06:11:24 UTC 2008 - removed a buggy workaround for C, now that 5.6.2 is the baseline 1.08 Fri Jun 29 01:36:24 UTC 2007 (chromatic) - removed noisy diag() calls from successful tests (RT #19444, Adam Kennedy) - removed some magic from the @ISA assignment to work with 5.9.5 (Andreas Koenig) 1.07 Thu Oct 5 05:46:04 UTC 2006 (chromatic) - clarified class mocking documentation (reported by Praveen Ray) - T::MO::E should die when called with an unhandleable method (Paul the Nomad) Sat Sep 30 04:18:23 UTC 2006 (chromatic) - fixed incorrect version request for Scalar::Util (alexchorny, RT #21773) Sat Sep 9 21:19:35 UTC 2006 (chromatic) - fixed a logging documentation error (Nicholas Clark) - made fake_module() croak when mocking a loaded module but not mocking subs (RT #21049, reported by Mutant) - tested check_class_loaded() more carefully (fixes RT #19448, reported by Adam Kennedy) 1.06 Fri Apr 21 01:03:27 UTC 2006 (chromatic) - added __get_parents() to list wrapped object's parents in T::M::O::E 1.05 Sun Apr 9 05:58:52 UTC 2006 (chromatic) - fixed anonymous subroutine name interaction with the debugger 1.04 Sat Mar 18 21:52:52 UTC 2006 (chromatic) - made all T::MO::E mocking methods return the invocant (bugfix) - moved developer tests under t/developer/ to avoid running by default 1.03 Sun Mar 5 01:43:20 UTC 2006 (chromatic) - removed test dependency on Test::Warn - improved signature test - improved mock package loading in T::MO::E (RT #17692 from Badgersrc) - clarified T::MO::E object wrapping behavior (RT #17929 from Larry Clapp) - named generated can() and isa() methods in T::MO::E - cleaned up some extraneous whitespace - allowed isa() to check reference type of mocked object once again (RT #15446 from PM) - avoid circular references preventing mock destruction (RT #17941 from David Pisoni) - fixed inherited AUTOLOAD() calls from T::MO::E (RT #14445 from Adam Kennedy) 1.02 Sat Dec 24 08:36:07 UTC 2005 (chromatic) - avoid warnings in UNIVERSAL::isa and UNIVERSAL::can by always calling both as methods (oops) - mark dependency on Perl 5.6.0 - skip signature check without SIGNATURE file - remove chdir/library logic from tests and add warnings - clean up warnings in t/bugs.t - made Test::MockObject::Extends warnings clean 1.01 Sat Aug 27 03:36:39 UTC 2005 (chromatic) - set $AUTOLOAD in parent AUTOLOAD(), if delegating (RT #14251) - don't require parent module if it has a new() method - use UNIVERSAL::isa and UNIVERSAL::can modules - give the installed isa() and can() methods the appropriate names in T::MO 1.00 Tue Jul 12 01:49:06 UTC 2005 (chromatic) - removed deprecated Test::MockObject::add() - fixed stringification-finding bug (reported by water on Perl Monks) - bumped up version numbers - added POD and POD coverage tests - added some documentation - allow catchable warnings in fake_module() - modify delegation approach (reported by Adam Kennedy in RT #13200) 0.20 Wed Dec 15 02:57:48 UTC 2004 (chromatic) - added set_isas() to Test::MockObject (Stevan Little) - fixed typo in T::MO::E documentation (Stevan Little) - added SIGNATURE and t/0-signature.t 0.15 Sun Nov 14 04:53:01 UTC 2004 - allow skipping logging of certain methods (with tests and documentation) - avoid subroutine redefinition warnings in T::MO::E Sat Nov 13 05:32:29 UTC 2004 - fix Win32 test bug by not canonicalizing %INC paths (CPAN tester rrwo) 0.14 Fri Mar 26 03:58:12 UTC 2004 - updated version number for new release - improved documentation formatting in Test::MockObject - added documentation for dispatch_mocked_method() in T::MO Fri Mar 19 07:34:55 UTC 2004 - added log_call() to Test::MockObject Sat Mar 13 05:49:39 UTC 2004 - added Test::MockObject::Extends and t/extends.t 0.13 Sat Dec 20 00:16:36 UTC 2003 - new release 'cuz I accidentally deleted 0.12 from the CPAN (Chris Winters reported it) - make set_true() and set_false() work on lists of method names - marked fake_module() and fake_new() as potentially deprecated 0.12 Wed Feb 5 17:42:15 GMT 2003 - fix false positives in called_ok() (Jay Bonci found it) - clarify documentation for clear() (Jay Bonci) 0.11 Sat Jan 11 08:03:35 GMT 2003 - fix list context bug at end of series in set_series() 0.10 Sun Jan 5 06:27:49 GMT 2003 - use flyweight objects (store state outside mocked objects) - allow array, scalar, sub, and glob references as objects - minor typo fixes and brace placement fixings 0.09 Sun Jun 30 21:14:29 PDT 2002 - made most mocking methods return $self (Piers Cawley's suggestion) - add $VERSION when mocking a module (ensure package is not empty) 0.08 Wed Jun 26 03:38:45 UTC 2002 - pass $self to added add() methods (Ilya Martynov) - test for same (Ilya again) - localize $1 in AUTOLOAD() to prevent its clobbering (bugfix, tested) 0.07 Sat Jun 22 06:43:47 UTC 2002 - deprecated add() - added mock() - expanded and reorganized documentation somewhat() - added next_call() - added carp() for unknown mocked method call attempt (what a description!) 0.06 Thu Jun 20 05:37:32 UTC 2002 - added t/bugs.t to catch regressions - fixed several warnings: - uninitialized values in called_pos_ok() - improved diagnostics in called_pos_ok() - avoid redefined subroutine warnings in fake_module() - fixed behavior of called_pos_ok() -- avoid incorrect successes - prevented called() from dying if $pos is out of range - prevented _call() from autovivifying stack entries - made fake_new() a wrapper around fake_module() 0.05 Sun Jun 9 21:16:41 PDT 2002 - fixed tests for object passing - added set_bound() - removed fake_import() (retcon!) and modified fake_module() to be general enough to do the same sort of thing Fri Jun 7 23:15:41 PDT 2002 - fix typo in documentation - pass along object to method calls (bugfix) Mon May 27 20:31:35 UTC 2002 - fix fake_module(), which never worked. Oops, bug in both test and module! - added fake_import() and its tests 0.04 Mon Apr 29 01:03:36 UTC 2002 - pass tests in 5.005_03 (Tatsuhiko Miyagawa) - can() should return subref instead of just 1 (also Tatsuhiko) - added test for can() buglet (me) - added test numbers (hey, it's CPAN time!) 0.03 Sat Apr 27 11:12:39 2002 - first released version, initially created with: h2xs -A -X -n Test::MockObject Test-MockObject-1.20161202/Makefile.PL0000644000175000017500000000324513020377752017535 0ustar chromaticchromatic# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v5.043. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Perl extension for emulating troublesome interfaces", "AUTHOR" => "chromatic", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Test-MockObject", "LICENSE" => "perl", "NAME" => "Test::MockObject", "PREREQ_PM" => { "Carp" => 0, "Devel::Peek" => 0, "Scalar::Util" => 0, "Test::Builder" => 0, "UNIVERSAL::can" => "1.20110617", "UNIVERSAL::isa" => "1.20110614", "constant" => 0, "strict" => 0, "warnings" => 0 }, "TEST_REQUIRES" => { "CGI" => "4.15", "Test::Exception" => "0.31", "Test::More" => "0.98", "Test::Warn" => "0.23", "base" => 0, "fields" => 0, "overload" => 0, "vars" => 0 }, "VERSION" => "1.20161202", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "CGI" => "4.15", "Carp" => 0, "Devel::Peek" => 0, "Scalar::Util" => 0, "Test::Builder" => 0, "Test::Exception" => "0.31", "Test::More" => "0.98", "Test::Warn" => "0.23", "UNIVERSAL::can" => "1.20110617", "UNIVERSAL::isa" => "1.20110614", "base" => 0, "constant" => 0, "fields" => 0, "overload" => 0, "strict" => 0, "vars" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Test-MockObject-1.20161202/README0000644000175000017500000000062113020377752016436 0ustar chromaticchromatic This archive contains the distribution Test-MockObject, version 1.20161202: Perl extension for emulating troublesome interfaces This software is copyright (c) 2016 by chromatic@wgz.org. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v5.043. Test-MockObject-1.20161202/META.yml0000644000175000017500000000155113020377752017032 0ustar chromaticchromatic--- abstract: 'Perl extension for emulating troublesome interfaces' author: - chromatic build_requires: CGI: '4.15' Test::Exception: '0.31' Test::More: '0.98' Test::Warn: '0.23' base: '0' fields: '0' overload: '0' vars: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 5.043, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-MockObject requires: Carp: '0' Devel::Peek: '0' Scalar::Util: '0' Test::Builder: '0' UNIVERSAL::can: '1.20110617' UNIVERSAL::isa: '1.20110614' constant: '0' strict: '0' warnings: '0' resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Test-MockObject repository: https://github.com/chromatic/Test-MockObject.git version: '1.20161202' Test-MockObject-1.20161202/LICENSE0000644000175000017500000004367413020377752016602 0ustar chromaticchromaticThis software is copyright (c) 2016 by chromatic@wgz.org. 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) 2016 by chromatic@wgz.org. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. 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) 2016 by chromatic@wgz.org. 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 Test-MockObject-1.20161202/MANIFEST0000644000175000017500000000056013020377752016711 0ustar chromaticchromatic# This file was automatically generated by Dist::Zilla::Plugin::Manifest v5.043. Changes LICENSE MANIFEST META.yml Makefile.PL README dist.ini lib/Test/MockObject.pm lib/Test/MockObject/Extends.pm t/base.t t/bugs.t t/debugger.t t/debuggingwarnings.t t/debuggingwarningsextends.t t/extends-bugs.t t/extends-fields.t t/extends.t t/ignore.t t/isa.t t/nodefaultwarnings.t Test-MockObject-1.20161202/lib/0000775000175000017500000000000013020377752016327 5ustar chromaticchromaticTest-MockObject-1.20161202/lib/Test/0000775000175000017500000000000013020377752017246 5ustar chromaticchromaticTest-MockObject-1.20161202/lib/Test/MockObject/0000775000175000017500000000000013020377752021266 5ustar chromaticchromaticTest-MockObject-1.20161202/lib/Test/MockObject/Extends.pm0000644000175000017500000002131413020377752023235 0ustar chromaticchromaticpackage Test::MockObject::Extends; $Test::MockObject::Extends::VERSION = '1.20161202'; use strict; use warnings; use Test::MockObject; # Alias our 'import' to T:MO::import to handle this: # use Test::MockObject::Extends '-debug'; *import = \&Test::MockObject::import; use Devel::Peek 'CvGV'; use Scalar::Util 'blessed'; use constant PERL_5_9 => $^V gt v5.9.0; sub new { my ($class, $fake_class) = @_; return Test::MockObject->new() unless defined $fake_class; my $parent_class = $class->get_class( $fake_class ); $class->check_class_loaded( $parent_class ); my $self = blessed( $fake_class ) ? $fake_class : {}; # Fields now locks the hash as of 5.9.0 - #84535 if (PERL_5_9 && blessed( $fake_class ) && do { no strict 'refs'; exists ${$parent_class . '::'}{FIELDS} # uses fields }) { # bypass prototypes &Hash::Util::unlock_hash(\%$fake_class); bless $self, $class->gen_package( $parent_class ); &Hash::Util::lock_keys(\%$fake_class, fields::_accessible_keys($parent_class)); } else { bless $self, $class->gen_package( $parent_class ); } return $self; } sub check_class_loaded { my ($self, $parent_class) = @_; my $result = Test::MockObject->check_class_loaded( $parent_class ); return $result if $result; (my $load_class = $parent_class) =~ s/::/\//g; require $load_class . '.pm'; } sub get_class { my ($self, $invocant) = @_; return $invocant unless blessed $invocant; return ref $invocant; } my $packname = 'a'; sub gen_package { my ($class, $parent) = @_; my $package = 'T::MO::E::' . $packname++; no strict 'refs'; *{ $package . '::mock' } = \&mock; *{ $package . '::unmock' } = \&unmock; @{ $package . '::ISA' } = ( $parent ); *{ $package . '::can' } = $class->gen_can( $parent ); *{ $package . '::isa' } = $class->gen_isa( $parent ); *{ $package . '::AUTOLOAD' } = $class->gen_autoload( $parent ); *{ $package . '::__get_parents' } = $class->gen_get_parents( $parent ); return $package; } sub gen_get_parents { my ($self, $parent) = @_; return sub { no strict 'refs'; return @{ $parent . '::ISA' }; }; } sub gen_isa { my ($class, $parent) = @_; sub { local *__ANON__ = 'isa'; my ($self, $class) = @_; return 1 if $class eq $parent; my $isa = $parent->can( 'isa' ); return $isa->( $self, $class ); }; } sub gen_can { my ($class, $parent) = @_; sub { local *__ANON__ = 'can'; my ($self, $method) = @_; my $parent_method = $self->SUPER::can( $method ); return $parent_method if $parent_method; return Test::MockObject->can( $method ); }; } sub gen_autoload { my ($class, $parent) = @_; sub { our $AUTOLOAD; my $method = substr( $AUTOLOAD, rindex( $AUTOLOAD, ':' ) +1 ); return if $method eq 'DESTROY'; my $self = shift; if (my $parent_method = $parent->can( $method )) { return $self->$parent_method( @_ ); } elsif (my $mock_method = Test::MockObject->can( $method )) { return $self->$mock_method( @_ ); } elsif (my $parent_al = $parent->can( 'AUTOLOAD' )) { my ($parent_pack) = CvGV( $parent_al ) =~ /\*(.*)::AUTOLOAD/; { no strict 'refs'; ${ "${parent_pack}::AUTOLOAD" } = "${parent}::${method}"; } unshift @_, $self; goto &$parent_al; } else { die "Undefined method $method at ", join( ' ', caller() ), "\n"; } }; } sub mock { my ($self, $name, $sub) = @_; Test::MockObject::_set_log( $self, $name, ( $name =~ s/^-// ? 0 : 1 ) ); my $mock_sub = sub { my ($self) = @_; $self->log_call( $name, @_ ); $sub->( @_ ); }; { no strict 'refs'; no warnings 'redefine'; *{ ref( $self ) . '::' . $name } = $mock_sub; } return $self; } sub unmock { my ($self, $name) = @_; Test::MockObject::_set_log( $self, $name, 0 ); no strict 'refs'; my $glob = *{ ref( $self ) . '::' }; delete $glob->{ $name }; return $self; } 1; __END__ =head1 NAME Test::MockObject::Extends - mock part of an object or class =head1 SYNOPSIS use Some::Class; use Test::MockObject::Extends; # create an object to mock my $object = Some::Class->new(); # wrap that same object with a mocking wrapper $object = Test::MockObject::Extends->new( $object ); # now chain mock and control calls $object->set_true( 'parent_method' ) ->set_always( -grandparent_method => 1 ) ->clear(); =head1 DESCRIPTION Test::MockObject::Extends lets you mock one or more methods of an existing object or class. This can be very handy when you're testing a well-factored module that does almost exactly what you want. Wouldn't it be handy to take control of a method or two to make sure you receive testable results? Now you can. =head1 METHODS =over 4 =item C C takes one optional argument, the object or class to mock. If you're mocking a method for an object that holds internal state, create an appropriate object, then pass it to this constructor. B this will modify the object in place. If you're mocking an object that does not need state, as in the cases where there's no internal data or you'll only be calling class methods, or where you'll be mocking all of the access to internal data, you can pass in the name of the class to mock partially. If you've not yet loaded the class, this method will try to load it for you. This may fail, so beware. If you pass no arguments, it will assume you really meant to create a normal C object and will oblige you. Note that if you pass a class, the object returned will appear to be an instance of that class; I. =item C See the documentation for Test::MockObject for all of the ways to mock methods and to retrieve method logging information. These methods return the invocant, so you can chain them. =item C Removes any active mocking of the named method. This means any calls to that method will hit the method of that name in the class being mocked, if it exists. This method returns the invocant, you can chain it. =item C As you'd expect from a mocked object, this will return true for the class it's mocking. =back =head1 INTERNAL METHODS To do its magic, this module uses several internal methods: =over 4 =item * C This verifies that you have the mockee defined. If not, it attempts to load the corresponding module for you. =item * C Returns an AUTOLOAD subroutine for the mock object that checks that the extended object (or class) can perform the requested method, that L can perform it, or that the parent has an appropriate AUTOLOAD of its own. (It should have its own C in that case too though.) =item * C Returns a C method for the mock object that respects the same execution order as C. =item * C Returns an C method for the mock object that claims to be the C<$extended> object appropriately. =item * C Returns a C<__get_parents()> method for the mock object that claims to be the C<$extended> object appropriately. =item * C Creates a new unique package for the mock object with the appropriate methods already installed. =item * C Returns the class name of the invocant, whether it's an object or a class name. =back =head1 CAVEATS There may be some weird corner cases with dynamically generated methods in the mocked class. You really should use subroutine declarations though, or at least set C appropriately. There are also potential name collisions with methods in this module or C, though this should be rare. =head1 AUTHOR chromatic, Echromatic at wgz dot orgE Documentation bug fixed by Stevan Little. Additional AUTOLOAD approach suggested by Adam Kennedy. Field-based objects supported by Gavin Mogan. Other bugs reported by Paul the Nomad and Praveen Ray. Thank you all! =head1 BUGS No known bugs. =head1 COPYRIGHT Copyright (c) 2004 - 2014, chromatic. All rights reserved. You may use, modify, and distribute this module under the same terms as Perl 5.10 Test-MockObject-1.20161202/lib/Test/MockObject.pm0000644000175000017500000005565013020377752021635 0ustar chromaticchromaticpackage Test::MockObject; $Test::MockObject::VERSION = '1.20161202'; use strict; use warnings; use Scalar::Util qw( blessed refaddr reftype weaken ); sub import { my $self = shift; return unless grep /^-debug/, @_; eval { require UNIVERSAL::isa; UNIVERSAL::isa::->import('verbose'); }; eval { require UNIVERSAL::can; UNIVERSAL::can::->import('-always_warn'); }; } use Test::Builder; my $Test = Test::Builder->new(); my (%calls, %subs); sub new { my ($class, $type) = @_; $type ||= {}; bless $type, $class; } sub mock { my ($self, $name, $sub) = @_; $sub ||= sub {}; # leading dash means unlog, otherwise do log _set_log( $self, $name, ( $name =~ s/^-// ? 0 : 1 ) ); _subs( $self )->{$name} = $sub; $self; } sub set_isa { my ($self, @supers) = @_; my $supers = _isas( $self ); $supers->{$_} = 1 for @supers; } sub set_always { my ($self, $name, $value) = @_; $self->mock( $name, sub { $value } ); } sub set_true { my $self = shift; for my $name ( @_ ) { $self->mock( $name, sub { 1 } ); } return $self; } sub set_false { my $self = shift; for my $name ( @_ ) { $self->mock( $name, sub {} ); } return $self; } sub set_list { my ($self, $name, @list) = @_; $self->mock( $name, sub { @{[ @list ]} } ); } sub set_series { my ($self, $name, @list) = @_; $self->mock( $name, sub { return unless @list; shift @list } ); } sub set_bound { my ($self, $name, $ref) = @_; my %bindings = ( SCALAR => sub { $$ref }, ARRAY => sub { @$ref }, HASH => sub { %$ref }, ); return unless exists $bindings{reftype( $ref )}; $self->mock( $name, $bindings{reftype( $ref )} ); } # hack around debugging mode being too smart for my sub names my $old_p; BEGIN { $old_p = $^P; $^P &= ~0x200; } BEGIN { for my $universal ( { sub => \&_subs, name => 'can' }, { sub => \&_isas, name => 'isa' } ) { my $sub = sub { my ($self, $sub) = @_; local *__ANON__ = $universal->{name}; # mockmethods are special cases, class methods are handled directly my $lookup = $universal->{sub}->( $self ); return $lookup->{$sub} if blessed $self and exists $lookup->{$sub}; my $parent = 'SUPER::' . $universal->{name}; return $self->$parent( $sub ); }; no strict 'refs'; *{ $universal->{name} } = $sub; } $^P = $old_p; } sub remove { my ($self, $sub) = @_; delete _subs( $self )->{$sub}; $self; } sub called { my ($self, $sub) = @_; for my $called (reverse @{ _calls( $self ) }) { return 1 if $called->[0] eq $sub; } return 0; } sub clear { my $self = shift; @{ _calls( $self ) } = (); $self; } sub call_pos { $_[0]->_call($_[1], 0); } sub call_args { return @{ $_[0]->_call($_[1], 1) }; } sub _call { my ($self, $pos, $type) = @_; my $calls = _calls( $self ); return if abs($pos) > @$calls; $pos-- if $pos > 0; return $calls->[$pos][$type]; } sub call_args_string { my $args = $_[0]->_call( $_[1], 1 ) or return; return join($_[2] || '', @$args); } sub call_args_pos { my ($self, $subpos, $argpos) = @_; my $args = $self->_call( $subpos, 1 ) or return; $argpos-- if $argpos > 0; return $args->[$argpos]; } sub next_call { my ($self, $num) = @_; $num ||= 1; my $calls = _calls( $self ); return unless @$calls >= $num; my ($call) = (splice(@$calls, 0, $num))[-1]; return wantarray() ? @$call : $call->[0]; } sub AUTOLOAD { our $AUTOLOAD; my $self = shift; my $sub; { local $1; ($sub) = $AUTOLOAD =~ /::(\w+)\z/; } return if $sub eq 'DESTROY'; $self->dispatch_mocked_method( $sub, @_ ); } sub dispatch_mocked_method { my $self = $_[0]; my $sub = splice( @_, 1, 1 ); my $subs = _subs( $self ); if (exists $subs->{$sub}) { $self->log_call( $sub, @_ ); goto &{ $subs->{$sub} }; } else { require Carp; Carp::carp("Un-mocked method '$sub()' called"); } return; } sub log_call { my ($self, $sub, @call_args) = @_; return unless _logs( $self, $sub ); # prevent circular references with weaken for my $arg ( @call_args ) { next unless ref $arg; weaken( $arg ) if refaddr( $arg ) eq refaddr( $self ); } push @{ _calls( $self ) }, [ $sub, \@call_args ]; } sub called_ok { my ($self, $sub, $name) = @_; $name ||= "object called '$sub'"; $Test->ok( $self->called($sub), $name ); } sub called_pos_ok { my ($self, $pos, $sub, $name) = @_; $name ||= "object called '$sub' at position $pos"; my $called = $self->call_pos($pos, $sub); unless ($Test->ok( (defined $called and $called eq $sub), $name )) { $called = 'undef' unless defined $called; $Test->diag("Got:\n\t'$called'\nExpected:\n\t'$sub'\n"); } } sub called_args_string_is { my ($self, $pos, $sep, $expected, $name) = @_; $name ||= "object sent expected args to sub at position $pos"; $Test->is_eq( $self->call_args_string( $pos, $sep ), $expected, $name ); } sub called_args_pos_is { my ($self, $pos, $argpos, $arg, $name) = @_; $name ||= "object sent expected arg '$arg' to sub at position $pos"; $Test->is_eq( $self->call_args_pos( $pos, $argpos ), $arg, $name ); } sub fake_module { my ($class, $modname, %subs) = @_; if ($class->check_class_loaded( $modname ) and ! keys %subs) { require Carp; Carp::croak( "No mocked subs for loaded module '$modname'" ); } $modname =~ s!::!/!g; $INC{ $modname . '.pm' } = 1; no warnings 'redefine'; { no strict 'refs'; ${ $modname . '::' }{VERSION} ||= -1; } for my $sub (keys %subs) { my $type = reftype( $subs{ $sub } ) || ''; unless ( $type eq 'CODE' ) { require Carp; Carp::carp("'$sub' is not a code reference" ); next; } no strict 'refs'; *{ $_[1] . '::' . $sub } = $subs{ $sub }; } } sub check_class_loaded { my ($self, $class, $load_flag) = @_; (my $path = $class) =~ s{::}{/}g; return 1 if exists $INC{ $path . '.pm' }; my $symtable = \%main::; my $found = 1; for my $symbol ( split( '::', $class )) { unless (exists $symtable->{ $symbol . '::' }) { $found = 0; last; } $symtable = $symtable->{ $symbol . '::' }; } return $found; } sub fake_new { my ($self, $class) = @_; $self->fake_module( $class, new => sub { $self } ); } sub DESTROY { my $self = shift; $self->_clear_calls(); $self->_clear_subs(); $self->_clear_logs(); $self->_clear_isas(); } sub _get_key { my $invocant = shift; return blessed( $invocant ) ? refaddr( $invocant ) : $invocant; } { my %calls; sub _calls { $calls{ _get_key( shift ) } ||= []; } sub _clear_calls { delete $calls{ _get_key( shift ) }; } } { my %subs; sub _subs { $subs{ _get_key( shift ) } ||= {}; } sub _clear_subs { delete $subs{ _get_key( shift ) }; } } { my %logs; sub _set_log { my $key = _get_key( shift ); my ($name, $log) = @_; $logs{$key} ||= {}; if ($log) { $logs{$key}{$name} = 1; } else { delete $logs{$key}{$name}; } } sub _logs { my $key = _get_key( shift ); my ($name) = @_; return exists $logs{$key}{$name}; } sub _clear_logs { delete $logs{ _get_key( shift ) }; } } { my %isas; sub _isas { $isas{ _get_key( shift ) } ||= {}; } sub _clear_isas { delete $isas{ _get_key( shift ) }; } } 1; __END__ =head1 NAME Test::MockObject - Perl extension for emulating troublesome interfaces =head1 SYNOPSIS use Test::MockObject; my $mock = Test::MockObject->new(); $mock->set_true( 'somemethod' ); ok( $mock->somemethod() ); $mock->set_true( 'veritas') ->set_false( 'ficta' ) ->set_series( 'amicae', 'Sunny', 'Kylie', 'Bella' ); =head1 DESCRIPTION It's a simple program that doesn't use any other modules, and those are easy to test. More often, testing a program completely means faking up input to another module, trying to coax the right output from something you're not supposed to be testing anyway. Testing is a lot easier when you can control the entire environment. With Test::MockObject, you can get a lot closer. Test::MockObject allows you to create objects that conform to particular interfaces with very little code. You don't have to reimplement the behavior, just the input and the output. =head2 IMPORTANT CAVEATS Before you go wild with your testing powers, consider three caveats: =over 4 =item * It is possible to write highly detailed unit tests that pass even when your integration tests may fail. Testing the pieces individually does not excuse you from testing the whole thing together. =item * In cases where you only need to mock one or two pieces of an existing module, consider L instead. =item * If the code under testing produces strange errors about type checks, pass the C<-debug> flag when using C or C. This will load both L and L to perform additional debugging on the incorrect use of both methods from the L package. (This behavior used to be active by default, but that was, however correct, probably a burden to onerous for the CPAN.) =back =head2 EXPORT None. =head2 METHODS The most important thing a Mock Object can do is to conform sufficiently to an interface. For example, if you're testing something that relies on CGI.pm, you may find it easier to create a mock object that returns controllable results at given times than to fake query string input. =head3 The Basics =over 4 =item * C Creates a new mock object. By default, this is a blessed hash. Pass a reference to bless that reference. my $mock_array = Test::MockObject->new( [] ); my $mock_scalar = Test::MockObject->new( \( my $scalar ) ); my $mock_code = Test::MockObject->new( sub {} ); my $mock_glob = Test::MockObject->new( \*GLOB ); =back =head3 Mocking Your mock object is nearly useless if you don't tell it what it's mocking. This is done by installing methods. You control the output of these mocked methods. In addition, any mocked method is tracked. You can tell not only what was called, but which arguments were passed. Please note that you cannot track non-mocked method calls. They will still be allowed, though Test::MockObject will carp() about them. This is considered a feature, though it may be possible to disable this in the future. As implied in the example above, it's possible to chain these calls together. Thanks to a suggestion from the fabulous Piers Cawley (CPAN RT #1249), this feature came about in version 0.09. Shorter testing code is nice! =over 4 =item * C, I)> Adds a coderef to the object. This allows code to call the named method on the object. For example, this code: my $mock = Test::MockObject->new(); $mock->mock( 'fluorinate', sub { 'impurifying precious bodily fluids' } ); print $mock->fluorinate; will print a helpful warning message. Please note that methods are only added to a single object at a time and not the class. (There is no small similarity to the Self programming language or the L module.) This method forms the basis for most of Test::MockObject's testing goodness. B this method used to be C. Due to its ambiguity, it now has a different spelling. For backwards compatibility purposes, add() is available, though version 0.07 deprecated it. It goes to some contortions to try to do what you mean, but I make few guarantees. =item * C), [ I => I, ... ] B See L for an alternate (and better) approach. Lies to Perl that it has already loaded a named module. This is handy when providing a mockup of a real module if you'd like to prevent the actual module from interfering with the nice fakery. If you're mocking L, say: $mock->fake_module( 'Regexp::English' ); This is both a class and as an object method. Beware that this must take place before the actual module has a chance to load. Either wrap it in a BEGIN block before a use or require or place it before a C or C call. You can optionally add functions to the mocked module by passing them as name => coderef pairs to C. This is handy if you want to test an C: my $import; $mock->fake_module( 'Regexp::English', import => sub { $import = caller } ); use_ok( 'Regexp::Esperanto' ); is( $import, 'Regexp::Esperanto', 'Regexp::Esperanto should use() Regexp::English' ); If you use C to mock a module that already exists in memory -- one you've loaded elsewhere perhaps, but do not pass any subroutines to mock, this method will throw an exception. This is because if you call the constructor later on, you probably won't get a mock object back and you'll be confused. =item * C)> B see L for a better alternative to this method. Provides a fake constructor for the given module that returns the invoking mock object. Used in conjunction with C, you can force the tested unit to work with the mock object instead. $mock->fake_module( 'CGI' ); $mock->fake_new( 'CGI' ); use_ok( 'Some::Module' ); my $s = Some::Module->new(); is( $s->{_cgi}, $mock, 'new() should create and store a new CGI object' ); =item * C, I)> Adds a method of the specified name that always returns the specified value. =item * C, I, ... I)> Adds a method of the specified name that always returns a true value. This can take a list of names. =item * C, I, ... I)> Adds a method of the specified name that always returns a false value. (Since it installs an empty subroutine, the value should be false in both scalar and list contexts.) This can take a list of names. =item * C, [ I, I, ... ]> Adds a method that always returns a given list of values. It takes some care to provide a list and not an array, if that's important to you. =item * C, [ I, I, ... ]> Adds a method that will return the next item in a series on each call. This can help to test error handling, by forcing a failure on the first method call and then subsequent successes. Note that the series does not repeat; it will eventually run out. =item * C, I)> Adds a method bound to a variable. Pass in a reference to a variable in your test. When you change the variable, the return value of the new method will change as well. This is often handier than replacing mock methods. =item * C, I, ... I )> Adds an apparent parent to the module, so that calling C on the mock will return true appropriately. Sometimes you really need this. =item * C)> Removes a named method. =back =head3 Checking Your Mocks =over 4 =item * C Returns a subroutine reference if this particular mocked object can handle the named method, false otherwise. =item * C Returns true if the invocant object mocks a particular class. You must have used C first. =item * C)> Checks to see if something has called a named method on the object. This returns a boolean value. The current implementation does not scale especially well, so use this sparingly if you need to search through hundreds of calls. =item * C Clears the internal record of all method calls on the object. It's handy to do this every now and then. Note that this does not affect the mocked methods, only all of the methods called on the object to this point. It's handy to C methods in between series of tests. That makes it much easier to call C without having to skip over the calls from the last set of tests. =item * C ])> Returns the name and argument list of the next mocked method called on an object, in list context. In scalar context, returns only the method name. There are two important things to know about this method. First, it starts at the beginning of the call list. If your code runs like this: $mock->set_true( 'foo' ); $mock->set_true( 'bar' ); $mock->set_true( 'baz' ); $mock->foo(); $mock->bar( 3, 4 ); $mock->foo( 1, 2 ); Then you might see output of: my ($name, $args) = $mock->next_call(); print "$name (@$args)"; # prints 'foo' $name = $mock->next_call(); print $name; # prints 'bar' ($name, $args) = $mock->next_call(); print "$name (@$args)"; # prints 'foo 1 2' If you provide an optional number as the I argument, the method will skip that many calls, returning the data for the last one skipped. $mock->foo(); $mock->bar(); $mock->baz(); $name = $mock->next_call(); print $name; # prints 'foo' $name = $mock->next_call( 2 ); print $name # prints 'baz' When it reaches the end of the list, it returns undef. This is probably the most convenient method in the whole module, but for the sake of completeness and backwards compatibility (it takes me a while to reach the truest state of laziness!), there are several other methods. =item * C)> Returns the name of the method called on the object at a specified position. This is handy if you need to test a certain order of calls. For example: Some::Function( $mock ); is( $mock->call_pos(1), 'setup', 'Function() should first call setup()' ); is( $mock->call_pos(-1), 'end', '... and last call end()' ); Positions can be positive or negative. Please note that the first position is, in fact, 1. (This may change in the future. I like it, but am willing to reconsider.) =item * C)> Returns a list of the arguments provided to the method called at the appropriate position. Following the test above, one might say: is( ($mock->call_args(1))[0], $mock, '... passing the object to setup()' ); is( scalar $mock->call_args(-1), 0, '... and no args to end()' ); =item * C, I)> Returns the argument at the specified position for the method call at the specified position. One might rewrite the first test of the last example as: is( $mock->call_args_pos(1, 1), $mock, '... passing the object to setup()'); =item * C, [ I ])> Returns a stringified version of the arguments at the specified position. If no separator is given, they will not be separated. This can be used as: is( $mock->call_args_string(1), "$mock initialize", '... passing object, initialize as arguments' ); =item * C, [ I ])> Tests to see whether a method of the specified name has been called on the object. This and the following methods use Test::Builder, so they integrate nicely with a test suite built around Test::Simple, Test::More, or anything else compatible: $mock->foo(); $mock->called_ok( 'foo' ); A generic default test name is provided. =item * C, I, [ I ])> Tests to see whether the named method was called at the specified position. A default test name is provided. =item * C, I, I, [ I ])> Tests to see whether the argument at the appropriate position of the method in the specified position equals a specified value. A default, rather non-descript test name is provided. =item * C, I, I, [ I ])> Joins together all of the arguments to a method at the appropriate position and matches against a specified string. A generically bland test name is provided by default. You can probably do much better. =item * C Attempts to determine whether you have a class of the given name loaded and compiled. Returns true or false. =back =head3 Logging Test::MockObject logs all mocked methods by default. Sometimes you don't want to do this. To prevent logging all calls to a given method, prepend the name of the method with C<-> when mocking it. That is: $mock->set_true( '-foo', 'bar' ); will set mock both C and C, causing both to return true. However, the object will log only calls to C, not C. To log C again, merely mock it again without the leading C<->: $mock->set_true( 'foo' ); C<$mock> will log all subsequent calls to C again. =head3 Subclassing There are two methods provided for subclassing: =over 4 =item * C This method determines how to call a method (named as C<$method_name>) not available in this class. It also controls logging. You may or may not find it useful, but I certainly take advantage of it for Test::MockObject::Extends. =item * C This method tracks the call of the named method and its arguments. =back =head1 TODO =over 4 =item * Add a factory method to avoid namespace collisions (soon) =item * Add more useful methods (catch C?) =back =head1 AUTHOR chromatic, Echromatic at wgz dot orgE Thanks go to Curtis 'Ovid' Poe, as well as ONSITE! Technology, Inc., for finding several bugs and providing several constructive suggestions. Jay Bonci also found a false positive in C. Thanks! Chris Winters was the first to report I'd accidentally scheduled 0.12 for deletion without uploading a newer version. He also gave useful feedback on Test::MockObject::Extends. Stevan Little provided the impetus and code for C. Nicholas Clark found a documentation error. Mutant suggested a potential problem with fake_module(). =head1 SEE ALSO L, L, L, LEwww.perl.comEpubEaE2001E12E04Etesting.html>, and LEwww.perl.comEpubEaE2002E07E10Etmo.html>. =head1 COPYRIGHT Copyright (c) 2002 - 2016 by chromatic Echromatic at wgz dot orgE. This program is free software; you can use, modify, and redistribute it under the same terms as Perl 5.24 itself. See http://www.perl.com/perl/misc/Artistic.html =cut Test-MockObject-1.20161202/t/0000775000175000017500000000000013020377752016024 5ustar chromaticchromaticTest-MockObject-1.20161202/t/bugs.t0000644000175000017500000001007313020377752017150 0ustar chromaticchromatic#! perl use strict; use warnings; use Test::More tests => 18; use Test::MockObject; use Scalar::Util 'weaken'; { my $mock = Test::MockObject->new(); local $@ = ''; eval { $mock->called( 1, 'foo' ) }; is( $@, '', 'called() should not die from no array ref object' ); } { my $mock = Test::MockObject->new(); $mock->{_calls} = [ 1 .. 4 ]; $mock->_call( 5 ); is( @{ $mock->{_calls} }, 4, '_call() should not autovivify extra calls on the stack' ); } { my $mock = Test::MockObject->new(); my $warn = ''; local $SIG{__WARN__} = sub { $warn = shift; }; $mock->fake_module( 'Foo', bar => sub {} ); $mock->fake_module( 'Foo', bar => sub {} ); is( $warn, '', 'fake_module() should catch redefined sub warnings' ); } { my ($ok, $warn, @diag) = ('') x 2; { local (*Test::Builder::ok, *Test::Builder::diag); *Test::Builder::ok = sub { $ok = $_[1]; }; *Test::Builder::diag = sub { push @diag, $_[1]; }; my $mock = Test::MockObject->new(); $mock->{_calls} = [ [ 4, 4 ], [ 5, 5 ] ]; $mock->called_pos_ok( 2, 8 ); local $SIG{__WARN__} = sub { $warn = shift; }; $mock->called_pos_ok( 888, 'foo' ); } ok( ! $ok, 'called_pos_ok() should return false if name does not match' ); like( $diag[0], qr/Got.+Expected/s, '... printing a helpful diagnostic' ); unlike( $warn, qr/uninitialized value/, 'called_pos_ok() should throw no uninitialized warnings on failure'); like( $diag[1], qr/'undef'/, '... faking it with the word in the error' ); } { my $mock = Test::MockObject->new(); $mock->set_true( 'foo' ); $_ = 'bar'; $mock->foo( $1 ) if /(\w+)/; is( $mock->call_args_pos( -1, 2 ), 'bar', '$1 should be preserved through AUTOLOAD invocation' ); } { my $mock = Test::MockObject->new(); $mock->fake_module( 'fakemodule' ); no strict 'refs'; ok( %{ 'fakemodule::' }, 'fake_module() should create a symbol table entry for the module' ); } # respect list context at the end of a series { my $mock = Test::MockObject->new(); $mock->set_series( count => 2, 3 ); my $i; while (my ($count) = $mock->count()) { $i++; last if $i > 2; } is( $i, 2, 'set_series() should return false at the end of a series' ); } # Jay Bonci discovered false positives in called_ok() in 0.11 { local *Test::Builder::ok; *Test::Builder::ok = sub { $_[1]; }; my $new_mock = Test::MockObject->new(); my $result = $new_mock->called_ok( 'foo' ); is( $result, 0, 'called_ok() should not report false positives' ); } package Override; my $id = 'default'; use base 'Test::MockObject'; use overload '""' => sub { return $id }; package main; my $o = Override->new(); $o->set_always( foo => 'foo' ); is( "$o", 'default', 'default overloadings should work' ); $id = 'my id'; is( "$o", 'my id', '... and not be static' ); is( $o->foo(), 'foo', '... but should not interfere with method finding' ); # no overload '""'; # David Pisoni found memory leak condition { # Setup MOs with 2 references my ($obj1, $obj2, $obj1prime, $obj2prime); $obj1 = $obj1prime = Test::MockObject->new(); $obj2 = $obj2prime = Test::MockObject->new(); # Weaken one of the references each weaken $obj1prime; weaken $obj2prime; # test for memory leak condition $obj1->set_true('this'); $obj1->this($obj2); undef $obj2; is( ref($obj2prime), 'Test::MockObject', 'MO cached by another MO log should not be garbage collected' ); undef $obj1; ok( !ref($obj2prime), '... but should go away when caching MO does' ); ok( !ref($obj1prime), '... and the caching MO better go away too!' ); } # Mutant reported RT #21049 - lack of new() in fake_module() may be a problem { my $mock = Test::MockObject->new(); local $@; $INC{'Some/Module.pm'} = 1; eval { $mock->fake_module( 'Some::Module' ) }; like( $@, qr/No mocked subs for loaded module 'Some::Module'/, 'fake_module() should throw exception for loaded module without mocks'); } # Adam Kennedy reported RT #19448 - typo in check_class_loaded() { my $mock = Test::MockObject->new(); package Foo::Bar; sub foo {} package main; ok( $mock->check_class_loaded( 'Foo::Bar' ), 'check_class_loaded() should work for nested class names' ); } Test-MockObject-1.20161202/t/extends.t0000644000175000017500000001221413020377752017661 0ustar chromaticchromatic#!/usr/bin/perl use strict; use warnings; use Test::More tests => 41; use Test::Exception; my $module = 'Test::MockObject::Extends'; use_ok( $module ) or exit; my $tme = $module->new(); isa_ok( $tme, 'Test::MockObject' ); $tme = $module->new( 'Test::Builder' ); ok( $tme->isa( 'Test::Builder' ), 'passing a class name to new() should set inheritance properly' ); $tme = $module->new( 'CGI' ); ok( $INC{'CGI.pm'}, 'new() should load parent module unless already loaded' ); package Some::Class; @Some::Class::ISA = 'Another::Class'; sub path { return $_[0]->{path}; } sub foo { return 'original'; } sub bar { return 'original'; } package Another::Class; package main; # fake that we have loaded these $INC{'Some/Class.pm'} = 1; $INC{'Another/Class.pm'} = 1; $tme = $module->new( 'Some::Class' ); my $result = $tme->set_always( bar => 'mocked' ); is( $tme->bar(), 'mocked', 'mock() should override method in parent' ); is( $tme->foo(), 'original', '... calling original methods in parent' ); is( $result, $tme, '... returning invocant' ); $result = $tme->unmock( 'bar' ); is( $tme->bar(), 'original', 'unmock() should remove method overriding' ); is( $result, $tme, '... returning invocant' ); $result = $tme->mock( pass_self => sub { is( shift, $tme, '... and should pass along invocant' ); is( $result, $tme, '... returning invocant' ); }); $tme->pass_self(); my ($method, $args) = $tme->next_call(); is( $method, 'bar', '... logging methods appropriately' ); my $sc = bless { path => 'my path' }, 'Some::Class'; my $mock_sc = $module->new( $sc ); is( $mock_sc->path(), 'my path', '... should wrap existing object appropriately' ); isa_ok( $mock_sc, 'Some::Class' ) or diag( '... marking isa() appropriately on mocked object' ); isa_ok( $mock_sc, 'Another::Class' ) or diag( '... and delegating isa() appropriately on parent classes' ); ok( ! $mock_sc->isa( 'No::Class' ), '... returning the right result even when the class is not a parent' ); $tme->set_always( -foo => 11 ); is( $tme->foo(), 11, 'unlogged methods should work' ); ok( ! $tme->called( 'foo' ), '... and logging should not happen for them' ); { my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= shift }; $tme->set_always( foo => 12 ); is( $warnings, '', '... not throwing redefinition warnings' ); } $tme->set_always( foo => 12 ); is( $tme->foo(), 12, '... allowing overriding with logged versions' ); ok( $tme->called( 'foo' ), '... with logging happening then, obviously' ); package Parent; $INC{'Parent.pm'} = 1; use vars '$somethingnasty'; $somethingnasty = ''; sub new { bless {}, $_[0] } sub mockthis { $somethingnasty = 1 } sub AUTOLOAD { return $_[0]->mockthis() } package main; my $parent = Parent->new(); my $extend = Test::MockObject::Extends->new( $parent ); $extend->mock( 'mockthis', sub { return 'foo' } ); is( $extend->foo(), 'foo', 'Mocking worked' ); ok( ! $Parent::somethingnasty, "Method didn't trigger bad method" ); package Foo; @Foo::ISA = 'Parent'; my ($called_foo, $called_autoload, $method_name); use vars '$AUTOLOAD'; BEGIN { $called_foo = 0; $called_autoload = 0; $method_name = ''; } sub new { bless {}, $_[0]; } sub foo { $called_foo++; return 'foo'; } sub AUTOLOAD { $called_autoload++; $method_name = $Foo::AUTOLOAD; return 'autoload'; } package main; my $object = Foo->new(); isa_ok( $object, 'Foo' ); my $mock; lives_ok { $mock = Test::MockObject::Extends->new( $object ) } 'Creating a wrapped module should not die'; isa_ok( $mock, 'Foo' ); # Call foo() is( $mock->foo(), 'foo', 'foo() should return as expected' ); is( $called_foo, 1, '... calling the method' ); is( $called_autoload, 0, '... not touching AUTOLOAD()' ); is( $Foo::AUTOLOAD, undef, '... or $Foo::AUTOLOAD' ); # Call an autoloaded method is( $mock->bar(), 'autoload', 'bad() should returns as expected' ); is( $called_autoload, 1, '... calling AUTOLOAD()' ); is( $method_name, 'Foo::bar', '... with the appropriate $Foo::AUTOLOAD' ); # get the parents of the mocked object (to work with SUPER) $result = [ $mock->__get_parents() ]; is_deeply( $result, [qw( Parent )], '__get_parents() should return a list of parents of the wrapped object' ); package FooNoAutoload; my ($called_fooNA, $called_autoloadNA, $method_nameNA); sub new { bless {}, $_[0]; } sub fooNA { $called_fooNA++; return 'fooNA'; } package main; BEGIN { $called_fooNA = 0; $called_autoloadNA = 0; $method_nameNA = ''; } $object = FooNoAutoload->new(); isa_ok( $object, 'FooNoAutoload' ); undef $mock; lives_ok { $mock = Test::MockObject::Extends->new( $object ) } 'Creating a wrapped module should not die'; isa_ok( $mock, 'FooNoAutoload' ); #37 # Call foo() is( $mock->fooNA(), 'fooNA', 'fooNA() should return as expected' ); is( $called_fooNA, 1, '... calling the method' ); is( $called_autoloadNA, 0, '... not touching AUTOLOAD()' ); # Call a non-existent method dies_ok (sub{ $mock->bar()}, '... should die if calling a non-mocked and non-AUTOLOADED method' ); Test-MockObject-1.20161202/t/debugger.t0000644000175000017500000000133513020377752017775 0ustar chromaticchromatic#!perl use strict; use warnings; use Test::More tests => 4; # ask for generated anonymous sub names with this debugger variable BEGIN { $^P |= 0x200 } use_ok( 'Test::MockObject' ); my $mock = Test::MockObject->new(); package Some::Parent; BEGIN { for my $name (qw( isa can )) { my $sub = sub { my $caller = ( caller( 1 ) )[ 3 ]; ::is( $caller, "Test::MockObject::$name", "generated $name() should have correct name under debugger" ); }; no strict 'refs'; *{ $name } = $sub; } } package main; local @Test::MockObject::ISA; @Test::MockObject::ISA = 'Some::Parent'; my $tmo = Test::MockObject->new(); $tmo->isa( 'foo' ); $tmo->can( 'bar' ); ok( $^P & 0x200, 'T::MO should not permanently reset $^P' ); Test-MockObject-1.20161202/t/isa.t0000644000175000017500000000116013020377752016761 0ustar chromaticchromatic#!/usr/bin/perl use strict; use warnings; use Test::More tests => 7; use_ok( 'Test::MockObject' ); my $mock = Test::MockObject->new(); can_ok( $mock, 'set_isa' ); # set_isa() should make isa() report true for the given parents $mock->set_isa( 'CGI', 'Apache::Request', 'Apache' ); isa_ok( $mock, 'CGI' ); isa_ok( $mock, 'Apache' ); # ... it should be able to add parents $mock->set_isa( 'Something' ); isa_ok( $mock, 'Something' ); # ... without overwriting previous parents isa_ok( $mock, 'Apache::Request' ); # ... or reporting true for everything ok( ! $mock->isa( 'Fail' ), '... this is not a "Fail" object' ); Test-MockObject-1.20161202/t/extends-fields.t0000644000175000017500000000103713020377752021126 0ustar chromaticchromatic#!/usr/bin/env perl use Test::More; use Test::Exception; use Test::MockObject::Extends; package MyModule; use strict; use warnings; use fields qw(field1 field2); sub new { my $self = shift; $self = fields::new($self) unless ref $self; return $self; } package main; use Test::MockObject::Extends; my $fieldy = MyModule->new; isa_ok $fieldy, 'MyModule'; my $mocky; lives_ok { $mocky = Test::MockObject::Extends->new( $fieldy ) } 'fields-based object should be mockstensible'; isa_ok $mocky, 'MyModule'; done_testing; Test-MockObject-1.20161202/t/extends-bugs.t0000644000175000017500000000766013020377752020630 0ustar chromaticchromatic#!/usr/bin/perl use strict; use warnings; use Test::More tests => 33; use Test::Exception; my $module = 'Test::MockObject::Extends'; use_ok( $module ) or exit; # RT #17692 - cannot mock inline package without new() { package InlinePackageNoNew; sub foo; } lives_ok { Test::MockObject::Extends->new( 'InlinePackageNoNew' ) } 'Mocking a package defined inline should not load anything'; # RT #15446 - isa() ignores type of blessed reference # fake that Foo is loaded $INC{'Foo.pm'} = './Foo.pm'; # create object my $obj = bless {}, "Foo"; # test if the object is a reference to a hash # silence warnings with UNIVERSAL::isa and Sub::Uplevel no warnings 'uninitialized'; ok( $obj->isa( 'HASH' ), 'The object isa HASH' ); ok( UNIVERSAL::isa( $obj, 'HASH' ), '...also if UNIVERSAL::isa() is called as a function' ); # wrap in mock object Test::MockObject::Extends->new( $obj ); # test if the mock object is still a reference to a hash ok( $obj->isa( 'HASH' ), 'The extended object isa HASH' ); ok( UNIVERSAL::isa( $obj, 'HASH' ), "...also if UNIVERSAL::isa() is called as a function" ); # RT #14445 - inherited AUTOLOAD does not work correctly CLASS: { package Foo; use vars qw( $called_foo $called_autoload $method_name ); BEGIN { $called_foo = 0; $called_autoload = 0; $method_name = ''; } sub new { bless {}, $_[0]; } sub foo { $called_foo++; return 'foo'; } sub AUTOLOAD { $called_autoload++; $method_name = $Foo::AUTOLOAD; return 'autoload'; } package Bar; use vars qw( @ISA $called_this ); BEGIN { @ISA = 'Foo'; $called_this = 0; } sub this { $called_this++; return 'this'; } 1; } my $object = Foo->new(); isa_ok( $object, 'Foo' ); # Create a trvial mocked autoloading object my $mock = Test::MockObject::Extends->new($object); isa_ok( $mock, 'Foo' ); # Call foo is( $mock->foo(), 'foo', 'foo() returns as expected' ); is( $Foo::called_foo, 1, '$called_foo is incremented' ); is( $Foo::called_autoload, 0, '$called_autoload is unchanged' ); is( $Foo::method_name, '', '$method_name is unchanged' ); # Call an autoloaded method is( $mock->bar(), 'autoload', 'bad() returns as expected' ); is( $Foo::called_autoload, 1, '$called_autoload is incremented' ); is( $Foo::method_name, 'Foo::bar', '$method_name is the correct value' ); $object = Bar->new(); isa_ok( $object, 'Foo' ); isa_ok( $object, 'Bar' ); # Create a non-trivial subclassed autoloading object $mock = Test::MockObject::Extends->new( $object ); isa_ok( $mock, 'Foo' ); isa_ok( $mock, 'Bar' ); # Call foo is( $mock->foo(), 'foo', 'foo() returns as expected' ); is( $Foo::called_foo, 2, '$called_foo is incremented' ); is( $Foo::called_autoload, 1, '$called_autoload is unchanged' ); is( $Bar::called_this, 0, '$called_this is unchanged' ); # Call this is( $mock->this(), 'this', 'this() returns as expected' ); is( $Foo::called_foo, 2, '$called_foo is unchanged' ); is( $Foo::called_autoload, 1, '$called_autoload is unchanged' ); is( $Bar::called_this, 1, '$called_this is incremented' ); # Call an autoloaded method is( $mock->that(), 'autoload', 'that() returns as expected' ); is( $Foo::called_autoload, 2, '$called_autoload is incremented' ); is( $Foo::method_name, 'Bar::that', '$method_name is set correctly' ); ### This might demonstrate why the problem happened is( $Bar::AUTOLOAD, undef, "The \$AUTOLOAD for the object's actual class should be unset" ); is( $Foo::AUTOLOAD, 'Bar::that', 'The $AUTOLOAD that catches the call should contain the desired name' ); # Get rid of a silly warning $Bar::AUTOLOAD = $Bar::AUTOLOAD; package Obj; sub class_method { 'TRUE-CLASS-METHOD' } package main; my $o = Test::MockObject::Extends->new('Obj')->set_always( -class_method => 'FAKED RESULT' ); is( $o->class_method, 'FAKED RESULT', 'class method mocked' ); Test-MockObject-1.20161202/t/debuggingwarnings.t0000644000175000017500000000106713020377752021717 0ustar chromaticchromatic#! perl use strict; use warnings; use Test::More; use Test::Warn; BEGIN { use_ok 'Test::MockObject'; Test::MockObject->import( '-debug' ); } package Foo; sub can {} package main; warnings_like { UNIVERSAL::isa( {}, 'HASH' ) } qr/Called UNIVERSAL::isa\(\) as a function, not a method/, 'T::MO should enable U::i when loaded with -debug flag'; warnings_exist { UNIVERSAL::can( 'Foo', 'to_string' ) } [ qr/Called UNIVERSAL::can\(\) as a function, not a method/ ], 'T::MO should enable U::c when loaded with -debug flag'; done_testing(); Test-MockObject-1.20161202/t/debuggingwarningsextends.t0000644000175000017500000000111713020377752023306 0ustar chromaticchromatic#! perl use strict; use warnings; use Test::More; use Test::Warn; BEGIN { use_ok 'Test::MockObject::Extends'; Test::MockObject::Extends->import( '-debug' ); } package Foo; sub can {} package main; warnings_like { UNIVERSAL::isa( {}, 'HASH' ) } qr/Called UNIVERSAL::isa\(\) as a function, not a method/, 'T::MO::E should enable U::i when loaded with -debug flag'; warnings_exist { UNIVERSAL::can( 'Foo', 'to_string' ) } [ qr/Called UNIVERSAL::can\(\) as a function, not a method/ ], 'T::MO::E should enable U::c when loaded with -debug flag'; done_testing(); Test-MockObject-1.20161202/t/ignore.t0000644000175000017500000000112313020377752017467 0ustar chromaticchromatic#!/usr/bin/perl use strict; use warnings; my $package = 'Test::MockObject'; use Test::More tests => 6; use_ok( $package ); my $mock = $package->new(); $mock->set_true( -somesub => 'anothersub' ); ok( $mock->somesub(), 'mocking a method with a leading dash should work' ); ok( $mock->anothersub(), '... not preventing subsequent mocks' ); is( $mock->next_call(), 'anothersub', '... but should prevent logging of endashed sub calls' ); $mock->set_false( 'somesub' ); ok( ! $mock->somesub(), 'unlogged call should be remockable' ); is( $mock->next_call(), 'somesub', '... and reloggable' ); Test-MockObject-1.20161202/t/nodefaultwarnings.t0000644000175000017500000000111613020377752021740 0ustar chromaticchromatic#! perl use strict; use warnings; use Test::More 0.98; use Test::Warn 0.23; use_ok 'Test::MockObject'; warning_is { UNIVERSAL::isa( {}, 'HASH' ) } undef, 'T::MO should not enable U::i by default'; warning_is { UNIVERSAL::can( 'UNIVERSAL', 'to_string' ) } undef, 'T::MO should not enable U::c by default'; use_ok 'Test::MockObject::Extends'; warning_is { UNIVERSAL::isa( {}, 'HASH' ) } undef, 'T::MO::E should not enable U::i by default'; warning_is { UNIVERSAL::can( 'UNIVERSAL', 'to_string' ) } undef, 'T::MO::E should not enable U::c by default'; done_testing(); Test-MockObject-1.20161202/t/base.t0000644000175000017500000002035113020377752017122 0ustar chromaticchromatic#!/usr/bin/perl use strict; use warnings; my $package = 'Test::MockObject'; use Test::More tests => 103; use_ok( $package ); # new() can_ok( $package, 'new' ); my $mock = Test::MockObject->new(); isa_ok( $mock, $package ); # mock() can_ok( $mock, 'mock' ); my $result = $mock->mock('foo'); can_ok( $mock, 'foo' ); is( $result, $mock, 'mock() should return itself' ); is( $mock->foo(), undef, '... default mock should return nothing' ); # remove() can_ok( $package, 'remove' ); $result = $mock->remove('foo'); ok( ! $mock->can('foo'), 'remove() should remove a sub from potential action' ); is( $result, $mock, '... returning itself' ); # this is used for a couple of tests sub foo { 'foo' } $mock->mock('foo', \&foo); local $@; my $fooput = eval{ $mock->foo() }; is( $@, '', 'mock() should install callable subref' ); is( $fooput, 'foo', '... which behaves normally' ); is( $mock->can('foo'), \&foo, 'can() should return a subref' ); can_ok( $package, 'set_always' ); $result = $mock->set_always( 'bar', 'bar' ); is( $mock->bar(), 'bar', 'set_always() should add a sub that always returns its value' ); is( $mock->bar(), 'bar', '... so it should at least do it twice in a row' ); is( $result, $mock, '... returning itself' ); can_ok( $package, 'set_true' ); $result = $mock->set_true( 'blah' ); ok( $mock->blah(), 'set_true() should install a sub that returns true' ); $result = $mock->set_true( qw( true1 true2 true3 ) ); ok( $mock->true1(), '... or multiple subs' ); ok( $mock->true2(), '... all' ); ok( $mock->true3(), '... returning true' ); is( $result, $mock, '... and should return itself' ); can_ok( $package, 'set_false' ); $result = $mock->set_false( 'bloo' ); ok( ! $mock->bloo(), 'set_false() should install a sub that returns false' ); my @false = $mock->bloo(); ok( ! @false, '... even in list context' ); is( $result, $mock, '... and should return itself' ); $result = $mock->set_false( qw( false1 false2 false3 ) ); ok( ! $mock->false1(), '... or multiple subs' ); ok( ! $mock->false2(), '... all' ); ok( ! $mock->false3(), '... returning false' ); can_ok( $package, 'set_list' ); $result = $mock->set_list( 'baz', ( 4 .. 6 ) ); is( scalar $mock->baz(), 3, 'set_list() should install a sub to return a list'); is( $result, $mock, '... and should return itself' ); is( join('-', $mock->baz()), '4-5-6', '... and the sub should always return the list' ); can_ok( $package, 'set_series' ); $result = $mock->set_series( 'amicae', 'Sunny', 'Kylie', 'Isabella' ); is( $mock->amicae(), 'Sunny', 'set_series() should install a sub to return a series' ); is( $result, $mock, '... and should return itself' ); is( $mock->amicae(), 'Kylie', '... in order' ); is( $mock->amicae(), 'Isabella', '... through the series' ); ok( ! $mock->amicae(), '... but false when finishing the series' ); can_ok( $package, 'called' ); $mock->foo(); ok( $mock->called('foo'), 'called() should report true if named sub was called' ); ok( ! $mock->called('notfoo'), '... and false if it was not' ); can_ok( $package, 'clear' ); $result = $mock->clear(); ok( ! $mock->called('foo'), 'clear() should clear recorded call stack' ); is( $result, $mock, '... and should return itself' ); can_ok( $package, 'call_pos' ); $mock->foo(1, 2, 3); $mock->bar([ foo ]); $mock->baz($mock, 88); is( $mock->call_pos(1), 'foo', 'call_pos() should report name of sub called by position' ); is( $mock->call_pos(-1), 'baz', '... and should handle negative numbers' ); can_ok( $package, 'call_args' ); my ($arg) = ($mock->call_args(2))[1]; is( $arg->[0], 'foo', 'call_args() should return args for sub called by position' ); is( ($mock->call_args(2))[0], $mock, '... with the object as the first argument' ); can_ok( $package, 'call_args_string' ); is( $mock->call_args_string(1, '-'), "$mock-1-2-3", 'call_args_string() should return args joined' ); is( $mock->call_args_string(1), "${mock}123", '... with no default separator' ); can_ok( $package, 'call_args_pos' ); is( $mock->call_args_pos(3, 1), $mock, 'call_args_argpos() should return argument for sub by position' ); is( $mock->call_args_pos(-1, -1), 88, '... handing negative positions equally well' ); can_ok( $package, 'called_ok' ); $mock->called_ok( 'foo' ); can_ok( $package, 'called_pos_ok' ); $mock->called_pos_ok( 1, 'foo' ); can_ok( $package, 'called_args_string_is' ); $mock->called_args_string_is( 1, '-', "$mock-1-2-3" ); can_ok( $package, 'called_args_pos_is' ); $mock->called_args_pos_is( 1, -1, 3 ); can_ok( $package, 'fake_module' ); $mock->fake_module( 'Some::Module' ); is( $INC{'Some/Module.pm'}, 1, 'fake_module() should prevent a module from being loaded' ); my @imported; $mock->fake_module( 'import::me', import => sub { push @imported, $_[0] }); eval { import::me->import() }; is( $imported[0], 'import::me', 'fake_module() should install functions in new package namespace' ); { my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= shift }; $mock->fake_module( 'badimport', foo => 'bar' ); like( $warnings, qr/'foo' is not a code reference/, '... and should carp if it does not receive a function reference' ); } can_ok( $package, 'fake_new' ); $mock->fake_new( 'Some::Module' ); is( Some::Module->new(), $mock, 'fake_new() should create a fake constructor to return mock object' ); can_ok( $package, 'check_class_loaded' ); ok( $package->check_class_loaded( 'Test::MockObject' ), 'check_class_loaded() should return true for loaded class' ); ok( ! $package->check_class_loaded( 'Test::MockObject::Bob' ), '... and false for unloaded class' ); ok( $package->check_class_loaded( 'strict' ), '... true for loaded class with no colons' ); ok( ! $package->check_class_loaded( 'unstrict' ), '... false for unloaded class with no colons' ); package Blah; package Blah::Nested; package main; ok( $package->check_class_loaded( 'Blah' ), '... true for defined class even with no symbols' ); ok( $package->check_class_loaded( 'Blah::Nested' ), '... true for defined class with colons but with no symbols' ); $INC{'Some.pm'} = 1; $INC{'Some/Package.pm'} = 1; ok( $package->check_class_loaded( 'Some' ), '... true for class in %INC' ); ok( $package->check_class_loaded( 'Some::Package' ), '... and true for class with colons in %INC' ); can_ok( $package, 'set_bound' ); $arg = 1; $result = $mock->set_bound( 'bound', \$arg ); is( $mock->bound(), 1, 'set_bound() should bind to a scalar reference' ); is( $result, $mock, '... and should return itself' ); $arg = 2; is( $mock->bound(), 2, '... and its return value should change with the ref' ); $arg = [ 3, 5, 7 ]; $mock->set_bound( 'bound_array', $arg ); is( join('-', $mock->bound_array()), '3-5-7', '... handling array refs' ); $arg = { foo => 'bar' }; $mock->set_bound( 'bound_hash', $arg ); is( join('-', $mock->bound_hash()), 'foo-bar', '... and hash refs' ); { local $INC{'Carp.pm'} = 1; local *Carp::carp; my @c; *Carp::carp = sub { push @c, shift; }; $mock->notamethod(); is( @c, 1, 'Module should carp when calling a non-existant method' ); is( $c[0], "Un-mocked method 'notamethod()' called", '... warning as such'); } # next_call() can_ok( $mock, 'next_call' ); $mock->clear(); $mock->foo( 1, 2, 3 ); $mock->bar(); $mock->baz(); my ($method, $args) = $mock->next_call(); is( $method, 'foo', 'next_call() should return first method' ); isa_ok( $args, 'ARRAY', '... and args in a data structure which' ); is( join('-', @$args), "$mock-1-2-3", '... containing the real arguments' ); ok( ! $mock->called( 'foo' ), '... and removing that call from the stack' ); $result = $mock->next_call( 2 ); is( $result, 'baz', '... and should skip multiple calls, with an argument provided' ); is( $mock->next_call(), undef, '... returning undef with no call in that position' ); is( $result, 'baz', '... returning only the method name in scalar context' ); # _calls() can_ok( $package, '_calls' ); my $callstack = Test::MockObject::_calls( 'key' ); isa_ok( $callstack, 'ARRAY', '_calls() should return something that' ); $callstack->[0] = 'foo'; is_deeply( Test::MockObject::_calls( 'key' ), [ 'foo' ], '... always for the same key' ); # _subs() can_ok( $package, '_subs' ); my $subhash = Test::MockObject::_subs( 'key' ); isa_ok( $subhash, 'HASH', '_subs() should return something that' ); $subhash->{foo} = 'bar'; is_deeply( Test::MockObject::_subs( 'key' ), { foo => 'bar' }, '... always for the same key' );