11 @test_more_exports = qw(
12 ok isnt like unlike is_deeply cmp_ok
13 skip todo_skip pass fail
14 eq_array eq_hash eq_set
15 plan can_ok isa_ok diag
21 use Test::More import => \@test_more_exports;
24 our @EXPORT = (@test_more_exports, qw(
27 blocks next_block first_block
28 delimiters spec_file spec_string
29 filters filters_delay filter_arguments
30 run run_compare run_is run_is_deeply run_like run_unlike
32 tie_output no_diag_on_only
34 find_my_self default_object
36 croak carp cluck confess
41 field _filters => [qw(norm trim)];
42 field _filters_map => {};
44 -init => '$self->_spec_init';
46 -init => '$self->_block_list_init';
47 field _next_list => [];
49 -init => '$self->block_delim_default';
51 -init => '$self->data_delim_default';
52 field _filters_delay => 0;
53 field _no_diag_on_only => 0;
55 field block_delim_default => '===';
56 field data_delim_default => '---';
60 my $reserved_section_names = {};
63 $default_object ||= $default_class->new;
64 return $default_object;
67 my $import_called = 0;
70 my $class = (grep /^-base$/i, @_)
73 if (not defined $default_class) {
74 $default_class = $class;
77 # croak "Can't use $class after using $default_class"
78 # unless $default_class->isa($class);
81 unless (grep /^-base$/i, @_) {
83 for (my $ii = 1; $ii <= $#_; ++$ii) {
84 if ($_[$ii] eq '-package') {
90 Test::More->import(import => \@test_more_exports, @args)
98 # Wrap Test::Builder::plan
99 my $plan_code = \&Test::Builder::plan;
102 no warnings 'redefine';
103 *Test::Builder::plan = sub {
110 $SIG{__DIE__} = sub { $DIED = 1; die @_ };
112 sub block_class { $self->find_class('Block') }
113 sub filter_class { $self->find_class('Filter') }
117 my $class = ref($self) . "::$suffix";
118 return $class if $class->can('new');
119 $class = __PACKAGE__ . "::$suffix";
120 return $class if $class->can('new');
121 eval "require $class";
122 return $class if $class->can('new');
123 die "Can't find a class for $suffix";
127 if ($self->{block_list}) {
128 my $caller = (caller(1))[3];
130 croak "Too late to call $caller()"
135 my $self = ref($_[0]) eq $default_class
142 (my ($self), @_) = find_my_self(@_);
144 croak "Invalid arguments passed to 'blocks'"
146 croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
147 if @_ && $_[0] !~ /^[a-zA-Z]\w*$/;
149 my $blocks = $self->block_list;
151 my $section_name = shift || '';
152 my @blocks = $section_name
153 ? (grep { exists $_->{$section_name} } @$blocks)
156 return scalar(@blocks) unless wantarray;
158 return (@blocks) if $self->_filters_delay;
160 for my $block (@blocks) {
162 unless $block->is_filtered;
169 (my ($self), @_) = find_my_self(@_);
170 my $list = $self->_next_list;
172 $list = [@{$self->block_list}, undef];
173 $self->_next_list($list);
175 my $block = shift @$list;
176 if (defined $block and not $block->is_filtered) {
183 (my ($self), @_) = find_my_self(@_);
184 $self->_next_list([]);
188 sub filters_delay() {
189 (my ($self), @_) = find_my_self(@_);
190 $self->_filters_delay(defined $_[0] ? shift : 1);
193 sub no_diag_on_only() {
194 (my ($self), @_) = find_my_self(@_);
195 $self->_no_diag_on_only(defined $_[0] ? shift : 1);
199 (my ($self), @_) = find_my_self(@_);
201 my ($block_delimiter, $data_delimiter) = @_;
202 $block_delimiter ||= $self->block_delim_default;
203 $data_delimiter ||= $self->data_delim_default;
204 $self->block_delim($block_delimiter);
205 $self->data_delim($data_delimiter);
210 (my ($self), @_) = find_my_self(@_);
212 $self->_spec_file(shift);
217 (my ($self), @_) = find_my_self(@_);
219 $self->_spec_string(shift);
224 (my ($self), @_) = find_my_self(@_);
225 if (ref($_[0]) eq 'HASH') {
226 $self->_filters_map(shift);
229 my $filters = $self->_filters;
235 sub filter_arguments() {
236 $Test::Base::Filter::arguments;
240 eval { require Text::Diff; 1 } &&
241 $Text::Diff::VERSION >= 0.35 &&
242 $Algorithm::Diff::VERSION >= 1.15;
246 (my ($self), @_) = find_my_self(@_);
247 my ($actual, $expected, $name) = @_;
248 local $Test::Builder::Level = $Test::Builder::Level + 1;
249 if ($ENV{TEST_SHOW_NO_DIFFS} or
250 not defined $actual or
251 not defined $expected or
252 $actual eq $expected or
253 not($self->have_text_diff) or
256 Test::More::is($actual, $expected, $name);
259 $name = '' unless defined $name;
260 ok $actual eq $expected,
261 $name . "\n" . Text::Diff::diff(\$expected, \$actual);
266 (my ($self), @_) = find_my_self(@_);
267 my $callback = shift;
268 for my $block (@{$self->block_list}) {
269 $block->run_filters unless $block->is_filtered;
270 &{$callback}($block);
274 my $name_error = "Can't determine section names";
276 return @_ if @_ == 2;
277 my $block = $self->first_block
278 or croak $name_error;
280 $_ !~ /^(ONLY|LAST|SKIP)$/;
281 } @{$block->{_section_order}[0] || []};
282 croak "$name_error. Need two sections in first block"
288 plan('no_plan') unless $Have_Plan;
292 run_compare() unless $Have_Plan or $DIED or not $import_called;
296 (my ($self), @_) = find_my_self(@_);
298 my ($x, $y) = $self->_section_names(@_);
299 local $Test::Builder::Level = $Test::Builder::Level + 1;
300 for my $block (@{$self->block_list}) {
301 next unless exists($block->{$x}) and exists($block->{$y});
302 $block->run_filters unless $block->is_filtered;
303 if (ref $block->$x) {
304 is_deeply($block->$x, $block->$y,
305 $block->name ? $block->name : ());
307 elsif (ref $block->$y eq 'Regexp') {
308 my $regexp = ref $y ? $y : $block->$y;
309 like($block->$x, $regexp, $block->name ? $block->name : ());
312 is($block->$x, $block->$y, $block->name ? $block->name : ());
318 (my ($self), @_) = find_my_self(@_);
320 my ($x, $y) = $self->_section_names(@_);
321 local $Test::Builder::Level = $Test::Builder::Level + 1;
322 for my $block (@{$self->block_list}) {
323 next unless exists($block->{$x}) and exists($block->{$y});
324 $block->run_filters unless $block->is_filtered;
325 is($block->$x, $block->$y,
326 $block->name ? $block->name : ()
331 sub run_is_deeply() {
332 (my ($self), @_) = find_my_self(@_);
334 my ($x, $y) = $self->_section_names(@_);
335 for my $block (@{$self->block_list}) {
336 next unless exists($block->{$x}) and exists($block->{$y});
337 $block->run_filters unless $block->is_filtered;
338 is_deeply($block->$x, $block->$y,
339 $block->name ? $block->name : ()
345 (my ($self), @_) = find_my_self(@_);
347 my ($x, $y) = $self->_section_names(@_);
348 for my $block (@{$self->block_list}) {
349 next unless exists($block->{$x}) and defined($y);
350 $block->run_filters unless $block->is_filtered;
351 my $regexp = ref $y ? $y : $block->$y;
352 like($block->$x, $regexp,
353 $block->name ? $block->name : ()
359 (my ($self), @_) = find_my_self(@_);
361 my ($x, $y) = $self->_section_names(@_);
362 for my $block (@{$self->block_list}) {
363 next unless exists($block->{$x}) and defined($y);
364 $block->run_filters unless $block->is_filtered;
365 my $regexp = ref $y ? $y : $block->$y;
366 unlike($block->$x, $regexp,
367 $block->name ? $block->name : ()
374 return $spec unless $spec =~
375 s/\A\s*<<<(.*?)>>>\s*$//sm;
377 eval "package main; $eval_code";
382 sub _block_list_init {
383 my $spec = $self->spec;
384 $spec = $self->_pre_eval($spec);
385 my $cd = $self->block_delim;
386 my @hunks = ($spec =~ /^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg);
387 my $blocks = $self->_choose_blocks(@hunks);
388 $self->block_list($blocks); # Need to set early for possible filter use
390 for my $block (@$blocks) {
391 $block->blocks_object($self);
392 $block->seq_num($seq++);
400 my $block = $self->_make_block($hunk);
401 if (exists $block->{ONLY}) {
402 diag "I found ONLY: maybe you're debugging?"
403 unless $self->_no_diag_on_only;
406 next if exists $block->{SKIP};
407 push @$blocks, $block;
408 if (exists $block->{LAST}) {
415 sub _check_reserved {
417 croak "'$id' is a reserved name. Use something else.\n"
418 if $reserved_section_names->{$id} or
424 my $cd = $self->block_delim;
425 my $dd = $self->data_delim;
426 my $block = $self->block_class->new;
427 $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die;
429 my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
430 my $description = shift @parts;
432 unless ($description =~ /\S/) {
433 $description = $name;
435 $description =~ s/\s*\z//;
436 $block->set_value(description => $description);
438 my $section_map = {};
439 my $section_order = [];
441 my ($type, $filters, $value) = splice(@parts, 0, 3);
442 $self->_check_reserved($type);
443 $value = '' unless defined $value;
444 $filters = '' unless defined $filters;
445 if ($filters =~ /:(\s|\z)/) {
446 croak "Extra lines not allowed in '$type' section"
448 ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
449 $value = '' unless defined $value;
450 $value =~ s/^\s*(.*?)\s*$/$1/;
452 $section_map->{$type} = {
455 push @$section_order, $type;
456 $block->set_value($type, $value);
458 $block->set_value(name => $name);
459 $block->set_value(_section_map => $section_map);
460 $block->set_value(_section_order => $section_order);
465 return $self->_spec_string
466 if $self->_spec_string;
469 if (my $spec_file = $self->_spec_file) {
470 open FILE, $spec_file or die $!;
484 sub _strict_warnings() {
485 require Filter::Util::Call;
487 Filter::Util::Call::filter_add(
490 my ($data, $end) = ('', '');
491 while (my $status = Filter::Util::Call::filter_read()) {
492 return $status if $status < 0;
493 if (/^__(?:END|DATA)__\r?$/) {
500 $_ = "use strict;use warnings;$data$end";
508 die "No buffer to tie" unless @_;
509 tie $handle, 'Test::Base::Handle', $_[0];
513 $ENV{TEST_SHOW_NO_DIFFS} = 1;
516 package Test::Base::Handle;
520 bless \ $_[0], $class;
527 #===============================================================================
530 # This is the default class for accessing a Test::Base block object.
531 #===============================================================================
532 package Test::Base::Block;
533 our @ISA = qw(Spiffy);
535 our @EXPORT = qw(block_accessor);
541 sub block_accessor() {
542 my $accessor = shift;
544 return if defined &$accessor;
548 Carp::croak "Not allowed to set values for '$accessor'";
550 my @list = @{$self->{$accessor} || []};
557 block_accessor 'name';
558 block_accessor 'description';
559 Spiffy::field 'seq_num';
560 Spiffy::field 'is_filtered';
561 Spiffy::field 'blocks_object';
562 Spiffy::field 'original_values' => {};
566 my $accessor = shift;
567 block_accessor $accessor
568 unless defined &$accessor;
569 $self->{$accessor} = [@_];
573 my $map = $self->_section_map;
574 my $order = $self->_section_order;
575 Carp::croak "Attempt to filter a block twice"
576 if $self->is_filtered;
577 for my $type (@$order) {
578 my $filters = $map->{$type}{filters};
579 my @value = $self->$type;
580 $self->original_values->{$type} = $value[0];
581 for my $filter ($self->_get_filters($type, $filters)) {
582 $Test::Base::Filter::arguments =
583 $filter =~ s/=(.*)$// ? $1 : undef;
584 my $function = "main::$filter";
586 if (defined &$function) {
587 local $_ = join '', @value;
589 @value = &$function(@value);
591 @value == 1 and $value[0] =~ /\A(\d+|)\z/
593 if ($value[0] && $_ eq $old) {
594 Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't.");
600 my $filter_object = $self->blocks_object->filter_class->new;
601 die "Can't find a function or method for '$filter' filter\n"
602 unless $filter_object->can($filter);
603 $filter_object->current_block($self);
604 @value = $filter_object->$filter(@value);
606 # Set the value after each filter since other filters may be
608 $self->set_value($type, @value);
611 $self->is_filtered(1);
616 my $string = shift || '';
617 $string =~ s/\s*(.*?)\s*/$1/;
619 my $map_filters = $self->blocks_object->_filters_map->{$type} || [];
620 $map_filters = [ $map_filters ] unless ref $map_filters;
623 @{$self->blocks_object->_filters},
625 split(/\s+/, $string),
628 last unless length $filter;
629 if ($filter =~ s/^-//) {
630 @filters = grep { $_ ne $filter } @filters;
632 elsif ($filter =~ s/^\+//) {
633 push @append, $filter;
636 push @filters, $filter;
639 return @filters, @append;
643 %$reserved_section_names = map {
645 } keys(%Test::Base::Block::), qw( new DESTROY );
652 Test::Base - A Data Driven Testing Framework
658 # lib/MyProject/Test.pm
659 package MyProject::Test;
660 use Test::Base -Base;
664 package MyProject::Test::Filter;
665 use Test::Base::Filter -base;
668 return MyProject->do_something(shift);
676 plan tests => 1 * blocks;
678 run_is input => 'expected';
686 === Test one (the name of the test)
687 --- input my_filter local_filter
696 This is an optional description
697 of this particular test.
708 Testing is usually the ugly part of Perl module authoring. Perl gives
709 you a standard way to run tests with Test::Harness, and basic testing
710 primitives with Test::More. After that you are pretty much on your own
711 to develop a testing framework and philosophy. Test::More encourages
712 you to make your own framework by subclassing Test::Builder, but that is
715 Test::Base gives you a way to write your own test framework base
716 class that I<is> trivial. In fact it is as simple as two lines:
718 package MyTestFramework;
719 use Test::Base -Base;
721 A module called C<MyTestFramework.pm> containing those two lines, will
722 give all the power of Test::More and all the power of Test::Base to
723 every test file that uses it. As you build up the capabilities of
724 C<MyTestFramework>, your tests will have all of that power as well.
726 C<MyTestFramework> becomes a place for you to put all of your reusable
727 testing bits. As you write tests, you will see patterns and duplication,
728 and you can "upstream" them into C<MyTestFramework>. Of course, you
729 don't have to subclass Test::Base at all. You can use it directly in
730 many applications, including everywhere you would use Test::More.
732 Test::Base concentrates on offering reusable data driven patterns, so
733 that you can write tests with a minimum of code. At the heart of all
734 testing you have inputs, processes and expected outputs. Test::Base
735 provides some clean ways for you to express your input and expected
736 output data, so you can spend your time focusing on that rather than
737 your code scaffolding.
739 =head1 EXPORTED FUNCTIONS
741 Test::Base extends Test::More and exports all of its functions. So you
742 can basically write your tests the same as Test::More. Test::Base
743 also exports many functions of its own:
745 =head2 is(actual, expected, [test-name])
747 This is the equivalent of Test::More's C<is> function with one
748 interesting twist. If your actual and expected results differ and the
749 output is multi-line, this function will show you a unified diff format
750 of output. Consider the benefit when looking for the one character that
751 is different in hundreds of lines of output!
753 Diff output requires the optional C<Text::Diff> CPAN module. If you
754 don't have this module, the C<is()> function will simply give you normal
755 Test::More output. To disable diffing altogether, set the
756 C<TEST_SHOW_NO_DIFFS> environment variable (or C<$ENV{TEST_SHOW_NO_DIFFS}>)
757 to a true value. You can also call the C<no_diff> function as a shortcut.
759 =head2 blocks( [data-section-name] )
761 The most important function is C<blocks>. In list context it returns a
762 list of C<Test::Base::Block> objects that are generated from the test
763 specification in the C<DATA> section of your test file. In scalar
764 context it returns the number of objects. This is useful to calculate
765 your Test::More plan.
767 Each Test::Base::Block object has methods that correspond to the names
768 of that object's data sections. There is also a C<name> and a
769 C<description> method for accessing those parts of the block if they
772 The C<blocks> function can take an optional single argument, that
773 indicates to only return the blocks that contain a particular named data
774 section. Otherwise C<blocks> returns all blocks.
776 my @all_of_my_blocks = blocks;
778 my @just_the_foo_blocks = blocks('foo');
782 You can use the next_block function to iterate over all the blocks.
784 while (my $block = next_block) {
788 It returns undef after all blocks have been iterated over. It can then
789 be called again to reiterate.
793 Returns the first block or undef if there are none. It resets the iterator to
794 the C<next_block> function.
796 =head2 run(&subroutine)
798 There are many ways to write your tests. You can reference each block
799 individually or you can loop over all the blocks and perform a common
800 operation. The C<run> function does the looping for you, so all you need
801 to do is pass it a code block to execute for each block.
803 The C<run> function takes a subroutine as an argument, and calls the sub
804 one time for each block in the specification. It passes the current
805 block object to the subroutine.
809 is(process($block->foo), $block->bar, $block->name);
812 =head2 run_is([data_name1, data_name2])
814 Many times you simply want to see if two data sections are equivalent in
815 every block, probably after having been run through one or more filters.
816 With the C<run_is> function, you can just pass the names of any two data
817 sections that exist in every block, and it will loop over every block
818 comparing the two sections.
822 If no data sections are given C<run_is> will try to detect them
825 NOTE: Test::Base will silently ignore any blocks that don't contain
828 =head2 run_is_deeply([data_name1, data_name2])
830 Like C<run_is> but uses C<is_deeply> for complex data structure comparison.
832 =head2 run_like([data_name, regexp | data_name]);
834 The C<run_like> function is similar to C<run_is> except the second
835 argument is a regular expression. The regexp can either be a C<qr{}>
836 object or a data section that has been filtered into a regular
839 run_like 'foo', qr{<html.*};
840 run_like 'foo', 'match';
842 =head2 run_unlike([data_name, regexp | data_name]);
844 The C<run_unlike> function is similar to C<run_like>, except the opposite.
846 run_unlike 'foo', qr{<html.*};
847 run_unlike 'foo', 'no_match';
849 =head2 run_compare(data_name1, data_name2)
851 The C<run_compare> function is like the C<run_is>, C<run_is_deeply> and
852 the C<run_like> functions all rolled into one. It loops over each
853 relevant block and determines what type of comparison to do.
855 NOTE: If you do not specify either a plan, or run any tests, the
856 C<run_compare> function will automatically be run.
858 =head2 delimiters($block_delimiter, $data_delimiter)
860 Override the default delimiters of C<===> and C<--->.
862 =head2 spec_file($file_name)
864 By default, Test::Base reads its input from the DATA section. This
865 function tells it to get the spec from a file instead.
867 =head2 spec_string($test_data)
869 By default, Test::Base reads its input from the DATA section. This
870 function tells it to get the spec from a string that has been
873 =head2 filters( @filters_list or $filters_hashref )
875 Specify a list of additional filters to be applied to all blocks. See
878 You can also specify a hash ref that maps data section names to an array
879 ref of filters for that data type.
882 xxx => [qw(chomp lines)],
887 If a filters list has only one element, the array ref is optional.
889 =head2 filters_delay( [1 | 0] );
891 By default Test::Base::Block objects are have all their filters run
892 ahead of time. There are testing situations in which it is advantageous
893 to delay the filtering. Calling this function with no arguments or a
894 true value, causes the filtering to be delayed.
898 plan tests => 1 * blocks;
899 for my $block (blocks) {
902 ok($block->is_filtered);
906 In the code above, the filters are called manually, using the
907 C<run_filters> method of Test::Base::Block. In functions like
908 C<run_is>, where the tests are run automatically, filtering is delayed
909 until right before the test.
911 =head2 filter_arguments()
913 Return the arguments after the equals sign on a filter.
916 my $args = filter_arguments;
917 # is($args, 'whazzup');
923 --- data my_filter=whazzup
927 You can capture STDOUT and STDERR for operations with this function:
930 tie_output(*STDOUT, $buffer);
934 is($out, "Hey!\nChe!\n");
938 Turn off diff support for is() in a test file.
940 =head2 default_object()
942 Returns the default Test::Base object. This is useful if you feel
943 the need to do an OO operation in otherwise functional test code. See
946 =head2 WWW() XXX() YYY() ZZZ()
948 These debugging functions are exported from the Spiffy.pm module. See
949 L<Spiffy> for more info.
951 =head2 croak() carp() cluck() confess()
953 You can use the functions from the Carp module without needing to import
954 them. Test::Base does it for you by default.
956 =head1 TEST SPECIFICATION
958 Test::Base allows you to specify your test data in an external file,
959 the DATA section of your program or from a scalar variable containing
962 A I<test specification> is a series of text lines. Each test (or block)
963 is separated by a line containing the block delimiter and an optional
964 test C<name>. Each block is further subdivided into named sections with
965 a line containing the data delimiter and the data section name. A
966 C<description> of the test can go on lines after the block delimiter but
967 before the first data section.
969 Here is the basic layout of a specification:
972 <optional block description lines>
973 --- <data section name 1> <filter-1> <filter-2> <filter-n>
975 --- <data section name 2> <filter-1> <filter-2> <filter-n>
977 --- <data section name n> <filter-1> <filter-2> <filter-n>
981 <optional block description lines>
982 --- <data section name 1> <filter-1> <filter-2> <filter-n>
984 --- <data section name 2> <filter-1> <filter-2> <filter-n>
986 --- <data section name n> <filter-1> <filter-2> <filter-n>
989 Here is a code example:
993 delimiters qw(### :::);
1000 We want to see if foo and bar
1001 are really the same...
1024 This example specifies two blocks. They both have foo and bar data
1025 sections. The second block has a baz component. The block delimiter is
1026 C<###> and the data delimiter is C<:::>.
1028 The default block delimiter is C<===> and the default data delimiter
1031 There are some special data section names used for control purposes:
1037 A block with a SKIP section causes that test to be ignored. This is
1038 useful to disable a test temporarily.
1040 A block with an ONLY section causes only that block to be used. This is
1041 useful when you are concentrating on getting a single test to pass. If
1042 there is more than one block with ONLY, the first one will be chosen.
1044 Because ONLY is very useful for debugging and sometimes you forgot to
1045 remove the ONLY flag before commiting to the VCS or uploading to CPAN,
1046 Test::Base by default gives you a diag message saying I<I found ONLY
1047 ... maybe you're debugging?>. If you don't like it, use
1050 A block with a LAST section makes that block the last one in the
1051 specification. All following blocks will be ignored.
1055 The real power in writing tests with Test::Base comes from its
1056 filtering capabilities. Test::Base comes with an ever growing set
1057 of useful generic filters than you can sequence and apply to various
1058 test blocks. That means you can specify the block serialization in
1059 the most readable format you can find, and let the filters translate
1060 it into what you really need for a test. It is easy to write your own
1063 Test::Base allows you to specify a list of filters to each data
1064 section of each block. The default filters are C<norm> and C<trim>.
1065 These filters will be applied (in order) to the data after it has been
1066 parsed from the specification and before it is set into its
1067 Test::Base::Block object.
1069 You can add to the default filter list with the C<filters> function. You
1070 can specify additional filters to a specific block by listing them after
1071 the section name on a data section delimiter line.
1077 filters qw(foo bar);
1078 filters { perl => 'strict' };
1080 sub upper { uc(shift) }
1085 --- foo trim chomp upper
1091 --- perl eval dumper
1097 Putting a C<-> before a filter on a delimiter line, disables that
1100 =head2 Scalar vs List
1102 Each filter can take either a scalar or a list as input, and will return
1103 either a scalar or a list. Since filters are chained together, it is
1104 important to learn which filters expect which kind of input and return
1105 which kind of output.
1107 For example, consider the following filter list:
1109 norm trim lines chomp array dumper eval
1111 The data always starts out as a single scalar string. C<norm> takes a
1112 scalar and returns a scalar. C<trim> takes a list and returns a list,
1113 but a scalar is a valid list. C<lines> takes a scalar and returns a
1114 list. C<chomp> takes a list and returns a list. C<array> takes a list
1115 and returns a scalar (an anonymous array reference containing the list
1116 elements). C<dumper> takes a list and returns a scalar. C<eval> takes a
1117 scalar and creates a list.
1119 A list of exactly one element works fine as input to a filter requiring
1120 a scalar, but any other list will cause an exception. A scalar in list
1121 context is considered a list of one element.
1123 Data accessor methods for blocks will return a list of values when used
1124 in list context, and the first element of the list in scalar context.
1125 This is usually "the right thing", but be aware.
1127 =head2 The Stock Filters
1129 Test::Base comes with large set of stock filters. They are in the
1130 C<Test::Base::Filter> module. See L<Test::Base::Filter> for a listing and
1131 description of these filters.
1133 =head2 Rolling Your Own Filters
1135 Creating filter extensions is very simple. You can either write a
1136 I<function> in the C<main> namespace, or a I<method> in the
1137 C<Test::Base::Filter> namespace or a subclass of it. In either case the
1138 text and any extra arguments are passed in and you return whatever you
1139 want the new value to be.
1141 Here is a self explanatory example:
1145 filters 'foo', 'bar=xyz';
1151 sub Test::Base::Filter::bar {
1152 my $self = shift; # The Test::Base::Filter object
1154 my $args = $self->current_arguments;
1155 my $current_block_object = $self->block;
1156 # transform $data in a barish manner
1160 If you use the method interface for a filter, you can access the block
1161 internals by calling the C<block> method on the filter object.
1163 Normally you'll probably just use the functional interface, although all
1164 the builtin filters are methods.
1166 Note that filters defined in the C<main> namespace can look like:
1172 since Test::Base automatically munges the input string into $_
1173 variable and checks the return value of the function to see if it
1174 looks like a number. If you must define a filter that returns just a
1175 single number, do it in a different namespace as a method. These
1176 filters don't allow the simplistic $_ munging.
1180 Test::Base has a nice functional interface for simple usage. Under the
1181 hood everything is object oriented. A default Test::Base object is
1182 created and all the functions are really just method calls on it.
1184 This means if you need to get fancy, you can use all the object
1185 oriented stuff too. Just create new Test::Base objects and use the
1186 functions as methods.
1189 my $blocks1 = Test::Base->new;
1190 my $blocks2 = Test::Base->new;
1192 $blocks1->delimiters(qw(!!! @@@))->spec_file('test1.txt');
1193 $blocks2->delimiters(qw(### $$$))->spec_string($test_data);
1195 plan tests => $blocks1->blocks + $blocks2->blocks;
1199 =head1 THE C<Test::Base::Block> CLASS
1201 In Test::Base, blocks are exposed as Test::Base::Block objects. This
1202 section lists the methods that can be called on a Test::Base::Block
1203 object. Of course, each data section name is also available as a method.
1207 This is the optional short description of a block, that is specified on the
1208 block separator line.
1210 =head2 description()
1212 This is an optional long description of the block. It is the text taken from
1213 between the block separator and the first data section.
1217 Returns a sequence number for this block. Sequence numbers begin with 1.
1219 =head2 blocks_object()
1221 Returns the Test::Base object that owns this block.
1223 =head2 run_filters()
1225 Run the filters on the data sections of the blocks. You don't need to
1226 use this method unless you also used the C<filters_delay> function.
1228 =head2 is_filtered()
1230 Returns true if filters have already been run for this block.
1232 =head2 original_values()
1234 Returns a hash of the original, unfiltered values of each data section.
1238 One of the nicest things about Test::Base is that it is easy to
1239 subclass. This is very important, because in your personal project, you
1240 will likely want to extend Test::Base with your own filters and other
1241 reusable pieces of your test framework.
1243 Here is an example of a subclass:
1245 package MyTestStuff;
1246 use Test::Base -Base;
1248 our @EXPORT = qw(some_func);
1251 (my ($self), @_) = find_my_self(@_);
1255 package MyTestStuff::Block;
1256 use base 'Test::Base::Block';
1259 $self->description(@_);
1262 package MyTestStuff::Filter;
1263 use base 'Test::Base::Filter';
1266 $self->assert_scalar(@_);
1270 Note that you don't have to re-Export all the functions from
1271 Test::Base. That happens automatically, due to the powers of Spiffy.
1273 The first line in C<some_func> allows it to be called as either a
1274 function or a method in the test code.
1276 =head1 DISTRIBUTION SUPPORT
1278 You might be thinking that you do not want to use Test::Base in you
1279 modules, because it adds an installation dependency. Fear not.
1280 Module::Install takes care of that.
1282 Just write a Makefile.PL that looks something like this:
1284 use inc::Module::Install;
1287 all_from 'lib/Foo.pm';
1293 The line with C<use_test_base> will automatically bundle all the code
1294 the user needs to run Test::Base based tests.
1296 =head1 OTHER COOL FEATURES
1298 Test::Base automatically adds:
1303 to all of your test scripts and Test::Base subclasses. A Spiffy
1308 This module started its life with the horrible and ridicule inducing
1309 name C<Test::Chunks>. It was renamed to C<Test::Base> with the hope
1310 that it would be seen for the very useful module that it has become. If
1311 you are switching from C<Test::Chunks> to C<Test::Base>, simply
1312 substitute the concept and usage of C<chunks> to C<blocks>.
1316 Ingy döt Net <ingy@cpan.org>
1320 Copyright (c) 2006. Ingy döt Net. All rights reserved.
1321 Copyright (c) 2005. Brian Ingerson. All rights reserved.
1323 This program is free software; you can redistribute it and/or modify it
1324 under the same terms as Perl itself.
1326 See http://www.perl.com/perl/misc/Artistic.html