Test-LectroTest-0.5001000755000764000764 012145027551 13731 5ustar00thorthor000000000000TODO100644000764000764 444612145027551 14512 0ustar00thorthor000000000000Test-LectroTest-0.5001* Key X = Done C = Canceled - = Pending * Development stuff X Rename tests from 00x.t to something more meaningful X Remove DataDumper Sortkeys dependency (more backward compatible) * Improvements X Make Paste combinator accept List arguments (via concat). X Multiple generator-bindings per Property to allow for focusing on certain subpaces of the haystack: ##[ [ x <- Int ], [ x <- Int(range=>[-1,1]) ]## X all bindings must have identical sets of variables X test runner runs a full set of trials against each binding X Better handling of errors caught durring testing X Include "Error caught: $@" in output. X Combinators X Size X Each -- Impl: List of length 1 w/ multiple generators X Apply(f,gs...) -- returns f(@{Each(gs)}) X Concat(gs) = Apply(map {@$_ $_}, @{Each(gs)}) X Map(f, gs...) X ConcatMap X Flatten(gs) - Test apparatus X label & friends X output & reporting X integrate w/ Test::Harness - Seed for repeatable tests - Flight recorder -- record everything to file - allow and report multiple test failures -- maybe separate pkg? - Allow behavior tests to add notes to a trial; include the notes in details. - Docs X TestRunner X Property - Tutorial - Topics - When not to use LectroTest - Using LectroTest with Test::More and ilk - Repeatability - Emit the RNG seed at the outset of the tests for repeatability - Accept an option to use a given seed * CPAN submission X Module list short description: "automatic, specification-based testing tool" X Rename for better harmony with the global Perl namespace: LectroTest.pm --> Poof! (?) LectroTest::Simple -> Test::LectroTest (::Simple ?) LectroTest::Test -> Test::LectroTest::Property LectroTest::TestRunner -> Test::LectroTest::TestRunner LectroTest::Generator -> Test::LectroTest::Generator - Docs review X Make sure LectroTest URL is in all docs X Set version to something sensible * Old stuff X Replace Char's range=>[] w/ charset=>"". X Test case $t return $t->redo; # if random vars don't satisfy test preconditions $t->label("zero") if $x == 0; $t->trivial if $x == 0 && $y == 0; C Let each property optionally specify how many times it is to be tested: Property { ... } name => ..., trials => 100; Local variables: mode: outline End: THANKS100644000764000764 226212145027551 14727 0ustar00thorthor000000000000Test-LectroTest-0.5001-*- Outline -*- * A BIG THANKS TO THE FOLLOWING GREAT PEOPLE - Koen Claessen and John Hughes for creating QuickCheck for the Haskell programming language and providing the inspiration for LectroCheck - Jacob Matthews for his constant Scheming (hee, hee) and for his excellent suggestions - Casey West, Chris Winters, Dan Wright, and the rest of the Pittsburgh Perl Mongers for continuing support, suggestions, and abundant, all-around coolness - Andy Lester for prodding me into getting the word out and writing something about LectroTest - Steffen Müller for good ideas about testing corner cases, which became the basis for LectroTests's failure recording and playback capabilities - Andreas Koenig (ANDK) for suggesting that I modify the test suite for generators (t/gens.t) to emit a notice that test failures do not necessarily indicate a failure. - Petr Pisar for reporting a missing prototype https://rt.cpan.org/Ticket/Display.html?id=85281 - Nicholas Bamber (SILASMONK) for patch to remove UNIVERSAL->import https://rt.cpan.org/Public/Bug/Display.html?id=66114 - Ricardo SIGNES for the thunderously time-saving Dist::Zilla -- Tom Moertel README100644000764000764 46712145027551 14661 0ustar00thorthor000000000000Test-LectroTest-0.5001 This archive contains the distribution Test-LectroTest, version 0.5001: Easy, automatic, specification-based tests This software is copyright (c) 2013 by Tom Moertel. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Changes100644000764000764 2017612145027551 15333 0ustar00thorthor000000000000Test-LectroTest-0.5001-*-Outline-*- LectroTest Change Log Tom Moertel (tom@moertel.com) * 0.5001 (2013-05-14) - Update Changes file. * 0.5000 (2013-05-15) - Remove signature test. - Stop using UNIVERSAL->import (fixes #66114). Thanks Nicholas Bamber (SILASMONK) for the patch. - Add prototype to silence warning (fixes #85281). Thanks to Petr Pisar for pointing out the problem. - Minor tweaks to whitespace * 0.3600 (2007-08-30) ** Misc - Test suite for generators now emits notice that a failure may not indicate a real problem. (rt.cpan.org #28203; thanks ANDK) - Minor typo fixes in the documentation. * 0.3500 (2006-05-31) ** Improvements - Added failure recording and playback, which is great for building regression-testing suites and for recording failures in the wild. Both Test::LectroTest and Test::LectroTest::Compat take the following options: - playback_failures => file - record_failures => file - regressions => file The first tells LT to use the prerecorded failures in the given file for playback during testing, *in addition to* the normal randomly generated cases. The second tells LT to record any failures that occur during testing. The failures will be written to the given file. The third is a shorthand for setting the first two options to the same file. It is a more readable way to declare your intent to build up and use a persistent regressions file. These options are documented more fully in the docs for Test::LectroTest::TestRunner. ** Misc - I'm now using Module::Signature to sign the Test::LectroTest distribution. * 0.3400 (2006-01-18) ** Improvements - $tcon->dump( val, ... ) now returns val as its result so that the method call can be used to record values in passing. - Added Pod and Pod-coverage tests. Tweaked the code to satisfy them. * 0.3300 (2005-07-20) ** Fixes - Test::LectroTest can now be listed as a dependency in an ExtUtils::MakeMaker Makefile.PL. (Thanks Steffen Müller) ** Misc - Minor documentation tweaks for clarity. - Minor code clean ups. * 0.3200 (2005-03-03) ** Improvements - You can now attach notes and variable dumps to trials. In the event the trial fails, the notes will be emitted as part of the counterexample to aid in debugging. See Test::LectroTest::TestRunner::testcontroller for the documentation on the new $tcon->note() and $tcon->dump() methods. - Strings in counterexamples are now printed in double-quoted form. This makes it easy to see invisibles. * 0.3100 (2005-02-19) - This release is identical to 0.3000 except that for this release I did not screw up the version numbering in the distribution tarball. (Ouch!) * 0.3000 (2005-02-19) ** Improvements - Full test coverage! Devel::Coverage says that the LT unit tests now cover 100% of statements, branches, conditionals, and subroutines. - Test::LectroTest now follows Test::Simple's exit-code strategy: The number of failures (up to 254) is reported via the exit code. - (!) Test::LectroTest::TestRunner::run_suite now returns the number of properties that successfully checked. (Before it reported 0 if any check failed.) !!!NOTE!!! This is an API change. If you have written code that checks the result of run_suite, you will need to change it. ** Fixes - An empty suite powered by Test::LectroTest now emits "1..0" as its sole output when previously there was no output. ** Misc - Added a bunch of new test cases. - Renamed test files: from t/001.t to t/gens.t, etc. - Removed superfluous use of Data::Dumper in t/gens.t. - Relaxed dependencies on external packages need only for building. * 0.2010 (2005-02-16) ** Improvements - Now you can mix LectroTest and Test::* modules! Test::LectroTest::Compat provides the compatibility magic. ** Fixes - Updated copyright notices. - Removed use of List::Util from t/001.t. (This should be the last use of the module. Now we can cut the dependency.) - Renamed the test .t files to something sensible. ** Misc - Made list of dependencies in Build.PL pedantically complete. * 0.2008 (2005-02-05) ** Improvements - Paste can now be used to join elements of generated lists, which are "flattened" before pasting. For example, the following are equivalent: Paste( (Bool) x 4 ) Paste( List(Bool, length=>4) ) - Removed dependency upon Data::Dumper's Sortkeys method and upon List::Util entirely. This makes LectroTest compatible with older versions of Perl. (I tested on v5.6.1 built for i386-linux.) Thanks Alex Kapranoff for the Sortkeys dependency report. ** Fixes - Minor clarifying edits to documentation. * 0.2007 (2004-09-30) ** Improvements - You can now specify multiple sets of generator-bindings for a property. This lets you focus on specific portions of your test space to ensure the desired coverage. For example, if you wanted to cover all integers but especially focus on the range [-1,1]: Property { ##[ x <- Int ], [ x <- Int(range=>[-1,1]) ]## blah($x) != 0 }, name => "blah result is non-zero" ; - Generator now accepts an :all export tag to export everything (which is what I use almost all of the time). - If a generator throws an exception, it is caught and reported specifically in a special warning counterexample. - Expanded test suite for TestRunner and Property. ** Fixes - Some of the new combinators were listed under the :common export tag instead of under :combinators. * 0.2006 New combinators, doc fixes (2004-09-15) ** Improvements - More new combinators that you can shake a stick at: Each, Apply, Map, Concat, Flatten, ConcatMap, FlattenMap. - As usual, documentation tweaks: - Better explanation of sizing guidance (Generator) - Added warnings about empty ranges, etc. (Generator) - Documented the new combinators (Generator) - Additional pre-flight checks for Int and Float generators: If a range is provided that does not contain zero, LectroTest will complain if the generator is also sized (because the run-time intersection of the sizing-guidance range and the generator's range can be empty, making it impossible to generate a valid value). ** Fixes - Fixed an overly-uppity pre-flight check for List(length=>N). - Fixed TestRunner's modifying of $" in a way that escaped into the behavior-test part of Properties during checks. * 0.2005 Re-release of 0.2004 to make CPAN happy (2004-09-13) - I once had a version in Test::LectroTest::Generator but removed it because I wanted to version only the entire Test::LectroTest module. But CPAN rejected Generator because its version had "fallen." Crap. So, back in goes the version number, now bumped. * 0.2004 Documentation improvements, minor code improvements (2004-09-13) ** Fixes - Some links in documentation were broken. ** Improvements - Vastly improved docs: All modules now have decent documentation. (Tutorial still needs step-by-steps, tho.) - More pre-flight checks and better error reporting. - Cleaned up Test::LectroTest's hack for running property checks and end of load. * 0.2003 Bug fix and doc improvements (2004-09-11) ** Fixes - !! Important fix: In generator bindings with more than one variable, variables sometimes got each others' values. ** Improvements - Updated docs. - LectroTest::Property now pre-flight checks for the use of $tcon in a generator binding and emits and error in that case. ($tcon is used for the test controller.) - TestRunner will now catch and report exceptions thrown during property checks: - A thrown exception results in test failure. - The "details" report will include a "Caught exception" section, if needed. - TestRunner::results now has an exception field: - undef if no exception was thrown during testing - the exception otherwise * 0.2002 Documentation improvements (2004-09-09) - Added README (d'oh!) from Test::LectroTest. - Updated docs in Test::LectroTest. * 0.2001 First Pre-CPAN upload release (2004-09-09) - Major documentation improvements - Lots of cleanups - Reorg under Test: LectroTest::* -> Test::LectroTest::* LectroTest::Simple -> Test::LectroTest * 0.1002 First public release (2004-09-08) - Clean ups * 0.1001 First cut t000755000764000764 012145027551 14115 5ustar00thorthor000000000000Test-LectroTest-0.5001pod.t100644000764000764 26112145027551 15203 0ustar00thorthor000000000000Test-LectroTest-0.5001/t# standard Test::Pod recipe for module authors use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); LICENSE100644000764000764 4365012145027551 15047 0ustar00thorthor000000000000Test-LectroTest-0.5001This software is copyright (c) 2013 by Tom Moertel. 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 Tom Moertel. 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 Tom Moertel. 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 buildrpm100755000764000764 52012145027551 15533 0ustar00thorthor000000000000Test-LectroTest-0.5001#!/bin/bash if [ -z "$1" ]; then echo Usage: buildrpm VERSION 1>&2 exit 1 fi for v in "$@"; do cpan2rpm "Test-LectroTest-$v.tar.gz" \ --release=1.fc3.tgm \ --url=http://community.moertel.com/LectroTest \ --author='Tom Moertel ' \ --version=$v \ --make-no-test done dist.ini100644000764000764 101012145027551 15446 0ustar00thorthor000000000000Test-LectroTest-0.5001name = Test-LectroTest version = 0.5001 author = Tom Moertel license = Perl_5 copyright_holder = Tom Moertel [@Basic] [PodSyntaxTests] [PodCoverageTests] [PkgVersion] [PodVersion] [AutoPrereqs] [TestRelease] [ConfirmRelease] [UploadToCPAN] ; [Prereqs] ; Carp = 0 ; Class::Struct = 0 ; Data::Dumper = 0 ; Filter::Util::Call = 0 ; Test::Builder = 0 ; ; [Prereqs / TestRequires] ; File::Temp = 0 ; Test::More = 0 gens.t100755000764000764 10042212145027551 15440 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!/usr/bin/perl -w use strict; use Test::More tests => 248; BEGIN { use_ok( 'Test::LectroTest::Generator', qw(:common :combinators) ) } =head1 NAME gens.t - Unit tests for Test::LectroTest::Generator =head1 SYNOPSIS perl -Ilib t/gens.t =head1 DESCRIPTION B This test suite relies upon a number of randomized tests and statistical inferences. As a result, there is a small probability (about 1 in 200) that some part of the suite will fail even if everything is working properly. Therefore, if a test fails, re-run the test suite to determine whether the supposed problem is real or just a rare instance of the Fates poking fun at you. This documentation is written mainly for programmers who maintain the test suite. If you are an end user of the LectroTest modules, you can stop reading now because otherwise you will be bored to tears. =cut # set up warning net for errors in this test suite BEGIN { no warnings 'redefine'; my $ok = \&Test::Builder::ok; *Test::Builder::ok = sub { (my $r = $ok->(@_)) || emit_warning(); $r }; } sub emit_warning { Test::Builder->new->diag(<isa('Test::LectroTest::Generator'), "$_ ctor returns a Test::LectroTest::Generator"); } #============================================================================== #============================================================================== #============================================================================== # Helpers sub clipped_triangle_mean($$$) { my ($m,$s,$n) = @_; my $bot = max($m,$s); my $mfrac = max(($m-$s)/($n-$s+1),0); return $m + (1-$mfrac) * (($bot-$m)/2+($n-$bot)/4); } sub max { my $max; foreach (@_) { $max = $_ if !defined($max) || $_ > $max; } $max; } #============================================================================== #============================================================================== #============================================================================== =head1 Generator tests Here we test the generators. We perform the following tests. =cut #============================================================================== =pod =head2 Bool The Bool distribution is really an Int distribution over the range [0,1]. Therefore, we make sure that it has a mean of 0.5. =cut dist_mean_ok("Bool", Bool, [1..$tsize], sub{$_[0]}, 0.5); #============================================================================== =pod =head2 Char The Char distribution should return only the characters in the set we give it, and all of the characters in the set should be possible output values. First, we test to see that a trivial Char generator for a single character always returns that character. =cut { my $gstr = 'Char(charset=>"x")'; my $gen = eval $gstr; my @vals = map {$gen->generate($_)} 1..1000; is( scalar( grep { $_ eq "x" } @vals ), 1000, "$gstr generates only 'x' values" ); } =pod Next, we make sure that a Char generator with a ten-character range generates all ten characters and does so with equal probability. =cut { my $gstr = 'Char(charset=>"a-j")'; my $gen = eval $gstr; complete_and_uniform_ok($gen, $gstr, ["a".."j"]); } =pod Next, we run a few tests to make sure that the parser for character set specifications work. We try the following: "a", "-", "a-a", "-a", "a-", "aA-C", "A-Ca": =cut # cset-spec expected charset for ( ["a" ,"a" ], ["-" ,"-" ], ["a-a" ,"a" ], ["-a" ,"-a" ], ["a-" ,"-a" ], ["aA-C" ,"ABCa" ], ["A-Ca" ,"ABCa" ], ["X-YaA-C" ,"ABCXYa" ], ["A-CaX-Y" ,"ABCXYa" ], ) { my ($cspec, $expected) = @$_; my @expected = split //, $expected; my $gstr = "Char(charset=>'$cspec')"; my $gen = eval $gstr; my @got = map { $gen->generate } 1..10_000; @got = sort keys %{{ map {($_,1)} @got }}; # uniq my $got = join '', @got; is ($got, $expected, "$gstr generated the char set '$expected'"); } #============================================================================== =pod =head2 Elements and OneOf The Elements tests indirectly test OneOf, upon which the Elements generator is built. We ensure that the Elements distribution is complete and uniform. =cut for ([0..9],["a".."j"]) { my $g = Elements(@$_); complete_and_uniform_ok($g, "Elements(@$_)", $_); } =pod We must also test the pre-flight check. =cut like( eval { Elements() } || $@, qr/must be.*at least one element/, "pre-flight: Elements() caught" ); #============================================================================== =pod =head2 Float The Float tests are modeled after the Int tests, but there are subtle differences in order to accomodate the differences between the underlying generators. In particular, Float has an (approximately) continuous distribution whereas Int has a discrete distribution. First, we test seven Float generators having ranges 201 wide and centered around -300, -200, ... 200, 300. The generators are unsized (B0>) and thus should have means at the range centers. =cut for (-3..3) { my $center = $_ * 100; my ($m,$n) = ($center-100, $center+100); dist_mean_ok("Float(sized=>0,range=>[$m,$n])", Float(sized=>0,range=>[$m,$n]), [1..$tsize],sub{$_[0]}, $center); } =pod Second, we test five more Float generators having ranges from [0,$span] where $span becomes increasingly large, finally equaling the configuration parameter $tsize. These generators are sized, and so we would expect the mean of their distributions to be equal to a weighted average of X1 and X2, where X1 is the mean of the equivalent un-sized distribution, and X2 is half of the mean of the sizing guidance over the range of values for which the sizing constrains the range. =cut for (1..5) { my $span = $_ * $tsize/5; # Weights Means my $expected_mean = (($tsize-$span)/$tsize)* ($span/2) # X1 + ($span/$tsize) * ($span/4); # X2 dist_mean_ok("Float(sized=>1,range=>[0,$span])", Float(sized=>1,range=>[0,$span]), [0..$tsize],sub{$_[0]}, $expected_mean); } =pod Third, we repeat the above test, this time using balanced ranges [-$span,$span] for the same increasing progression of $span values. Because the range is balanced, as is the effect of sizing, the mean of the distributions must be zero. =cut for (1..5) { my $span = $_ * $tsize/5; dist_mean_ok("Float(sized=>1,range=>[-$span,$span])", Float(sized=>1,range=>[-$span,$span]), [0..$tsize],sub{$_[0]}, 0); } =pod Fourth, we run a series of unsized tests over 3-element ranges near zero. Because the ranges are so small, we expect that if there were off-by-one errors in the code, they would stand out here. =cut for (-3..3) { my ($m,$n) = ($_-1,$_+1); dist_mean_ok("Float(sized=>0,range=>[$m,$n])", Float(sized=>0,range=>[$m,$n]), [0..$tsize],sub{$_[0]}, $_); } =pod Fifth, we make sure that LectroTest prevents us from providing an empty range. =cut for ( 'Float(range=>[1,0])', 'Float(range=>[0,-1])' ) { like( eval $_ || $@, qr/is empty/, "$_ is caught as an empty range" ); } for ( 'Float(range=>[0,0])' ) { isa_ok( eval $_, 'Test::LectroTest::Generator', "$_ is not wrongly caught as empty / " ); } =pod Sixth, we test the case where the generator is called without sizing guidance. In this case the full range is used. =cut for (-3..3) { my ($m,$n) = ($_ - 4, $_ + 4); my $g = Sized { undef } Float(range=>[$m,$n]); dist_mean_ok("Sized{undef} Float(range=>[$m,$n])", $g, [(undef)x$tsize], sub{$_[0]}, $_); } =pod Finally, we make sure that LectroTest prevents us from using a sized generator with a given range that does not contain zero. =cut for ( 'Float(range=>[-10,-1])', 'Float(range=>[1,10])' ) { like( eval $_ || $@, qr/does not contain zero/, "$_ is caught as incompatible with sizing" ); } for ( 'Float(range=>[-10,0])', 'Float(range=>[0,10])', 'Float' ) { isa_ok( eval $_, 'Test::LectroTest::Generator', "$_ is not wrongly caught as incompatible with sizing /" ); } #============================================================================== #============================================================================== =pod =head2 Int We must test Int hardcore because it is the generator upon which most others are built. First, we test seven Int generators having ranges ten elements wide and centered around -3000, -2000, ... 2000, 3000. We ensure that each of the generators is complete and uniformly distributed. =cut for (-3..3) { my $center = $_ * 1_000; my ($m,$n) = ($center-5, $center+4); my $g = Int(sized=>0,range=>[$m,$n]); complete_and_uniform_ok($g, "Int(sized=>0,range=>[$m,$n])",[$m..$n]); } =pod Second, we test seven more Int generators having ranges 201 elements wide and centered around -300, -200, ... 200, 300. The generators are unsized (B0>) and thus should have means at the range centers. =cut for (-3..3) { my $center = $_ * 100; my ($m,$n) = ($center-100, $center+100); dist_mean_ok("Int(sized=>0,range=>[$m,$n])", Int(sized=>0,range=>[$m,$n]), [1..$tsize],sub{$_[0]}, $center); } =pod Third, we test five more Int generators having ranges from [0,$span] where $span becomes increasingly large, finally equaling the configuration parameter $tsize. These generators are sized, and so we would expect the mean of their distributions to be equal to a weighted average of X1 and X2, where X1 is the mean of the equivalent un-sized distribution, and X2 is half of the mean of the sizing guidance over the range of values for which the sizing constrains the range. =cut for (1..5) { my $span = $_ * $tsize/5; # Weights Means my $expected_mean = (($tsize-$span)/$tsize)* ($span/2) # X1 + ($span/$tsize) * ($span/4); # X2 dist_mean_ok("Int(sized=>1,range=>[0,$span])", Int(sized=>1,range=>[0,$span]), [0..$tsize],sub{$_[0]}, $expected_mean); } =pod Fourth, we repeat the above test, this time using balanced ranges [-$span,$span] for the same increasing progression of $span values. Because the range is balanced, as is the effect of sizing, the mean of the distributions must be zero. =cut for (1..5) { my $span = $_ * $tsize/5; dist_mean_ok("Int(sized=>1,range=>[-$span,$span])", Int(sized=>1,range=>[-$span,$span]), [0..$tsize],sub{$_[0]}, 0); } =pod Fifth, we run a series of unsized tests over 3-element ranges near zero. Because the ranges are so small, we expect that if there were off-by-one errors in the code, they would stand out here. =cut for (-3..3) { my ($m,$n) = ($_-1,$_+1); dist_mean_ok("Int(sized=>0,range=>[$m,$n])", Int(sized=>0,range=>[$m,$n]), [0..$tsize],sub{$_[0]}, $_); } =pod Sixth, we make sure that LectroTest prevents us from providing an empty range. =cut for ( 'Int(range=>[1,0])', 'Int(range=>[0,-1])' ) { like( eval $_ || $@, qr/is empty/, "$_ is caught as an empty range" ); } for ( 'Int(range=>[0,0])' ) { isa_ok( eval $_, 'Test::LectroTest::Generator', "$_ is not wrongly caught as empty / " ); } =pod Seventh, we test the case where the generator is called without sizing guidance. In this case the full range is used. =cut for (-3..3) { my ($m,$n) = ($_ - 5, $_ + 4); my $g = Sized { undef } Int(range=>[$m,$n]); complete_and_uniform_ok($g, "Sized{undef} Int(range=>[$m,$n])",[$m..$n]); } =pod Finally, we make sure that LectroTest prevents us from using a sized generator with a given range that does not contain zero. =cut for ( 'Int(range=>[-10,-1])', 'Int(range=>[1,10])' ) { like( eval $_ || $@, qr/does not contain zero/, "$_ is caught as incompatible with sizing" ); } for ( 'Int(range=>[-10,0])', 'Int(range=>[0,10])', 'Int' ) { isa_ok( eval $_, 'Test::LectroTest::Generator', "$_ is not wrongly caught as incompatible with sizing /" ); } #============================================================================== =pod =head2 Hash Hash is a thin wrapper around List and so we need only a few Hash-specific tests to get good coverage. =cut for( 'Unit(0),Unit(1) {0=>1}', 'Int(range=>[0,5],sized=>0),Unit(1),length=>1000 {0=>1,1=>1,2=>1,3=>1,4=>1,5=>1}' ) { my ($hash_args, $expected) = split ' ', $_, 2; my $gen_spec = "Hash($hash_args)"; is_deeply( (eval $gen_spec)->generate(1000), eval $expected, "$gen_spec gens $expected"); } =pod Still, we need to test the pre-flight checks. =cut like( eval { Hash(Int) } || $@, qr/requires two/, "pre-flight: Hash(Int) caught" ); #============================================================================== =pod =head2 List We consider four test cases to determine whether List respects its B modifier. First, we test the default list generation method, where list length is constrained only by the sizing guidance. For sizing guidance in [1..I], the expected mean generated list length is (1+I)/4. =cut { my $gstr = "List(Unit(1))"; my $gen = eval $gstr; for (1,5,10,25) { dist_mean_ok( "$gstr elem length under sizing [1..$_]", $gen, [(1..$_)x($tsize/$_)], sub { scalar @{$_[0]} }, (1+$_)/4 ); } } =pod Second, we test the B>I variant. It should generate lists whose length always equals I. =cut { for my $len (0..3) { my $gstr = "List(Unit('x'),length=>$len)"; my $gen = eval $gstr; my @vals = map {$gen->generate($_)} 1..$tsize; is( scalar ( grep { $len == grep {'x' eq $_} @$_ } @vals ), $tsize, "All lists from $gstr are [('x')x$len]" ); } } =pod Third, we test the B>[I,] variant. For sizing guidance in [I..I], the expected mean of the distribution is given by the formula in the helper function C(I,I,I). (Note that when I=0 this case is equivalent to the first case.) =cut { for my $s (0,1,2) { for ([0,5],[1,5],[4,5],[5,10]) { my ($m,$n) = @$_; my $gstr = "List(Unit('x'),length=>[$m,])"; my $gen = eval $gstr; dist_mean_ok("$gstr elem length under sizing [$s..$n]", $gen, [($s..$n)x($tsize/$n)], sub { scalar @{$_[0]} }, clipped_triangle_mean($m,$s,$n)); } } } =pod Fourth, we test the B>[I,I] variant. The expected mean generated list length is (I+I)/2, regardless of sizing guidance (which should be ignored in this case). =cut for (0..3) { $_ *= 10; my ($m,$n) = ($_,$_+9); my $gstr = "List(Unit('x'),length=>[$m,$n])"; my $gen = eval $gstr; dist_mean_ok("$gstr elem length", $gen, [0..$tsize], sub { scalar @{$_[0]} }, ($m+$n)/2 ); } =pod Fifth, we check to see if List's pre-flight checks catch common problems. =cut like( eval { List(Int,length=>-1) } || $@, qr/length.*< 0/, "pre-flight: List(length=>-1) caught" ); like( eval { List(Int,length=>[-1]) } || $@, qr/length.*< 0/, "pre-flight: List(length=>[-1,]) caught" ); like( eval { List(Int,length=>[-1,0]) } || $@, qr/length.*invalid/, "pre-flight: List(length=>[-1,0]) caught" ); like( eval { List(Int,length=>[1,0]) } || $@, qr/length.*invalid/, "pre-flight: List(length=>[1,0]) caught" ); for ("[]", "[0,1,2]", "{1=>1}") { like( eval "List(Int,length=>$_)" || $@, qr/length spec.*bad/, "pre-flight: List(length=>$_) caught" ); } #============================================================================== =pod =head2 String We consider four test cases to determine whether String respects its B modifier. These test cases are nearly identical to the four cases for the List generator. Because String is built on List, these tests are mostly redundant. However, it is a good idea to have them anyway because it frees us to change the implementation. First, we test the default string generation method, where string length is constrained only by the sizing guidance. For sizing guidance in [1..I], the expected mean generated string length is (1+I)/4. =cut { my $gstr = "String()"; my $gen = eval $gstr; for (1,5,10,25) { dist_mean_ok( "$gstr length under sizing [1..$_]", $gen, [(1..$_)x($tsize/$_)], sub { length $_[0] }, (1+$_)/4 ); } } =pod Second, we test the B>I variant. It should generate strings whose length always equals I. =cut { for my $len (0..3) { my $gstr = "String(charset=>'x',length=>$len)"; my $gen = eval $gstr; my @vals = map {$gen->generate($_)} 1..$tsize; is( scalar ( grep { $_ eq "x"x$len } @vals ), $tsize, "All strings from $gstr are '" . ("x"x$len) . "'" ); } } =pod Third, we test the B>[I,] variant. For sizing guidance in [I..I] we have the expected mean of the distribution is given by the formula in the helper function C(I,I,I). (Note that when I=0, this test case is equivalent to the first.) =cut { for my $s (0,1,2) { for ([0,5],[1,5],[4,5],[5,10]) { my ($m,$n) = @$_; my $gstr = "String(length=>[$m,])"; my $gen = eval $gstr; dist_mean_ok("$gstr length under sizing [$s..$n]", $gen, [($s..$n)x($tsize/$n)], sub { length $_[0] }, clipped_triangle_mean($m,$s,$n)); } } } =pod Fourth, we test the B>[I,I] variant. The expected mean generated string length is (I+I)/2, regardless of sizing guidance (which should be ignored in this case). =cut for (0..3) { $_ *= 10; my ($m,$n) = ($_,$_+9); my $gstr = "String(length=>[$m,$n])"; my $gen = eval $gstr; dist_mean_ok("$gstr elem length", $gen, [0..$tsize], sub { length $_[0] }, ($m+$n)/2 ); } #============================================================================== =pod =head2 Unit The Unit generator is simple and always returns the same value. So we test it with three values: "a", 1, and 0.334. =cut for (qw|"a" 1 0.334|) { my $v = eval $_; ok(Unit($v)->generate eq $v, "Unit($_)->generate eq $_"); } #============================================================================== #============================================================================== #============================================================================== =head1 Combinator tests Here we test the combinators. We perform the following tests. =cut #============================================================================== =head2 Frequency We provide two tests of the Frequency combinator. First, we make sure that when all of the frequencies are identical the resulting distribution is complete and uniform. In effect, Frequency behaves like Elements for this case. =cut for ([0..9],["a".."j"]) { my $g = Frequency( map {[1,Unit($_)]} @$_ ); complete_and_uniform_ok($g, "Frequency(all freqs = 1, @$_)", $_); } =pod Second, we test that the frequencies are actually respected. When a sub-generator has a zero frequency, it should never be selected. We test this by creating a "yes" generator with frequency 1 and a "no" generator with frequency 0. We make sure that the combined Frequency generator generates only "yes" values. We run two variants of this test, one for each ordering of the two sub-generators. =cut for ('([[0,Unit("no")],[1,Unit("yes")]])', '([[1,Unit("yes")],[0,Unit("no")]])') { my $g = Frequency( @{eval $_} ); my @yesses = grep { $_ eq "yes" } map {$g->generate} 1..1000; is(scalar @yesses, 1000, "Frequency$_ generates only 'yes'"); } =pod Third, we check to make sure the pre-flight checks catch bad arguments. =cut like( eval { Frequency() } || $@, qr/at least one frequency/, "pre-flight: Frequency() caught" ); like( eval { Frequency([0,Bool]) } || $@, qr/at least one frequency.*greater than zero/, "pre-flight: Frequency([0,Bool]) caught" ); like( eval { Frequency([1,Bool],[-1,Bool]) } || $@, qr/non-negative/, "pre-flight: Frequency([1,Bool],[-1,Bool]) caught" ); #============================================================================== =pod =head2 Paste To test the Paste generator, we create six Unit generators that return, respectively, the values "a".."f". Then we combine them in two ways via Paste combinators. The first does not use glue and thus should always generate "abcdef". The second uses the glue "-" and thus should always generate "a-b-c-d-e-f". =cut { my @gens = map {Unit($_)} "a".."f"; is(Paste(@gens)->generate, "abcdef", "Paste w/o glue as expected"); is(Paste(@gens,glue=>'-')->generate, "a-b-c-d-e-f", "Paste w/ glue as expected"); } =pod We also test to see that Paste handles Lists properly. It should concatenate the elements of all Lists and then paste them together with the other arguments. =cut { my $lgen0 = List( Unit(1), length=>0 ); my $lgen4 = List( Unit(1), length=>4 ); is(Paste($lgen0)->generate(5), "", "Paste([empty]) => empty str"); is(Paste($lgen4)->generate(5), "1111", "Paste([1,1,1,1]) => '1111'"); is(Paste(Unit(0),$lgen0,Unit(2))->generate(5), "02", "Paste(0,[],2) => '02'"); is(Paste(Unit(0),$lgen4,Unit(2))->generate(5), "011112", "Paste(0,[1,1,1,1],2) => '011112'"); } #============================================================================== =pod =head2 Sized We run two tests for the Sized combinator. First, we apply the constant-sizing C combinator to a sized-Int generator over the range[-1,100]. If the combinator works properly, the sizing guidance passed to the Int generator will always be one, effectively clipping its range to [-1,1]. Thus we test that the mean of the resulting distribution is 0. =cut { # const sizing of 1 should clip range to [-1,1]; # thus, w/ uniform distribution, mean = 0 my $gstr = 'Sized{1}(Int(sized=>1,range=>[-1,100]))'; my $gen = eval $gstr; dist_mean_ok($gstr, $gen, [1..200],sub{$_[0]}, 0); } =pod Second, we apply a "size-halving" combinator C to the same Int generator as before and draw values from the combined generator for sizing values ranging from [1..200]. We expect the mean of the distribution of generated values should be equal to (-1 + 100) / 4. =cut { # halving sizing should clip range to [-1,h] where h varies from # [1/2,100] linearly; thus dist forms a triangle w/ peak height at # 200/2 = 100 and has mean of (-1 + 100) / 4 = 24.75. my $gstr = 'Sized{$_[0]/2}(Int(sized=>1,range=>[-1,100]))'; my $gen = eval $gstr; dist_mean_ok($gstr, $gen, [1..200],sub{$_[0]}, (-1 + 100) / 4); } #============================================================================== =pod =head2 Each The Each combinator is just a wrapper around List, so the tests for it are simple. =cut for ( 'Each(Unit(1),Unit(2),Unit(3))' ) { my $g = eval $_; is_deeply( $g->generate(1), [1,2,3], "$_ generates [1,2,3]" ); } #============================================================================== =pod =head2 Apply Apply, in turn, is built upon Each, so we just make sure that it gets its own additional functionality right. =cut for ( 'Apply(sub{join"/",@_},Unit(1),Unit(2),Unit(3))' ) { my $g = eval $_; is( $g->generate(1), "1/2/3", "$_ generates 1/2/3" ); } #============================================================================== =pod =head2 Map Map is also built upon Each. Again, we just make sure it adds the correct twist. =cut for ( ['(Map {"x" x $_[0]} Unit(1),Unit(2))', '["x","xx"]'] ) { my ($gstr, $expected) = @$_; my $g = eval $gstr || die $@; is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" ); } #============================================================================== =pod =head2 Concat Testing Concat is straightforward. We just feed it a few list generators and make sure it returns the right thing. =cut for ( ['Concat', '[]'] , ['Concat(List(Int,length=>0))', '[]'] , ['Concat(Unit("a"))', '["a"]'] , ['Concat(Unit("a"),List(Int,length=>0))', '["a"]'] , ['Concat(List(Int,length=>0))', '[]'] , ['Concat(List(Unit([1]),length=>1))', '[[1]]'] , ['Concat(List(Unit(1),length=>2))', '[1,1]'] , ['Concat(List(Unit(1),length=>2),List(Unit([2]),length=>1))' ,'[1,1,[2]]'] ) { my ($gstr, $expected) = @$_; my $g = eval $gstr || die $@; is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" ); } =cut #============================================================================== =pod =head2 Flatten Testing Flatten is like Concat, except here we must make sure that the resulting list does not contain any other lists. =cut for ( ['Flatten', '[]'] , ['Flatten(Unit([[[[[[[]]]]]]]))', '[]'] , ['Flatten(Unit("a"))', '["a"]'] , ['Flatten(Unit("a"),List(Int,length=>0))', '["a"]'] , ['Flatten(List(Int,length=>0))', '[]'] , ['Flatten(List(Unit([9]),length=>1))', '[9]'] , ['Flatten(List(Unit(9),length=>2))', '[9,9]'] , ['Flatten(List(Unit(9),length=>2),List(Unit([2]),length=>1))' ,'[9,9,2]'] ) { my ($gstr, $expected) = @$_; my $g = eval $gstr || die $@; is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" ); } =cut #============================================================================== =pod =head2 ConcatMap Testing ConcatMap is like testing Concat and Map together. (Who would have guessed?) =cut for ( ['ConcatMap{}', '[]'] , ['ConcatMap{1}Unit(2)', '[1]'] , ['ConcatMap{[1]}Unit(2)', '[1]'] , ['ConcatMap{[@_]}Each(Unit(2),Unit(3))', '[[2,3]]'] , ['ConcatMap{[@_]}Unit(2),Unit(3)', '[2,3]'] , ['ConcatMap{my($a)=@_;$a%2?[$a]:[]}Unit(1),Unit(2),Unit(3)', '[1,3]'] ) { my ($gstr, $expected) = @$_; my $g = eval $gstr || die $@; is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" ); } #============================================================================== =pod =head2 FlattenMap Can you see where this is going? FlattenMap is just like Flatten and Map, together as best friends. =cut for ( ['FlattenMap{}', '[]'] , ['FlattenMap{9}Unit(2)', '[9]'] , ['FlattenMap{[8]}Unit(2)', '[8]'] , ['FlattenMap{[[7]]}Unit(2)', '[7]'] , ['FlattenMap{[@_]}Each(Unit(2),Unit(3))', '[2,3]'] , ['FlattenMap{[@_]}Unit(2),Unit([3])', '[2,3]'] , ['FlattenMap{[[[[[9]]]]]}Unit(2),Unit([3])', '[9,9]'] , ['FlattenMap{my($a)=@_;$a%2?[$a]:[]}Unit(9),Unit(2),Unit(3)', '[9,3]'] ) { my ($gstr, $expected) = @$_; my $g = eval $gstr || die $@; is_deeply( $g->generate(1), eval $expected, "$gstr generates $expected" ); } =cut #============================================================================== #============================================================================== #============================================================================== # More helpers =head1 Helper functions The test suite relies upon a few helper functions. =head2 sample_distribution_z_score This function takes an expected mean and a set of data values. It analyzes the data set to determine its mean M and standard deviation. Then it computes a z-score for the hypothesis that M is equal to the expected mean. The return value is the z-score. =cut sub sample_distribution_z_score { my ($expected_mean, $data) = @_; my ($sum, $ssq, $count) = (0, 0, scalar @$data); $sum += $_, $ssq += $_**2 for @$data; my $mean = $sum/$count; my $numer = $ssq + $count * $mean**2 - 2 * $mean * $sum; my $s2 = $numer / ($count - 1); my $stdev = sqrt $s2; my $sampdev = $stdev / sqrt($count); my $z_score = ($mean - $expected_mean) / $sampdev; return $z_score; } =pod =head2 dist_mean_ok This function is used to determine if the mean of the distribution of values returned by a generator is equal to the expected mean. The generator is asked to generate one value for each element of sizing guidance given. The resulting values are passed through the given $numerizer function to convert them into numbers (useful if you are testing a String or Char generator). The name you are giving to the whole mean test should be passed in $name. This is passed to the Test::More C function which records the result of the test. =cut sub dist_mean_ok { my ($name, $gen, $sizes, $numerizer, $expected_mean) = @_; my @data = map { $numerizer->($gen->generate($_)) } @$sizes; my $z = sample_distribution_z_score($expected_mean, \@data); cmp_ok(abs($z), '<', 3.89, # w/in 99.99% confidence interval sprintf "$name dist mean is $expected_mean (z-score = %.2f)", $z); } =pod =head2 complete_and_uniform_ok This function determines whether the given generator $g returns values that are uniformly distributed across the complete range of values it is supposed to cover. In order for this test to function properly the generator must be designed to select from among ten distinct values. (E.g., Int(range=>[0,9]) is fine but not Int(range=>[1,100]).) The test draws 10,000 output values from the generator and then ensures that all ten @$expected_values are represented in the output and that all ten were selected with equal probability. The result of the test is reported via the Test::More C function. =cut sub complete_and_uniform_ok { my ($g, $dist_name, $expected_values) = @_; die unless @$expected_values == 10; my %counts; $counts{$_}++ for map { $g->generate } 1..10_000; my $test = 0; # assume failure foreach my $count (values %counts) { # if the distribution is uniform, the following # test will succeed with 99.997 percent probability $test = 875 <= $count && $count <= 1125; last unless $test; } ok($test && grep(defined,@counts{@$expected_values}) == 10, "$dist_name is complete and uniformly distributed"); } =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 COPYRIGHT and LICENSE Copyright (C) 2004 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. META.yml100644000764000764 116212145027551 15263 0ustar00thorthor000000000000Test-LectroTest-0.5001--- abstract: 'Easy, automatic, specification-based tests' author: - 'Tom Moertel ' build_requires: File::Temp: 0 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.30 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.300023, CPAN::Meta::Converter version 2.120921' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Test-LectroTest requires: Carp: 0 Class::Struct: 0 Data::Dumper: 0 Exporter: 0 Filter::Util::Call: 0 POSIX: 0 Scalar::Util: 0 Test::Builder: 0 constant: 0 strict: 0 warnings: 0 version: 0.5001 MANIFEST100644000764000764 114612145027551 15145 0ustar00thorthor000000000000Test-LectroTest-0.5001Changes LICENSE MANIFEST MANIFEST.SKIP META.yml Makefile.PL README THANKS TODO buildrpm checkpods dist.ini lib/Test/LectroTest.pm lib/Test/LectroTest/Compat.pm lib/Test/LectroTest/FailureRecorder.pm lib/Test/LectroTest/Generator.pm lib/Test/LectroTest/Property.pm lib/Test/LectroTest/RegressionTesting.pod lib/Test/LectroTest/TestRunner.pm lib/Test/LectroTest/Tutorial.pod posts/perlmonks/testing-tutorial.html t/compat.t t/docs-eg.t t/gens.t t/harness.t t/lib/CaptureOutput.pm t/pod-coverage.t t/pod.t t/props.t t/props2.t t/recorder.t t/release-pod-coverage.t t/release-pod-syntax.t t/runner.t tex/titlepage.ltx checkpods100755000764000764 13012145027551 15655 0ustar00thorthor000000000000Test-LectroTest-0.5001#!/bin/bash find t lib -name '*.pm' -o -name '*.pod' -o -name '*.t' | xargs podchecker props.t100755000764000764 266112145027551 15615 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#! perl # the following tests exercise properties # within the default LT harness use Test::LectroTest trials => 10; my $intgen = Int; Property { ##[ ]## 1; }, name => "0-arg always succeeds" ; Property { ##[ #]## 1; }, name => "0-arg, alt-syntax always succeeds" ; Property { ##[ x <- $intgen ]## $tcon->label("negative") if $x < 0; $tcon->label("odd") if $x % 2; 1; }, name => "1-arg always succeeds (labels, too)" ; Property { ##[ x <- $intgen #]## 1; }, name => "1-arg, alt-syntax always succeeds" ; Property { ##[ x <- $intgen # ]## 1; }, name => "1-arg, alt2-syntax always succeeds" ; Property { ##[ x <- $intgen ####]## 1; }, name => "1-arg, alt3-syntax always succeeds" ; Property { ##[ x <- $intgen #### ]## 1; }, name => "1-arg, alt4-syntax always succeeds" ; Property { ##[ x <- Float, y <- Int ]## 1; }, name => "2-arg always succeeds" ; Property { ##[ x <- Unit(1), a <- Unit(2), c <- Unit(3), y <-Unit(4) ]## $x == 1 && $a == 2 && $c == 3 && $y == 4; }, name => "argument order is preserved"; Property { ##[ r <- Unit(1), a <- Unit(2), w <- Unit(3), t <-Unit(4) ]## $r == 1 && $a == 2 && $w == 3 && $t == 4; }, name => "argument order is preserved (2)"; Property { ##[ f <- Float ]## $tcon->dump( $f, "f" ) == $f; }, name => "tcon->dump returns its value arg as its result"; props2.t100755000764000764 573712145027551 15706 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!/usr/bin/perl use warnings; use strict; use Test::LectroTest::Generator ':all'; use Test::LectroTest::Property; use Test::More tests => 12; =head1 NAME t/props2.t - Additional property checks =head1 SYNOPSIS perl -Ilib t/props2.t =head1 DESCRIPTION These checks are designed to exercise Properties independent of a test harness. First, we see whether LectroTest::Property prevents you from using the reserved identifier "tcon" in a generator-binding declaration. =cut eval { Property { [ tcon => 1 ] } sub { 1; } }; like($@, qr/cannot use reserved name 'tcon' in a generator binding/, "Property->new disallows use of 'tcon' in bindings"); eval { Property { ##[ tcon <- 1 ]## 1; } }; like($@, qr/cannot use reserved name 'tcon' in a generator binding/, "magic Property syntax disallows use of 'tcon' in bindings"); =pod Second, we check to see if C catches and complains about bad arguments in its pre-flight checks: =cut eval { Test::LectroTest::Property->new(); }; like( $@, qr/test subroutine must be provided/, "pre-flight: new w/ no args" ); eval { Test::LectroTest::Property->new('inputs'); }; like( $@, qr/invalid list of named parameters/, "pre-flight: unbalanced arguments list" ); eval { Test::LectroTest::Property->new(inputs=>[]); }; like( $@, qr/test subroutine must be provided/, "pre-flight: new w/o test sub" ); eval { Property { ##[ x <- Unit(0)], [ ]## 1 } }; like( $@, qr/\(\) does not match \(x\)/, "pre-flight: sets of bindings must have same vars (x) vs ()" ); eval { Property { ##[ x <- Unit(0)], [ y <- Unit(0) ]## 1 } }; like( $@, qr/\(y\) does not match \(x\)/, "pre-flight: sets of bindings must have same vars (x) vs (y)" ); eval { Property { ##[ x <- Unit(0)], [ x <- Unit(0) ], [ ]## 1 } }; like( $@, qr/\(\) does not match \(x\)/, "pre-flight: sets of bindings must have same vars (x) vs (x) vs ()" ); eval { Property { ##[ x <- Unit(0), 1 ]## 1 } }; like( $@, qr/did not get a set of valid input-generator bindings/, "pre-flight: odd params in binding is caught" ); like( eval { Test::LectroTest::Property->new( inputs => [] ) } || $@, qr/test subroutine must be provided/, "pre-flight: no test subroutine" ); like( eval { Test::LectroTest::Property->new(inputs=>{1,1}, test=>sub{}) } || $@, qr/did not get a set of valid input-generator bindings/, "pre-flight: invalid set of generator bindings" ); like( eval { Test::LectroTest::Property->new(inputs=>[{1,1}], test=>sub{}) } || $@, qr/did not get a set of valid input-generator bindings/, "pre-flight: invalid inner set of generator bindings" ); =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 COPYRIGHT and LICENSE Copyright (C) 2004 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. runner.t100755000764000764 2334212145027551 16002 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!/usr/bin/perl use warnings; use strict; use File::Temp; use Test::More tests => 28; use Test::LectroTest::Generator ':all'; use Test::LectroTest::Property; use Test::LectroTest::TestRunner; BEGIN { unshift @INC, 't/lib'; } use CaptureOutput; =head1 NAME t/runner.t - tests for Property and TestRunner =head1 SYNOPSIS perl -Ilib t/runner.t =head1 DESCRIPTION This test suite excercises Property and TestRunner, which work hand in hand. =head2 SET UP First, we declare a few helper functions. =cut sub check($@) { my $property = shift; my $runner = Test::LectroTest::TestRunner->new( @_ ); my $details = $runner->run( $property )->details; return $details; } =pod Next, we declare a few simple properties to check. =cut my $except_gen = Gen { die "gen go boom!" }; my $null_1gens = Property { ##[ ]## 1 }; my $null_2gens = Property { ##[ ], [ ]## 1 }; my $null_retry = Property { ##[ ]## $tcon->retry }; my $except_prop1 = Property { ##[ ]## die "prop go boom!" }; my $except_prop2 = Property { ##[ x <- $except_gen ]## 1 }; my $except_prop3 = Property { ##[ x <- Int ], [ x <- $except_gen ]## 1 }; my $ex_retry = Property { ##[ x <- Int ], [ x <- $except_gen ]## $tcon->retry }; =pod =head2 TRIALS Some tests to see if the C control knob is working. =cut like( check( $null_1gens, trials => 1 ), qr/^ok.*1 attempts/, "1 gen set + trials=>1 --> 1 trial" ); like( check( $null_2gens, trials => 1 ), qr/^ok.*2 attempts/, "2 gen set + trials=>1 --> 2 trials" ); =pod =head2 RETRIES Some tests to see if the C control knob is working. =cut # should not finish the first trial but abort after 10 retries like( check( $null_retry, trials => 1, retries => 10 ), qr/^not ok.*incomplete/, "retry-always prop --> incomplete" ); # we should exhaust all of our retries on the first property check # (using the first set of bindings) and never get to the second, which # uses a generator that will throw an exception; therefore the # check should be marked "incomplete" like( check( $ex_retry, trials => 1, retries => 10 ), qr/^not ok.*incomplete/, "retry before exception prop --> incomplete" ); =pod =head2 EXCEPTION HANDLING Some tests to see if exceptions are caught and reported properly: =cut for (qw(1 2 3)) { my $prop_str = '$except_prop' . $_; my $prop = eval $prop_str or die "can't get $prop_str"; like( check( $prop, trials => 1, retries => 10), qr/^not ok.*exception/s, "$prop_str dies and is caught" ); } =pod =head2 LABELING Some tests to observe labeling properties. =cut unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->label(); 1 } ) , trials => 10 ) , qr/%/s, , "labeling every trial with an empty label yields no label output" ); like( check( ( Property { ##[ x <- Unit(0) ]## $tcon->label("all"); 1 } ) , trials => 10 ) , qr/^ok.*100% all/s, , "labeling every trial --> 100%" ); like( check( ( Property { ##[ x <- Unit(0) ], [ x <- Unit(1) ]## $tcon->label("odd") if $x; 1 } ) , trials => 10 ) , qr/^ok.*50% odd/s, , "labeling half of trials --> 50%" ); sub labler { my @labels = @_; my $count = 0; return Property { ##[ ]## $tcon->label( $labels[$count++] ); $count = 0 if $count == @labels; 1; }; } # the following test assumes that the number of trials # is a multiple of 4 like( check( labler(qw|a a a b|), trials => 1000 ), qr/ 75% a.*25% b/s, "75/25 labeling case checks" ); # the following test assumes that the number of trials # is a multiple of 10 like( check( labler(qw|a a a a a a a b b c|), trials => 1000), qr/ 70% a.*20% b.*10% c/s, "70/20/10 labeling case checks" ); my $trivial = Property { ##[ #]## $tcon->trivial; 1; }; like( check($trivial, trials => 100), qr/100% trivial/, "100% trivial labeling case checks" ); =pod =pod =head2 COUNTEREXAMPLE NOTES Now we check to see whether notes attached to a failing trial are emitted as part of a counterexample. =cut # notes should be emitted only when the property check fails unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->note("XXXX"); 1 } ) , trials => 10 ) , qr/XXXX/s, , "notes appear only when a check fails" ); unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->dump(0, "XXXX"); 1 } ) , trials => 10 ) , qr/XXXX/s, , "dump notes appear only when a check fails" ); # when the check fails, all notes must be emitted, in order unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->note(1,2,3,4,5); 0 } ) , trials => 10 ) , qr/Notes:\s+1\s+2\s+3\s+4\s+5/s, , "all notes are emitted, in order, when check fails" ); unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->dump("XXX", "x"); $tcon->dump("YYY", "y"); 0 } ) , trials => 10 ) , qr/Notes:\s+\$x = "XXX";\s+\$y = "YYY"/s, , "dump notes are emitted, in order, when check fails" ); unlike( check( ( Property { ##[ x <- Unit(0) ]## $tcon->dump("XXX"); $tcon->dump("YYY"); 0 } ) , trials => 10 ) , qr/Notes:\s+\$VAR1 = "XXX";\s+\$VAR2 = "YYY"/s, , "unnamed dump notes are emitted, in order, when check fails" ); =head2 SCALEFN Here we check to see whether our scaling function is being used. =cut my $gen_scale = Gen { $_[0] }; # return scaling guidance as gen'd value sub prop_scale($) { my $scale = shift; Property { ##[ x <- $gen_scale ]## $tcon->label("desired scale") if $x == $scale; 1 } } for (qw(0 1 10)) { my $scale = $_; like( check( prop_scale($_), scalefn => sub { $scale }, trials => 10 ) , qr/^ok.*100% desired scale/s, , "desired scale $_ --> 100%" ); } =pod =head2 TEST NUMBERING Here we see whether we can override the TestRunner's built in numbering. =cut like( Test::LectroTest::TestRunner->new->run($null_1gens, 123)->summary, qr/ok 123/, "TestRunner->run(x,N) respects given test number N" ); =pod =head2 VERBOSITY Now we check to see whether the verbosity indicator is respected. =cut # this sub captures the output for a suite of property checks for ([1, \&like, "does"], [0, \&unlike, "does not"]) { my ($verbose, $testfn, $does) = @$_; $testfn->( check_suite( verbose => $verbose, trials => 10, Property { ##[ x <- Unit(0) ]## $tcon->label("all"); 1 } ), , qr/%/s, , "verbose=>$verbose $does include label statistics" ); } for ([1, \&like, "does"], [0, \&unlike, "does not"]) { my ($verbose, $testfn, $does) = @$_; $testfn->( check_suite( verbose => $verbose, trials => 10, Property { ##[ x <- Unit(0) ]## $x > 0 } ), , qr/counterexample/i, , "verbose=>$verbose $does include counterexample" ); } =pod =head2 FAILURE RECORDING Now we check to see if we can record failures and play them back as regression tests. =cut { my $tmp = File::Temp->new(); my @vals; my $prop_fail = Property { ##[ x <- Int ]## push @vals, $x; 0 }; my $prop_succ = Property { ##[ x <- Int ]## push @vals, $x; 1 }; my $checkit = sub { my $prop = shift; check_suite(($prop) x 10, trials => 1, @_); }; # record ten failures into the regression file and save the # values of x for each in @vals $checkit->($prop_fail, record_failures => $tmp->filename); my @recorded_vals = @vals; @vals = (); # check ten successful properties using the regression file from # earlier; because these properties have the same name as the # failing properties checked above ("Unnamed"), the ten recorded # failure cases will be tried for each of these properties, in # addition to the one random case that would normally be tried # for each $checkit->($prop_succ, playback_failures => $tmp->filename); # now @vals should contain 10 played-back failues and 1 random # trial for *each* for the ten successful property checks; here we # remove the random-trial value for each property check so # that we may compare the played back recording to the original splice(@vals, 11 * $_ + 10, 1) for reverse 0..9; is_deeply( \@vals, [ (@recorded_vals) x 10 ], "recorded failures are played back as regression tests" ); my $prop_newname = Property { ##[ x <- Int ]## push @vals, $x; 1 }, name => "a new name"; @vals = (); $checkit->($prop_newname, playback_failures => $tmp->filename); is( scalar @vals, 10, "failures recorded for a different prop are ignored" ); } =pod =head2 HELPER FUNCTIONS The following helper checks the given properties as a suite and returns the test output as a string. =cut sub check_suite { my @props = grep is_prop($_), @_; my @opts = grep !is_prop($_), @_; my $recorder = capture(*STDOUT); Test::LectroTest::TestRunner->new(@opts)->run_suite(@props); return $recorder->(); } sub is_prop { ref $_[0] eq 'Test::LectroTest::Property'; } =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 COPYRIGHT and LICENSE Copyright (C) 2004 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. compat.t100755000764000764 256212145027551 15735 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!/usr/bin/perl -w use strict; use Test::LectroTest::Compat tests => 7; use Test::More; my $true = Property { ##[ ]## 1 }, name => "always succeeds"; my $false = Property { ##[ ]## 0 }, name => "always fails"; my $cmp_ok = Property { ##[ x <- Int( range=>[0,10] ) ]## cmp_ok($x, '>=', 0) && cmp_ok($x, '<=', 10); }, name => "cmp_ok can be used"; my $cmp_ok_fail = Property { ##[ x <- Int( range=>[0,10] ) ]## cmp_ok($x, '>', 10); }, name => "cmp_ok can be used (2)";; holds( $true, trials => 5 ); holds( $cmp_ok ); cmp_ok( 0, '<', 1, "trivial 0<1 test" ); holds( Property { ##[ ]## 1; }, name => "inline" ); cmp_ok( 0, '<', 1, "trivial 0<1 test" ); ok( ! capture( sub { holds( $false ) } ), "false property yields test failure" ); ok( ! capture( sub { holds( $cmp_ok_fail ) } ), "failing cmp_ok w/in prop yields test failure"); # the following function evaluates a given Test::* test (given as an # anonymous subroutine) within a protective environment that captures # the result of the test without reporting it back to Test::More # (which uses Test::Builder). this function is used to run tests that # we expect to fail sub capture { no warnings; no strict 'refs'; my $test_fn = shift; local *Test::Builder::ok = sub { $_[1] ? 1 : 0 }; local *Test::Builder::diag = sub { 0 }; return $test_fn->(); } harness.t100755000764000764 266212145027551 16116 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#! perl # Tom Moertel # Here we test the output and exit status of the Test::LectroTest # testing apparatus to make sure that they conform to the expectations # of Test::Harness. In particular the output should have an "ok" # for every successful test and a "not ok" line for every failure. # The exit status should be equal to the number of failures or # 254, whichever is least. use File::Temp 'tempfile'; use Test::More tests => 6; BEGIN { unshift @INC, 't/lib'; } use CaptureOutput; my $prop_success = "Property { ##[ ]## 1 };\n"; my $prop_failure = "Property { ##[ ]## 0 };\n"; for( [0,0,0], [0,1,1], [1,0,0], [1,1,1], [0,254,254], [0,300,254] ) { my ($s, $f) = @$_; # successes, failures, my $results = make_and_run_suite($s, $f); my $oks = grep 1, $results =~ /^ok/mg; my $noks = grep 1, $results =~ /^not ok/mg; my ($status) = $results =~ /^(.*)/; is_deeply( [$oks, $noks, $status], $_, "suite @$_" ); } sub make_and_run_suite { my ($successes, $failures) = @_; my ($fh, $fn) = tempfile() or die "can't open temp file: $!"; print $fh "use Test::LectroTest;\n", ($prop_success) x $successes, ($prop_failure) x $failures; close $fh or die "can't close temp file: $!"; my @cmd = ($^X, "-Ilib", $fn); my $recorder = capture(*STDOUT); my $exit_status = system(@cmd) >> 8; unlink $fn; return "$exit_status\n" . $recorder->(); } docs-eg.t100755000764000764 226512145027551 15773 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!/usr/bin/perl use warnings; use strict; use Test::LectroTest; =head1 NAME t/docs-eg.t - test cases for examples from documentation =head1 SYNOPSIS perl -Ilib t/docs-eg.t =head1 DESCRIPTION These test cases make sure that the examples in the documentation work. =head2 Examples from Property.pm =cut sub my_sqrt { sqrt($_[0]) } my $epsilon = 0.000_001; Property { ##[ x <- Float ]## return $tcon->retry if $x < 0; $tcon->label("less than 1") if $x < 1; my $sx = my_sqrt( $x ); abs($sx * $sx - $x) < $epsilon; }, name => "my_sqrt satisfies defn of square root"; sub my_thing_to_test { 1 } Property { ##[ i <- Int, delta <- Float(range=>[0,1]) ]## my $lo_val = my_thing_to_test($i); my $hi_val = my_thing_to_test($i + $delta); 1; }, name => "my_thing_to_test ignores fractions" ; { my $prop = Test::LectroTest::Property->new( inputs => [ i => Int, delta => Float(range=>[0,1]) ], test => sub { my ($tcon, $delta, $i) = @_; my $lo_val = my_thing_to_test($i); my $hi_val = my_thing_to_test($i + $delta); }, name => "my_thing_to_test ignores fractions" ) ; push @Test::LectroTest::props, $prop; } Makefile.PL100644000764000764 237412145027551 15772 0ustar00thorthor000000000000Test-LectroTest-0.5001 use strict; use warnings; use ExtUtils::MakeMaker 6.30; my %WriteMakefileArgs = ( "ABSTRACT" => "Easy, automatic, specification-based tests", "AUTHOR" => "Tom Moertel ", "BUILD_REQUIRES" => { "File::Temp" => 0, "Test::More" => 0 }, "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => "6.30" }, "DISTNAME" => "Test-LectroTest", "EXE_FILES" => [], "LICENSE" => "perl", "NAME" => "Test::LectroTest", "PREREQ_PM" => { "Carp" => 0, "Class::Struct" => 0, "Data::Dumper" => 0, "Exporter" => 0, "Filter::Util::Call" => 0, "POSIX" => 0, "Scalar::Util" => 0, "Test::Builder" => 0, "constant" => 0, "strict" => 0, "warnings" => 0 }, "VERSION" => "0.5001", "test" => { "TESTS" => "t/*.t" } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); recorder.t100755000764000764 573212145027551 16261 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#! perl # Tom Moertel # Here we test the failure-recoding and failure-playback features. use File::Temp 'tempfile'; use Test::More tests => 14; BEGIN { unshift @INC, 't/lib'; } use CaptureOutput; my $prop_success = "Property { ##[ ]## 1 };\n"; my $prop_failure = "Property { ##[ ]## 0 };\n"; my @MODULES = my ( $LT, $LTC ) = (qw( Test::LectroTest Test::LectroTest::Compat )); my @RECORDER_OPTS = my ( $RF, $PF, $RG) = (qw( record_failures playback_failures regressions )); $| = 1; # make sure it is OK to specify an unusable file for recoding and # playback (e.g., we may be on read-only media or perhaps no regressions # have been recorded yet) for my $module (@MODULES) { my $plan = sub { mk_plan($module, 1, 1, @_) }; for my $opt (@RECORDER_OPTS) { my $opt_plan = $plan->("$opt => '/path/that/does/not/exist/....';\n"); my $oks = suite_results($opt_plan, prop_succ($module, 1))->[1]; is( $oks, 1, "$module + $opt + non-existent file is OK" ); } } # make sure playback works for my $pass (0, 1) { with_temp_file( sub { my ($pfile) = @_; for my $module (@MODULES) { for my $opt ($PF, $RG) { my $plan = mk_plan($module, 2, 0, "$opt => '$pfile';\n", (prop_x($module, 0)) x 2); my ($results, $oks, $noks) = @{suite_results($plan)}; is_deeply( [$oks, $noks], [2 * $pass, 2 * (1-$pass)], "$module + $opt playback works (npass=$pass)" ); } }}, "[ 'P', { x => $pass } ]\n" ); } sub mk_plan { my ($module, $tests, $trials, @statements) = @_; $tests = $module eq $LT ? "" : "tests => $tests, "; $module .= " trials => $trials, " if $module eq $LT; join("", "use $module $tests", @statements, "\n"); } sub mk_prop { my ($module, $trials, $body) = @_; my $prop = "Property { $body }, name => 'P'"; return "$prop;\n" if $module eq $LT; return "holds( ($prop), trials => $trials );\n"; } sub prop_succ { mk_prop(@_, '##[ x <- Int ]## 1' ) } sub prop_fail { mk_prop(@_, '##[ x <- Int ]## 0' ) } sub prop_x { mk_prop(@_, '##[ x <- Int ]## $x' ) } sub suite_results { my $results = make_and_run_suite(@_); my $oks = @{[ $results =~ /^ok/mg ]}; my $noks = @{[ $results =~ /^not ok/mg ]}; my ($status) = $results =~ /^(.*)/; [$results, $oks, $noks, $status]; } sub with_temp_file { my ($code, @body) = @_; my ($fh, $fn) = tempfile() or die "can't open temp file: $!"; print $fh @body; close $fh; my $result = $code->($fn); unlink $fn; $result; } sub make_and_run_suite { my $code = sub { my @cmd = ($^X, "-Ilib", $_[0]); my $recorder = capture(*STDOUT); my $errors = capture(*STDERR); my $exit_status = system(@cmd) >> 8; $errors->(); # don't care about STDERR output "$exit_status\n" . $recorder->(); }; with_temp_file( $code, @_ ); } MANIFEST.SKIP100644000764000764 55712145027551 15677 0ustar00thorthor000000000000Test-LectroTest-0.5001# Avoid version control files. \bRCS\b \bCVS\b ,v$ \B\.svn\b # Avoid Makemaker generated and utility files. \bMakefile$ \bblib \bMakeMaker-\d \bpm_to_blib$ \bblibdirs$ # Avoid Module::Build generated and utility files. \bBuild$ \b_build # Avoid temp and backup files. ~$ \.old$ \.bak$ \#$ \b\.# monotone.db MT pod2htmd.tmp pod2htmi.tmp toms-notes.txt \b_darcs\b pod-coverage.t100644000764000764 123612145027551 17017 0ustar00thorthor000000000000Test-LectroTest-0.5001/t# standard Test::Pod::Coverage recipe for module authors use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; my $trusted = join "|", split ' ', do { local $/; }; all_pod_coverage_ok( { trustme => [qr/^$trusted$/] } ); # Properties and Generators are created and invoked using special # syntax. Thus the typical OO means of creating them are discouraged # in the documentation. Nevertheless, the documentation does fully # explain how to create and use these objects. The following hints # help Pod::Coverage to recognize the fact: __DATA__ Property Gen generate new tex000755000764000764 012145027551 14452 5ustar00thorthor000000000000Test-LectroTest-0.5001titlepage.ltx100644000764000764 163012145027551 17321 0ustar00thorthor000000000000Test-LectroTest-0.5001/tex\frenchspacing \title{LectroTest for Perl\\Complete Documentation} \author{Tom Moertel\footnote{tom@moertel.com}} \maketitle \abstract{\noindent This document describes LectroTest for Perl, which takes the form of the Test::LectroTest family of Perl modules. LectroTest is an automated, specification-based testing system. Rather than forcing you to specify individual test cases, LectroTest generates them automatically according to property definitions that you provide. Each property definition represents a specification of your software's expected behavior. LectroTest tests this behavior by running your software in thousands of random test cases. When your software's actual behavior can be shown to deviate from the specifications, LectroTest will emit a ``counterexample'' to show where the deviation occurred. Counterexamples can be used to debug your software, and they also make great regression tests.} lib000755000764000764 012145027551 14663 5ustar00thorthor000000000000Test-LectroTest-0.5001/tCaptureOutput.pm100644000764000764 376412145027551 20217 0ustar00thorthor000000000000Test-LectroTest-0.5001/t/lib# Tom Moertel package CaptureOutput; use File::Temp qw( tempfile ); =head1 NAME CaptureOutput - temporarily capture output from a filehandle =head1 SYNOPSIS print STDERR "before capturing\n"; my $recorder = capture(*STDERR); # start capturing print STDERR "during capturing\n"; my $recd_output = $recorder->(); # stop & get recording print STDERR "after capturing\n"; print "Recorded output = $recd_output"; =head1 DESCRIPTION This module exports a single function C that allows you to temporarily capture output from a given filehandle. The function returns an anonymous function that can be used to restore the filehandle to its previous condition and return any captured output. For example, the output of the code in the Synopsis is as follows: before redirection after redirection Saved output = during redirection =cut sub import { my $caller = caller; { no strict 'refs'; *{$caller.'::capture'} = \&capture; } } sub capture { my $target_fh = shift; my $temp_fh = tempfile(); my $temp_fd = fileno $temp_fh; local *SAVED; local *TARGET = $target_fh; open SAVED, ">&TARGET" or die "can't remember target: $!"; open TARGET, ">&=$temp_fd" or die "can't redirect target: $!"; my $saved_fh = *SAVED; return sub { seek $temp_fh, 0, 0 or die "can't seek: $!"; # rewind my $captured_output = do { local $/; <$temp_fh> }; close $temp_fh or die "can't close temp file handle: $!"; local (*SAVED, *TARGET) = ($saved_fh, $target_fh); open TARGET, ">&SAVED" or die "can't restore target: $!"; close SAVED or die "can't close SAVED: $!"; return $captured_output; } } 1; =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 COPYRIGHT and LICENSE Copyright (c) 2004-05 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Test000755000764000764 012145027551 15337 5ustar00thorthor000000000000Test-LectroTest-0.5001/libLectroTest.pm100644000764000764 2060612145027551 20151 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Testpackage Test::LectroTest; { $Test::LectroTest::VERSION = '0.5001'; } use warnings; use strict; use Test::LectroTest::TestRunner; use Filter::Util::Call; require Test::LectroTest::Property; require Test::LectroTest::Generator; =head1 NAME Test::LectroTest - Easy, automatic, specification-based tests =head1 VERSION version 0.5001 =head1 SYNOPSIS #!/usr/bin/perl -w use MyModule; # contains code we want to test use Test::LectroTest; Property { ##[ x <- Int, y <- Int ]## MyModule::my_function( $x, $y ) >= 0; }, name => "my_function output is non-negative" ; Property { ... }, name => "yet another property" ; # more properties to check here =head1 DESCRIPTION This module provides a simple (yet full featured) interface to LectroTest, an automated, specification-based testing system for Perl. To use it, declare properties that specify the expected behavior of your software. LectroTest then checks your software to see whether those properties hold. Declare properties using the C function, which takes a block of code and promotes it to a L: Property { ##[ x <- Int, y <- Int ]## MyModule::my_function( $x, $y ) >= 0; }, name => "my_function output is non-negative" ; The first part of the block must contain a generator-binding declaration. For example: ##[ x <- Int, y <- Int ]## (Note the special bracketing, which is required.) This particular binding says, "For all integers I and I." (By the way, you aren't limited to integers. LectroTest also gives you booleans, strings, lists, hashes, and more, and it lets you define your own generator types. See L for more.) The second part of the block is simply a snippet of code that makes use of the variables we bound earlier to test whether a property holds for the piece of software we are testing: MyModule::my_function( $x, $y ) >= 0; In this case, it asserts that C returns a non-negative result. (Yes, C<$x> and C<$y> refer to the same I and I that we bound to the generators earlier. LectroTest automagically loads these lexically bound Perl variables with values behind the scenes.) B If you want to use testing assertions like C from L or C, C, or C from L (and the related family of L-based testing modules), see L, which lets you mix and match LectroTest with these modules. Finally, we give the whole Property a name, in this case "my_function output is non-negative." It's a good idea to use a meaningful name because LectroTest refers to properties by name in its output. Let's take a look at the finished property specification: Property { ##[ x <- Int, y <- Int ]## MyModule::my_function( $x, $y ) >= 0; }, name => "my_function output is non-negative" ; It says, "For all integers I and I, we assert that my_function's output is non-negative." To check whether this property holds, simply put it in a Perl program that uses the Test::LectroTest module. (See the L for an example.) When you run the program, LectroTest will load the property (and any others in the file) and check it by running random trials against the software you're testing. B If you want to place LectroTest property checks into a test plan managed by L-based modules such as L or L, see L. If LectroTest is able to "break" your software during the property check, it will emit a counterexample to your property's assertions and stop. You can plug the counterexample back into your software to debug the problem. (You might also want to add the counterexample to a list of regression tests.) A successful LectroTest looks like this: 1..1 ok 1 - 'my_function output is non-negative' (1000 attempts) On the other hand, if you're not so lucky: 1..1 not ok 1 - 'my_function output is non-negative' falsified \ in 324 attempts # Counterexample: # $x = -34 # $y = 0 =head1 EXIT CODE The exit code returned by running a suite of property checks is the number of failed checks. The code is 0 if all properties passed their checks or I if I properties failed. (If more than 254 properties failed, the exit code will be 254.) =head1 ADJUSTING THE TESTING PARAMETERS There is one testing parameter (among others) that you might wish to change from time to time: the number of trials to run for each property checked. By default it is 1,000. If you want to try more or fewer trials, pass the C>I flag: use Test::LectroTest trials => 10_000; =head1 TESTING FOR REGRESSIONS AND CORNER CASES LectroTest can record failure-causing test cases to a file, and it can play those test cases back as part of its normal testing strategy. The easiest way to take advantage of this feature is to set the I parameter when you C this module: use Test::LectroTest regressions => "regressions.txt"; This tells LectroTest to use the file "regressions.txt" for both recording and playing back failures. If you want to record and play back from separate files, or want only to record I play back, use the I and/or I options: use Test::LectroTest playback_failures => "regression_suite_for_my_module.txt", record_failures => "failures_in_the_field.txt"; See L for more. =head1 CAVEATS When you use this module, it imports all of the generator-building functions from L into the your code's namespace. This is almost always what you want, but I figured I ought to say something about it here to reduce the possibility of surprise. A Property specification must appear in the first column, i.e., without any indentation, in order for it to be automatically loaded and checked. If this poses a problem, let me know, and this restriction can be lifted. =cut our $r; our @props; our @opts; sub import { my $self = shift; Test::LectroTest::Property->export_to_level(1, $self); Test::LectroTest::Generator->export_to_level(1, $self, ':all'); @opts = @_; $r = Test::LectroTest::TestRunner->new( @_ ); my $lines = 0; my $subfilter = Test::LectroTest::Property::_make_code_filter(); filter_add( sub { my $status = filter_read(); s{^(?=Test|Property)\b}{push \@Test::LectroTest::props, }; $subfilter->( $status ); }); } sub _run { return @props - $r->run_suite( @props, @opts ); } END { if ($r) { my $failed = Test::LectroTest::_run(); $? = $failed > 254 ? 254 : $failed; } } 1; __END__ =head1 SEE ALSO For a gentle introduction to LectroTest, see L. Also, the slides from my LectroTest talk for the Pittsburgh Perl Mongers make for a great introduction. Download a copy from the LectroTest home (see below). L explains how to test for regressions and corner cases using LectroTest. L lets you mix LectroTest with the popular family of L-based modules such as L and L. L explains in detail what you can put inside of your property specifications. L describes the many generators and generator combinators that you can use to define the test or condition space that you want LectroTest to search for bugs. L describes the objects that check your properties and tells you how to turn their control knobs. You'll want to look here if you're interested in customizing the testing procedure. =head1 LECTROTEST HOME The LectroTest home is http://community.moertel.com/LectroTest. There you will find more documentation, presentations, mailing-list archives, a wiki, and other helpful LectroTest-related resources. It's also the best place to ask questions. =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 INSPIRATION The LectroTest project was inspired by Haskell's QuickCheck module by Koen Claessen and John Hughes: http://www.cs.chalmers.se/~rjmh/QuickCheck/. =head1 COPYRIGHT and LICENSE Copyright (c) 2004-05 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut release-pod-syntax.t100644000764000764 45012145027551 20145 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); release-pod-coverage.t100644000764000764 76512145027551 20423 0ustar00thorthor000000000000Test-LectroTest-0.5001/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod::Coverage 1.08"; plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage" if $@; eval "use Pod::Coverage::TrustPod"; plan skip_all => "Pod::Coverage::TrustPod required for testing POD coverage" if $@; all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); LectroTest000755000764000764 012145027551 17427 5ustar00thorthor000000000000Test-LectroTest-0.5001/lib/TestCompat.pm100644000764000764 1776712145027551 21412 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Test/LectroTestpackage Test::LectroTest::Compat; { $Test::LectroTest::Compat::VERSION = '0.5001'; } use warnings; use strict; use Filter::Util::Call; use Test::Builder; use Test::LectroTest::TestRunner; require Test::LectroTest::Property; require Test::LectroTest::Generator; =head1 NAME Test::LectroTest::Compat - Use LectroTest property checks in a Test::Simple world =head1 VERSION version 0.5001 =head1 SYNOPSIS #!/usr/bin/perl -w use MyModule; # contains code we want to test use Test::More tests => 2; use Test::LectroTest::Compat; # property specs can now use Test::Builder-based # tests such as Test::More's cmp_ok() my $prop_nonnegative = Property { ##[ x <- Int, y <- Int ]## cmp_ok(MyModule::my_function( $x, $y ), '>=', 0); }, name => "my_function output is non-negative" ; # and we can now check whether properties hold # as a Test::Builder-style test that integrates # with other T::B tests holds( $prop_nonnegative ); # test whether prop holds cmp_ok( 0, '<', 1, "trivial 0<1 test" ); # a "normal" test =head1 DESCRIPTION This module lets you use mix LectroTest property checking with other popular Test::* modules. With it, you can use C- and C-style assertions from Test::* modules within your LectroTest property specifications and you can check LectroTest properties as part of a Test::Simple or Test::More test plan. (You can actually take advantage of any module based on Test::Builder, not just Test::Simple and Test::More.) The module exports a single function C which is described below. =head2 holds(I, I...) holds( $prop_nonnegative ); # check prop_nonnegative holds( $prop_nonnegative, trials => 100 ); holds( Property { ##[ x <- Int ]## my_function2($x) < 0; }, name => "my_function2 is non-positive" ); Checks whether the given property holds. When called, this method creates a new Test::LectroTest::TestRunner, asks the TestRunner to check the property, and then reports the result to Test::Builder, which in turn reports to you as part of a typical Test::Simple- or Test::More-style test plan. Any options you provide to C after the property will be passed to the C so you can change the number of trials to run and so on. (See the docs for C in L for the complete list of options.) =head1 TESTING FOR REGRESSIONS AND CORNER CASES LectroTest can record failure-causing test cases to a file, and it can play those test cases back as part of its normal testing strategy. The easiest way to take advantage of this feature is to set the I parameter when you C this module: use Test::LectroTest::Compat regressions => "regressions.txt"; This tells LectroTest to use the file "regressions.txt" for both recording and playing back failures. If you want to record and play back from separate files, or want only to record I play back, use the I and/or I options: use Test::LectroTest::Compat playback_failures => "regression_suite_for_my_module.txt", record_failures => "failures_in_the_field.txt"; See L for more. B If you pass any of the recording or playback parameters to Test::LectroTest::Compat, you must have version 0.3500 or greater of LectroTest installed. Module authors, update your modules' build dependencies accordingly. =cut my $Test = Test::Builder->new(); sub import { my $self = shift; my $caller = caller; { no strict 'refs'; *{$caller.'::holds'} = \&holds; } $Test->exported_to($caller); $Test->plan(_filter_recorder_opts(@_)); Test::LectroTest::Property->export_to_level(1, $self); Test::LectroTest::Generator->export_to_level(1, $self, ':all'); filter_add(Test::LectroTest::Property->_make_code_filter); } sub holds { my ($diag_store, $results) = _check_property(@_); my $success = $results->success; (my $name = $results->summary) =~ s/^.*?- /property /; $Test->ok($success, $name); $Test->diag(@$diag_store) if @$diag_store; my $details = $results->details; $details =~ s/^.*?\n//; # remove summary line $details =~ s/^\# / /mg; # replace commenting w/ indent $Test->diag($details) if $details; return $success ? 1 : 0; # same result policy as Test::Builder::ok } my ($playback_failures, $record_failures); sub _check_property { no warnings 'redefine'; my $diag_store = []; my $property = shift; local *Test::Builder::ok = \&_disconnected_ok; local *Test::Builder::diag = sub { shift; push @$diag_store, @_; 0 }; # for efficiency, we recycle any recorders that the TestRunner # may have created (the recorders cache test cases) my @opts = ( $playback_failures ? (playback_failures => $playback_failures) : (), $record_failures ? (record_failures => $record_failures) : (), @_ # passed-in options go last to override defaults ); my $runner = Test::LectroTest::TestRunner->new(@opts); my @results = ($diag_store, $runner->run($property)); # the TestRunner may have converted file names into TestRecorder # objects, so we just "upgrade" to these objects if they exist # and we're still holding filenames $playback_failures = $runner->playback_failures if $playback_failures && !ref($playback_failures); $record_failures = $runner->record_failures if $record_failures && !ref($record_failures); return @results; } my @RECORDER_OPTS = (qw( record_failures playback_failures regressions )); sub _filter_recorder_opts { my (@opts); while (@_) { unless (grep $_ eq $_[0], @RECORDER_OPTS) { push @opts, shift; } else { my ($ropt, $rval) = (shift, shift); if ($ropt eq "regressions") { $playback_failures = $record_failures = $rval; } elsif ($ropt eq "playback_failures") { $playback_failures = $rval; } else { $record_failures = $rval; } } } return @opts; } # the following sub replaces Test::Builder's # ok() method when we want to disable T::B's # test harness sub _disconnected_ok { $_[1] ? 1 : 0 } 1; =head1 BUGS In order to integrate with the L testing harness (whose underlying testing model is somewhat incompatible with the needs of random trial-based testing) this module redefines two Test::Builder functions (C and C) for the duration of each property check. =head1 SEE ALSO For a gentle introduction to LectroTest, see L. Also, the slides from my LectroTest talk for the Pittsburgh Perl Mongers make for a great introduction. Download a copy from the LectroTest home (see below). L explains how to test for regressions and corner cases using LectroTest. L explains in detail what you can put inside of your property specifications. L describes the many generators and generator combinators that you can use to define the test or condition space that you want LectroTest to search for bugs. L describes the objects that check your properties and tells you how to turn their control knobs. You'll want to look here if you're interested in customizing the testing procedure. L and L explain how to do simple case-based testing in Perl. L is the test harness upon which this module is built. =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 INSPIRATION The LectroTest project was inspired by Haskell's QuickCheck module by Koen Claessen and John Hughes: http://www.cs.chalmers.se/~rjmh/QuickCheck/. =head1 COPYRIGHT and LICENSE Copyright (c) 2004-13 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Property.pm100644000764000764 3336412145027551 22002 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Test/LectroTestpackage Test::LectroTest::Property; { $Test::LectroTest::Property::VERSION = '0.5001'; } use strict; use warnings; use Carp; use Filter::Util::Call; use constant NO_FILTER => 'NO_FILTER'; =head1 NAME Test::LectroTest::Property - Properties that make testable claims about your software =head1 VERSION version 0.5001 =head1 SYNOPSIS use MyModule; # provides my_function_to_test use Test::LectroTest::Generator qw( :common ); use Test::LectroTest::Property qw( Test ); use Test::LectroTest::TestRunner; my $prop_non_neg = Property { ##[ x <- Int, y <- Int ]## $tcon->label("negative") if $x < 0; $tcon->label("odd") if $x % 2; $tcon->retry if $y == 0; # 0 can't be used in test my_function_to_test( $x, $y ) >= 0; }, name => "my_function_to_test output is non-negative"; my $runner = Test::LectroTest::TestRunner->new(); $runner->run_suite( $prop_non_neg, # ... more properties here ... ); =head1 DESCRIPTION B If you're just looking for an easy way to write and run unit tests, see L first. Once you're comfortable with what is presented there and ready to delve into the full offerings of properties, this is the document for you. This module allows you to define Properties that can be checked automatically by L. A Property is a specification of your software's required behavior over a given set of conditions. The set of conditions is given by a generator-binding specification. The required behavior is defined implicitly by a block of code that tests your software for a given set of generated conditions; if your software matches the expected behavor, the block of code returns true; otherwise, false. This documentation serves as reference documentation for LectroTest Properties. If you don't understand the basics of Properties yet, see L before continuing. =cut BEGIN { use Exporter ( ); our @ISA = qw( Exporter ); our @EXPORT = qw( &Property ); our @EXPORT_OK = qw( &Property ); our %EXPORT_TAGS = ( ); } our @EXPORT_OK; our @CARP_NOT = qw ( Test::LectroTest::TestRunner ); my %defaults = ( name => 'Unnamed Test::LectroTest::Property' ); =pod =head2 Two ways to create Properties There are two ways to create a property: =over 4 =item 1 Use the C function to promote a block of code that contains both a generator-binding specification and a behavior test into a Test::LectroTest::Property object. B Example: my $prop1 = Property { ##[ x <- Int ]## thing_to_test($x) >= 0; }, name => "thing_to_test is non-negative"; =cut sub Property(&&@) { my ($genspec_fn, $test_fn, @args) = @_; return Test::LectroTest::Property->new( inputs => $genspec_fn->(), test => $test_fn, @args ); } =pod =item 2 Use the C method of Test::LectroTest::Property and provide it with the necessary ingredients via named parameters: my $prop2 = Test::LectroTest::Property->new( inputs => [ x => Int ], test => sub { my ($tcon,$x) = @_; thing_to_test($x) >= 0 }, name => "thing_to_test is non-negative" ); =back =cut my $pkg = __PACKAGE__; sub new { my $class = shift; croak "$pkg: invalid list of named parameters: (@_)" if @_ % 2; my %args = @_; croak "$pkg: test subroutine must be provided" if ref($args{test}) ne 'CODE'; croak "$pkg: did not get a set of valid input-generator bindings" if ref($args{inputs}) ne "ARRAY"; $args{inputs} = [$args{inputs}] unless ref $args{inputs}[0]; my $inputs_list = []; my $last_vars; for my $inputs (@{$args{inputs}}) { croak "$pkg: did not get a set of valid input-generator bindings" if ref($inputs) ne "ARRAY" || @$inputs % 2; $inputs = { @$inputs }; croak "$pkg: cannot use reserved name 'tcon' in a generator binding" if defined $inputs->{tcon}; my @vars = sort keys %$inputs; croak "$pkg: each set of generator bindings must bind the same " . "set of variables but (@vars) does not match ($last_vars)" if $last_vars && $last_vars ne "@vars"; $last_vars = "@vars"; push @$inputs_list, $inputs; } delete $args{inputs}; return bless { %defaults, inputs => $inputs_list, %args }, $class; } =pod Both are equivalent, but the first is concise, easier to read, and lets LectroTest do some of the heavy lifting for you. The second is probably better, however, if you are constructing property specifications programmatically. =head2 Generator-binding specification The generator-binding specification declares that certain variables are to be bound to certain kinds of random-value generators during the tests of your software's behavior. The number and kind of generators define the "condition space" that is examined during property checks. If you use the C function to create your properties, your generator-binding specification must come first in your code block, and you must use the following syntax: ##[ var1 <- gen1, var2 <- gen2, ... ]## Comments are not allowed within the specification, but you may break it across multiple lines: ##[ var1 <- gen1, var2 <- gen2, ... ]## or ##[ var1 <- gen1, var2 <- gen2, ... ]## Further, for better integration with syntax-highlighting IDEs, the terminating C<]##> delimiter may be preceded by a hash symbol C<#> and optional whitespace to make it appear like a comment: ##[ var1 <- gen1, var2 <- gen2, ... # ]## On the other hand, if you use Cnew()> to create your objects, the generator-binding specification takes the form of an array reference containing variable-generator pairs that is passed to C via the parameter named C: inputs => [ var1 => gen1, var2 => gen2, ... ] Normal Perl syntax applies here. =head2 Specifying multiple sets of generator bindings Sometimes you may want to repeat a property check with multiple sets of generator bindings. This can happen, for instance, when your condition space is vast and you want to ensure that a particular portion of it receives focused coverage while still sampling the overall space. For times like this, you can list multiple sets of bindings within the C<##[> and C<]##> delimiters, like so: ##[ var1 <- gen1A, ... ], [ var1 <- gen1B, ... ], ... more sets of bindings ... [ var1 <- gen1N, ... ]## Note that only the first and last set need the special delimiters. The equivalent when using C is as follows: inputs => [ [ var1 => gen1A, ... ], [ var1 => gen1B, ... ], ... [ var1 => gen1N, ... ] ] Regardless of how you declare the sets of bindings, each set must provide bindings for the exact same set of variables. (The generators, of course, can be different.) For example, this kind of thing is illegal: ##[ x <- Int ], [ y <- Int ]## The above is illegal because both sets of bindings must use I or both must use I; they can't each use a different variable. ##[ x <- Int ], [ x <- Int, y <- Float ]## The above is illegal because the second set has an extra variable that isn't present in the first. Both sets must use exactly the same variables. None of the variables may be extra, none may be missing, and all must be named identically across the sets of bindings. =head2 Behavior test The behavior test is a subroutine that accepts a test-controller object and a given set of input conditions, tests your software's observed behavior against the required behavior with respect to the input conditions, and returns true or false to indicate acceptance or rejection. If you are using the C function to create your property objects, lexically bound variables are created and loaded with values automatically, per your input-generator specification, so you can just go ahead and use the variables immediately: my $prop = Property { ##[ i <- Int, delta <- Float(range=>[0,1]) ]## my $lo_val = my_thing_to_test($i); my $hi_val = my_thing_to_test($i + $delta); $lo_val == $hi_val; }, name => "my_thing_to_test ignores fractions" ; On the other hand, if you are using Cnew()>, you must declare and initialize these variables manually from Perl's C<@_> variable I after receiving C<$tcon>, the test controller object. (This inconvenience, by the way, is why the former method is preferred.) The hard way: my $prop = Test::LectroTest::Property->new( inputs => [ i => Int, delta => Float(range=>[0,1]) ], test => sub { my ($tcon, $delta, $i) = @_; my $lo_val = my_thing_to_test($i); my $hi_val = my_thing_to_test($i + $delta); $lo_val == $hi_val }, name => "my_thing_to_test ignores fractions" ) ; =head2 Control logic, retries, and labeling Inside the behavior test, you have access to a special variable C<$tcon> that allows you to interact with the test controller. Through C<$tcon> you can do the following: =over 4 =item * retry the current trial with different inputs (if you don't like the inputs you were given at first) =item * add labels to the current trial for reporting purposes =item * attach notes and variable dumps to the current trial for diagnostic purposes, should the trial fail =back (For the full details of what you can do with C<$tcon> see the "testcontroller" section of L.) For example, let's say that we have written a function C that returns the square root of its input. In order to check whether our implementation fulfills the mathematical definition of square root, we might specify the following property: my $epsilon = 0.000_001; Property { ##[ x <- Float ]## return $tcon->retry if $x < 0; $tcon->label("less than one") if $x < 1; my $sx = my_sqrt( $x ); abs($sx * $sx - $x) < $epsilon; }, name => "my_sqrt satisfies defn of square root"; Because we don't want to deal with imaginary numbers, our square-root function is defined only over non-negative numbers. To make sure we don't accidentally check our property "at" a negative number, we use the following line to re-start the trial with a different input should the input we are given at first be negative: return $tcon->retry if $x < 0; An interesting fact is that for all values I between zero and one, the square root of I is larger than I itself. Perhaps our implementation treats such values as a special case. In order to be confident that we are checking this case, we added the following line: $tcon->label("less than one") if $x < 1; In the property-check output, we can see what percentage of the trials checked this case: 1..1 ok 1 - 'my_sqrt satisfies defn of square root' (1000 attempts) # 1% less than one =head2 Trivial cases Random-input generators may create some inputs that are trivial and don't provide much testing value. To make it easy to label such cases, you can use the following from within your behavior tests: $tcon->trivial if ... ; The above is exactly equivalent to the following: $tcon->label("trivial") if ... ; =cut sub import { Test::LectroTest::Property->export_to_level( 1, grep {$_ ne NO_FILTER} @_ ); return if grep {$_ eq NO_FILTER} @_; filter_add( _make_code_filter() ); } sub _make_code_filter { my $content = ""; sub { my $status = shift; if ( defined $status ? $status : ($status = filter_read()) ) { if (s| \#\# ( \[ .*? ) \#*\s*\]\#\# | "["._binding($1)."]]}"._body($1) |exs) { # 1-line decl } elsif (s| \#\# ( \[.* ) | "["._binding($1) |exs) { # opening of multi-line decl $content .= " $1"; } elsif ($content && s| ^(.*?)\#*\s*\]\#\# | _binding($1)."]]}"._body("$content$1") |exs) { # close of multi-line decl $content = ""; } elsif ($content) { s/(.*)/_binding($1)/es; $content .= " $1"; } } return $status; } } # convert bindinging operators ( <- ) into key arrows ( => ) sub _binding { my $s = shift; $s =~ s| <- | => |gx; return $s; } sub _body { my ($gen_decl_str) = @_; my @vars = $gen_decl_str =~ /(\w+)\s*<-/gs; @vars = sort keys %{{ map {($_,1)} @vars }}; # uniq | sort @vars = grep { 'tcon' ne $_ } @vars; # disallow reserved var 'tcon' ' sub { my (' . join(',', map {"\$$_"} 'tcon', @vars) . ') = @_;'; } 1; =pod =head1 SEE ALSO L describes the many generators and generator combinators that you can use to define the test or condition spaces that you want LectroTest to search for bugs. L describes the objects that check your properties and tells you how to turn their control knobs. You'll want to look here if you're interested in customizing the testing procedure. =head1 HERE BE SOURCE FILTERS The special syntax used to specify generator bindings relies upon a source filter (see L). If you don't want to use the syntax, you can disable the filter like so: use Test::LectroTest::Property qw( NO_FILTER ); =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 INSPIRATION The LectroTest project was inspired by Haskell's QuickCheck module by Koen Claessen and John Hughes: http://www.cs.chalmers.se/~rjmh/QuickCheck/. =head1 COPYRIGHT and LICENSE Copyright (c) 2004-13 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Tutorial.pod100644000764000764 1211112145027551 22112 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Test/LectroTest=head1 NAME Test::LectroTest::Tutorial - How to use LectroTest to test your software =head1 VERSION version 0.5001 =head1 SYNOPSIS LectroTest is an automated, specification-based testing system. To use it, declare properties that specify the expected behavior of your software. Then invoke LectroTest to test whether those properties hold. LectroTest does this by running repeated random trials against your software. If LectroTest finds that a property doesn't hold, it emits the counterexample that "broke" your software. You can then plug the counterexample into your software to debug the problem. (It's also a good idea to add the counterexample to your list of regression tests.) =head1 OVERVIEW Think of your software's behavior as a haystack that you're searching for needles. Each error is a needle. You want to find the needles and remove of them. LectroTest will search the haystack for you -- it's nice that way -- but first you must tell it about the shape of the haystack and how to recognize a needle when it sees one. =head2 The Haystack The shape of the haystack is defined by a set of "generator bindings," in which variables are bound to the output of value generators: x <- Int, c <- Char( charset=>"A-Z" ) The above can be read, "For all integers I and all characters I in the range A through Z." The idea is that each unique instance of the pair (I) specifies a point in the haystack that we can search for needles. =head2 The Needle Recognizer The "needle recognizer" is defined by a snippet of code that uses the bound variables to inspect a given point in the haystack. It returns a "thumbs up" (true) if the point is free of needles or a "thumbs down" (false) if it finds a needle: the_thing_we_are_testing($x, $c) >= 0; The above asserts for each point in the haystack that the output of the function C must be non-negative. =head2 Put them together to make a Property The generator bindings and needle recognizer are combined to make a property: Property { ##[ x <- Int, c <- Char( charset=>"A-Z" ) ]## the_thing_we_are_testing($x, $c) >= 0; }, name => "the_thing_we_are_testing(...) is non-negative"; You'll note that we also added a meaningful name. Although not strictly required, it's an excellent practice that makes life easier. (You'll also note that we placed the generator bindings inside of the magic delimiters C<##[ ]##>. This tells Perl that our bindings are bindings and not regular Perl code.) We can read the above property like so: "For all integers I and all characters I in the range A through Z, we assert that C is non-negative." =head2 Testing whether your Properties hold After you define properties for your software, just add them to a small Perl program that uses the Test::LectroTest module: # MyProperties.l.t use MyModule; # provides the_thing_we_are_testing use Test::LectroTest; Property { ##[ x <- Int, c <- Char( charset=>"A-Z" ) ]## the_thing_we_are_testing($x, $c) >= 0; }, name => "the_thing_we_are_testing(...) is non-negative"; Then you can test your properties simply by running the program: $ perl MyProperties.l.t If your properties check out, you'll see something like this: 1..1 ok 1 - 'the_thing_we_are_testing(...) is non-negative' (1000 attempts) If something goes wrong, however, LectroTest will tell you where it happened: 1..1 not ok 1 - 'the_thing_we_are_testing(...) is non-negative' \ falsified in 23 attempts # Counterexample: # $x = 4 # $c = "R" What this says is that at the point (I=4, I="R") in the haystack, there is a needle (i.e., your property doesn't hold). With this information, you can examine your code to determine the cause of the error. =head1 LET'S DO IT! Now that we have big-picture understanding of "LectroTesting," let's try a few examples together. [TODO: write the step-by-step tutorial examples. For now, take a look at the slides from my LectroTest talk for two such examples. The slides are available at the L.] =head1 SEE ALSO L gives a quick overview of automatic, specification-based testing with LectroTest. L explains in detail what you can put inside of your property specifications. L describes the many generators and generator combinators that you can use to define the shapes of the haystacks you encounter during your testing adventures. L describes the objects that check your properties and tells you how to turn their control knobs. You'll want to look here if you're interested in customizing the testing procedure. =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 INSPIRATION The LectroTest project was inspired by Haskell's QuickCheck module by Koen Claessen and John Hughes: http://www.cs.chalmers.se/~rjmh/QuickCheck/. =head1 COPYRIGHT and LICENSE Copyright (c) 2004-13 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Generator.pm100644000764000764 7565512145027551 22115 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Test/LectroTestpackage Test::LectroTest::Generator; { $Test::LectroTest::Generator::VERSION = '0.5001'; } use strict; use warnings; use Carp; BEGIN { use Exporter (); our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); my @gens = qw( &Int &Bool &Char &String &List &Hash &Float &Elements &Unit ); my @combs = qw( &Paste &OneOf &Frequency &Sized &Each &Apply &Map &Concat &Flatten &ConcatMap &FlattenMap ); my @specials = qw( &Gen) ; @ISA = qw(Exporter); @EXPORT = (); @EXPORT_OK = ( @gens, @combs, @specials); %EXPORT_TAGS = ( common => [@gens] , combinators => [@combs] , all => [@gens, @combs, @specials] ); } our @EXPORT_OK; =head1 NAME Test::LectroTest::Generator - Random value generators and combinators =head1 VERSION version 0.5001 =head1 SYNOPSIS use Test::LectroTest::Generator qw(:common :combinators); my $int_gen = Int; my $pct_gen = Int( range=>[0,100] ); my $flt_gen = Float( range=>[0,1] ); my $bln_gen = Bool; my $chr_gen = Char( charset=>"a-z" ); my $str_gen = String( charset=>"A-Z0-9", length=>[3,] ); my $ary_gen = List( Int(sized=>0) ); my $hsh_gen = Hash( $str_gen, $pct_gen ); my $uni_gen = Unit( "e" ); # always returns "e" my $elm_gen = Elements("e1", "e2", "e3", "e4"); for my $sizing_guidance (1..100) { my $i = $int_gen->generate( $sizing_guidance ); print "$i "; } print "\n"; # generates single digits my $digit_gen = Elements( 0..9 ); # or Int(range=>[0,9],sized=>0) # generates SSNs like "910-77-2236" my $ssn_gen = Paste( Paste( ($digit_gen) x 3 ), Paste( ($digit_gen) x 2 ), Paste( ($digit_gen) x 4 ), glue => "-" ); # print 10 SSNs print( map {$ssn_gen->generate($_)."\n"} 1..10 ); my $english_dist_vowel_gen = Frequency( [8.167,Unit("a")], [12.702,Unit("e")], [6.996,Unit("i")], [ 7.507,Unit("o")], [2.758,Unit("u")] ); # Source: http://www.csm.astate.edu/~rossa/datasec/frequency.html =head1 DESCRIPTION This module provides random value generators for common data types and provides an interface and tools for creating your own generators. It also provides generator combinators that can be used to create more-complex generators by combining simple ones. A generator is an object having a method C, which takes a single argument, I and returns a new random value. The generated value is always a scalar. Generators that produce data structures return references to them. =head2 Sizing guidance The C method interprets its I argument as guidance about the complexity of the value it should create. Typically, smaller I values result in smaller generated numbers and shorter generated strings and lists. Some generators, for which sizing doesn't make sense, ignore sizing guidance altogether; those that do use sizing guidance can be told to ignore it via the B modifier. The purpose of sizing is to allow LectroTest to generate simple values at first and then, as testing progresses, to slowly ramp up the complexity. In this way, counterexamples for obvious problems will be easier for you to understand. =cut #============================================================================== # modifier defaults our %defaults = ( Int => { range => [-32768 , 32767 ], sized => 1 }, Float => { range => [-32768.0, 32767.0], sized => 1 }, List => { length => undef }, Char => { charset => "\x00-\x7f", }, String => { }, Paste => { glue => "" }, ); #============================================================================== # methods sub new { my $class = shift; return bless { @_ }, $class; } sub generate { my ($self, $size) = @_; return scalar $self->{generator}->($size); } #============================================================================== # helpers sub _defargs { my $gen_name = shift; shift while ref($_[0]); # skip template, if any return { %{$defaults{$gen_name}}, @_ }; } sub _template { my $tmpl = []; push @$tmpl, shift while ref($_[0]); return $tmpl; } #============================================================================== # plain old functions sub Gen(&) { my ($genfn) = @_; return Test::LectroTest::Generator->new(generator=>$genfn); } =pod =head2 Generators The following functions create fully-formed generators, ready to use. These functions are exported into your code's namespace if you ask for C<:generators> or C<:all> when you C this module. Each generator has a C method that you can call to extract a new, random value from the generator. =over 4 =item Int my $gen = Int( range=>[0,9], sized=>0 ); Creates a generator for integer values, by default in the range [-32768,32767], inclusive, but this can be changed via the optional B modifier. =over 4 =item Int( range=>[I, I] ) Causes the generated values to be constrained to the range [I, I], inclusive. By default, the range is [-32768, 32767]. B If your range is empty (i.e., I E I), LectroTest will complain. B If zero is not within the range you provide, sizing makes no sense because the intersection of your range and the sizing range can be empty, and thus you must turn off sizing with C0>. If you forget, LectroTest will complain. =item Int( sized=>I ) If true (the default), constrains the absolute value of the generated integers to the sizing guidance provided to the C method. Otherwise, the generated values are constrained only by the range. =back =cut sub Int(@) { my $args = _defargs("Int", @_); my ($sized, $rlo, $rhi) = ($args->{sized}, map int, @{$args->{range}}); croak "range=>[$rlo,$rhi] is empty" if $rlo > $rhi; if (!$sized) { # if unsized, use this simpler generator my $span = $rhi - $rlo + 1; return Gen { return $rlo + int(rand($span)); }; } # otherwise, provide a sizing-capable generator croak "the given range=>[$rlo,$rhi] does not contain zero " . "and cannot be used with a sized generator" if 0 < $rlo || 0 > $rhi; return Gen { my ($lo, $hi) = ($rlo, $rhi); my $size = shift; if (defined $size) { $size = int( $size + 0.5 ); $lo = -$size if -$size > $lo; $hi = $size if $size < $hi; } return $lo + int(rand($hi - $lo + 1)); }; } =pod =item Float my $gen = Float( range=>[-2.0,2.0], sized=>1 ); Creates a generator for floating-point values, by default in the range [-32768.0,32768.0), but this can be changed via the optional B modifier. By default Float generators are sized. =over 4 =item Float( range=>[I, I] ) Causes the generated values to be constrained to the range [I, I). By default, the range is [-32768.0,32768.0). (Note that the I value itself can never be generated, but values infinitesimally close to it can.) B If your range is empty (i.e., I E I), LectroTest will complain. B If zero is not within the range you provide, sizing makes no sense because the intersection of your range and the sizing range can be empty, and thus you must turn off sizing with C0>. If you forget, LectroTest will complain. =item Float( sized=>I ) If true (the default), constrains the absolute value of the generated values to the sizing guidance provided to the C method. Otherwise, the generated values are constrained only by the range. =back =cut sub Float(@) { my $args = _defargs("Float", @_); my ($sized, $rlo, $rhi) = ($args->{sized}, @{$args->{range}}); croak "range=>[$rlo,$rhi] is empty" if $rlo > $rhi; if (!$sized) { # if unsized, use this simpler generator my $span = $rhi - $rlo; return Gen { return $rlo + rand($span); }; } # otherwise, provide a sizing-capable generator croak "the given range [$rlo,$rhi] does not contain zero " . "and cannot be used with a sized generator" if $rlo > 0 || 0 > $rhi; return Gen { my ($lo, $hi) = ($rlo, $rhi); my $size = shift; if (defined $size) { $lo = -$size if -$size > $lo; $hi = $size if $size < $hi; } return $lo + rand($hi - $lo); }; } =pod =item Bool my $gen = Bool; Creates a generator for boolean values: 0 for false, 1 for true. The generator ignores sizing guidance. =cut sub Bool(@) { return Int( @_, range=>[0,1], sized=>0 ); } =pod =item Char my $gen = Char( charset=>"A-Za-z0-9_" ); Creates a generator for characters. By default the characters are in the ASCII range [0,127], inclusive, but this behavior can be changed with the B modifier: =over 4 =item Char( charset=>I ) Characters will be drawn from the character set given by the character-set specification I. The syntax of I is similar the Perl C built-in and is a string comprised of characters and character ranges: =over 4 =item I Adds the character I to the set. =item I-I Adds the characters in the range I through I (inclusive) to the set. Note: If I is lexicographically greater than I, the range is empty, and no characters will be added to the set. =back Examples: =over 4 =item charset=>"abcdwxyz" The characters "a", "b", "c", "d", "w", "x", "y", and "z" are in the set. =item charset=>"a-dx-z" Shorter version of the previous example. =item charset=>"\x00-\x7f" The ASCII character set. =item charset=>"-_A-Za-z0-9" The character set contains "-", "_", upper- and lower-case ASCII letters, and the digits 0-9. Notice that the dash must occur first so that it is not misinterpreted as denoting a range of characters. =back =back =cut sub _to_range($) { my ($lo, $hi) = @{shift()}[0,1]; [ map {chr} ord$lo .. ord $hi ] } sub _parse_charset($) { local ($_) = @_; my @ranges; while (/(.)(?:-(.))?/sg) { push @ranges, [$1, defined $2 ? $2 : $1]; } [ sort keys %{{ map {($_,1)} map {@{_to_range($_)}} @ranges }} ] } sub Char(@) { my $cset = _defargs("Char", @_)->{charset}; return Elements( @{ _parse_charset($cset) } ) } =pod =item List(I) my $gen = List( Bool, length=>[1,10] ); Creates a generator for lists (which are returned as array refs). The elements of the lists are generated by the generator given as I. The lengths of the generated lists are constrained by sizing guidance at the time of generation. You can override the default sizing behavior using the optional B modifier: When the list generator calls the element generator, it divides the sizing guidance by the length of the list. For example, if the list being generated will have 7 elements, when the list generator calls the element generator to generate each element, it will scale the sizing guidance by 1/7. In this way the sizing guidance provides a rough constraint on the total number of elements produced, regardless of the depth of the list structure being generated. =over 4 =item List( ..., length=>I ) Generated lists are exactly length I. =item List( ..., length=>[I,] ) Generated lists are at least length I. (Maximum length is constrained by sizing factor.) =item List( ..., length=>[I,I] ) Generated lists are of length between I and I, inclusive. Sizing guidance is ignored. =back B If more than one I is given, they will be used in turn to create successive elements. In this case, the length of the list will be multiplied by the number of generators given. For example, providing two generators will create double-length lists. =cut sub List(@) { my $template = _template(@_); my $builder = sub { my ($len, $size) = @_; my $subsize = defined $size ? $size / ($len+1) : 1; my @list; foreach (1..$len) { foreach my $generator (@$template) { push @list, $generator->generate($subsize); } } return \@list; }; # return generator customized for length specification my $lenspec = _defargs("List", @_)->{length}; # case 0: length=>undef if ( ! defined $lenspec ) { $lenspec = [0,]; # convert into case 2 } # case 1: length=>N if ( ! ref($lenspec) ) { my $n = $lenspec; croak "length=>$n can't be < 0" if $n < 0; return Gen { return $builder->($lenspec, @_); } } # case 2: length=>[M,] elsif ( ref($lenspec) eq 'ARRAY' && @$lenspec == 1 ) { my ($m) = @$lenspec; croak "length=>[$m,] can't be < 0" if $m < 0; return Gen { my ($size) = @_; return $builder->( $m >= $size ? $m : $m + int(rand($size - $m + 1)), @_); }; } # case 3: length=>[M,N] elsif ( ref($lenspec) eq 'ARRAY' && @$lenspec == 2 ) { my ($m,$n) = @$lenspec; croak "length=>[$m,$n]) is invalid" if $m > $n || $m < 0; return Gen { return $builder->( $m + int(rand($n - $m + 1)), @_ ) }; } # case 4: bad length specification else { croak "length specification length=>$lenspec is bad"; } } =pod =item Hash(I, I) my $gen = Hash( String( charset=>"A-Z", length=>3 ), Float( range=>[0.0, 100.0] ); Creates a generator for hashes (which are returned as hash refs). The keys of the hash are generated by the generator given as I, and the values are generated by the generator I. The Hash generator takes an optional B modifier that specifies the desired hash length (= number of keys): =over 4 =item Hash( ..., length=>I ) Specifies the desired length of the generated hashes, using the same I syntax as for the List generator. Note that the generated hashes may be smaller than expected because of key collision. =back =cut sub Hash(@) { croak "Hash(keygen,valgen,...) requires two generators" unless @{_template(@_)} == 2; my $listgen = List(@_); return Gen { return { @{$listgen->generate(@_)} } }; } =pod =item String my $gen = String( length=>[3,], charset=>"A-Z" ); Creates a generator for strings. By default the strings will be drawn from the ASCII character set (0 through 127) and be of length constrained by the sizing factor. Both defaults can be changed using modifiers: =over 4 =item String( charset=>I ) Characters will be drawn from the character set given by the character-set specification I. The syntax of I is similar the Perl C operator and is a string comprised of characters and character ranges. See Char for a full description. =item String( length=>I ) Specifies the desired length of generated strings, using the same I syntax as for the List generator. =back =cut sub String(@) { my $args = _defargs("String", @_); my ($cset, $length) = @$args{qw(charset length)}; my $lcgen = List(Char(defined $cset ? (charset=>$cset) : ()), defined $length ? (length=>$length) : ()); return Gen { join "", @{$lcgen->generate(@_)}; } } =pod =item Elements(I, I, ...) my $gen = Elements( "alpha", "beta", "gamma" ); Creates a generator that chooses among the given elements I, I, ... with equal probability. Each call to the C method will return one of the element values. Sizing guidance has no effect on this generator. B This generator builder does not accept modifiers. If you pass any, they will be interpreted as elements to be added to the pool from which the generator randomly selects, which is probably not what you want. =cut sub Elements(@) { croak "Elements(e...) must be given at least one element" unless @_; return OneOf( map {Unit($_)} @_ ); } =pod =item Unit(I) my $gen = Unit( "alpha" ); Creates a generator that always returns the value I. Not too useful on its own but can be handy as a building block for combinators to chew on. Naturally, sizing guidance has no effect on this generator. B This generator builder does not accept modifiers. =cut sub Unit($) { my ($e) = @_; return Gen { return $e; } } =pod =back =head2 Generator combinators The following combinators allow you to build more complicated generators from simpler ones. These combinators are exported into your code's namespace if you ask for C<:combinators> or C<:all> when you C this module. =over 4 =item Paste(I..., glue=>I) my $gen = Paste( (String(charset=>"0-9",length=>4)) x 4, glue => " " ); # gens credit-card numbers like "4592 9459 9023 1369" my $lgen = Paste( List( String(charset=>"0-9",length=>4) , length=>4 ), glue => " " ); # another way of doing the same Creates a combined generator that generates values by joining the values generated by each of the supplied sub-generators I. (Generated list values will have their elements "flattened" into the rest of the generated results before joining.) The resulting string is returned. The values are joined using the given glue string I. If no B modifier is provided, the default glue is the empty string. The sizing guidance given to the combined generator will be passed unchanged to each of the sub-generators. =cut sub Paste(@) { my @gens = @{_template(@_)}; my $glue = _defargs("Paste", @_)->{glue}; Apply( sub { join $glue, map @$_, @_ }, Flatten(@gens) ); } =pod =item OneOf(I...) my $gen = OneOf( Unit(0), List(Int,length=>3) ); # generates scalar 0 or a 3-element list of integers Creates a combined generator that generates each value by selecting at random (with equal probability) one of the sub-generators in I and using that generator to generate the output value. The sizing guidance given to the combined generator will be passed unchanged to the selected sub-generator. B This combinator does not accept modifiers. =cut sub OneOf(@) { my $gens = \@_; my $igen = Int(sized=>0,range=>[0, @_-1]); return Gen { return $gens->[$igen->generate]->generate(@_); } } =pod =item Frequency([I, I], [I, I], ...) my $gen = Frequency( [50, Unit("common" )], [35, Unit("less common")], [15, Unit("uncommon" )] ); # generates one of "common", "less common", or # "uncommon" with respective probabilities # 50%, 35%, and 15%. Creates a combined generator that generates each value by selecting at random one of the generators I or I or ... and using that generator to generate the output value. Each generator is selected with probability proportional to its associated frequency. (If all of the given frequencies are the same, the Frequency combinator effectively becomes OneOf.) The frequencies can be any non-negative numerical values you want and will be normalized to a 0-to-1 scale internally. At least one frequency must be greater than zero. The sizing guidance given to the combined generator will be passed unchanged to the selected sub-generator. B This combinator does not accept modifiers. =cut sub Frequency(@) { my @freqs = map {$_->[0]} @_; my @gens = map {$_->[1]} @_; if ((my @baddies = grep {$_ < 0} @freqs)) { croak "frequencies must be non-negative; got $baddies[0]"; } my $total = 0; $total += $_ foreach @freqs; unless ($total) { croak "at least one frequency must be greater than zero"; } @freqs = map {$_/$total} @freqs; # normalize to [0,1] scale $total = 0; $_ = $total += $_ for (@freqs); # turn into cumulative freqs $freqs[-1] = 1; # just in case of round-off error return Gen { my $r = rand; my $i = 0; $i++ while $freqs[$i] < $r; return $gens[$i]->generate(@_); } } =pod =item Each(I...) my $gen = Each( Unit(1), Unit("X") ); # always generates [ 1, "X" ] Creates a generator that returns a list (array ref) whose successive elements are the successive values generated by the given generators I. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B This combinator does not accept modifiers. (Note for technical buffs: C is exactly equivalent to C1)>). =cut sub Each(@) { return List( @_, length=>1 ); } =pod =item Apply(I, I...) my $gen = Apply( sub { $_[0] x $_[1] } , Unit("X"), Unit(4) ); # always generates "XXXX" Creates a generator that applies the given function I to arguments generated from each of the given sub-generators I and returns the resulting value. Each sub-generator contributes one value, and the values are passed to I as arguments in the same order as the sub-generators were given to Apply. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B The function I is always evaluated in scalar context. If you need to generate an array, return it as an array reference. B This combinator does not accept modifiers. =cut sub Apply(&@) { my $f = shift; my $g = Each( @_ ); return Gen { scalar $f->( @{$g->generate(@_)} ) }; } =pod =item Map(I, I...) my $gen = Map( sub { "X" x $_[0] } , Unit(4), Unit(3), Unit(0) ); # always generates [ "XXXX", "XXX", "" ] Creates a generator that applies the given function I to the values generated by the given generators I one at a time and returns a list (array ref) whose elements are each of the successive results. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B The function I is always evaluated in scalar context. If you need to generate an array, return it as an array reference. B This combinator does not accept modifiers. =cut sub _Map { my $f = shift; my $g = Each( @_ ); return Gen { [ map { scalar $f->($_) } @{ $g->generate(@_) } ] }; } sub Map(&@) { _Map(@_); } =pod =item Concat(I...) my $gen = Concat( List( Unit(1), length=>3 ) , List( Unit("x"), length=>1 ) ); # always generates [1, 1, 1, "x"] Creates a generator that concatenates the values generated by each of its sub-generators, resulting in a list (which is returned as a array reference). The values returned by the sub-generators are expected to be lists (array refs). If a sub-generator returns a scalar value, it will be treated like a single-element list that contains the value. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B If a sub-generator returns something other than a list or scalar, you will get a run-time error. B This combinator does not accept modifiers. =cut # we'll use this helper in Flatten and ConcatMap (and Paste) sub _concat(@) { [ map { ref($_) ? @{$_} : ($_) } @_ ]; } sub Concat(@) { Apply( \&_concat, @_ ); } =pod =item Flatten(I...) my $gen = Flatten( Unit( [[[[[[ 1 ]]]]]] ) ); # generates [1] Flatten is just like Concat except that it recursively flattens any sublists generated by the generators I and then concatenates them to generate a final a list of depth one, regardless of the depth of any sublists. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B If a sub-generator returns something other than a list or scalar, you will get a run-time error. B This combinator does not accept modifiers. =cut sub _flatten(@); sub _flatten(@) { _concat map { ref($_) ? _flatten(@$_) : ($_) } @_ ; } sub Flatten(@) { Apply( \&_flatten, @_ ); } =pod =item ConcatMap(I, I) sub take_odds { my $x = shift; $x % 2 ? [$x] : [] } my $gen = ConcatMap( \&take_odds , Unit(1), Unit(2), Unit(3) ); # generates [1, 3] Creates a generator that applies the function I to each of the values generated by the given generators I in turn, and then concatenates the results. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B The function I is always evaluated in scalar context. If you need to generate an array, return it as an array reference. B If a sub-generator returns something other than a list or scalar, you will get a run-time error. B This combinator does not accept modifiers. =cut sub ConcatMap(&@) { my $g = _Map( @_ ); return Gen { _concat @{ $g->generate( @_ ) }; }; } =pod =item FlattenMap(I, I) my $gen = FlattenMap( sub { [ ($_[0]) x 3 ] } , Unit([1]), Unit([[2]]) ); # generates [1, 1, 1, 2, 2, 2] Creates a generator that applies the function I to each of the values generated by the given generators I in turn, and then flattens and concatenates the results. The sizing guidance given to the combined generator will be passed unchanged to each sub-generator. B The function I is always evaluated in scalar context. If you need to generate an array, return it as an array reference. B If a sub-generator returns something other than a list or scalar, you will get a run-time error. B This combinator does not accept modifiers. =cut sub FlattenMap(&@) { my $g = _Map( @_ ); return Gen { _flatten @{ $g->generate( @_ ) }; }; } =pod =item Sized(I, I) my $gen = Sized { 2 * $_[0] } List(Int); # ^ magnify sizing guidance by factor of two my $gen2 = Sized { 10 } Int; # ^ use constant guidance of 10 Creates a generator that adjusts sizing guidance by passing it through the function I. Then it calls the generator I with the adjusted guidance and returns the result. B This combinator does not accept modifiers. =cut sub Sized(&$) { my ($sizer, $gen) = @_; return Gen { return $gen->generate($sizer->(@_)); }; } =pod =back =head2 Rolling your own generators You can create your own generators by creating any object that has a C method. Your method should accept as its first argument sizing guidance I and, if it makes sense, adjust the complexity of the values it generates accordingly. The easiest way to create a generator is by using the magic function C. It promotes a block of code into a generator. For example, here's a home-brew generator for times in ctime(3) format that is built on top of an Int generator: use Test::LectroTest::Generator qw( :common Gen ); my $time_gen = Int(range=>[0, 2_147_483_647], sized=>0); my $ctime_gen = Gen { scalar localtime $time_gen->generate( @_ ); }; print($ctime_gen->generate($_), "\n") for 1..5; # Fri Jun 2 18:13:21 1978 # Thu Mar 28 00:55:51 1974 # Wed Mar 26 06:41:09 2025 # Sun Sep 11 15:39:44 2016 # Fri Dec 26 00:39:31 1975 Alternatively, we could build the generator using the Apply combinator: my $ctime_gen2 = Apply { localtime $_[0] } $time_gen; B C is not exported into your code's namespace by default. If you want to use it, you must import it by name or import C<:all> when you use this module. =cut 1; =head1 EXAMPLES Here are some examples to consider. =head2 Simple examples use strict; use Test::LectroTest::Generator qw(:common); show("Ints (sized by default)", Int); show("Floats (sized by default)", Float); show("Percentages (unsized)", Int( range=>[0,100], sized=>0 )); show("Lists (sized by default) of Ints (unsized) in [0,10]", List( Int( sized=>0, range=>[0,10] ) )); show("Uppercase-alpha identifiers at least 3 chars long", String( length=>[3,], charset=>"A-Z" )); show("Hashes (sized by default) of form AAA=>Digit", Hash( String( length=>3, charset=>"A-Z" ), Int( sized=>0, range=>[0,9] ) )); sub show { print "\n", shift(), "\n"; my ($gen) = @_; for (1..10) { my $val = $gen->generate($_); printf "Size %2d: ", $_; if (ref $val eq "HASH") { my @pairs = map {"$_=>$val->{$_}"} keys %$val; print "{ @pairs }"; } elsif (ref $val eq "ARRAY") { print "[ @$val ]" } else { print $val; } print "\n"; } } =head2 Advanced examples For these examples we use C to inspect the data structures we generate. Also, we import not only the common generator constructors (like Int) but also the generic Gen constructor, which lets us build generators out of blocks on the fly. use Data::Dumper; use Test::LectroTest::Generator qw(:common Gen); First, here's a recipe for building a list of lists of integers: my $loloi_gen = List( List( Int(sized=>0) ) ); print Dumper($loloi_gen->generate(10)); You may want to run the example several times to get a feel for the distribution of the generated output. Now, a more complicated example. Here we build sized trees of random depth using a recursive set of generators. my $tree_gen = do { my $density = 0.5; my $leaf_gen = Int( sized=>0 ); my $tree_helper = \1; my $branch_gen = List( Gen { $$tree_helper->generate(@_) } ); $tree_helper = \Gen { my ($size) = @_; return rand($size) < $density ? $leaf_gen->generate($size) : $branch_gen->generate($size + 1); }; $$tree_helper; }; print Dumper($tree_gen->generate(30)); We define a tree as either a leaf or a branch, and we randomly decide between the two at each node in the growing tree. Leaves are just integers and become more likely when the sizing guidance diminishes (which happens as we go deeper). The code uses C<$density> as a control knob for leaf density. (Try re-running the above code after changing the value of C<$density>. Try 0, 1, and 2.) Branches, on the other hand, are lists of trees. Because branches generate trees, and trees generate branches, we use a reference trick to set up the mutually recursive relationship. This we encapsulate within a B block for tidiness. =head1 SEE ALSO L gives a quick overview of automatic, specification-based testing with LectroTest. =head1 AUTHOR Tom Moertel (tom@moertel.com) =head1 INSPIRATION The LectroTest project was inspired by Haskell's QuickCheck module by Koen Claessen and John Hughes: http://www.cs.chalmers.se/~rjmh/QuickCheck/. =head1 COPYRIGHT and LICENSE Copyright (c) 2004-13 by Thomas G Moertel. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut TestRunner.pm100644000764000764 5650412145027551 22270 0ustar00thorthor000000000000Test-LectroTest-0.5001/lib/Test/LectroTestpackage Test::LectroTest::TestRunner; { $Test::LectroTest::TestRunner::VERSION = '0.5001'; } use strict; use warnings; use Carp; use Data::Dumper; use Scalar::Util qw(blessed); use Test::LectroTest::Property qw( NO_FILTER ); use Test::LectroTest::FailureRecorder; use Test::LectroTest::Generator qw( Unit ); =head1 NAME Test::LectroTest::TestRunner - Configurable TAP-compatible engine for running LectroTest property checks =head1 VERSION version 0.5001 =head1 SYNOPSIS use Test::LectroTest::TestRunner; my @args = trials => 1_000, retries => 20_000; my $runner = Test::LectroTest::TestRunner->new( @args ); # test a single property and print details upon failure my $result = $runner->run( $a_single_lectrotest_property ); print $result->details unless $result->success; # test a suite of properties, w/ Test::Harness::TAP output my $num_successful = $runner->run_suite( @properties ); print "# All passed!" if $num_successful == @properties; =head1 DESCRIPTION B If you just want to write and run simple tests, see L. If you really want to learn about the property-checking apparatus or turn its control knobs, read on. This module provides Test::LectroTest::TestRunner, a class of objects that tests properties by running repeated random trials. Create a TestRunner, configure it, and then call its C or C methods to test properties individually or in groups. =head1 METHODS The following methods are available. =cut our %defaults = ( trials => 1_000, retries => 20_000, scalefn => sub { $_[0] / 2 + 1 }, number => 1, verbose => 1, record_failures => undef, playback_failures => undef, ); # build field accessors for my $field (keys %defaults) { no strict 'refs'; *{$field} = sub { my $self = shift; $self->{$field} = $_[0] if @_; $self->{$field} }; } sub regressions { my ($self, $value) = @_; $self->record_failures($value); $self->playback_failures($value); } =pod =head2 new(I) my $runner = new Test::LectroTest::TestRunner( trials => 1_000, retries => 20_000, scalefn => sub { $_[0] / 2 + 1 }, verbose => 1, regressions => "/path/to/regression_suite.txt", ); Creates a new Test::LectroTest::TestRunner and configures it with the given named parameters, if any. Typically, you need only provide the C parameter because the other values are reasonable for almost all situations. Here is what each parameter means: =over 4 =item trials The number of trials to run against each property checked. The default is 1_000. =item retries The number of times to allow a property to retry trials (via C<$tcon-Eretry>) during the entire property check before aborting the check. This is used to prevent infinite looping, should the property retry every attempt. =item scalefn A subroutine that scales the sizing guidance given to input generators. The TestRunner starts with an initial guidance of 1 at the beginning of a property check. For each trial (or retry) of the property, the guidance value is incremented. This causes successive trials to be tried using successively more complex inputs. The C subroutine gets to adjust this guidance on the way to the input generators. Typically, you would change the C subroutine if you wanted to change the rate and which inputs grow during the course of the trials. =item verbose If this paramter is set to true (the default) the TestRunner will use verbose output that includes things like label frequencies and counterexamples. Otherwise, only one-line summaries will be output. Unless you have a good reason to do otherwise, leave this parameter alone because verbose output is almost always what you want. =item record_failures If this parameter is set to a file's pathname (or a FailureRecorder object), the TestRunner will record property-check failures to the file (or recorder). (This is an easy way to build a regression-testing suite.) If the file cannot be created or written to, this parameter will be ignored. Set this parameter to C (the default) to turn off recording. =item playback_failures If this parameter is set to a file's pathname (or a FailureRecorder object), the TestRunner will load previously recorded failures from the file (or recorder) and use them as I test cases when checking properties. If the file cannot be read, this option will be ignored. Set this parameter to C (the default) to turn off recording. =item regressions If this parameter is set to a file's pathname (or a FailureRecorder object), the TestRunner will load failures from and record failures to the file (or recorder). Setting this parameter is a shortcut for, and exactly equivalent to, setting I and to the same value, which is typically what you want when managing a persistent suite of regression tests. This is a write-only accessor. =back You can also set and get the values of the configuration properties using accessors of the same name. For example: $runner->trials( 10_000 ); =cut sub new { my $class = shift; my $self = bless { %defaults, @_ }, $class; if (defined(my $val = delete $self->{regressions})) { $self->regressions($val); } return $self; } =pod =head2 run(I) $results = $runner->run( $a_property ); print $results->summary, "\n"; if ($results->success) { # celebrate! } Checks whether the given property holds by running repeated random trials. The result is a Test::LectroTest::TestRunner::results object, which you can query for fined-grained information about the outcome of the check. The C method takes an optional second argument which gives the test number. If it is not provided (usually the case), the next number available from the TestRunner's internal counter is used. $results = $runner->run( $third_property, 3 ); Additionally, if the TestRunner's I parameter is defined, this method will play back any relevant failure cases from the given playback file (or FailureRecorder). Additionally, if the TestRunner's I parameter is defined, this method will record any new failures to the given file (or FailureRecorder). =cut sub run { my ($self, $prop, $number) = @_; # if a test number wasn't provided, take the next from our counter unless (defined $number) { $number = $self->number; $self->number( $number + 1); } # create a new results object to hold our results; run trials my ($inputs_list, $testfn, $name) = @$prop{qw/inputs test name/}; my $results = Test::LectroTest::TestRunner::results->new( name => $name, number => $number ); # create an empty label store and start at attempts = 0 my %labels; my $attempts = 0; my $in_regressions = 1; # for each set of input-generators, run a series of trials for my $gen_specs (@{$self->_regression_generators($name)}, undef, # separator @$inputs_list) { # an undef value separates the regression-test generators (if # any) from the property's own generators; we use it to turn # on failure recording after the regression-test generators # have all been used. (we don't record failures during # regression testing because they have already been recorded) if (!defined($gen_specs)) { $in_regressions = 0; next; } my $retries = 0; my $base_size = 0; my @vars = sort keys %$gen_specs; my $scalefn = $self->scalefn; for (1 .. ($in_regressions ? 1 : $self->trials)) { # run a trial $base_size++; my $controller=Test::LectroTest::TestRunner::testcontroller->new; my $size = $scalefn->($base_size); my $inputs = { "WARNING" => "EXCEPTION FROM WITHIN GENERATOR" }; my $success = eval { $inputs = { map {($_, $gen_specs->{$_}->generate($size))} @vars }; $testfn->($controller, @$inputs{@vars}); }; # did the trial bail out because of an exception? $results->exception( do { my $ex=$@; chomp $ex; $ex } ) if $@; # was it retried? if ($controller->retried) { $retries++; if ($retries >= $self->retries) { $results->incomplete("$retries retries exceeded"); $results->attempts( $attempts ); return $results; } redo; # re-run the trial w/ new inputs } # the trial ran to completion, so count the attempt $attempts++; # and count the trial toward the bin with matching labels if ($controller->labels) { local $" = " & "; my @cl = sort @{$controller->labels}; $labels{"@cl"}++ if @cl; } # if the trial outcome was failure, return a counterexample unless ( $success ) { $results->counterexample_( $inputs ); $results->notes_( $controller->notes ); $results->attempts( $attempts ); $self->_record_regression( $name, $inputs ) unless $in_regressions; return $results; } # otherwise, loop up to the next trial } } $results->success(1); $results->attempts( $attempts ); $results->labels( \%labels ); return $results; } sub _recorder_for_writes { shift->_get_recorder('record_failures'); } sub _recorder_for_reads { shift->_get_recorder('playback_failures'); } sub _get_recorder { my ($self, $attr) = @_; my $val = $self->{$attr}; if ($val && ! ref $val) { $val = $self->{$attr} = Test::LectroTest::FailureRecorder->new($val); } return $val; } sub _regression_generators { my ($self, $prop_name) = @_; # if we get an error reading failures from the recorder, ignore it # because if we're building a new regression suite, there may not # even be a failure-recording file yet my $failures = eval { $self->_recorder_for_reads->get_failures_for_property($prop_name); } || []; my @gens; for my $inputs (@$failures) { # convert the failure case's inputs into a set of generator # bindings that will generate the failure case my %gen_bindings; $gen_bindings{$_} = Unit($inputs->{$_}) for keys %$inputs; push @gens, \%gen_bindings; } return \@gens; } sub _record_regression { my ($self, $name, $inputs) = @_; eval { $self->_recorder_for_writes # may be undef ->record_failure_for_property($name, $inputs); }; } =pod =head2 run_suite(I...) my $num_successful = $runner->run_suite( @properties ); if ($num_successful == @properties) { # celebrate most jubilantly! } Checks a suite of properties, sending the results of each property checked to C in a form that is compatible with L. For example: 1..5 ok 1 - Property->new disallows use of 'tcon' in bindings ok 2 - magic Property syntax disallows use of 'tcon' in bindings ok 3 - exceptions are caught and reported as failures ok 4 - pre-flight check catches new w/ no args ok 5 - pre-flight check catches unbalanced arguments list By default, labeling statistics and counterexamples (if any) are included in the output if the TestRunner's C property is true. You may override the default by passing the C named parameter after all of the properties in the argument list: my $num_successes = $runner->run_suite( @properties, verbose => 1 ); my $num_failed = @properties - $num_successes; =cut sub _prop($) { blessed $_[0] && $_[0]->isa("Test::LectroTest::Property") } sub run_suite { local $| = 1; my $self = shift; my @tests; my @opts; while (@_) { if (_prop $_[0]) { push @tests, shift; } else { push @opts, shift, shift; } } my %opts = (verbose => $self->verbose, @opts); my $verbose = $opts{verbose}; $self->number(1); # reset test-number count my $successful = 0; # reset success count print "1..", scalar @tests, "\n"; for (@tests) { my $results = $self->run($_); print $verbose ? $results->details : $results->summary ."\n"; $successful += $results->success ? 1 : 0; } return $successful; } =pod =head1 HELPER OBJECTS There are two kinds of objects that TestRunner uses as helpers. Neither is meant to be created by you. Rather, a TestRunner will create them on your behalf when they are needed. The objects are described in the following subsections. =head2 Test::LectroTest::TestRunner::results my $results = $runner->run( $a_property ); print "Property name: ", $results->name, ": "; print $results->success ? "Winner!" : "Loser!"; This is the object that you get back from C. It contains all of the information available about the outcome of a property check and provides the following methods: =over 4 =item success Boolean value: True if the property checked out successfully; false otherwise. =item summary Returns a one line summary of the property-check outcome. It does not end with a newline. Example: ok 1 - Property->new disallows use of 'tcon' in bindings =item details Returns all relevant information about the property-check outcome as a series of lines. The last line is terminated with a newline. The details are identical to the summary (except for the terminating newline) unless label frequencies are present or a counterexample is present, in which case the details will have these extras (the summary does not). Example: 1..1 not ok 1 - 'my_sqrt meets defn of sqrt' falsified in 1 attempts # Counterexample: # $x = '0.546384454460178'; =item name Returns the name of the property to which the results pertain. =item number The number assigned to the property that was checked. =item counterexample Returns the counterexample that "broke" the code being tested, if there is one. Otherwise, returns an empty string. If any notes have been attached to the failing trial, they will be included. =item labels Label counts. If any labels were applied to trials during the property check, this value will be a reference to a hash mapping each combination of labels to the count of trials that had that particular combination. Otherwise, it will be undefined. Note that each trial is counted only once -- for the I combination of labels that was applied to it. For example, consider the following labeling logic: Property { ##[ x <- Int ]## $tcon->label("negative") if $x < 0; $tcon->label("odd") if $x % 2; 1; }, name => "negative/odd labeling example"; For a particular trial, if I was 2 (positive and even), the trial would receive no labels. If I was 3 (positive and odd), the trial would be labeled "odd". If I was -2 (negative and even), the trial would be labeled "negative". If I was -3 (negative and odd), the trial would be labeled "negative & odd". =item label_frequencies Returns a string containing a line-by-line accounting of labels applied during the series of trials: print $results->label_frequencies; The corresponding output looks like this: 25% negative 25% negative & odd 25% odd If no labels were applied, an empty string is returned. =item exception Returns the text of the exception or error that caused the series of trials to be aborted, if the trials were aborted because an exception or error was intercepted by LectroTest. Otherwise, returns an empty string. =item attempts Returns the count of trials performed. =item incomplete In the event that the series of trials was halted before it was completed (such as when the retry count was exhausted), this method will return the reason. Otherwise, it returns an empty string. Note that a series of trials I complete if a counterexample was found. =back =cut package Test::LectroTest::TestRunner::results; { $Test::LectroTest::TestRunner::results::VERSION = '0.5001'; } use Class::Struct; import Data::Dumper; struct( name => '$', success => '$', labels => '$', counterexample_ => '$', notes_ => '$', exception => '$', attempts => '$', incomplete => '$', number => '$', ); sub summary { my $self = shift; my ($name, $attempts) = ($self->name, $self->attempts); my $incomplete = $self->incomplete; my $number = $self->number; local $" = " / "; return $self->success ? "ok $number - '$name' ($attempts attempts)" : $incomplete ? "not ok $number - '$name' incomplete ($incomplete)" : "not ok $number - '$name' falsified in $attempts attempts"; } sub details { my $self = shift; my $summary = $self->summary . "\n"; my $details .= $self->label_frequencies; my $cx = $self->counterexample; if ( $cx ) { $details .= "Counterexample:\n$cx"; } my $ex = $self->exception; if ( $ex ) { local $Data::Dumper::Terse = 1; $details .= "Caught exception: " . Dumper($ex); } $details =~ s/^/\# /mg if $details; # mark as TAP comments return "$summary$details"; } sub label_frequencies { my $self = shift; my $l = $self->labels; my $total = $self->attempts; my @keys = sort { $l->{$b} <=> $l->{$a} } keys %$l; join( "\n", (map {sprintf "% 3d%% %s", (200*$l->{$_}+1)/(2*$total), $_} @keys), "" ); } sub counterexample { my $self = shift; my $vars = $self->counterexample_; return "" unless $vars; # no counterexample my $sorted_keys = [ sort keys %$vars ]; no warnings 'once'; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Useqq = 1; return Data::Dumper->new([@$vars{@$sorted_keys}], $sorted_keys)->Dump . $self->notes; } sub notes { my $self = shift; my $notes = $self->notes_; return $notes ? join("\n", "Notes:", @$notes, "") : ""; } =pod =head2 Test::LectroTest::TestRunner::testcontroller During a live property-check trial, the variable C<$tcon> is available to your Properties. It lets you label the current trial or request that it be re-tried with new inputs. The following methods are available. =cut package Test::LectroTest::TestRunner::testcontroller; { $Test::LectroTest::TestRunner::testcontroller::VERSION = '0.5001'; } import Class::Struct; struct ( labels => '$', retried => '$', notes => '$' ); =pod =over 4 =item retry Property { ##[ x <- Int ]## return $tcon->retry if $x == 0; }, ... ; Stops the current trial and tells the TestRunner to re-try it with new inputs. Typically used to reject a particular case of inputs that doesn't make for a good or valid test. While not required, you will probably want to call C<$tcon-Eretry> as part of a C statement to prevent further execution of your property's logic, the results of which will be thrown out should it run to completion. The return value of C<$tcon-Eretry> is itself meaningless; it is the side-effect of calling it that causes the current trial to be thrown out and re-tried. =cut sub retry { shift->retried(1); } =pod =item label(I) Property { ##[ x <- Int ]## $tcon->label("negative") if $x < 0; $tcon->label("odd") if $x % 2; }, ... ; Applies a label to the current trial. At the end of the trial, all of the labels are gathered together, and the trial is dropped into a bucket bearing the combined label. See the discussion of L for more. =cut sub label { my $self = shift; my $labels = $self->labels; push @$labels, @_; $self->labels( $labels ); } =pod =item trivial Property { ##[ x <- Int ]## $tcon->trivial if $x == 0; }, ... ; Applies the label "trivial" to the current trial. It is identical to calling C