t000755000766000024 013266135663 12673 5ustar00ingystaff000000000000Test-Base-0.89is.t100644000766000024 7513266135663 13575 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; is(<<_ , <<_); 1 2 3 _ 1 2 3 _ oo.t100644000766000024 101613266135663 13633 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 8; my $test = Test::Base->new; my $t = -e 't' ? 't' : 'test'; my @blocks = $test->filters('chomp')->spec_file("$t/spec1")->blocks; is $blocks[0]->foo, '42'; is $blocks[0]->bar, '44'; is $blocks[1]->xxx, '123'; is $blocks[1]->yyy, '321'; @blocks = Test::Base->new->delimiters('^^^', '###')->blocks; is $blocks[0]->foo, "42\n"; is $blocks[0]->bar, "44\n"; is $blocks[1]->xxx, "123\n"; is $blocks[1]->yyy, "321\n"; __END__ ^^^ Test one ### foo 42 ### bar 44 ^^^ Test two ### xxx 123 ### yyy 321 Test-Base-0.89000755000766000024 013266135663 12507 5ustar00ingystaff000000000000README100644000766000024 5342313266135663 13477 0ustar00ingystaff000000000000Test-Base-0.89NAME Test::Base - A Data Driven Testing Framework SYNOPSIS A new test module: # lib/MyProject/Test.pm package MyProject::Test; use Test::Base -Base; use MyProject; package MyProject::Test::Filter; use Test::Base::Filter -base; sub my_filter { return MyProject->do_something(shift); } A sample test: # t/sample.t use MyProject::Test; plan tests => 1 * blocks; run_is input => 'expected'; sub local_filter { s/my/your/; } __END__ === Test one (the name of the test) --- input my_filter local_filter my input lines --- expected expected output === Test two This is an optional description of this particular test. --- input my_filter other input lines --- expected other expected output DESCRIPTION Testing is usually the ugly part of Perl module authoring. Perl gives you a standard way to run tests with Test::Harness, and basic testing primitives with Test::More. After that you are pretty much on your own to develop a testing framework and philosophy. Test::More encourages you to make your own framework by subclassing Test::Builder, but that is not trivial. Test::Base gives you a way to write your own test framework base class that is trivial. In fact it is as simple as two lines: package MyTestFramework; use Test::Base -Base; A module called MyTestFramework.pm containing those two lines, will give all the power of Test::More and all the power of Test::Base to every test file that uses it. As you build up the capabilities of MyTestFramework, your tests will have all of that power as well. MyTestFramework becomes a place for you to put all of your reusable testing bits. As you write tests, you will see patterns and duplication, and you can "upstream" them into MyTestFramework. Of course, you don't have to subclass Test::Base at all. You can use it directly in many applications, including everywhere you would use Test::More. Test::Base concentrates on offering reusable data driven patterns, so that you can write tests with a minimum of code. At the heart of all testing you have inputs, processes and expected outputs. Test::Base provides some clean ways for you to express your input and expected output data, so you can spend your time focusing on that rather than your code scaffolding. EXPORTED FUNCTIONS Test::Base extends Test::More and exports all of its functions. So you can basically write your tests the same as Test::More. Test::Base also exports many functions of its own: is(actual, expected, [test-name]) This is the equivalent of Test::More's is function with one interesting twist. If your actual and expected results differ and the output is multi- line, this function will show you a unified diff format of output. Consider the benefit when looking for the one character that is different in hundreds of lines of output! Diff output requires the optional Text::Diff CPAN module. If you don't have this module, the is() function will simply give you normal Test::More output. To disable diffing altogether, set the TEST_SHOW_NO_DIFFS environment variable (or $ENV{TEST_SHOW_NO_DIFFS}) to a true value. You can also call the no_diff function as a shortcut. blocks( [data-section-name] ) The most important function is blocks. In list context it returns a list of Test::Base::Block objects that are generated from the test specification in the DATA section of your test file. In scalar context it returns the number of objects. This is useful to calculate your Test::More plan. Each Test::Base::Block object has methods that correspond to the names of that object's data sections. There is also a name and a description method for accessing those parts of the block if they were specified. The blocks function can take an optional single argument, that indicates to only return the blocks that contain a particular named data section. Otherwise blocks returns all blocks. my @all_of_my_blocks = blocks; my @just_the_foo_blocks = blocks('foo'); next_block() You can use the next_block function to iterate over all the blocks. while (my $block = next_block) { ... } It returns undef after all blocks have been iterated over. It can then be called again to reiterate. first_block() Returns the first block or undef if there are none. It resets the iterator to the next_block function. run(&subroutine) There are many ways to write your tests. You can reference each block individually or you can loop over all the blocks and perform a common operation. The run function does the looping for you, so all you need to do is pass it a code block to execute for each block. The run function takes a subroutine as an argument, and calls the sub one time for each block in the specification. It passes the current block object to the subroutine. run { my $block = shift; is(process($block->foo), $block->bar, $block->name); }; run_is([data_name1, data_name2]) Many times you simply want to see if two data sections are equivalent in every block, probably after having been run through one or more filters. With the run_is function, you can just pass the names of any two data sections that exist in every block, and it will loop over every block comparing the two sections. run_is 'foo', 'bar'; If no data sections are given run_is will try to detect them automatically. NOTE: Test::Base will silently ignore any blocks that don't contain both sections. is_deep($data1, $data2, $test_name) Like Test::More's is_deeply but uses the more correct Test::Deep module. run_is_deeply([data_name1, data_name2]) Like run_is_deeply but uses is_deep which uses the more correct Test::Deep. run_is_deeply([data_name1, data_name2]) Like run_is but uses is_deeply for complex data structure comparison. run_is_deeply([data_name1, data_name2]) Like run_is_deeply but uses is_deep which uses the more correct Test::Deep. run_like([data_name, regexp | data_name]); The run_like function is similar to run_is except the second argument is a regular expression. The regexp can either be a qr{} object or a data section that has been filtered into a regular expression. run_like 'foo', qr{ [qw(chomp lines)], yyy => ['yaml'], zzz => 'eval', }; If a filters list has only one element, the array ref is optional. filters_delay( [1 | 0] ); By default Test::Base::Block objects are have all their filters run ahead of time. There are testing situations in which it is advantageous to delay the filtering. Calling this function with no arguments or a true value, causes the filtering to be delayed. use Test::Base; filters_delay; plan tests => 1 * blocks; for my $block (blocks) { ... $block->run_filters; ok($block->is_filtered); ... } In the code above, the filters are called manually, using the run_filters method of Test::Base::Block. In functions like run_is, where the tests are run automatically, filtering is delayed until right before the test. filter_arguments() Return the arguments after the equals sign on a filter. sub my_filter { my $args = filter_arguments; # is($args, 'whazzup'); ... } __DATA__ === A test --- data my_filter=whazzup tie_output() You can capture STDOUT and STDERR for operations with this function: my $out = ''; tie_output(*STDOUT, $out); print "Hey!\n"; print "Che!\n"; untie *STDOUT; is($out, "Hey!\nChe!\n"); no_diff() Turn off diff support for is() in a test file. default_object() Returns the default Test::Base object. This is useful if you feel the need to do an OO operation in otherwise functional test code. See OO below. WWW() XXX() YYY() ZZZ() These debugging functions are exported from the Spiffy.pm module. See Spiffy for more info. croak() carp() cluck() confess() You can use the functions from the Carp module without needing to import them. Test::Base does it for you by default. TEST SPECIFICATION Test::Base allows you to specify your test data in an external file, the DATA section of your program or from a scalar variable containing all the text input. A test specification is a series of text lines. Each test (or block) is separated by a line containing the block delimiter and an optional test name. Each block is further subdivided into named sections with a line containing the data delimiter and the data section name. A description of the test can go on lines after the block delimiter but before the first data section. Here is the basic layout of a specification: === --- --- --- === --- --- --- Here is a code example: use Test::Base; delimiters qw(### :::); # test code here __END__ ### Test One We want to see if foo and bar are really the same... ::: foo a foo line another foo line ::: bar a bar line another bar line ### Test Two ::: foo some foo line some other foo line ::: bar some bar line some other bar line ::: baz some baz line some other baz line This example specifies two blocks. They both have foo and bar data sections. The second block has a baz component. The block delimiter is ### and the data delimiter is :::. The default block delimiter is === and the default data delimiter is --- . There are some special data section names used for control purposes: --- SKIP --- ONLY --- LAST A block with a SKIP section causes that test to be ignored. This is useful to disable a test temporarily. A block with an ONLY section causes only that block to be used. This is useful when you are concentrating on getting a single test to pass. If there is more than one block with ONLY, the first one will be chosen. Because ONLY is very useful for debugging and sometimes you forgot to remove the ONLY flag before committing to the VCS or uploading to CPAN, Test::Base by default gives you a diag message saying I found ONLY ... maybe you're debugging?. If you don't like it, use no_diag_on_only. A block with a LAST section makes that block the last one in the specification. All following blocks will be ignored. FILTERS The real power in writing tests with Test::Base comes from its filtering capabilities. Test::Base comes with an ever growing set of useful generic filters than you can sequence and apply to various test blocks. That means you can specify the block serialization in the most readable format you can find, and let the filters translate it into what you really need for a test. It is easy to write your own filters as well. Test::Base allows you to specify a list of filters to each data section of each block. The default filters are norm and trim. These filters will be applied (in order) to the data after it has been parsed from the specification and before it is set into its Test::Base::Block object. You can add to the default filter list with the filters function. You can specify additional filters to a specific block by listing them after the section name on a data section delimiter line. Example: use Test::Base; filters qw(foo bar); filters { perl => 'strict' }; sub upper { uc(shift) } __END__ === Test one --- foo trim chomp upper ... --- bar -norm ... --- perl eval dumper my @foo = map { - $_; } 1..10; \ @foo; Putting a - before a filter on a delimiter line, disables that filter. Scalar vs List Each filter can take either a scalar or a list as input, and will return either a scalar or a list. Since filters are chained together, it is important to learn which filters expect which kind of input and return which kind of output. For example, consider the following filter list: norm trim lines chomp array dumper eval The data always starts out as a single scalar string. norm takes a scalar and returns a scalar. trim takes a list and returns a list, but a scalar is a valid list. lines takes a scalar and returns a list. chomp takes a list and returns a list. array takes a list and returns a scalar (an anonymous array reference containing the list elements). dumper takes a list and returns a scalar. eval takes a scalar and creates a list. A list of exactly one element works fine as input to a filter requiring a scalar, but any other list will cause an exception. A scalar in list context is considered a list of one element. Data accessor methods for blocks will return a list of values when used in list context, and the first element of the list in scalar context. This is usually "the right thing", but be aware. The Stock Filters Test::Base comes with large set of stock filters. They are in the Test::Base::Filter module. See Test::Base::Filter for a listing and description of these filters. Rolling Your Own Filters Creating filter extensions is very simple. You can either write a function in the main namespace, or a method in the Test::Base::Filter namespace or a subclass of it. In either case the text and any extra arguments are passed in and you return whatever you want the new value to be. Here is a self explanatory example: use Test::Base; filters 'foo', 'bar=xyz'; sub foo { transform(shift); } sub Test::Base::Filter::bar { my $self = shift; # The Test::Base::Filter object my $data = shift; my $args = $self->current_arguments; my $current_block_object = $self->block; # transform $data in a barish manner return $data; } If you use the method interface for a filter, you can access the block internals by calling the block method on the filter object. Normally you'll probably just use the functional interface, although all the builtin filters are methods. Note that filters defined in the main namespace can look like: sub filter9 { s/foo/bar/; } since Test::Base automatically munges the input string into $_ variable and checks the return value of the function to see if it looks like a number. If you must define a filter that returns just a single number, do it in a different namespace as a method. These filters don't allow the simplistic $_ munging. OO Test::Base has a nice functional interface for simple usage. Under the hood everything is object oriented. A default Test::Base object is created and all the functions are really just method calls on it. This means if you need to get fancy, you can use all the object oriented stuff too. Just create new Test::Base objects and use the functions as methods. use Test::Base; my $blocks1 = Test::Base->new; my $blocks2 = Test::Base->new; $blocks1->delimiters(qw(!!! @@@))->spec_file('test1.txt'); $blocks2->delimiters(qw(### $$$))->spec_string($test_data); plan tests => $blocks1->blocks + $blocks2->blocks; # ... etc THE TEST::BASE::BLOCK CLASS In Test::Base, blocks are exposed as Test::Base::Block objects. This section lists the methods that can be called on a Test::Base::Block object. Of course, each data section name is also available as a method. name() This is the optional short description of a block, that is specified on the block separator line. description() This is an optional long description of the block. It is the text taken from between the block separator and the first data section. seq_num() Returns a sequence number for this block. Sequence numbers begin with 1. blocks_object() Returns the Test::Base object that owns this block. run_filters() Run the filters on the data sections of the blocks. You don't need to use this method unless you also used the filters_delay function. is_filtered() Returns true if filters have already been run for this block. original_values() Returns a hash of the original, unfiltered values of each data section. SUBCLASSING One of the nicest things about Test::Base is that it is easy to subclass. This is very important, because in your personal project, you will likely want to extend Test::Base with your own filters and other reusable pieces of your test framework. Here is an example of a subclass: package MyTestStuff; use Test::Base -Base; our @EXPORT = qw(some_func); sub some_func { (my ($self), @_) = find_my_self(@_); ... } package MyTestStuff::Block; use base 'Test::Base::Block'; sub desc { $self->description(@_); } package MyTestStuff::Filter; use base 'Test::Base::Filter'; sub upper { $self->assert_scalar(@_); uc(shift); } Note that you don't have to re-Export all the functions from Test::Base. That happens automatically, due to the powers of Spiffy. The first line in some_func allows it to be called as either a function or a method in the test code. DISTRIBUTION SUPPORT You might be thinking that you do not want to use Test::Base in you modules, because it adds an installation dependency. Fear not. Module::Install::TestBase takes care of that. Just write a Makefile.PL that looks something like this: use inc::Module::Install; name 'Foo'; all_from 'lib/Foo.pm'; use_test_base; WriteAll; The line with use_test_base will automatically bundle all the code the user needs to run Test::Base based tests. OTHER COOL FEATURES Test::Base automatically adds: use strict; use warnings; to all of your test scripts and Test::Base subclasses. A Spiffy feature indeed. HISTORY This module started its life with the horrible and ridicule inducing name Test::Chunks. It was renamed to Test::Base with the hope that it would be seen for the very useful module that it has become. If you are switching from Test::Chunks to Test::Base, simply substitute the concept and usage of chunks to blocks. AUTHOR Ingy döt Net COPYRIGHT Copyright 2005-2018. Ingy döt Net. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See http://www.perl.com/perl/misc/Artistic.html Changes100644000766000024 2123513266135663 14106 0ustar00ingystaff000000000000Test-Base-0.890.89 Thu Apr 19 08:54:04 PDT 2018 - Apply PR/19 and PR/21 from @perlpunk++ 0.88 Sun Aug 24 08:09:16 PDT 2014 - Remove a debugging line. 0.87 Tue Aug 19 16:35:34 PDT 2014 - Replace tabs with spaces 0.86 Mon Aug 18 08:29:20 PDT 2014 - Fix for issue/15 0.85 Mon Aug 18 08:07:52 PDT 2014 - Pull Module::Install::TestBase out of Test::Base - It will be released in separate dist - Was causing Test::Base to fail tests 0.84 Sat Aug 16 15:08:32 PDT 2014 - Remove .gitignore - Fix Meta error. s/zild/=zild/ 0.83 Sat Aug 16 12:31:00 PDT 2014 - Meta 0.0.2 0.82 Sat Aug 16 04:14:25 PDT 2014 - Eliminate spurious trailing whitespace 0.81 Sat Aug 16 02:52:12 PDT 2014 - Eliminate File::Basename from test/ 0.80 Fri Aug 15 20:49:55 PDT 2014 - Add t/000-require-modules.t 0.79 Sat Aug 9 00:55:07 PDT 2014 - Dep on EU::MM 6.52 0.78 Sat Aug 9 00:23:58 PDT 2014 - Fix swim errors 0.77 Fri Aug 8 12:39:43 PDT 2014 - Change Provider test to use string eval, keeping it out of the eyes of Perl::Prereqs. 0.76 Thu Aug 7 00:29:39 PDT 2014 - Fix bad encoding in Pod 0.75 Wed Aug 6 22:04:50 PDT 2014 - Use PR/14 which makes old and new Test::Builders work. exodist++ 0.74 Wed Aug 6 13:36:29 PDT 2014 - Add dependency on Filter::Util::Call just to be sure - Spiffy requires it and we already require Spiffy 0.73 Wed Aug 6 13:24:45 PDT 2014 - Doc fix. Thanks @Perlover++ 0.72 Wed Aug 6 10:31:52 PDT 2014 - Dep on new Spiffy-0.40 to get rid of warnings on blead 5.21.x 0.71 Wed Aug 6 09:50:04 PDT 2014 - Applied PR/4 from schwern++ 0.70 Wed Aug 6 09:30:03 PDT 2014 - Fixed doc typo 0.69 Wed Aug 6 09:09:34 PDT 2014 - Add $VERSION back into Test::Base 0.68 Wed Aug 6 08:56:09 PDT 2014 - PR/11 and fixes 0.67 Tue Aug 5 10:16:09 PDT 2014 - Add badges to doc 0.66 Mon Aug 4 00:39:44 PDT 2014 - Remove (c) from Copyright - Ginish doc to Swim 0.65 Sat Aug 2 23:48:34 PDT 2014 - Fix copyright years. 0.64 Fri Aug 1 23:16:11 PDT 2014 - Add Algorithm::Diff and Text::Diff to test.requires 0.63 Fri Aug 1 23:04:30 PDT 2014 - Switch to Zilla-Dist 0.62 Mon Feb 10 14:45:04 PST 2014 - Bad plan in a test 0.61 Sat Feb 8 11:08:00 PST 2014 - Switch to dzil 0.60 Mon Apr 4 15:51:09 CST 2011 - Applied patch by andk++ - Make regexp test skip on 5.14 for now. 0.59 Thu Aug 20 14:56:36 PDT 2009 - Fixed test dep bug reported by Alias++. 0.58 Thu Mar 26 17:26:13 PDT 2009 - Another undef filtering change. 0.57 Thu Mar 26 16:42:03 PDT 2009 - Allow value of undef to be filtered without warnings. 0.56 Sat Mar 7 12:13:32 PST 2009 - Add Test::Deep support with is_deep and run_is_deep 0.55 Thu Dec 4 01:10:11 PST 2008 - Module::Install::TestBase::use_test_base require 'Filter::Util::Call' now. 0.54 Wed Nov 29 15:21:02 PST 2006 - Make dependency on Filter::Util::Call explicit in Makefile.PL Thanks to Adriano Ferreira 0.53 Wed Nov 29 15:21:02 PST 2006 - Changes from miyagawa and crew 0.52 Mon Jun 19 10:44:53 PDT 2006 - Add use_ok to exports 0.51 Fri Jun 16 13:05:22 PDT 2006 - Remove build-requires dep of Spiffy for Module::Install::TestBase - Add in a patch from the good folk at Socialtext. 0.50 Mon Jan 30 10:52:52 PST 2006 - No change. 0.49 got borked on the way to CPAN 0.49 Mon Jan 30 10:52:48 PST 2006 - Added Module::Install::TestBase 0.48 Sun Jan 29 10:19:46 PST 2006 - Fixed test failures on windows 0.47 Thu Jan 19 10:59:37 PST 2006 - Depend on newer Spiffy 0.29 0.46 Sat Jan 14 05:46:31 PST 2006 - Don't sign the distribution tarball - Don't require the diffing stuff 0.45 Mon Jan 9 20:58:04 PST 2006 - Let multilevel inheritance work! - no_diff function turns off diffing. 0.44 Fri Jul 22 23:38:04 PDT 2005 - Bug fix in is_diff from rking - Allow Test::Base to be required without trying to run tests - allow ONLY|LAST|SKIP with run_* implicit names. 0.43 Sun Jun 19 03:14:40 PDT 2005 - change Test::Base::Filter::block to current_block. - change Test::Base::Filter::arguments to current_arguments. - add split and Split filters - add join and Join filters - add reverse and Reverse filters - add hash filter - allow (parens) around a data section name for readability. - allow regexps on split - allow for compact, one-line data sections - allow for repeated filters - detect sections names automatically - import XXX stuff into Filter class - add run_compare - automatically set no_plan sometimes - automatically run run_compare if no plan set at END - massive refactoring of all tests 0.42 Tue Jun 14 09:31:25 PDT 2005 - Make any block method callable with a dummy AUTOLOAD 0.41 Sun Jun 12 15:49:15 PDT 2005 - Add first_block() function - Split Test::Base::Filter into a separate module 0.40 Sat Jun 11 20:55:42 PDT 2005 - Change name from Test::Chunks to more lofty Test::Base - Change concept of "chunks" to "blocks" 0.38 Wed Jun 8 00:33:00 PDT 2005 - Allow simple substitutions on $_ in filters defined in `main::` - Add a filter_arguments() function - Fixed a undef warning in `is()` 0.37 Tue Jun 7 11:04:07 PDT 2005 - Implement rking style diff_is - Add filters `exec_perl_stdout` 0.36 Sun Jun 5 11:49:54 PDT 2005 - add tie_output support - suppress warning in accessor - support backslash escapes in filter arguments - New filters `unchomp chop append eval_stdout eval_stderr eval_all` - Add join string to join filter - Add a Test-Less index 0.35 Thu Jun 2 17:46:30 PDT 2005 - Subtle filter bug fixed 0.34 Sat May 28 23:55:49 PDT 2005 - Allow "late" call of `filters`. - Allow for appending filters that are predefined. 0.33 Sat May 28 23:55:41 PDT 2005 - Support `next_chunk` iterator. 0.32 Tue May 24 08:03:57 PDT 2005 - Add a method to access filter arguments - Curry `use` args to Test::More - Change base64 filter to base64_decode base64_encode - Apply filter just before dispatch in run() - Apply filters in order - Default to Test::Chunks inline classes for subclassing modules (for Filter and Chunks) 0.31 Mon May 23 20:48:28 PDT 2005 - Guess names for chunk_class and filter_class. Easier subclassing. 0.30 Mon May 23 16:39:23 PDT 2005 - Further delay filtering by no running filters when chunks is called in scalar context. 0.29 Sun May 22 21:30:02 PDT 2005 - add filters_delay function - add run_filters method to Test::Chunks::Chunk - Refactor many methods into Test::Chunks::Chunk - Expose internals to the filter methods by providing a `chunk` method to the Filter object. 0.28 Wed May 11 17:13:19 PDT 2005 - Make running of the filters be lazy to avoid undesired side effects when not running all tests. May want to be even lazier in the future... 0.27 Tue May 10 17:01:18 PDT 2005 - Added run_unlike 0.26 Mon May 9 07:57:58 PDT 2005 - Embed perl code in a test specification. This is still experimental and undocumented. 0.25 Sat May 7 01:02:03 PDT 2005 - Add `LAST` special section name to stop at a certain test. - Add test for strict/warnings filter. - Change 'description' method to 'name'. - Add a description method for the multiline description. 0.24 Thu May 5 01:54:29 PDT 2005 - Refactored delimiter default handling 0.23 Thu May 5 00:33:32 PDT 2005 - Make Test::Chunks more subclassable - Add join filter - General Refactorings 0.22 Tue May 3 12:32:39 PDT 2005 - Support a grepping feature for `chunks()` - Ignore chunks that don't contain a specified data section for `run_*` functions. 0.21 Mon May 2 12:29:48 PDT 2005 - Deprecate filters_map and just use filters with a map. 0.20 Mon May 2 00:08:17 PDT 2005 - Added list context to filters. Very powerful stuff. 0.19 Sat Apr 30 17:27:09 PDT 2005 - Add regexp flag tests - Change -XXX to :XXX and use better Spiffy 0.24 0.18 Sat Apr 30 17:27:09 PDT 2005 - Support run_is_deeply 0.17 Sat Apr 30 12:16:03 PDT 2005 - Allow user filters to be plain functions - Add run_like - Add regexp and get_url filters - Allow run* functions to work as methods - Remove diff_is() until implemented 0.16 Fri Apr 29 20:04:24 PDT 2005 - added run_is for common equality tests - strict and dumper filters - Can't use `Spiffy -XXX` until Spiffy exporting is fixed. 0.15 Wed Apr 27 23:50:50 PDT 2005 - export everything Test::More does. - croak if things get called in the wrong order. 0.14 Wed Apr 27 12:22:45 PDT 2005 - Move filters into the Test::Chunks::Filter class 0.13 Mon Apr 25 11:14:27 PDT 2005 - add eval, yaml, list and lines filters - support a filter_map for more flexibility 0.12 Fri Apr 22 00:12:21 PDT 2005 - finished the tests - automagically add strict and warnings to every test script 0.11 Thu Apr 21 11:26:32 PDT 2005 - added delimiters() spec_file() spec_string() filters() functions - implemented nice filters system - lots more tests - finished the doc 0.10 Wed Apr 20 18:05:42 PDT 2005 - Initial version of Test::Chunks spec1100644000766000024 11413266135663 13745 0ustar00ingystaff000000000000Test-Base-0.89/t=== Test one --- foo 42 --- bar 44 === Test two --- xxx 123 --- yyy 321 spec2100644000766000024 6013266135663 13726 0ustar00ingystaff000000000000Test-Base-0.89/t=== --- foo 1 --- bar 2 === --- foo 3 --- bar 4 use.t100644000766000024 15513266135663 13775 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; ok(1, "Dummy test to test module load without any test spec"); Test::More::done_testing(); xxx.t100644000766000024 61413266135663 14030 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan eval { require YAML; 1 } ? (tests => 1 * blocks) : (skip_all => 'Requires YAML'); my ($block) = blocks; eval { XXX($block->text) }; my $error = "$@"; $error =~ s/\\/\//g; is $error, $block->xxx, $block->name; sub fix { s/\bt\b/test/ if -e 'test'; $_; } __DATA__ === XXX Test --- text eval +{ foo => 'bar' } --- xxx fix --- foo: bar ... at t/xxx.t line 9 LICENSE100644000766000024 4366013266135663 13626 0ustar00ingystaff000000000000Test-Base-0.89This software is copyright (c) 2018 by Ingy döt Net. 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) 2018 by Ingy döt Net. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2018 by Ingy döt Net. 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 chop.t100644000766000024 52313266135663 14131 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; filters qw(norm trim chomp); plan tests => 1 * blocks; my $c = next_block; is_deeply $c->input, $c->output; $c = next_block; is $c->input, $c->output; __END__ === --- input lines chomp chop array one two three --- output eval [qw(on tw thre)] === --- input chomp chop one two three --- output eval "one\ntwo\nthre" deep.t100644000766000024 101013266135663 14125 0ustar00ingystaff000000000000Test-Base-0.89/tBEGIN { eval("use Test::Tester") } use Test::Base; BEGIN { skip_all_unless_require('Test::Tester'); skip_all_unless_require('Test::Deep'); } plan tests => 2; my $a = {}; my $b = bless {}, 'Foo'; my $name = "is_deep works on non vs blessed hashes"; my ($dummy, @results) = Test::Tester::run_tests( sub { is_deep($a, $b, $name); }, { ok => 0, name => $name, }, ); is($results[0]->{ok}, 0, "Test did not match"); is($results[0]->{name}, $name, "Test name is correct"); eval.t100644000766000024 52613266135663 14132 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; filters 'eval'; my $block = first_block; is ref($block->hash), 'HASH'; is ref($block->array), 'ARRAY'; is scalar(@{$block->array}), 11; is $block->factorial, '362880'; __END__ === Test --- hash { foo => 'bar', bar => 'hihi', } --- array [ 10 .. 20 ] --- factorial my $x = 1; $x *= $_ for (1 .. 9); $x; hash.t100644000766000024 23213266135663 14120 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- words lines chomp hash foo 42 bar 44 baz because --- hash eval +{ foo => 42, bar => 44, baz => 'because', } head.t100644000766000024 20613266135663 14077 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- in lines head one two three --- out one === --- in lines head=2 join one two three --- out one two join.t100644000766000024 45713266135663 14145 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; is next_block->input, 'onetwothree'; is next_block->input, 'one=two=three'; is next_block->input, "one\n\ntwo\n\nthree"; __DATA__ === --- input lines chomp join one two three === --- input lines chomp join== one two three === --- input lines chomp join=\n\n one two three last.t100644000766000024 63413266135663 14146 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; is scalar(blocks), 3, 'Does LAST limit tests to 3?'; run { is(shift()->test, 'all work and no play'); } __DATA__ === --- test: all work and no play === --- test: all work and no play === --- LAST --- test: all work and no play === --- test: all work and no play === --- test: all work and no play === --- test: all work and no play === --- test: all work and no play late.t100644000766000024 67213266135663 14132 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 5; run {}; eval { filters 'blah', 'blam'; }; is "$@", ""; eval { filters {foo => 'grate'}; }; is "$@", ""; eval { delimiters '***', '&&&'; }; like "$@", qr{^Too late to call delimiters\(\)}; eval { spec_file 'foo.txt'; }; like "$@", qr{^Too late to call spec_file\(\)}; eval { spec_string "my spec\n"; }; like "$@", qr{^Too late to call spec_string\(\)}; __DATA__ === Dummy --- foo --- bar list.t100644000766000024 130513266135663 14172 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 5; my $block1 = [blocks]->[0]; my @values = $block1->grocery; is scalar(@values), 3, 'check list context'; is_deeply \@values, ['apples', 'oranges', 'beef jerky'], 'list context content'; my $block2 = [blocks]->[1]; is_deeply $block2->todo, [ 'Fix YAML', 'Fix Inline', 'Fix Test::Base', ], 'deep block from index'; my $block3 = [blocks]->[2]; is $block3->perl, 'xxx', 'scalar context'; is_deeply [$block3->perl], ['xxx', 'yyy', 'zzz'], 'deep list compare'; __END__ === One --- grocery lines chomp apples oranges beef jerky === Two --- todo lines chomp array Fix YAML Fix Inline Fix Test::Base === Three --- perl eval return qw( xxx yyy zzz ) name.t100644000766000024 40113266135663 14113 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1 * blocks; my @blocks = blocks; is $blocks[0]->name, 'One Time'; is $blocks[1]->name, 'Two Toes'; is $blocks[2]->name, ''; is $blocks[3]->name, 'Three Tips'; __END__ === One Time === Two Toes --- foo === === Three Tips next.t100644000766000024 43613266135663 14161 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 10; for (1..2) { is next_block->foo, 'This is foo'; is next_block->bar, 'This is bar'; while (my $block = next_block) { pass; } } __DATA__ === One --- foo chomp This is foo === Two --- bar chomp This is bar === Three === Four === Five only.t100644000766000024 32713266135663 14163 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; no_diag_on_only; run { pass }; is scalar(blocks), 1; is first_block->foo, "2"; __DATA__ === One --- foo: 1 === Two --- ONLY --- foo: 2 === Three --- foo: 3 --- ONLY === Four --- foo: 4 skip.t100644000766000024 36113266135663 14146 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 5; run { pass }; is scalar(blocks), 2; my @block = blocks; is $block[0]->foo, "2\n"; is $block[1]->foo, "3\n"; __DATA__ === One --- SKIP --- foo 1 === Two --- foo 2 === Three --- foo 3 === Four --- SKIP --- foo 4 sort.t100644000766000024 31213266135663 14163 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === Can sort a list --- (in) split sort join=-: foo bar baz --- out: bar-baz-foo === Can sort backwards --- (in) split sort reverse join=-: foo bar baz --- out: foo-baz-bar tail.t100644000766000024 21213266135663 14124 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- in lines tail one two three --- out three === --- in lines tail=2 join one two three --- out two three trim.t100644000766000024 50613266135663 14154 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; my ($block1, $block2) = blocks; is $block1->foo, "line 1\nline 2\n"; is $block1->bar, "line1\nline2\n"; is $block2->foo, "aaa\n\nbbb\n"; is $block2->bar, "\nxxxx\n\nyyyy\n\n"; __END__ === One --- foo line 1 line 2 --- bar line1 line2 === Two --- bar -trim xxxx yyyy --- foo aaa bbb yaml.t100644000766000024 101513266135663 14157 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan eval { require YAML; 1 } ? (tests => 1 * blocks) : (skip_all => 'Requires YAML'); filters { data1 => 'yaml', data2 => 'eval', }; run_compare; __END__ === YAML Hashes --- data1 foo: xxx bar: [ 1, 2, 3] --- data2 +{ foo => 'xxx', bar => [1,2,3], } === YAML Arrays --- data1 - foo - bar - {x: y} --- data2 [ 'foo', 'bar', { x => 'y' }, ] === YAML Scalar --- data1 --- | sub foo { print "bar\n"; } --- data2 <<'END'; sub foo { print "bar\n"; } END MANIFEST100644000766000024 354613266135663 13731 0ustar00ingystaff000000000000Test-Base-0.89# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.010. CONTRIBUTING Changes LICENSE MANIFEST META.json META.yml Makefile.PL README lib/Test/Base.pm lib/Test/Base.pod lib/Test/Base/Filter.pm lib/Test/Base/Filter.pod t/000-require-modules.t t/Test-Less/index.txt t/TestBaseSubclass.pm t/TestBaseTest.pm t/TestBaseTestA.pm t/TestBaseTestB.pm t/TestBaseTestC.pm t/TestBass.pm t/append.t t/arguments.t t/array.t t/author-pod-syntax.t t/autoload.t t/base64.t t/blocks-scalar.t t/blocks_grep.t t/chomp.t t/chop.t t/compact.t t/compile.t t/deep.t t/delimiters.t t/description.t t/diff_is.t t/dos_spec t/dumper.t t/embed_perl.t t/escape.t t/eval.t t/eval_all.t t/eval_stderr.t t/eval_stdout.t t/expected-zero.t t/export.t t/exported_func.t t/filter_arguments.t t/filter_delay.t t/filter_functions.t t/filters-append.t t/filters.t t/filters_map.t t/first_block.t t/flatten.t t/get_url.t t/hash.t t/head.t t/internals.t t/is.t t/jit-run.t t/join-deep.t t/join.t t/last.t t/late.t t/lazy-filters.t t/lines.t t/list.t t/main_filters.t t/multi-level-inherit.t t/name.t t/next.t t/no_diff.t t/no_plan.t t/normalize.t t/only-with-implicit.t t/only.t t/oo.t t/oo_run.t t/parentheses.t t/prepend.t t/preserve-order.t t/prototypes.t t/quick-plan.t t/quick_test.t t/read_file.t t/regexp.t t/repeated-filters.t t/require.t t/reserved_names.t t/reverse-deep.t t/reverse.t t/run-args.t t/run_compare.t t/run_is.t t/run_is_deep.t t/run_is_deeply.t t/run_like.t t/run_unlike.t t/sample-file.txt t/simple.t t/skip.t t/slice.t t/sort-deep.t t/sort.t t/spec1 t/spec2 t/spec_file.t t/spec_string.t t/split-deep.t t/split-regexp.t t/split.t t/strict-warnings.t t/strict-warnings.test t/strict.t t/subclass-autoclass.t t/subclass-import.t t/subclass.t t/subclass_late.t t/tail.t t/tie_output.t t/trim.t t/unchomp.t t/undef.t t/use-test-more.t t/use.t t/write_file.t t/xxx.t t/yaml.t t/zero-blocks.t META.yml100644000766000024 162513266135663 14045 0ustar00ingystaff000000000000Test-Base-0.89--- abstract: 'A Data Driven Testing Framework' author: - 'Ingy döt Net ' build_requires: Algorithm::Diff: '1.15' ExtUtils::MakeMaker: '6.52' Text::Diff: '0.35' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150005' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-Base no_index: directory: - example - inc - t - xt recommends: Test::Deep: '0' requires: Filter::Util::Call: '0' Scalar::Util: '1.07' Spiffy: '0.40' Test::More: '0.88' perl: v5.8.1 resources: bugtracker: https://github.com/ingydotnet/test-base-pm/issues homepage: https://github.com/ingydotnet/test-base-pm repository: https://github.com/ingydotnet/test-base-pm.git version: '0.89' x_serialization_backend: 'YAML::Tiny version 1.69' array.t100644000766000024 23713266135663 14320 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; is_deeply first_block->foo, [qw(one two three)]; __DATA__ === Create an array reference --- foo lines chomp array one two three chomp.t100644000766000024 47013266135663 14307 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; filters qw(norm trim chomp); plan tests => 1 * blocks; my @blocks = blocks; is $blocks[0]->input, "I am the foo"; is $blocks[1]->input, "One\n\nTwo\n\nThree"; is $blocks[2]->input, "Che!\n"; __END__ === --- input I am the foo === --- input One Two Three === --- input chomp -chomp Che! lines.t100644000766000024 67513266135663 14322 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 6; my @lines1 = [blocks]->[0]->text1; ok @lines1 == 3; is_deeply \@lines1, [ "One\n", "Two\n", "Three \n", ]; my @lines2 = [blocks]->[0]->text2; ok @lines2 == 3; is_deeply \@lines2, [ "Three", "Two", "One", ]; is ref([blocks]->[0]->text3), 'ARRAY'; is scalar(@{[blocks]->[0]->text3}), 0; __END__ === One --- text1 lines One Two Three --- text2 lines chomp Three Two One --- text3 lines array slice.t100644000766000024 35513266135663 14302 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- in lines slice=0,2 join one two three four five --- out one two three === --- in lines slice=2,3 join one two three four five --- out three four === --- in lines slice=1 join one two three --- out two split.t100644000766000024 103413266135663 14351 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; my $b = next_block; is $b->ok, "I am ok. Are you ok?"; $b = next_block; is_deeply [$b->words], [qw(foo bar baz)]; __DATA__ === Split a string of lines into words --- ok split join=\s I am ok. Are you ok? === Split on a string --- words split=x: fooxbarxbaz --- LAST The other tests don't work yet. === --- ok lines split I am ok. Are you ok? === --- test lines Split Reverse Join reverse join=\n I Like Ike Give Peace A Chance Love Is The Answer --- flip Answer The Is Love Chance A Peace Give Ike Like I undef.t100644000766000024 67013266135663 14304 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; filters { perl => ['eval', 'bang'], value => 'chomp', perl2 => 'eval', dummy => 'uuu', }; run_is perl => 'value'; run_is dummy => 'perl2'; sub bang { return defined($_) ? ':-(' : '!!!'; } sub uuu { undef($_); return undef; } __DATA__ === No warnings for sending undef to filter --- perl undef --- value !!! === No warnings returning undef from filter --- dummy --- perl2 undef META.json100644000766000024 330313266135663 14210 0ustar00ingystaff000000000000Test-Base-0.89{ "abstract" : "A Data Driven Testing Framework", "author" : [ "Ingy d\u00f6t Net " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.010, CPAN::Meta::Converter version 2.150005", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test-Base", "no_index" : { "directory" : [ "example", "inc", "t", "xt" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Test::Pod" : "1.41" } }, "runtime" : { "recommends" : { "Test::Deep" : "0" }, "requires" : { "Filter::Util::Call" : "0", "Scalar::Util" : "1.07", "Spiffy" : "0.40", "Test::More" : "0.88", "perl" : "v5.8.1" } }, "test" : { "requires" : { "Algorithm::Diff" : "1.15", "ExtUtils::MakeMaker" : "6.52", "Text::Diff" : "0.35" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/ingydotnet/test-base-pm/issues" }, "homepage" : "https://github.com/ingydotnet/test-base-pm", "repository" : { "type" : "git", "url" : "https://github.com/ingydotnet/test-base-pm.git", "web" : "https://github.com/ingydotnet/test-base-pm" } }, "version" : "0.89", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0211" } append.t100644000766000024 41713266135663 14451 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- in) lines append=---\n join one two three --- out) one --- two --- three --- === --- in) lines chomp append=---\n join one two three --- out one--- two--- three--- === --- in) chomp append=---\n one two three --- out one two three--- base64.t100644000766000024 103713266135663 14305 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => ~~blocks; run_is; __END__ === Test One --- encoded base64_decode SSBMb3ZlIEx1Y3kK --- decoded I Love Lucy === Test Two --- encoded c3ViIHJ1bigmKSB7CiAgICBteSAkc2VsZiA9ICRkZWZhdWx0X29iamVjdDsKICAgIG15ICRjYWxs YmFjayA9IHNoaWZ0OwogICAgZm9yIG15ICRibG9jayAoJHNlbGYtPmJsb2NrcykgewogICAgICAg ICZ7JGNhbGxiYWNrfSgkYmxvY2spOwogICAgfQp9Cg== --- decoded base64_encode sub run(&) { my $self = $default_object; my $callback = shift; for my $block ($self->blocks) { &{$callback}($block); } } dos_spec100644000766000024 22013266135663 14527 0ustar00ingystaff000000000000Test-Base-0.89/t=== Test One --- Foo Line 1 Line 2 --- Bar chomp Line 3 Line 4 === Test One --- Foo Line 5 Line 6 --- Bar chomp Line 7 Line 8 dumper.t100644000766000024 70113266135663 14472 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 3 * blocks; run_is perl => 'dumper'; run_is dumper => 'perl'; run_is dumper => 'dumper'; __DATA__ === Dumper Test --- perl eval dumper [ 1..5, { 'a' .. 'p' }] --- dumper [ 1, 2, 3, 4, 5, { 'a' => 'b', 'c' => 'd', 'e' => 'f', 'g' => 'h', 'i' => 'j', 'k' => 'l', 'm' => 'n', 'o' => 'p' } ] === Another Dumper Test --- perl eval dumper "i like ike" --- dumper 'i like ike' escape.t100644000766000024 32013266135663 14433 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; is next_block->escaped, "line1\nline2"; is next_block->escaped, "\tfoo\n\t\tbar\n"; __END__ === --- escaped escape chomp line1\nline2 === --- escaped escape \tfoo \t\tbar export.t100644000766000024 166513266135663 14551 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 41; ok(defined &plan); ok(defined &ok); ok(defined &is); ok(defined &isnt); ok(defined &like); ok(defined &unlike); ok(defined &is_deeply); ok(defined &cmp_ok); ok(defined &skip); ok(defined &todo_skip); ok(defined &pass); ok(defined &fail); ok(defined &eq_array); ok(defined &eq_hash); ok(defined &eq_set); ok(defined &can_ok); ok(defined &isa_ok); ok(defined &diag); ok(defined &use_ok); ok(defined &blocks); ok(defined &next_block); ok(defined &delimiters); ok(defined &spec_file); ok(defined &spec_string); ok(defined &filters); ok(not defined &filters_map); ok(defined &filters_delay); ok(defined &run); ok(defined &run_is); ok(defined &run_like); ok(defined &run_unlike); ok(defined &run_compare); ok(not defined &diff_is); ok(defined &default_object); ok(defined &WWW); ok(defined &XXX); ok(defined &YYY); ok(defined &ZZZ); ok(defined &croak); ok(defined &carp); # ok(defined &cluck); ok(defined &confess); oo_run.t100644000766000024 54313266135663 14503 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; my $blocks = Test::Base->new; $blocks->delimiters(qw(%%% ***))->filters('lower'); plan tests => 3 * $blocks->blocks; $blocks->run(sub { my $block = shift; is $block->foo, $block->bar, $block->name; }); $blocks->run_is('foo', 'bar'); $blocks->run_like('foo', qr{x}); sub lower { lc } __DATA__ %%% Test *** foo xyz *** bar XYZ regexp.t100644000766000024 54613266135663 14477 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- text one fish two fish red fish blue fish --- re regexp= one fish two fish red fish blue fish === --- text One Fish Two Fish Red Fish Blue Fish --- re regexp=im ^one fish ^two fish ^red fish ^blue fish === --- text One Fish Two Fish Red Fish Blue Fish --- re regexp \A^one\ fish\n ^two\ fish. ^red\ fish. ^blue\ fish\n\z run_is.t100644000766000024 75613266135663 14507 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 7 * blocks; run_is 'foo', 'bar'; run_is 'bar', 'baz'; run_is 'baz', 'foo'; for my $block (blocks) { is $block->foo, $block->bar, $block->name; is $block->bar, $block->baz, $block->name; is $block->baz, $block->foo, $block->name; } my @blocks = blocks; is $blocks[0]->foo, "Hey Now\n"; is $blocks[1]->foo, "Holy Cow\n"; __END__ === One --- foo Hey Now --- bar Hey Now --- baz Hey Now === Two --- baz Holy Cow --- bar Holy Cow --- foo Holy Cow simple.t100644000766000024 60013266135663 14465 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1 * blocks; # A silly test instead of pod2html for my $block (blocks) { is( uc($block->pod), $block->upper, $block->name, ); } __END__ === Header 1 Test --- pod =head1 The Main Event --- upper =HEAD1 THE MAIN EVENT === List Test --- pod =over =item * one =item * two =back --- upper =OVER =ITEM * ONE =ITEM * TWO =BACK strict.t100644000766000024 16613266135663 14513 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === Strict Test --- perl strict my $x = 5; --- strict use strict; use warnings; my $x = 5; compact.t100644000766000024 146113266135663 14650 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1 + 1 * blocks; filters { that => 'chomp' }; run_is this => 'that'; run sub { my $block = shift; my $value = $block->value or return; is $value, 'this', $block->name; }; my $bad_spec = <<'...'; === --- bad: real content bogus stuff --- xxx yyy ... my $tb = Test::Base->new->spec_string($bad_spec); eval { $tb->blocks }; like "$@", qr"Extra lines not allowed in 'bad' section", 'Bad spec fails'; sub upper { uc($_) } __DATA__ === Basic compact form --- (this): there is foo --- (that) there is foo === Filters work --- (this) upper: too high to die --- (that) TOO HIGH TO DIE === Can have no value --- (this): --- (that) === Can have ': ' in value --- (this) : foo: bar --- (that) chop foo: bart === Test trailing blank lines are ok --- (value): this compile.t100644000766000024 7013266135663 14605 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; pass 'Test::Base compiles'; diff_is.t100644000766000024 372313266135663 14630 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; SKIP: { if ($^O eq 'MSWin32' or $^O eq 'android') { skip "$^O doesn't have /tmp", 1; } unless (Test::Base->have_text_diff) { skip 'The autodiffing feature of Test::Base (which rocketh) requires Text-Diff-0.35 and Algorithm-Diff-1.15 (or greater).', 1; } filters { test => [qw(exec_perl_stdout smooth_output)], expected => 'smooth_output', }; run_is; sub smooth_output { s/test-blocks-\d+/test-blocks-321/; # XXX Busted across various Test::Simple versions # s/at line \d+\)/at line 000)/; # s/in (.*) at line (\d+)/at $1 line $2/; # for Test::Simple 0.65 s/( )(.*) line (\d+)\./$1at line ./; s/TAP version 13//; s{Looks like you failed (\d+) (tests?) of (\d+)\.}{$1 $2 of $3 failed.}; s/^\n//gm; } } __DATA__ === little diff --- test use lib 'lib'; use Test::Base tests => 1; is('a b c', 'a b x', 'little diff'); --- expected 1..1 not ok 1 - little diff # Failed test 'little diff' # at line . # got: 'a b c' # expected: 'a b x' # Looks like you failed 1 test of 1. === big diff --- SKIP --- test use lib 'lib'; use Test::Base tests => 1; is(< 1; is(< 2; run { my $block = shift; is($block->one, $block->two); }; my ($block) = blocks; is($block->one, "HEY NOW HEY NOW\n"); sub Test::Base::Filter::upper { my $self = shift; return uc(shift); } __END__ === --- one Hey now Hey Now --- two hEY NoW hEY NoW flatten.t100644000766000024 113213266135663 14652 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; run_is_deeply in => 'out'; filters_delay; my ($b3, $b4) = blocks('bad'); eval { $b3->run_filters }; like "$@", qr"Input to the 'flatten' filter must be a scalar"; eval { $b4->run_filters }; like "$@", qr"Can only flatten a hash or array ref"; __END__ === --- in eval flatten array { one => 'won', two => 'too', three => 'thrice', } --- out lines chomp array one won three thrice two too === --- in eval flatten array [qw(one two three four)] --- out lines chomp array one two three four === --- bad lines flatten one two === --- bad flatten: foo bar baz get_url.t100644000766000024 35313266135663 14642 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan skip_all => "Need to figure out network testing"; # plan tests => 1; run_like html => 'match'; __DATA__ === Test kwiki.org --- (html) get_url: http://www.kwiki.org --- (match) regexp The Official Kwiki Web Site jit-run.t100644000766000024 51013266135663 14564 0ustar00ingystaff000000000000Test-Base-0.89/t# Don't filter until just before dispatch in run() use Test::Base tests => 4; eval { run { pass }; }; like "$@", qr/Can't find a function or method for/, 'expect an error'; __END__ === One --- foo xxx === Two --- foo xxx === Three --- foo xxx === Bad --- foo filter_doesnt_exist_vsdyufbkhdkbjagyewkjbc xxx no_diff.t100644000766000024 14513266135663 14604 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; no_diff; is "xxx\nyyy\n", "xxx\nyyy\n", 'This test is really weak.'; no_plan.t100644000766000024 5013266135663 14601 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan 'no_plan'; pass; prepend.t100644000766000024 55613266135663 14643 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === Prepend lines before lines --- (in) lines prepend=---\n join one two three --- (out) --- one --- two --- three === Prepend chars before lines --- (in) lines chomp prepend=--- join=\n one two three --- (out) chomp ---one ---two ---three === Prepend to a multline string --- (in) prepend=--- one two three --- (out) ---one two three require.t100644000766000024 26113266135663 14653 0ustar00ingystaff000000000000Test-Base-0.89/t# This should not fail (used by Module::Install to check for dependency # presence, etc). require Test::Base; print "1..1\n"; print "ok 1 - Print ran. Code didn't blow up\n"; reverse.t100644000766000024 27413266135663 14656 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- (a) split reverse join=\s: this and that --- (b) : that and this === --- (a) lines reverse join This And That --- (b) That And This unchomp.t100644000766000024 24513266135663 14652 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; filters qw(norm trim chomp); is next_block->input, "on\ntw\nthre\n"; __END__ === --- input lines chomp chop unchomp join one two three Makefile.PL100644000766000024 251113266135663 14541 0ustar00ingystaff000000000000Test-Base-0.89# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.010. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "A Data Driven Testing Framework", "AUTHOR" => "Ingy d\x{f6}t Net ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Test-Base", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "Test::Base", "PREREQ_PM" => { "Filter::Util::Call" => 0, "Scalar::Util" => "1.07", "Spiffy" => "0.40", "Test::More" => "0.88" }, "TEST_REQUIRES" => { "Algorithm::Diff" => "1.15", "ExtUtils::MakeMaker" => "6.52", "Text::Diff" => "0.35" }, "VERSION" => "0.89", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Algorithm::Diff" => "1.15", "ExtUtils::MakeMaker" => "6.52", "Filter::Util::Call" => 0, "Scalar::Util" => "1.07", "Spiffy" => "0.40", "Test::More" => "0.88", "Text::Diff" => "0.35" ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); CONTRIBUTING100644000766000024 237013266135663 14424 0ustar00ingystaff000000000000Test-Base-0.89Contributing ============ The "Test-Base" Project needs your help! Please consider being a contributor. This file contains instructions that will help you be an effective contributor to the Project. GitHub ------ The code for this Project is hosted at GitHub. The URL is: https://github.com/ingydotnet/test-base-pm You can get the code with this command: git clone https://github.com/ingydotnet/test-base-pm If you've found a bug or a missing feature that you would like the author to know about, report it here: https://github.com/ingydotnet/test-base-pm/issues or fix it and submit a pull request here: https://github.com/ingydotnet/test-base-pm/pulls See these links for help on interacting with GitHub: * https://help.github.com/ * https://help.github.com/articles/creating-a-pull-request Zilla::Dist ----------- This Project uses Zilla::Dist to prepare it for publishing to CPAN. Read: https://metacpan.org/pod/Zilla::Dist::Contributing for up-to-date instructions on what contributors like yourself need to know to use it. IRC --- Test-Base has an IRC channel where you can find real people to help you: irc.freenode.net#pkg Join the channel. Join the team! Thanks in advance, # This file generated by Zilla-Dist-0.0.196 autoload.t100644000766000024 62513266135663 15013 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; my $block = first_block; ok((not defined &Test::Base::Block::bogus_method), "Method doesn't exist"); ok((not exists $block->{bogus_method}), "Slot really doesn't exist"); ok((not defined $block->bogus_method), "Method is callable"); my @list_context = $block->bogus_method; ok @list_context == 0, "Returns nothing in list context"; __DATA__ === One --- xyz Flavor eval_all.t100644000766000024 50513266135663 14757 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; filters { in => [qw(eval_all array)], out => 'eval', }; run_is_deeply in => 'out'; __DATA__ === --- (in) print "hi"; warn "hello\n"; print "bye"; print STDERR "baby"; die "darn\n"; --- (out) [undef, "darn\n", "hibye", "hello\nbaby"] === --- (in) [1..3]; --- (out) [[1,2,3], '', '', ''] run-args.t100644000766000024 15413266135663 14736 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; run_is; run_is_deeply; __END__ === --- foo: Coolness --- bar append=ness: Cool run_like.t100644000766000024 106013266135663 15025 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; run_like('html', 're1'); run_like 'html', 're2'; run_like html => qr{stylesheet}; __END__ === Like Test --- html --- re1 regexp=xis 7; eval "use Test::Base"; is "$@", '', 'ok to import parent class *after* subclass'; my @blocks = blocks; is ref(default_object), 'TestBass'; is $blocks[0]->el_nombre, 'Test One'; ok $blocks[0]->can('feedle'), 'Does feedle method exist?'; run_is xxx => 'yyy'; run_like_hell 'thunk', qr(thunk,.*ile.*unk); __DATA__ === Test One --- xxx lines foo_it join a lion a tiger a liger --- yyy foo - a lion foo - a tiger foo - a liger === --- thunk A thunk, a pile of junk === --- thunk A thunk, a jile of punk arguments.t100644000766000024 66013266135663 15207 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; run {}; sub Test::Base::Filter::something { my $self = shift; my $value = shift; my $arguments = $self->current_arguments; is $value, "candle\n", 'value is ok'; is $arguments, "wicked", 'arguments is ok'; is $Test::Base::Filter::arguments, "wicked", '$arguments global variable is ok'; } __END__ === One --- foo something=wicked candle internals.t100644000766000024 557213266135663 15230 0ustar00ingystaff000000000000Test-Base-0.89/t# Each filter should have access to blocks/block internals. use Test::Base tests => 20 * 2; run {}; package Test::Base::Filter; use Test::More; sub foo { my $self = shift; my $value = shift; # Test access to Test::Base::Filter object. ok ref($self), '$self is an object'; is ref($self), 'Test::Base::Filter', '$self is a Test:Base::Filter object'; like $value, qr/^This is some .*text.\z/, 'Filter value is correct'; # Test access to Test::Base::Block object. my $block = $self->current_block; is ref($block), 'Test::Base::Block', 'Have a reference to our block object'; ok not($block->is_filtered), 'Block is not completely filtered yet'; my $name = shift || 'One'; is $block->name, $name, 'name is correct'; my $description = shift || 'One'; is $block->description, $description, 'description is correct'; my $original = shift || "This is some text."; is $block->original_values->{xxx}, $original, 'Access to the original value'; my $seq_num = shift || 1; cmp_ok $block->seq_num, '==', $seq_num, 'Sequence number (seq_num) is correct'; my $array_xxx = shift || ["This is some text."]; is_deeply $block->{xxx}, $array_xxx, 'Test raw content of $block->{xxx}'; my $method_xxx = shift || "This is some text."; is $block->xxx, $method_xxx, 'Test method content of $block->xxx'; # Test access to Test::Base object. my $blocks = $block->blocks_object; my $block_list = $blocks->block_list; is ref($block_list), 'ARRAY', 'Have an array of all blocks'; is scalar(@$block_list), '2', 'Is there 2 blocks?'; is $blocks->block_class, "Test::Base::Block", 'block class'; is $blocks->filter_class, "Test::Base::Filter", 'filter class'; is_deeply $blocks->{_filters}, [qw(norm trim)], 'default filters are ok'; is $blocks->block_delim, '===', 'block delimiter'; is $blocks->data_delim, '---', 'data delimiter'; my $spec = <spec, $spec, 'spec is ok'; is $block_list->[$seq_num - 1], $block, 'test block ref in list'; } sub bar { my $self = shift; my $value = shift; $self->foo($value, 'Two', "This is the 2nd description.\nRight here.", "This is some more text.\n\n", 2, ["This is some more text."], "This is some more text.", ); } __END__ === One --- xxx foo: This is some text. === Two This is the 2nd description. Right here. --- xxx chomp bar This is some more text. join-deep.t100644000766000024 51213266135663 15050 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- (xxx) eval Join [ [qw(a b c)], [qw(d e f)], ] --- (yyy) eval [ qw(abc def) ] === --- (xxx) eval Join=x [ [ [qw(a b c)], [qw(d e f)], ], [ [qw(a b c)], [qw(d e f)], ] ] --- (yyy) eval [ [ qw(axbxc dxexf) ], [ qw(axbxc dxexf) ], ] normalize.t100644000766000024 41313266135663 15176 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 4; my $t = -e 't' ? 't' : 'test'; spec_file "$t/dos_spec"; my @blocks = blocks; is $blocks[0]->Foo, "Line 1\n\nLine 2\n"; is $blocks[0]->Bar, "Line 3\nLine 4"; is $blocks[1]->Foo, "Line 5\n\nLine 6\n"; is $blocks[1]->Bar, "Line 7\nLine 8"; read_file.t100644000766000024 50713266135663 15114 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; sub fix { s/\bt\b/test/ if -e 'test'; $_; } __END__ === Filename is chomped automatically --- file fix read_file t/sample-file.txt --- content A sample of some text in a sample file! === Filename is inline --- file fix read_file: t/sample-file.txt --- content A sample of some text in a sample file! sort-deep.t100644000766000024 25213266135663 15101 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __END__ === Test deep sorting --- (a) eval Sort [ [ [qw(c d b a)], [qw(foo bar baz)], ] ] --- (b) eval Reverse [ [ [qw(d c b a)], [qw(foo baz bar)], ] ] spec_file.t100644000766000024 46313266135663 15134 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; my $t = -e 't' ? 't' : 'test'; filters 'chomp'; spec_file "$t/spec2"; plan tests => 3 * blocks; run { my $block = shift; is ref($block), 'Test::Base::Block'; }; my @blocks = blocks; is($blocks[0]->foo, 1); is($blocks[0]->bar, 2); is($blocks[1]->foo, 3); is($blocks[1]->bar, 4); TestBass.pm100644000766000024 74513266135663 15107 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBass; use Test::Base -Base; # const block_class => 'TestBass::Block'; # const filter_class => 'TestBass::Filter'; our @EXPORT = qw(run_like_hell); sub run_like_hell() { (my ($self), @_) = find_my_self(@_); $self->run_like(@_); } package TestBass::Block; use base 'Test::Base::Block'; sub el_nombre { $self->name(@_) } block_accessor 'feedle'; package TestBass::Filter; use base 'Test::Base::Filter'; sub foo_it { map { "foo - $_"; } @_; } delimiters.t100644000766000024 22613266135663 15341 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; delimiters qw($$$ ***); run { ok(shift); }; __END__ $$$ *** foo this *** bar that $$$ *** foo hola *** bar latre embed_perl.t100644000766000024 62713266135663 15303 0ustar00ingystaff000000000000Test-Base-0.89/t# This feature allows you to put a Perl section at the top of your # specification, between <<< and >>>. Not making this an official # feature yet, until I decide whether I like it. use Test::Base tests => 2; run_is; sub reverse { join '', reverse split '', shift } __DATA__ <<< delimiters '+++', '***'; filters 'chomp'; >>> +++ One *** x reverse 123* *** y *321 +++ Two *** x reverse abc *** y cba prototypes.t100644000766000024 23013266135663 15423 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; is foo(), 'scalar_context', 'testing force scalar context'; sub foo { wantarray ? 'list_context' : 'scalar_context'; } quick-plan.t100644000766000024 17713266135663 15251 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; run_is; __DATA__ === Foo --- a: foo --- b: foo === Bar --- a: bar --- b: bar === Baz --- a: baz --- b: baz quick_test.t100644000766000024 36213266135663 15354 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === Compare strings --- in split sort join=\s: ccc bbb aaa --- out: aaa bbb ccc === Compare deeply --- in eval: [1, 2, 3] --- out eval Reverse: [3, 2, 1] === Compare like --- in: You are here --- out regexp: ere$ run_unlike.t100644000766000024 123113266135663 15370 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; sub perl514 { skip "perl-5.14 regexp stringification is different", shift || 1 if $] > 5.013; } run_unlike('html', 're1'); SKIP: { perl514; run_is 're1' => 're2'; } __END__ === Unlike Test --- html --- re1 regexp=i software error --- re2 chomp (?i-xsm:software error) split-deep.t100644000766000024 37013266135663 15246 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === Complex generic manipulation --- (test) lines chomp Split Reverse Join=\s reverse join=\n Hey I Like Ike Give Peace A Chance Love Is The Answer --- (flipper) chomp Answer The Is Love Chance A Peace Give Ike Like I Hey tie_output.t100644000766000024 61213266135663 15400 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; my $out = "Stuff\n"; my $err = ''; tie_output(*STDOUT, $out); tie_output(*STDERR, $err); warn "Keep out!\n"; print "The eagle has landed\n"; is $out, "Stuff\nThe eagle has landed\n"; print "This bird had flown\n"; is $out, "Stuff\nThe eagle has landed\nThis bird had flown\n"; print STDERR "You 'lil rascal...\n"; is $err, "Keep out!\nYou 'lil rascal...\n"; write_file.t100644000766000024 110313266135663 15344 0ustar00ingystaff000000000000Test-Base-0.89/tuse strict; use lib -e 't' ? 't' : 'test'; use TestBaseTest; if (-e 't') { plan tests => 4; } else { plan skip_all => "Dist test only"; } my $t = -e 't' ? 't' : 'test'; my $file = "$t/output/foo.txt"; ok not(-e $file), "$file doesn't already exist"; first_block; ok -e $file, "$file exists"; open my $fh, $file or die "Can't open '$file' for input:\n$!"; is join('', <$fh>), "One two\nBuckle my shoe\n", '$file content is right'; is first_block->poem, $file, 'Returns file name'; __END__ === --- poem write_file=t/output/foo.txt One two Buckle my shoe blocks_grep.t100644000766000024 66113266135663 15475 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; my $plan = 1 * blocks('foo') + 3; plan tests => $plan; is $plan, 5, 'Make sure plan adds up'; for my $block (blocks('foo')) { is $block->foo, exists($block->{bar}) ? $block->bar : 'no bar'; } eval { blocks(foo => 'bar') }; like "$@", qr{^Invalid arguments passed to 'blocks'}; run_is foo => 'bar'; __DATA__ === --- bar excluded === --- foo included --- bar included === --- foo chomp no bar description.t100644000766000024 76513266135663 15533 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 6; my @blocks = blocks; is $blocks[0]->description, 'One Time'; is $blocks[1]->description, "This is the real description\nof the test."; is $blocks[2]->description, ''; is $blocks[3]->description, ''; is $blocks[4]->description, 'Three Tips'; is $blocks[5]->description, 'Description goes here.'; __END__ === One Time === Two Toes This is the real description of the test. --- foo bar === === === Three Tips --- beezle blob === Description goes here. --- data Some data eval_stderr.t100644000766000024 32013266135663 15505 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; is next_block->perl, <<'...'; You are a foo! You are 1 2. ... __DATA__ === --- perl eval_stderr warn "You are a foo!\n"; my $foo = 2; print STDERR "You are 1 $foo.\n"; return 42; eval_stdout.t100644000766000024 31213266135663 15525 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; is next_block->perl, <<'...'; You are a foo! You are 1 2. ... __DATA__ === --- perl eval_stdout print "You are a foo!\n"; my $foo = 2; print "You are 1 $foo.\n"; return 42; filters_map.t100644000766000024 114413266135663 15525 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 7; eval { filters_map { perl => ['eval'], text => ['chomp', 'lines', 'array'], }; }; like $@, qr{Can't locate object method "filters_map"}; filters { perl => ['eval'], text => ['chomp', 'lines', 'array'], }; run { my $block = shift; is ref($block->perl), 'ARRAY'; is ref($block->text), 'ARRAY'; is_deeply $block->perl, $block->text; }; __DATA__ === One --- perl [ "One\n", "2nd line\n", "\n", "Third time's a charm", ] --- text One 2nd line Third time's a charm === Two --- text tic tac toe --- perl [ 'tic tac toe' ] first_block.t100644000766000024 44013266135663 15477 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 7; filters 'chomp'; is next_block->test, '1'; is next_block->test, '2'; is first_block->test, '1'; is first_block->test, '1'; is next_block->test, '2'; is next_block->test, '3'; ok not defined next_block; __DATA__ === --- test 1 === --- test 2 === --- test 3 parentheses.t100644000766000024 66513266135663 15530 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 17; sub some_text { 'This is some text' }; my $b = first_block; is $b->foo, $b->bar, $b->name; is $b->foo, some_text(); run { my $b = shift; ok defined $b->foo; is @{[$b->foo]}, 1; ok length $b->foo; }; __DATA__ === Parens clarify section --- (foo) some_text --- (bar) some_text === --- (foo: some text === --- foo) some text === --- (foo): some text === --- (foo) split join: some text run_compare.t100644000766000024 42713266135663 15515 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; run_compare in => 'out'; __DATA__ === Compare strings --- in split sort join=\s: ccc bbb aaa --- out: aaa bbb ccc === Compare deeply --- in eval: [1, 2, 3] --- out eval Reverse: [3, 2, 1] === Compare like --- in: You are here --- out regexp: ere$ run_is_deep.t100644000766000024 46313266135663 15477 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; BEGIN { skip_all_unless_require('Test::Deep'); } plan tests => 3; filters 'eval'; run_is_deep qw(foo bar); run { my $block = shift; ok ref $block->foo; ok ref $block->bar; }; __DATA__ === Test is_deeply --- foo { foo => 22, bar => 33 } --- bar { bar => 33, foo => 22 } spec_string.t100644000766000024 50313266135663 15516 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; filters 'chomp'; spec_string <<'...'; === --- foo 1 --- bar 2 === --- foo 3 --- bar 4 ... plan tests => 3 * blocks; run { my $block = shift; is ref($block), 'Test::Base::Block'; }; my @blocks = blocks; is $blocks[0]->foo, 1; is $blocks[0]->bar, 2; is $blocks[1]->foo, 3; is $blocks[1]->bar, 4; zero-blocks.t100644000766000024 20113266135663 15423 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1; ok(blocks == 0, 'Ok to have zero blocks'); __DATA__ There really is nothing here to test... Test000755000766000024 013266135663 14115 5ustar00ingystaff000000000000Test-Base-0.89/libBase.pm100644000766000024 4362413266135663 15516 0ustar00ingystaff000000000000Test-Base-0.89/lib/Testpackage Test::Base; our $VERSION = '0.89'; use Spiffy -Base; use Spiffy ':XXX'; my $HAS_PROVIDER; BEGIN { $HAS_PROVIDER = eval "require Test::Builder::Provider; 1"; if ($HAS_PROVIDER) { Test::Builder::Provider->import('provides'); } else { *provides = sub { 1 }; } } my @test_more_exports; BEGIN { @test_more_exports = qw( ok isnt like unlike is_deeply cmp_ok skip todo_skip pass fail eq_array eq_hash eq_set plan can_ok isa_ok diag use_ok $TODO ); } use Test::More import => \@test_more_exports; use Carp; our @EXPORT = (@test_more_exports, qw( is no_diff blocks next_block first_block delimiters spec_file spec_string filters filters_delay filter_arguments run run_compare run_is run_is_deeply run_like run_unlike skip_all_unless_require is_deep run_is_deep WWW XXX YYY ZZZ tie_output no_diag_on_only find_my_self default_object croak carp cluck confess )); field '_spec_file'; field '_spec_string'; field _filters => [qw(norm trim)]; field _filters_map => {}; field spec => -init => '$self->_spec_init'; field block_list => -init => '$self->_block_list_init'; field _next_list => []; field block_delim => -init => '$self->block_delim_default'; field data_delim => -init => '$self->data_delim_default'; field _filters_delay => 0; field _no_diag_on_only => 0; field block_delim_default => '==='; field data_delim_default => '---'; my $default_class; my $default_object; my $reserved_section_names = {}; sub default_object { $default_object ||= $default_class->new; return $default_object; } my $import_called = 0; sub import() { $import_called = 1; my $class = (grep /^-base$/i, @_) ? scalar(caller) : $_[0]; if (not defined $default_class) { $default_class = $class; } # else { # croak "Can't use $class after using $default_class" # unless $default_class->isa($class); # } unless (grep /^-base$/i, @_) { my @args; for (my $ii = 1; $ii <= $#_; ++$ii) { if ($_[$ii] eq '-package') { ++$ii; } else { push @args, $_[$ii]; } } Test::More->import(import => \@test_more_exports, @args) if @args; } _strict_warnings(); goto &Spiffy::import; } # Wrap Test::Builder::plan my $plan_code = \&Test::Builder::plan; my $Have_Plan = 0; { no warnings 'redefine'; *Test::Builder::plan = sub { $Have_Plan = 1; goto &$plan_code; }; } my $DIED = 0; $SIG{__DIE__} = sub { $DIED = 1; die @_ }; sub block_class { $self->find_class('Block') } sub filter_class { $self->find_class('Filter') } sub find_class { my $suffix = shift; my $class = ref($self) . "::$suffix"; return $class if $class->can('new'); $class = __PACKAGE__ . "::$suffix"; return $class if $class->can('new'); eval "require $class"; return $class if $class->can('new'); die "Can't find a class for $suffix"; } sub check_late { if ($self->{block_list}) { my $caller = (caller(1))[3]; $caller =~ s/.*:://; croak "Too late to call $caller()" } } sub find_my_self() { my $self = ref($_[0]) eq $default_class ? splice(@_, 0, 1) : default_object(); return $self, @_; } sub blocks() { (my ($self), @_) = find_my_self(@_); croak "Invalid arguments passed to 'blocks'" if @_ > 1; croak sprintf("'%s' is invalid argument to blocks()", shift(@_)) if @_ && $_[0] !~ /^[a-zA-Z]\w*$/; my $blocks = $self->block_list; my $section_name = shift || ''; my @blocks = $section_name ? (grep { exists $_->{$section_name} } @$blocks) : (@$blocks); return scalar(@blocks) unless wantarray; return (@blocks) if $self->_filters_delay; for my $block (@blocks) { $block->run_filters unless $block->is_filtered; } return (@blocks); } sub next_block() { (my ($self), @_) = find_my_self(@_); my $list = $self->_next_list; if (@$list == 0) { $list = [@{$self->block_list}, undef]; $self->_next_list($list); } my $block = shift @$list; if (defined $block and not $block->is_filtered) { $block->run_filters; } return $block; } sub first_block() { (my ($self), @_) = find_my_self(@_); $self->_next_list([]); $self->next_block; } sub filters_delay() { (my ($self), @_) = find_my_self(@_); $self->_filters_delay(defined $_[0] ? shift : 1); } sub no_diag_on_only() { (my ($self), @_) = find_my_self(@_); $self->_no_diag_on_only(defined $_[0] ? shift : 1); } sub delimiters() { (my ($self), @_) = find_my_self(@_); $self->check_late; my ($block_delimiter, $data_delimiter) = @_; $block_delimiter ||= $self->block_delim_default; $data_delimiter ||= $self->data_delim_default; $self->block_delim($block_delimiter); $self->data_delim($data_delimiter); return $self; } sub spec_file() { (my ($self), @_) = find_my_self(@_); $self->check_late; $self->_spec_file(shift); return $self; } sub spec_string() { (my ($self), @_) = find_my_self(@_); $self->check_late; $self->_spec_string(shift); return $self; } sub filters() { (my ($self), @_) = find_my_self(@_); if (ref($_[0]) eq 'HASH') { $self->_filters_map(shift); } else { my $filters = $self->_filters; push @$filters, @_; } return $self; } sub filter_arguments() { $Test::Base::Filter::arguments; } sub have_text_diff { eval { require Text::Diff; 1 } && $Text::Diff::VERSION >= 0.35 && $Algorithm::Diff::VERSION >= 1.15; } provides 'is'; sub is($$;$) { (my ($self), @_) = find_my_self(@_); my ($actual, $expected, $name) = @_; local $Test::Builder::Level = $Test::Builder::Level + 1 unless $HAS_PROVIDER; if ($ENV{TEST_SHOW_NO_DIFFS} or not defined $actual or not defined $expected or $actual eq $expected or not($self->have_text_diff) or $expected !~ /\n./s ) { Test::More::is($actual, $expected, $name); } else { $name = '' unless defined $name; ok $actual eq $expected, $name; diag Text::Diff::diff(\$expected, \$actual); } } sub run(&;$) { (my ($self), @_) = find_my_self(@_); my $callback = shift; for my $block (@{$self->block_list}) { $block->run_filters unless $block->is_filtered; &{$callback}($block); } } my $name_error = "Can't determine section names"; sub _section_names { return unless defined $self->spec; return @_ if @_ == 2; my $block = $self->first_block or croak $name_error; my @names = grep { $_ !~ /^(ONLY|LAST|SKIP)$/; } @{$block->{_section_order}[0] || []}; croak "$name_error. Need two sections in first block" unless @names == 2; return @names; } sub _assert_plan { plan('no_plan') unless $Have_Plan; } sub END { run_compare() unless $Have_Plan or $DIED or not $import_called; } sub run_compare() { (my ($self), @_) = find_my_self(@_); return unless defined $self->spec; $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); local $Test::Builder::Level = $Test::Builder::Level + 1; for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and exists($block->{$y}); $block->run_filters unless $block->is_filtered; if (ref $block->$x) { is_deeply($block->$x, $block->$y, $block->name ? $block->name : ()); } elsif (ref $block->$y eq 'Regexp') { my $regexp = ref $y ? $y : $block->$y; like($block->$x, $regexp, $block->name ? $block->name : ()); } else { is($block->$x, $block->$y, $block->name ? $block->name : ()); } } } sub run_is() { (my ($self), @_) = find_my_self(@_); $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); local $Test::Builder::Level = $Test::Builder::Level + 1; for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and exists($block->{$y}); $block->run_filters unless $block->is_filtered; is($block->$x, $block->$y, $block->name ? $block->name : () ); } } sub run_is_deeply() { (my ($self), @_) = find_my_self(@_); $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and exists($block->{$y}); $block->run_filters unless $block->is_filtered; is_deeply($block->$x, $block->$y, $block->name ? $block->name : () ); } } sub run_like() { (my ($self), @_) = find_my_self(@_); $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and defined($y); $block->run_filters unless $block->is_filtered; my $regexp = ref $y ? $y : $block->$y; like($block->$x, $regexp, $block->name ? $block->name : () ); } } sub run_unlike() { (my ($self), @_) = find_my_self(@_); $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and defined($y); $block->run_filters unless $block->is_filtered; my $regexp = ref $y ? $y : $block->$y; unlike($block->$x, $regexp, $block->name ? $block->name : () ); } } sub skip_all_unless_require() { (my ($self), @_) = find_my_self(@_); my $module = shift; eval "require $module; 1" or Test::More::plan( skip_all => "$module failed to load" ); } sub is_deep() { (my ($self), @_) = find_my_self(@_); require Test::Deep; Test::Deep::cmp_deeply(@_); } sub run_is_deep() { (my ($self), @_) = find_my_self(@_); $self->_assert_plan; my ($x, $y) = $self->_section_names(@_); for my $block (@{$self->block_list}) { next unless exists($block->{$x}) and exists($block->{$y}); $block->run_filters unless $block->is_filtered; is_deep($block->$x, $block->$y, $block->name ? $block->name : () ); } } sub _pre_eval { my $spec = shift; return unless defined $spec; return $spec unless $spec =~ s/\A\s*<<<(.*?)>>>\s*$//sm; my $eval_code = $1; eval "package main; $eval_code"; croak $@ if $@; return $spec; } sub _block_list_init { my $spec = $self->spec; return [] unless defined $spec; $spec = $self->_pre_eval($spec); my $cd = $self->block_delim; my @hunks = ($spec =~ /^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg); my $blocks = $self->_choose_blocks(@hunks); $self->block_list($blocks); # Need to set early for possible filter use my $seq = 1; for my $block (@$blocks) { $block->blocks_object($self); $block->seq_num($seq++); } return $blocks; } sub _choose_blocks { my $blocks = []; for my $hunk (@_) { my $block = $self->_make_block($hunk); if (exists $block->{ONLY}) { diag "I found ONLY: maybe you're debugging?" unless $self->_no_diag_on_only; return [$block]; } next if exists $block->{SKIP}; push @$blocks, $block; if (exists $block->{LAST}) { return $blocks; } } return $blocks; } sub _check_reserved { my $id = shift; croak "'$id' is a reserved name. Use something else.\n" if $reserved_section_names->{$id} or $id =~ /^_/; } sub _make_block { my $hunk = shift; my $cd = $self->block_delim; my $dd = $self->data_delim; my $block = $self->block_class->new; $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die; my $name = $1; my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk; my $description = shift @parts; $description ||= ''; unless ($description =~ /\S/) { $description = $name; } $description =~ s/\s*\z//; $block->set_value(description => $description); my $section_map = {}; my $section_order = []; while (@parts) { my ($type, $filters, $value) = splice(@parts, 0, 3); $self->_check_reserved($type); $value = '' unless defined $value; $filters = '' unless defined $filters; if ($filters =~ /:(\s|\z)/) { croak "Extra lines not allowed in '$type' section" if $value =~ /\S/; ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2; $value = '' unless defined $value; $value =~ s/^\s*(.*?)\s*$/$1/; } $section_map->{$type} = { filters => $filters, }; push @$section_order, $type; $block->set_value($type, $value); } $block->set_value(name => $name); $block->set_value(_section_map => $section_map); $block->set_value(_section_order => $section_order); return $block; } sub _spec_init { return $self->_spec_string if $self->_spec_string; local $/; my $spec; if (my $spec_file = $self->_spec_file) { open FILE, $spec_file or die $!; $spec = ; close FILE; } else { require Scalar::Util; my $handle = Scalar::Util::openhandle( \*main::DATA ); if ($handle) { $spec = <$handle>; } } return $spec; } sub _strict_warnings() { require Filter::Util::Call; my $done = 0; Filter::Util::Call::filter_add( sub { return 0 if $done; my ($data, $end) = ('', ''); while (my $status = Filter::Util::Call::filter_read()) { return $status if $status < 0; if (/^__(?:END|DATA)__\r?$/) { $end = $_; last; } $data .= $_; $_ = ''; } $_ = "use strict;use warnings;$data$end"; $done = 1; } ); } sub tie_output() { my $handle = shift; die "No buffer to tie" unless @_; tie *$handle, 'Test::Base::Handle', $_[0]; } sub no_diff { $ENV{TEST_SHOW_NO_DIFFS} = 1; } package Test::Base::Handle; sub TIEHANDLE() { my $class = shift; bless \ $_[0], $class; } sub PRINT { $$self .= $_ for @_; } #=============================================================================== # Test::Base::Block # # This is the default class for accessing a Test::Base block object. #=============================================================================== package Test::Base::Block; our @ISA = qw(Spiffy); our @EXPORT = qw(block_accessor); sub AUTOLOAD { return; } sub block_accessor() { my $accessor = shift; no strict 'refs'; return if defined &$accessor; *$accessor = sub { my $self = shift; if (@_) { Carp::croak "Not allowed to set values for '$accessor'"; } my @list = @{$self->{$accessor} || []}; return wantarray ? (@list) : $list[0]; }; } block_accessor 'name'; block_accessor 'description'; Spiffy::field 'seq_num'; Spiffy::field 'is_filtered'; Spiffy::field 'blocks_object'; Spiffy::field 'original_values' => {}; sub set_value { no strict 'refs'; my $accessor = shift; block_accessor $accessor unless defined &$accessor; $self->{$accessor} = [@_]; } sub run_filters { my $map = $self->_section_map; my $order = $self->_section_order; Carp::croak "Attempt to filter a block twice" if $self->is_filtered; for my $type (@$order) { my $filters = $map->{$type}{filters}; my @value = $self->$type; $self->original_values->{$type} = $value[0]; for my $filter ($self->_get_filters($type, $filters)) { $Test::Base::Filter::arguments = $filter =~ s/=(.*)$// ? $1 : undef; my $function = "main::$filter"; no strict 'refs'; if (defined &$function) { local $_ = (@value == 1 and not defined($value[0])) ? undef : join '', @value; my $old = $_; @value = &$function(@value); if (not(@value) or @value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/ ) { if ($value[0] && $_ eq $old) { Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't."); } @value = ($_); } } else { my $filter_object = $self->blocks_object->filter_class->new; die "Can't find a function or method for '$filter' filter\n" unless $filter_object->can($filter); $filter_object->current_block($self); @value = $filter_object->$filter(@value); } # Set the value after each filter since other filters may be # introspecting. $self->set_value($type, @value); } } $self->is_filtered(1); } sub _get_filters { my $type = shift; my $string = shift || ''; $string =~ s/\s*(.*?)\s*/$1/; my @filters = (); my $map_filters = $self->blocks_object->_filters_map->{$type} || []; $map_filters = [ $map_filters ] unless ref $map_filters; my @append = (); for ( @{$self->blocks_object->_filters}, @$map_filters, split(/\s+/, $string), ) { my $filter = $_; last unless length $filter; if ($filter =~ s/^-//) { @filters = grep { $_ ne $filter } @filters; } elsif ($filter =~ s/^\+//) { push @append, $filter; } else { push @filters, $filter; } } return @filters, @append; } { %$reserved_section_names = map { ($_, 1); } keys(%Test::Base::Block::), qw( new DESTROY ); } 1; filter_delay.t100644000766000024 107013266135663 15661 0ustar00ingystaff000000000000Test-Base-0.89/t# Each filter should have access to blocks/block internals. use Test::Base; filters qw(chomp lower); filters_delay; plan tests => 8 * blocks; for my $block (blocks) { ok not($block->is_filtered); unlike $block->section, qr/[a-z]/; like $block->section, qr/^I L/; like $block->section, qr/\n/; $block->run_filters; ok $block->is_filtered; like $block->section, qr/[a-z]/; like $block->section, qr/^i l/; unlike $block->section, qr/\n/; } sub lower { lc } __DATA__ === One --- section I LIKE IKE === One --- section I LOVE LUCY lazy-filters.t100644000766000024 42213266135663 15623 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; no_diag_on_only; sub shouldnt_be_run { fail "shouldnt_be_run was run"; } run_is foo => 'bar'; my ($block) = blocks; is($block->foo, "1234"); __DATA__ === --- foo shouldnt_be_run --- bar === --- ONLY --- foo chomp 1234 --- bar chomp 1234 main_filters.t100644000766000024 127213266135663 15676 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 6; is next_block->xxx, "I lmike mike\n"; is next_block->xxx, "I like mikey"; is next_block->xxx, "123\n"; is next_block->xxx, "I like MIKEY"; is next_block->xxx, "I like ike\n"; run_is xxx => 'yyy'; sub mike1 { s/ike/mike/g; }; sub mike2 { $_ = 'I like mikey'; return 123; }; sub mike3 { s/ike/heck/; return "123\n"; } sub mike4 { $_ = 'I like MIKEY'; return; } sub mike5 { return 200; } sub yyy { s/x/y/g } __DATA__ === --- xxx mike1 I like ike === --- xxx mike2 I like ike === --- xxx mike3 I like ike === --- xxx mike4 I like ike === --- xxx mike5 I like ike === --- xxx lines yyy xxx xxx xxx xxx --- yyy yyy yyy yyy yyy reverse-deep.t100644000766000024 73413266135663 15572 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- xxx) eval Reverse array [qw(a b c)], [qw(d e f)], [qw(g h i j)] --- yyy) eval [ [qw(c b a)], [qw(f e d)], [qw(j i h g)] ] === --- xxx) eval Reverse array [ [qw(a b c)], [qw(d e f)], [qw(g h i j)] ], [ [qw(a b c)], [qw(d e f)], [qw(g h i j)] ], --- yyy) eval [ [ [qw(c b a)], [qw(f e d)], [qw(j i h g)] ], [ [qw(c b a)], [qw(f e d)], [qw(j i h g)] ] ] split-regexp.t100644000766000024 36313266135663 15625 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- (xxx) chomp split=// reverse join one two --- (yyy) chomp owt eno === --- (xxx) split=/[XY]/ join=-: oneXtwoYthree --- (yyy): one-two-three === --- (xxx) split join=-: one two three --- (yyy): one-two-three Base.pod100644000766000024 5120213266135663 15653 0ustar00ingystaff000000000000Test-Base-0.89/lib/Test=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Test::Base - A Data Driven Testing Framework =for html test-base-pm test-base-pm =head1 SYNOPSIS A new test module: # lib/MyProject/Test.pm package MyProject::Test; use Test::Base -Base; use MyProject; package MyProject::Test::Filter; use Test::Base::Filter -base; sub my_filter { return MyProject->do_something(shift); } A sample test: # t/sample.t use MyProject::Test; plan tests => 1 * blocks; run_is input => 'expected'; sub local_filter { s/my/your/; } __END__ === Test one (the name of the test) --- input my_filter local_filter my input lines --- expected expected output === Test two This is an optional description of this particular test. --- input my_filter other input lines --- expected other expected output =head1 DESCRIPTION Testing is usually the ugly part of Perl module authoring. Perl gives you a standard way to run tests with Test::Harness, and basic testing primitives with Test::More. After that you are pretty much on your own to develop a testing framework and philosophy. Test::More encourages you to make your own framework by subclassing Test::Builder, but that is not trivial. Test::Base gives you a way to write your own test framework base class that I trivial. In fact it is as simple as two lines: package MyTestFramework; use Test::Base -Base; A module called C containing those two lines, will give all the power of Test::More and all the power of Test::Base to every test file that uses it. As you build up the capabilities of C, your tests will have all of that power as well. C becomes a place for you to put all of your reusable testing bits. As you write tests, you will see patterns and duplication, and you can "upstream" them into C. Of course, you don't have to subclass Test::Base at all. You can use it directly in many applications, including everywhere you would use Test::More. Test::Base concentrates on offering reusable data driven patterns, so that you can write tests with a minimum of code. At the heart of all testing you have inputs, processes and expected outputs. Test::Base provides some clean ways for you to express your input and expected output data, so you can spend your time focusing on that rather than your code scaffolding. =head1 EXPORTED FUNCTIONS Test::Base extends Test::More and exports all of its functions. So you can basically write your tests the same as Test::More. Test::Base also exports many functions of its own: =over =item C This is the equivalent of Test::More's C function with one interesting twist. If your actual and expected results differ and the output is multi- line, this function will show you a unified diff format of output. Consider the benefit when looking for the one character that is different in hundreds of lines of output! Diff output requires the optional C CPAN module. If you don't have this module, the C function will simply give you normal Test::More output. To disable diffing altogether, set the C environment variable (or C<$ENV{TEST_SHOW_NO_DIFFS}>) to a true value. You can also call the C function as a shortcut. =item C The most important function is C. In list context it returns a list of C objects that are generated from the test specification in the C section of your test file. In scalar context it returns the number of objects. This is useful to calculate your Test::More plan. Each Test::Base::Block object has methods that correspond to the names of that object's data sections. There is also a C and a C method for accessing those parts of the block if they were specified. The C function can take an optional single argument, that indicates to only return the blocks that contain a particular named data section. Otherwise C returns all blocks. my @all_of_my_blocks = blocks; my @just_the_foo_blocks = blocks('foo'); =item C You can use the next_block function to iterate over all the blocks. while (my $block = next_block) { ... } It returns undef after all blocks have been iterated over. It can then be called again to reiterate. =item C Returns the first block or undef if there are none. It resets the iterator to the C function. =item C There are many ways to write your tests. You can reference each block individually or you can loop over all the blocks and perform a common operation. The C function does the looping for you, so all you need to do is pass it a code block to execute for each block. The C function takes a subroutine as an argument, and calls the sub one time for each block in the specification. It passes the current block object to the subroutine. run { my $block = shift; is(process($block->foo), $block->bar, $block->name); }; =item C Many times you simply want to see if two data sections are equivalent in every block, probably after having been run through one or more filters. With the C function, you can just pass the names of any two data sections that exist in every block, and it will loop over every block comparing the two sections. run_is 'foo', 'bar'; If no data sections are given C will try to detect them automatically. NOTE: Test::Base will silently ignore any blocks that don't contain both sections. =item C Like Test::More's C but uses the more correct Test::Deep module. =item C Like C but uses C which uses the more correct Test::Deep. =item C Like C but uses C for complex data structure comparison. =item C Like C but uses C which uses the more correct Test::Deep. =item C The C function is similar to C except the second argument is a regular expression. The regexp can either be a C object or a data section that has been filtered into a regular expression. run_like 'foo', qr{ The C function is similar to C, except the opposite. run_unlike 'foo', qr{ The C function is like the C, C and the C functions all rolled into one. It loops over each relevant block and determines what type of comparison to do. NOTE: If you do not specify either a plan, or run any tests, the C function will automatically be run. =item C Override the default delimiters of C<===> and C<--->. =item C By default, Test::Base reads its input from the DATA section. This function tells it to get the spec from a file instead. =item C By default, Test::Base reads its input from the DATA section. This function tells it to get the spec from a string that has been prepared somehow. =item C Specify a list of additional filters to be applied to all blocks. See C below. You can also specify a hash ref that maps data section names to an array ref of filters for that data type. filters { xxx => [qw(chomp lines)], yyy => ['yaml'], zzz => 'eval', }; If a filters list has only one element, the array ref is optional. =item C By default Test::Base::Block objects are have all their filters run ahead of time. There are testing situations in which it is advantageous to delay the filtering. Calling this function with no arguments or a true value, causes the filtering to be delayed. use Test::Base; filters_delay; plan tests => 1 * blocks; for my $block (blocks) { ... $block->run_filters; ok($block->is_filtered); ... } In the code above, the filters are called manually, using the C method of Test::Base::Block. In functions like C, where the tests are run automatically, filtering is delayed until right before the test. =item C Return the arguments after the equals sign on a filter. sub my_filter { my $args = filter_arguments; # is($args, 'whazzup'); ... } __DATA__ === A test --- data my_filter=whazzup =item C You can capture STDOUT and STDERR for operations with this function: my $out = ''; tie_output(*STDOUT, $out); print "Hey!\n"; print "Che!\n"; untie *STDOUT; is($out, "Hey!\nChe!\n"); =item C Turn off diff support for is() in a test file. =item C Returns the default Test::Base object. This is useful if you feel the need to do an OO operation in otherwise functional test code. See L below. =item C These debugging functions are exported from the Spiffy.pm module. See L for more info. =item C You can use the functions from the Carp module without needing to import them. Test::Base does it for you by default. =back =head1 TEST SPECIFICATION Test::Base allows you to specify your test data in an external file, the DATA section of your program or from a scalar variable containing all the text input. A I is a series of text lines. Each test (or block) is separated by a line containing the block delimiter and an optional test C. Each block is further subdivided into named sections with a line containing the data delimiter and the data section name. A C of the test can go on lines after the block delimiter but before the first data section. Here is the basic layout of a specification: === --- --- --- === --- --- --- Here is a code example: use Test::Base; delimiters qw(### :::); # test code here __END__ ### Test One We want to see if foo and bar are really the same... ::: foo a foo line another foo line ::: bar a bar line another bar line ### Test Two ::: foo some foo line some other foo line ::: bar some bar line some other bar line ::: baz some baz line some other baz line This example specifies two blocks. They both have foo and bar data sections. The second block has a baz component. The block delimiter is C<###> and the data delimiter is C<:::>. The default block delimiter is C<===> and the default data delimiter is C<--- >. There are some special data section names used for control purposes: --- SKIP --- ONLY --- LAST A block with a SKIP section causes that test to be ignored. This is useful to disable a test temporarily. A block with an ONLY section causes only that block to be used. This is useful when you are concentrating on getting a single test to pass. If there is more than one block with ONLY, the first one will be chosen. Because ONLY is very useful for debugging and sometimes you forgot to remove the ONLY flag before committing to the VCS or uploading to CPAN, Test::Base by default gives you a diag message saying I. If you don't like it, use C. A block with a LAST section makes that block the last one in the specification. All following blocks will be ignored. =head1 FILTERS The real power in writing tests with Test::Base comes from its filtering capabilities. Test::Base comes with an ever growing set of useful generic filters than you can sequence and apply to various test blocks. That means you can specify the block serialization in the most readable format you can find, and let the filters translate it into what you really need for a test. It is easy to write your own filters as well. Test::Base allows you to specify a list of filters to each data section of each block. The default filters are C and C. These filters will be applied (in order) to the data after it has been parsed from the specification and before it is set into its Test::Base::Block object. You can add to the default filter list with the C function. You can specify additional filters to a specific block by listing them after the section name on a data section delimiter line. Example: use Test::Base; filters qw(foo bar); filters { perl => 'strict' }; sub upper { uc(shift) } __END__ === Test one --- foo trim chomp upper ... --- bar -norm ... --- perl eval dumper my @foo = map { - $_; } 1..10; \ @foo; Putting a C<-> before a filter on a delimiter line, disables that filter. =head2 Scalar vs List Each filter can take either a scalar or a list as input, and will return either a scalar or a list. Since filters are chained together, it is important to learn which filters expect which kind of input and return which kind of output. For example, consider the following filter list: norm trim lines chomp array dumper eval The data always starts out as a single scalar string. C takes a scalar and returns a scalar. C takes a list and returns a list, but a scalar is a valid list. C takes a scalar and returns a list. C takes a list and returns a list. C takes a list and returns a scalar (an anonymous array reference containing the list elements). C takes a list and returns a scalar. C takes a scalar and creates a list. A list of exactly one element works fine as input to a filter requiring a scalar, but any other list will cause an exception. A scalar in list context is considered a list of one element. Data accessor methods for blocks will return a list of values when used in list context, and the first element of the list in scalar context. This is usually "the right thing", but be aware. =head2 The Stock Filters Test::Base comes with large set of stock filters. They are in the C module. See L for a listing and description of these filters. =head2 Rolling Your Own Filters Creating filter extensions is very simple. You can either write a I in the C
namespace, or a I in the C namespace or a subclass of it. In either case the text and any extra arguments are passed in and you return whatever you want the new value to be. Here is a self explanatory example: use Test::Base; filters 'foo', 'bar=xyz'; sub foo { transform(shift); } sub Test::Base::Filter::bar { my $self = shift; # The Test::Base::Filter object my $data = shift; my $args = $self->current_arguments; my $current_block_object = $self->block; # transform $data in a barish manner return $data; } If you use the method interface for a filter, you can access the block internals by calling the C method on the filter object. Normally you'll probably just use the functional interface, although all the builtin filters are methods. Note that filters defined in the C
namespace can look like: sub filter9 { s/foo/bar/; } since Test::Base automatically munges the input string into $_ variable and checks the return value of the function to see if it looks like a number. If you must define a filter that returns just a single number, do it in a different namespace as a method. These filters don't allow the simplistic $_ munging. =head1 OO Test::Base has a nice functional interface for simple usage. Under the hood everything is object oriented. A default Test::Base object is created and all the functions are really just method calls on it. This means if you need to get fancy, you can use all the object oriented stuff too. Just create new Test::Base objects and use the functions as methods. use Test::Base; my $blocks1 = Test::Base->new; my $blocks2 = Test::Base->new; $blocks1->delimiters(qw(!!! @@@))->spec_file('test1.txt'); $blocks2->delimiters(qw(### $$$))->spec_string($test_data); plan tests => $blocks1->blocks + $blocks2->blocks; # ... etc =head1 THE C CLASS In Test::Base, blocks are exposed as Test::Base::Block objects. This section lists the methods that can be called on a Test::Base::Block object. Of course, each data section name is also available as a method. =over =item C This is the optional short description of a block, that is specified on the block separator line. =item C This is an optional long description of the block. It is the text taken from between the block separator and the first data section. =item C Returns a sequence number for this block. Sequence numbers begin with 1. =item C Returns the Test::Base object that owns this block. =item C Run the filters on the data sections of the blocks. You don't need to use this method unless you also used the C function. =item C Returns true if filters have already been run for this block. =item C Returns a hash of the original, unfiltered values of each data section. =back =head1 SUBCLASSING One of the nicest things about Test::Base is that it is easy to subclass. This is very important, because in your personal project, you will likely want to extend Test::Base with your own filters and other reusable pieces of your test framework. Here is an example of a subclass: package MyTestStuff; use Test::Base -Base; our @EXPORT = qw(some_func); sub some_func { (my ($self), @_) = find_my_self(@_); ... } package MyTestStuff::Block; use base 'Test::Base::Block'; sub desc { $self->description(@_); } package MyTestStuff::Filter; use base 'Test::Base::Filter'; sub upper { $self->assert_scalar(@_); uc(shift); } Note that you don't have to re-Export all the functions from Test::Base. That happens automatically, due to the powers of Spiffy. The first line in C allows it to be called as either a function or a method in the test code. =head1 DISTRIBUTION SUPPORT You might be thinking that you do not want to use Test::Base in you modules, because it adds an installation dependency. Fear not. L takes care of that. Just write a Makefile.PL that looks something like this: use inc::Module::Install; name 'Foo'; all_from 'lib/Foo.pm'; use_test_base; WriteAll; The line with C will automatically bundle all the code the user needs to run Test::Base based tests. =head1 OTHER COOL FEATURES Test::Base automatically adds: use strict; use warnings; to all of your test scripts and Test::Base subclasses. A Spiffy feature indeed. =head1 HISTORY This module started its life with the horrible and ridicule inducing name C. It was renamed to C with the hope that it would be seen for the very useful module that it has become. If you are switching from C to C, simply substitute the concept and usage of C to C. =head1 AUTHOR Ingy döt Net =head1 COPYRIGHT Copyright 2005-2018. Ingy döt Net. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut blocks-scalar.t100644000766000024 47113266135663 15722 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1 * blocks() + 1; for (1..blocks) { ok 1, 'Jusk checking my blocking'; } is scalar(blocks), 2, 'correct number of blocks'; sub this_filter_fails { confess "Should never get here"; } __DATA__ this === --- foo this_filter_fails xxxx === --- foo this_filter_fails yyyy expected-zero.t100644000766000024 24413266135663 15756 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; plan tests => 1*blocks; run { my $block = shift; is 0, $block->expected; } __END__ === ok --- expected chomp 0 === oops --- expected: 0 exported_func.t100644000766000024 45313266135663 16047 0ustar00ingystaff000000000000Test-Base-0.89/tpackage Testfunc; use Test::Base -Base; BEGIN { our @EXPORT = qw(func_with_args); } sub func_with_args() { (my ($self), @_) = find_my_self(@_); return @_; } package main; BEGIN { Testfunc->import } plan tests => 1; my @ret = func_with_args(1, 2, 3); is_deeply \@ret, [ 1, 2, 3 ]; run_is_deeply.t100644000766000024 37013266135663 16041 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; filters 'eval'; run_is_deeply qw(foo bar); run { my $block = shift; ok ref $block->foo; ok ref $block->bar; }; __DATA__ === Test is_deeply --- foo { foo => 22, bar => 33 } --- bar { bar => 33, foo => 22 } sample-file.txt100644000766000024 5013266135663 15725 0ustar00ingystaff000000000000Test-Base-0.89/tA sample of some text in a sample file! subclass_late.t100644000766000024 54713266135663 16032 0ustar00ingystaff000000000000Test-Base-0.89/tuse lib 't'; use Test::Base tests => 1; # I can't remember why I added this but it was preventing multiple # levels of inheritance which I needed for the YAML and YAML-Syck # projects. And is also just damn useful in general. SKIP: { skip("yagni For now...", 1); eval "use TestBass"; like "$@", qr{Can't use TestBass after using Test::Base}; } TestBaseTest.pm100644000766000024 17513266135663 15726 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBaseTest; use Test::Base -Base; use File::Path qw(rmtree); my $t = -e 't' ? 't' : 'test'; rmtree("$t/output"); use-test-more.t100644000766000024 5513266135663 15671 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; pass for 1 .. 3; filters-append.t100644000766000024 45613266135663 16122 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; filters qw(chomp +bar foo); is next_block->text, "this,foo,that,bar"; # 2nd test is needed is next_block->text, "this,foo,that,bar"; sub foo { $_[0] . ",foo" } sub bar { $_[0] . ",bar" } sub that { $_[0] . ",that" } __DATA__ === --- text that this === --- text that this preserve-order.t100644000766000024 53213266135663 16144 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 10; run {}; my $count = 0; sub test { my $num = shift; chomp $num; is $num, ++$count; return; } __END__ === One --- grape test 1 --- iceberg_lettuce test 2 --- fig test 3 --- eggplant test 4 --- jalepeno test 5 --- banana test 6 --- apple test 7 --- carrot test 8 --- hot_pepper test 9 --- date test 10 reserved_names.t100644000766000024 214413266135663 16223 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 18; for my $word (qw( BEGIN DESTROY EXPORT ISA block_accessor blocks_object description is_filtered name new run_filters seq_num set_value )) { my $blocks = my_blocks($word); eval {$blocks->blocks}; like $@, qr{'$word' is a reserved name}, "$word is a bad name"; } for my $word (qw( field const stub super )) { my $blocks = my_blocks($word); my @blocks = $blocks->blocks; eval {$blocks->blocks}; is "$@", '', "$word is a good name"; } sub my_blocks { my $word = shift; Test::Base->new->spec_string(<<"..."); === Fail test --- $word This is a test --- foo This is a test ... } my $blocks = Test::Base->new->spec_string(<<'...'); === Fail test --- bar This is a test --- foo This is a test ... eval {$blocks->blocks}; is "$@", ''; TestBaseTestA.pm100644000766000024 5513266135663 16004 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBaseTestA; use Test::Base -Base; TestBaseTestB.pm100644000766000024 6013266135663 16001 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBaseTestB; use TestBaseTestA -Base; TestBaseTestC.pm100644000766000024 6013266135663 16002 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBaseTestC; use TestBaseTestB -Base; strict-warnings.t100644000766000024 27513266135663 16342 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; use lib -e 't' ? 't' : 'test'; eval "require 'strict-warnings.test'"; like "$@", qr{\QGlobal symbol "\E.\Qglobal_variable" requires explicit package name\E}; subclass-import.t100644000766000024 20413266135663 16323 0ustar00ingystaff000000000000Test-Base-0.89/tuse strict; use lib -e 't' ? 't' : 'test'; # Make sure a subclass passes along inport args use TestBaseSubclass tests => 1; pass; filter_arguments.t100644000766000024 41613266135663 16553 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 3; run {}; sub foo { is filter_arguments, '123,456'; return; } sub bar { is filter_arguments, '---holy-crow+++'; is $_, "one\n two\n"; return; } __DATA__ === --- xxx foo=123,456 === --- xxx bar=---holy-crow+++ one two filter_functions.t100644000766000024 62513266135663 16560 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 2; filters { foo => 'upper', bar => 'lower', }; run_is 'foo', 'upper'; run_is 'bar', 'lower'; sub upper { uc(shift) } sub Test::Base::Filter::lower { shift; lc(shift) } __END__ === --- foo So long, and thanks for all the fish! --- bar So long, and thanks for all the fish! --- upper SO LONG, AND THANKS FOR ALL THE FISH! --- lower so long, and thanks for all the fish! repeated-filters.t100644000766000024 15313266135663 16436 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; __DATA__ === --- (foo) lines reverse reverse join one two three --- (bar) one two three TestBaseSubclass.pm100644000766000024 6013266135663 16537 0ustar00ingystaff000000000000Test-Base-0.89/tpackage TestBaseSubclass; use Test::Base -Base; Test-Less000755000766000024 013266135663 14516 5ustar00ingystaff000000000000Test-Base-0.89/tindex.txt100644000766000024 132413266135663 16526 0ustar00ingystaff000000000000Test-Base-0.89/t/Test-Less# This file is an index for the `test-less` facility. # # More information can be found at: # http://search.cpan.org/search?query=Test-Less;mode=dist # filter t/append.t Jun 6 00:32:41 2005 GMT -- ingy filter t/array.t Jun 6 00:32:41 2005 GMT -- ingy filter t/base64.t Jun 6 00:32:41 2005 GMT -- ingy filter t/chomp.t Jun 6 00:32:42 2005 GMT -- ingy filter t/chop.t Jun 6 00:35:08 2005 GMT -- ingy filter t/dumper.t Jun 6 00:35:08 2005 GMT -- ingy filter t/eval.t Jun 6 00:35:08 2005 GMT -- ingy filter t/eval_all.t Jun 6 00:35:08 2005 GMT -- ingy filter t/eval_stderr.t Jun 6 00:35:08 2005 GMT -- ingy filter t/eval_stdout.t Jun 6 00:35:08 2005 GMT -- ingy author-pod-syntax.t100644000766000024 45413266135663 16611 0ustar00ingystaff000000000000Test-Base-0.89/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); only-with-implicit.t100644000766000024 20413266135663 16736 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base tests => 1; no_diag_on_only; run_is; __END__ === --- ONLY --- foo: xxx --- bar: xxx === --- foo: xxx --- bar: yyy strict-warnings.test100644000766000024 5013266135663 17025 0ustar00ingystaff000000000000Test-Base-0.89/tuse Test::Base; $global_variable = 42; subclass-autoclass.t100644000766000024 77313266135663 17022 0ustar00ingystaff000000000000Test-Base-0.89/tpackage Testorama; use Test::Base -Base; BEGIN { our @EXPORT = qw(run_orama); } sub run_orama { pass 'Testorama EXPORT ok'; } package Test::Base::Block; sub foofoo { Test::More::pass 'Test::Base::Block ok'; } package Testorama::Filter; use base 'Test::Base::Filter'; sub rama_rama { Test::More::pass 'Testorama::Filter ok'; } package main; # use Testorama; BEGIN { Testorama->import } plan tests => 3; run_orama; [blocks]->[0]->foofoo; __DATA__ === --- stuff chomp rama_rama che! Base000755000766000024 013266135663 14767 5ustar00ingystaff000000000000Test-Base-0.89/lib/TestFilter.pm100644000766000024 1573513266135663 16745 0ustar00ingystaff000000000000Test-Base-0.89/lib/Test/Base#=============================================================================== # This is the default class for handling Test::Base data filtering. #=============================================================================== package Test::Base::Filter; use Spiffy -Base; use Spiffy ':XXX'; field 'current_block'; our $arguments; sub current_arguments { return undef unless defined $arguments; my $args = $arguments; $args =~ s/(\\s)/ /g; $args =~ s/(\\[a-z])/'"' . $1 . '"'/gee; return $args; } sub assert_scalar { return if @_ == 1; require Carp; my $filter = (caller(1))[3]; $filter =~ s/.*:://; Carp::croak "Input to the '$filter' filter must be a scalar, not a list"; } sub _apply_deepest { my $method = shift; return () unless @_; if (ref $_[0] eq 'ARRAY') { for my $aref (@_) { @$aref = $self->_apply_deepest($method, @$aref); } return @_; } $self->$method(@_); } sub _split_array { map { [$self->split($_)]; } @_; } sub _peel_deepest { return () unless @_; if (ref $_[0] eq 'ARRAY') { if (ref $_[0]->[0] eq 'ARRAY') { for my $aref (@_) { @$aref = $self->_peel_deepest(@$aref); } return @_; } return map { $_->[0] } @_; } return @_; } #=============================================================================== # these filters work on the leaves of nested arrays #=============================================================================== sub Join { $self->_peel_deepest($self->_apply_deepest(join => @_)) } sub Reverse { $self->_apply_deepest(reverse => @_) } sub Split { $self->_apply_deepest(_split_array => @_) } sub Sort { $self->_apply_deepest(sort => @_) } sub append { my $suffix = $self->current_arguments; map { $_ . $suffix } @_; } sub array { return [@_]; } sub base64_decode { $self->assert_scalar(@_); require MIME::Base64; MIME::Base64::decode_base64(shift); } sub base64_encode { $self->assert_scalar(@_); require MIME::Base64; MIME::Base64::encode_base64(shift); } sub chomp { map { CORE::chomp; $_ } @_; } sub chop { map { CORE::chop; $_ } @_; } sub dumper { no warnings 'once'; require Data::Dumper; local $Data::Dumper::Sortkeys = 1; local $Data::Dumper::Indent = 1; local $Data::Dumper::Terse = 1; Data::Dumper::Dumper(@_); } sub escape { $self->assert_scalar(@_); my $text = shift; $text =~ s/(\\.)/eval "qq{$1}"/ge; return $text; } sub eval { $self->assert_scalar(@_); my @return = CORE::eval(shift); return $@ if $@; return @return; } sub eval_all { $self->assert_scalar(@_); my $out = ''; my $err = ''; Test::Base::tie_output(*STDOUT, $out); Test::Base::tie_output(*STDERR, $err); my $return = CORE::eval(shift); no warnings; untie *STDOUT; untie *STDERR; return $return, $@, $out, $err; } sub eval_stderr { $self->assert_scalar(@_); my $output = ''; Test::Base::tie_output(*STDERR, $output); CORE::eval(shift); no warnings; untie *STDERR; return $output; } sub eval_stdout { $self->assert_scalar(@_); my $output = ''; Test::Base::tie_output(*STDOUT, $output); CORE::eval(shift); no warnings; untie *STDOUT; return $output; } sub exec_perl_stdout { my $tmpfile = "/tmp/test-blocks-$$"; $self->_write_to($tmpfile, @_); open my $execution, "$^X $tmpfile 2>&1 |" or die "Couldn't open subprocess: $!\n"; local $/; my $output = <$execution>; close $execution; unlink($tmpfile) or die "Couldn't unlink $tmpfile: $!\n"; return $output; } sub flatten { $self->assert_scalar(@_); my $ref = shift; if (ref($ref) eq 'HASH') { return map { ($_, $ref->{$_}); } sort keys %$ref; } if (ref($ref) eq 'ARRAY') { return @$ref; } die "Can only flatten a hash or array ref"; } sub get_url { $self->assert_scalar(@_); my $url = shift; CORE::chomp($url); require LWP::Simple; LWP::Simple::get($url); } sub hash { return +{ @_ }; } sub head { my $size = $self->current_arguments || 1; return splice(@_, 0, $size); } sub join { my $string = $self->current_arguments; $string = '' unless defined $string; CORE::join $string, @_; } sub lines { $self->assert_scalar(@_); my $text = shift; return () unless length $text; my @lines = ($text =~ /^(.*\n?)/gm); return @lines; } sub norm { $self->assert_scalar(@_); my $text = shift; $text = '' unless defined $text; $text =~ s/\015\012/\n/g; $text =~ s/\r/\n/g; return $text; } sub prepend { my $prefix = $self->current_arguments; map { $prefix . $_ } @_; } sub read_file { $self->assert_scalar(@_); my $file = shift; CORE::chomp $file; open my $fh, $file or die "Can't open '$file' for input:\n$!"; CORE::join '', <$fh>; } sub regexp { $self->assert_scalar(@_); my $text = shift; my $flags = $self->current_arguments; if ($text =~ /\n.*?\n/s) { $flags = 'xism' unless defined $flags; } else { CORE::chomp($text); } $flags ||= ''; my $regexp = eval "qr{$text}$flags"; die $@ if $@; return $regexp; } sub reverse { CORE::reverse(@_); } sub slice { die "Invalid args for slice" unless $self->current_arguments =~ /^(\d+)(?:,(\d))?$/; my ($x, $y) = ($1, $2); $y = $x if not defined $y; die "Invalid args for slice" if $x > $y; return splice(@_, $x, 1 + $y - $x); } sub sort { CORE::sort(@_); } sub split { $self->assert_scalar(@_); my $separator = $self->current_arguments; if (defined $separator and $separator =~ s{^/(.*)/$}{$1}) { my $regexp = $1; $separator = qr{$regexp}; } $separator = qr/\s+/ unless $separator; CORE::split $separator, shift; } sub strict { $self->assert_scalar(@_); <<'...' . shift; use strict; use warnings; ... } sub tail { my $size = $self->current_arguments || 1; return splice(@_, @_ - $size, $size); } sub trim { map { s/\A([ \t]*\n)+//; s/(?<=\n)\s*\z//g; $_; } @_; } sub unchomp { map { $_ . "\n" } @_; } sub write_file { my $file = $self->current_arguments or die "No file specified for write_file filter"; if ($file =~ /(.*)[\\\/]/) { my $dir = $1; if (not -e $dir) { require File::Path; File::Path::mkpath($dir) or die "Can't create $dir"; } } open my $fh, ">$file" or die "Can't open '$file' for output\n:$!"; print $fh @_; close $fh; return $file; } sub yaml { $self->assert_scalar(@_); require YAML; return YAML::Load(shift); } sub _write_to { my $filename = shift; open my $script, ">$filename" or die "Couldn't open $filename: $!\n"; print $script @_; close $script or die "Couldn't close $filename: $!\n"; } 1; 000-require-modules.t100644000766000024 42213266135663 16615 0ustar00ingystaff000000000000Test-Base-0.89/t# This test does a basic `use` check on all the code. use Test::More; use File::Find; sub test { s{^lib/(.*)\.pm$}{$1} or return; s{/}{::}g; ok eval("require $_; 1"), "require $_;$@"; } find { wanted => \&test, no_chdir => 1, }, 'lib'; done_testing; multi-level-inherit.t100644000766000024 26013266135663 17075 0ustar00ingystaff000000000000Test-Base-0.89/tuse strict; use lib -e 't' ? 't' : 'test'; use TestBaseTestC tests => 2; no_diff; pass 'It works'; run_is(); sub upper { uc } __DATA__ === First --- x upper foo --- y FOO Filter.pod100644000766000024 1252013266135663 17100 0ustar00ingystaff000000000000Test-Base-0.89/lib/Test/Base=pod =for comment DO NOT EDIT. This Pod was generated by Swim v0.1.46. See http://github.com/ingydotnet/swim-pm#readme =encoding utf8 =head1 NAME Test::Base::Filter - Default Filter Class for Test::Base =head1 SYNOPSIS package MyTestSuite; use Test::Base -Base; ... reusable testing code ... package MyTestSuite::Filter; use Test::Base::Filter -Base; sub my_filter1 { ... } =head1 DESCRIPTION Filters are the key to writing effective data driven tests with Test::Base. Test::Base::Filter is a class containing a large default set of generic filters. You can easily subclass it to add/override functionality. =head1 FILTERS This is a list of the default stock filters (in alphabetic order): =over =item C list => list Append a string to each element of a list. --- numbers lines chomp append=-#\n join one two three =item C list => scalar Turn a list of values into an anonymous array reference. =item C scalar => scalar Decode base64 data. Useful for binary tests. =item C scalar => scalar Encode base64 data. Useful for binary tests. =item C list => list Remove the final newline from each string value in a list. =item C =back list => list Remove the final char from each string value in a list. =over =item C scalar => list Take a data structure (presumably from another filter like eval) and use Data::Dumper to dump it in a canonical fashion. =item C scalar => scalar Unescape all backslash escaped chars. =item C scalar => list Run Perl's C command against the data and use the returned value as the data. =item C scalar => list Run Perl's C command against the data and return a list of 4 values: 1) The return value 2) The error in $@ 3) Captured STDOUT 4) Captured STDERR =item C scalar => scalar Run Perl's C command against the data and return the captured STDERR. =item C scalar => scalar Run Perl's C command against the data and return the captured STDOUT. =item C list => scalar Input Perl code is written to a temp file and run. STDOUT is captured and returned. =item C scalar => list Takes a hash or array ref and flattens it to a list. =item C scalar => scalar The text is chomped and considered to be a url. Then LWP::Simple::get is used to fetch the contents of the url. =item C list => scalar Turn a list of key/value pairs into an anonymous hash reference. =item C list => list Takes a list and returns a number of the elements from the front of it. The default number is one. =item C list => scalar Join a list of strings into a scalar. =item C Join the list of strings inside a list of array refs and return the strings in place of the array refs. =item C scalar => list Break the data into an anonymous array of lines. Each line (except possibly the last one if the C filter came first) will have a newline at the end. =item C scalar => scalar Normalize the data. Change non-Unix line endings to Unix line endings. =item C list => list Prepend a string onto each of a list of strings. =item C scalar => scalar Read the file named by the current content and return the file's content. =item C scalar => scalar The C filter will turn your data section into a regular expression object. You can pass in extra flags after an equals sign. If the text contains more than one line and no flags are specified, then the 'xism' flags are assumed. =item C list => list Reverse the elements of a list. =item C list => list Reverse the list of strings inside a list of array refs. =item C list => list Returns the element number x through element number y of a list. =item C list => list Sorts the elements of a list in character sort order. =item C list => list Sort the list of strings inside a list of array refs. =item C scalar => list Split a string in into a list. Takes a optional string or regexp as a parameter. Defaults to I. Same as Perl C. =item C list => list Split each of a list of strings and turn them into array refs. =item C scalar => scalar Prepend the string: use strict; use warnings; to the block's text. =item C list => list Return a number of elements from the end of a list. The default number is one. =item C list => list Remove extra blank lines from the beginning and end of the data. This allows you to visually separate your test data with blank lines. =item C list => list Add a newline to each string value in a list. =item C scalar => scalar Write the content of the section to the named file. Return the filename. =item C scalar => list Apply the YAML::Load function to the data block and use the resultant structure. Requires YAML.pm. =back =head1 AUTHOR Ingy döt Net =head1 COPYRIGHT Copyright 2005-2018. Ingy döt Net. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See L =cut