File Coverage

inc/Test/Base.pm
Criterion Covered Total %
statement 209 378 55.2
branch 47 188 25.0
condition 10 83 12.0
subroutine 38 63 60.3
pod 0 29 0.0
total 304 741 41.0


line stmt bran cond sub pod time code
1             #line 1
2 1     1   406 package Test::Base;
  1         2  
  1         42  
3 1     1   428 use 5.006001;
  1         21  
  1         6  
4 1     1   6 use Spiffy 0.30 -Base;
  1     1   1  
  1     1   26  
  1         3  
  1         2  
  1         23  
  1         3  
  1         1  
  1         4  
5             use Spiffy ':XXX';
6             our $VERSION = '0.60';
7              
8             my @test_more_exports;
9 1     1   21 BEGIN {
10             @test_more_exports = qw(
11             ok isnt like unlike is_deeply cmp_ok
12             skip todo_skip pass fail
13             eq_array eq_hash eq_set
14             plan can_ok isa_ok diag
15             use_ok
16             $TODO
17             );
18             }
19 1     1   463  
  1         2  
  1         9  
20 1     1   6 use Test::More import => \@test_more_exports;
  1         1  
  1         409  
21             use Carp;
22              
23             our @EXPORT = (@test_more_exports, qw(
24             is no_diff
25              
26             blocks next_block first_block
27             delimiters spec_file spec_string
28             filters filters_delay filter_arguments
29             run run_compare run_is run_is_deeply run_like run_unlike
30             skip_all_unless_require is_deep run_is_deep
31             WWW XXX YYY ZZZ
32             tie_output no_diag_on_only
33              
34             find_my_self default_object
35              
36             croak carp cluck confess
37             ));
38              
39             field '_spec_file';
40             field '_spec_string';
41             field _filters => [qw(norm trim)];
42             field _filters_map => {};
43             field spec =>
44             -init => '$self->_spec_init';
45             field block_list =>
46             -init => '$self->_block_list_init';
47             field _next_list => [];
48             field block_delim =>
49             -init => '$self->block_delim_default';
50             field data_delim =>
51             -init => '$self->data_delim_default';
52             field _filters_delay => 0;
53             field _no_diag_on_only => 0;
54              
55             field block_delim_default => '===';
56             field data_delim_default => '---';
57              
58             my $default_class;
59             my $default_object;
60             my $reserved_section_names = {};
61 2     2 0 4  
62 2   66     16 sub default_object {
63 2         4 $default_object ||= $default_class->new;
64             return $default_object;
65             }
66              
67             my $import_called = 0;
68 1     1   9 sub import() {
69 1 50       6 $import_called = 1;
70             my $class = (grep /^-base$/i, @_)
71             ? scalar(caller)
72 1 50       4 : $_[0];
73 1         2 if (not defined $default_class) {
74             $default_class = $class;
75             }
76             # else {
77             # croak "Can't use $class after using $default_class"
78             # unless $default_class->isa($class);
79             # }
80 1 50       4  
81 1         1 unless (grep /^-base$/i, @_) {
82 1         4 my @args;
83 0 0       0 for (my $ii = 1; $ii <= $#_; ++$ii) {
84 0         0 if ($_[$ii] eq '-package') {
85             ++$ii;
86 0         0 } else {
87             push @args, $_[$ii];
88             }
89 1 50       3 }
90             Test::More->import(import => \@test_more_exports, @args)
91             if @args;
92             }
93 1         4
94 1         19 _strict_warnings();
95             goto &Spiffy::import;
96             }
97              
98             # Wrap Test::Builder::plan
99             my $plan_code = \&Test::Builder::plan;
100             my $Have_Plan = 0;
101 1     1   4 {
  1         2  
  1         2975  
102             no warnings 'redefine';
103 1     1   2 *Test::Builder::plan = sub {
104 1         5 $Have_Plan = 1;
105             goto &$plan_code;
106             };
107             }
108              
109             my $DIED = 0;
110             $SIG{__DIE__} = sub { $DIED = 1; die @_ };
111 18     18 0 19  
  18         27  
112 2     2 0 3 sub block_class { $self->find_class('Block') }
  2         4  
113             sub filter_class { $self->find_class('Filter') }
114 20     20 0 16  
115 20         20 sub find_class {
116 20         37 my $suffix = shift;
117 20 100       66 my $class = ref($self) . "::$suffix";
118 1         2 return $class if $class->can('new');
119 1 50       5 $class = __PACKAGE__ . "::$suffix";
120 1         70 return $class if $class->can('new');
121 1 50       9 eval "require $class";
122 0         0 return $class if $class->can('new');
123             die "Can't find a class for $suffix";
124             }
125 0     0 0 0  
126 0 0       0 sub check_late {
127 0         0 if ($self->{block_list}) {
128 0         0 my $caller = (caller(1))[3];
129 0         0 $caller =~ s/.*:://;
130             croak "Too late to call $caller()"
131             }
132             }
133              
134 2 50   2 0 11 sub find_my_self() {
135             my $self = ref($_[0]) eq $default_class
136             ? splice(@_, 0, 1)
137 2         7 : default_object();
138             return $self, @_;
139             }
140              
141 0     0 0 0 sub blocks() {
142             (my ($self), @_) = find_my_self(@_);
143 0 0       0  
144             croak "Invalid arguments passed to 'blocks'"
145 0 0 0     0 if @_ > 1;
146             croak sprintf("'%s' is invalid argument to blocks()", shift(@_))
147             if @_ && $_[0] !~ /^[a-zA-Z]\w*$/;
148 0         0  
149             my $blocks = $self->block_list;
150 0   0     0
151 0         0 my $section_name = shift || '';
152 0 0       0 my @blocks = $section_name
153             ? (grep { exists $_->{$section_name} } @$blocks)
154             : (@$blocks);
155 0 0       0  
156             return scalar(@blocks) unless wantarray;
157 0 0       0
158             return (@blocks) if $self->_filters_delay;
159 0         0  
160 0 0       0 for my $block (@blocks) {
161             $block->run_filters
162             unless $block->is_filtered;
163             }
164 0         0  
165             return (@blocks);
166             }
167              
168 0     0 0 0 sub next_block() {
169 0         0 (my ($self), @_) = find_my_self(@_);
170 0 0       0 my $list = $self->_next_list;
171 0         0 if (@$list == 0) {
  0         0  
172 0         0 $list = [@{$self->block_list}, undef];
173             $self->_next_list($list);
174 0         0 }
175 0 0 0     0 my $block = shift @$list;
176 0         0 if (defined $block and not $block->is_filtered) {
177             $block->run_filters;
178 0         0 }
179             return $block;
180             }
181              
182 0     0 0 0 sub first_block() {
183 0         0 (my ($self), @_) = find_my_self(@_);
184 0         0 $self->_next_list([]);
185             $self->next_block;
186             }
187              
188 0     0 0 0 sub filters_delay() {
189 0 0       0 (my ($self), @_) = find_my_self(@_);
190             $self->_filters_delay(defined $_[0] ? shift : 1);
191             }
192              
193 0     0 0 0 sub no_diag_on_only() {
194 0 0       0 (my ($self), @_) = find_my_self(@_);
195             $self->_no_diag_on_only(defined $_[0] ? shift : 1);
196             }
197              
198 0     0 0 0 sub delimiters() {
199 0         0 (my ($self), @_) = find_my_self(@_);
200 0         0 $self->check_late;
201 0   0     0 my ($block_delimiter, $data_delimiter) = @_;
202 0   0     0 $block_delimiter ||= $self->block_delim_default;
203 0         0 $data_delimiter ||= $self->data_delim_default;
204 0         0 $self->block_delim($block_delimiter);
205 0         0 $self->data_delim($data_delimiter);
206             return $self;
207             }
208              
209 0     0 0 0 sub spec_file() {
210 0         0 (my ($self), @_) = find_my_self(@_);
211 0         0 $self->check_late;
212 0         0 $self->_spec_file(shift);
213             return $self;
214             }
215              
216 0     0 0 0 sub spec_string() {
217 0         0 (my ($self), @_) = find_my_self(@_);
218 0         0 $self->check_late;
219 0         0 $self->_spec_string(shift);
220             return $self;
221             }
222              
223 1     1 0 10 sub filters() {
224 1 50       4 (my ($self), @_) = find_my_self(@_);
225 1         28 if (ref($_[0]) eq 'HASH') {
226             $self->_filters_map(shift);
227             }
228 0         0 else {
229 0         0 my $filters = $self->_filters;
230             push @$filters, @_;
231 1         3 }
232             return $self;
233             }
234              
235 0     0 0 0 sub filter_arguments() {
236             $Test::Base::Filter::arguments;
237             }
238 0     0 0 0  
239 0 0 0     0 sub have_text_diff {
  0         0  
  0         0  
240             eval { require Text::Diff; 1 } &&
241             $Text::Diff::VERSION >= 0.35 &&
242             $Algorithm::Diff::VERSION >= 1.15;
243             }
244              
245 0     0 0 0 sub is($$;$) {
246 0         0 (my ($self), @_) = find_my_self(@_);
247 0         0 my ($actual, $expected, $name) = @_;
248 0 0 0     0 local $Test::Builder::Level = $Test::Builder::Level + 1;
      0        
      0        
      0        
      0        
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
254             $expected !~ /\n./s
255 0         0 ) {
256             Test::More::is($actual, $expected, $name);
257             }
258 0 0       0 else {
259 0         0 $name = '' unless defined $name;
260             ok $actual eq $expected,
261             $name . "\n" . Text::Diff::diff(\$expected, \$actual);
262             }
263             }
264              
265 0     0 0 0 sub run(&;$) {
266 0         0 (my ($self), @_) = find_my_self(@_);
267 0         0 my $callback = shift;
  0         0  
268 0 0       0 for my $block (@{$self->block_list}) {
269 0         0 $block->run_filters unless $block->is_filtered;
  0         0  
270             &{$callback}($block);
271             }
272             }
273              
274 1     1   2 my $name_error = "Can't determine section names";
275 1 50       5 sub _section_names {
276 0 0       0 return @_ if @_ == 2;
277             my $block = $self->first_block
278 0         0 or croak $name_error;
279 0 0       0 my @names = grep {
280 0         0 $_ !~ /^(ONLY|LAST|SKIP)$/;
281 0 0       0 } @{$block->{_section_order}[0] || []};
282             croak "$name_error. Need two sections in first block"
283 0         0 unless @names == 2;
284             return @names;
285             }
286 1     1   2  
287 1 50       7 sub _assert_plan {
288             plan('no_plan') unless $Have_Plan;
289             }
290 1     1   3  
291 1 0 33     8 sub END {
      33        
292             run_compare() unless $Have_Plan or $DIED or not $import_called;
293             }
294              
295 0     0 0 0 sub run_compare() {
296 0         0 (my ($self), @_) = find_my_self(@_);
297 0         0 $self->_assert_plan;
298 0         0 my ($x, $y) = $self->_section_names(@_);
299 0         0 local $Test::Builder::Level = $Test::Builder::Level + 1;
  0         0  
300 0 0 0     0 for my $block (@{$self->block_list}) {
301 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
302 0 0       0 $block->run_filters unless $block->is_filtered;
    0          
303 0 0       0 if (ref $block->$x) {
304             is_deeply($block->$x, $block->$y,
305             $block->name ? $block->name : ());
306             }
307 0 0       0 elsif (ref $block->$y eq 'Regexp') {
308 0 0       0 my $regexp = ref $y ? $y : $block->$y;
309             like($block->$x, $regexp, $block->name ? $block->name : ());
310             }
311 0 0       0 else {
312             is($block->$x, $block->$y, $block->name ? $block->name : ());
313             }
314             }
315             }
316              
317 1     1 0 7 sub run_is() {
318 1         5 (my ($self), @_) = find_my_self(@_);
319 1         9 $self->_assert_plan;
320 1         2 my ($x, $y) = $self->_section_names(@_);
321 1         3 local $Test::Builder::Level = $Test::Builder::Level + 1;
  1         24  
322 1 50 33     8 for my $block (@{$self->block_list}) {
323 1 50       18 next unless exists($block->{$x}) and exists($block->{$y});
324 0 0       0 $block->run_filters unless $block->is_filtered;
325             is($block->$x, $block->$y,
326             $block->name ? $block->name : ()
327             );
328             }
329             }
330              
331 0     0 0 0 sub run_is_deeply() {
332 0         0 (my ($self), @_) = find_my_self(@_);
333 0         0 $self->_assert_plan;
334 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
335 0 0 0     0 for my $block (@{$self->block_list}) {
336 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
337 0 0       0 $block->run_filters unless $block->is_filtered;
338             is_deeply($block->$x, $block->$y,
339             $block->name ? $block->name : ()
340             );
341             }
342             }
343              
344 0     0 0 0 sub run_like() {
345 0         0 (my ($self), @_) = find_my_self(@_);
346 0         0 $self->_assert_plan;
347 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
348 0 0 0     0 for my $block (@{$self->block_list}) {
349 0 0       0 next unless exists($block->{$x}) and defined($y);
350 0 0       0 $block->run_filters unless $block->is_filtered;
351 0 0       0 my $regexp = ref $y ? $y : $block->$y;
352             like($block->$x, $regexp,
353             $block->name ? $block->name : ()
354             );
355             }
356             }
357              
358 0     0 0 0 sub run_unlike() {
359 0         0 (my ($self), @_) = find_my_self(@_);
360 0         0 $self->_assert_plan;
361 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
362 0 0 0     0 for my $block (@{$self->block_list}) {
363 0 0       0 next unless exists($block->{$x}) and defined($y);
364 0 0       0 $block->run_filters unless $block->is_filtered;
365 0 0       0 my $regexp = ref $y ? $y : $block->$y;
366             unlike($block->$x, $regexp,
367             $block->name ? $block->name : ()
368             );
369             }
370             }
371              
372 0     0 0 0 sub skip_all_unless_require() {
373 0         0 (my ($self), @_) = find_my_self(@_);
374 0 0       0 my $module = shift;
375             eval "require $module; 1"
376             or Test::More::plan(
377             skip_all => "$module failed to load"
378             );
379             }
380              
381 0     0 0 0 sub is_deep() {
382 0         0 (my ($self), @_) = find_my_self(@_);
383 0         0 require Test::Deep;
384             Test::Deep::cmp_deeply(@_);
385             }
386              
387 0     0 0 0 sub run_is_deep() {
388 0         0 (my ($self), @_) = find_my_self(@_);
389 0         0 $self->_assert_plan;
390 0         0 my ($x, $y) = $self->_section_names(@_);
  0         0  
391 0 0 0     0 for my $block (@{$self->block_list}) {
392 0 0       0 next unless exists($block->{$x}) and exists($block->{$y});
393 0 0       0 $block->run_filters unless $block->is_filtered;
394             is_deep($block->$x, $block->$y,
395             $block->name ? $block->name : ()
396             );
397             }
398             }
399 1     1   2  
400 1         2 sub _pre_eval {
401 1 50       8 my $spec = shift;
402             return $spec unless $spec =~
403 0         0 s/\A\s*<<<(.*?)>>>\s*$//sm;
404 0         0 my $eval_code = $1;
405 0 0       0 eval "package main; $eval_code";
406 0         0 croak $@ if $@;
407             return $spec;
408             }
409 1     1   2  
410 1         18 sub _block_list_init {
411 1         4 my $spec = $self->spec;
412 1         21 $spec = $self->_pre_eval($spec);
413 1         223 my $cd = $self->block_delim;
414 1         5 my @hunks = ($spec =~ /^(\Q${cd}\E.*?(?=^\Q${cd}\E|\z))/msg);
415 1         20 my $blocks = $self->_choose_blocks(@hunks);
416 1         2 $self->block_list($blocks); # Need to set early for possible filter use
417 1         2 my $seq = 1;
418 18         271 for my $block (@$blocks) {
419 18         276 $block->blocks_object($self);
420             $block->seq_num($seq++);
421 1         7 }
422             return $blocks;
423             }
424 1     1   2  
425 1         2 sub _choose_blocks {
426 1         6 my $blocks = [];
427 18         26 for my $hunk (@_) {
428 18 50       38 my $block = $self->_make_block($hunk);
429 0 0       0 if (exists $block->{ONLY}) {
430             diag "I found ONLY: maybe you're debugging?"
431 0         0 unless $self->_no_diag_on_only;
432             return [$block];
433 18 50       81 }
434 18         23 next if exists $block->{SKIP};
435 18 50       41 push @$blocks, $block;
436 0         0 if (exists $block->{LAST}) {
437             return $blocks;
438             }
439 1         3 }
440             return $blocks;
441             }
442 36     36   34  
443 36         31 sub _check_reserved {
444 36 50 33     151 my $id = shift;
445             croak "'$id' is a reserved name. Use something else.\n"
446             if $reserved_section_names->{$id} or
447             $id =~ /^_/;
448             }
449 18     18   18  
450 18         20 sub _make_block {
451 18         346 my $hunk = shift;
452 18         280 my $cd = $self->block_delim;
453 18         35 my $dd = $self->data_delim;
454 18 50       117 my $block = $self->block_class->new;
455 18         28 $hunk =~ s/\A\Q${cd}\E[ \t]*(.*)\s+// or die;
456 18         137 my $name = $1;
457 18         26 my @parts = split /^\Q${dd}\E +\(?(\w+)\)? *(.*)?\n/m, $hunk;
458 18   50     55 my $description = shift @parts;
459 18 50       34 $description ||= '';
460 18         20 unless ($description =~ /\S/) {
461             $description = $name;
462 18         58 }
463 18         33 $description =~ s/\s*\z//;
464             $block->set_value(description => $description);
465 18         26
466 18         19 my $section_map = {};
467 18         31 my $section_order = [];
468 36         57 while (@parts) {
469 36         51 my ($type, $filters, $value) = splice(@parts, 0, 3);
470 36 50       69 $self->_check_reserved($type);
471 36 50       59 $value = '' unless defined $value;
472 36 50       54 $filters = '' unless defined $filters;
473 0 0       0 if ($filters =~ /:(\s|\z)/) {
474             croak "Extra lines not allowed in '$type' section"
475 0         0 if $value =~ /\S/;
476 0 0       0 ($filters, $value) = split /\s*:(?:\s+|\z)/, $filters, 2;
477 0         0 $value = '' unless defined $value;
478             $value =~ s/^\s*(.*?)\s*$/$1/;
479 36         78 }
480             $section_map->{$type} = {
481             filters => $filters,
482 36         50 };
483 36         48 push @$section_order, $type;
484             $block->set_value($type, $value);
485 18         25 }
486 18         27 $block->set_value(name => $name);
487 18         24 $block->set_value(_section_map => $section_map);
488 18         37 $block->set_value(_section_order => $section_order);
489             return $block;
490             }
491 1     1   2  
492 1 50       19 sub _spec_init {
493             return $self->_spec_string
494 1         3 if $self->_spec_string;
495 1         2 local $/;
496 1 50       20 my $spec;
497 0 0       0 if (my $spec_file = $self->_spec_file) {
498 0         0 open FILE, $spec_file or die $!;
499 0         0 $spec = ;
500             close FILE;
501             }
502 1         1 else {
503             $spec = do {
504 1     1   6 package main;
  1         1  
  1         394  
505 1         21 no warnings 'once';
506             ;
507             };
508 1         6 }
509             return $spec;
510             }
511              
512 1     1   5 sub _strict_warnings() {
513 1         1 require Filter::Util::Call;
514             my $done = 0;
515             Filter::Util::Call::filter_add(
516 1 50   1   3 sub {
517 1         3 return 0 if $done;
518 1         10 my ($data, $end) = ('', '');
519 10 50       17 while (my $status = Filter::Util::Call::filter_read()) {
520 10 100       18 return $status if $status < 0;
521 1         2 if (/^__(?:END|DATA)__\r?$/) {
522 1         2 $end = $_;
523             last;
524 9         10 }
525 9         22 $data .= $_;
526             $_ = '';
527 1         3 }
528 1         22 $_ = "use strict;use warnings;$data$end";
529             $done = 1;
530 1         7 }
531             );
532             }
533              
534 0     0 0 0 sub tie_output() {
535 0 0       0 my $handle = shift;
536 0         0 die "No buffer to tie" unless @_;
537             tie *$handle, 'Test::Base::Handle', $_[0];
538             }
539 0     0 0 0  
540 0         0 sub no_diff {
541             $ENV{TEST_SHOW_NO_DIFFS} = 1;
542             }
543              
544             package Test::Base::Handle;
545              
546 0     0   0 sub TIEHANDLE() {
547 0         0 my $class = shift;
548             bless \ $_[0], $class;
549             }
550 0     0   0  
551 0         0 sub PRINT {
552             $$self .= $_ for @_;
553             }
554              
555             #===============================================================================
556             # Test::Base::Block
557             #
558             # This is the default class for accessing a Test::Base block object.
559             #===============================================================================
560             package Test::Base::Block;
561             our @ISA = qw(Spiffy);
562              
563             our @EXPORT = qw(block_accessor);
564 0     0   0  
565 0         0 sub AUTOLOAD {
566             return;
567             }
568              
569 6     6   9 sub block_accessor() {
570 1     1   5 my $accessor = shift;
  1         1  
  1         141  
571 6 50       21 no strict 'refs';
572             return if defined &$accessor;
573 3     3   4 *$accessor = sub {
574 3 50       38 my $self = shift;
575 0         0 if (@_) {
576             Carp::croak "Not allowed to set values for '$accessor'";
577 3 50       4 }
  3         10  
578             my @list = @{$self->{$accessor} || []};
579 3 100       12 return wantarray
580             ? (@list)
581 6         27 : $list[0];
582             };
583             }
584              
585             block_accessor 'name';
586             block_accessor 'description';
587             Spiffy::field 'seq_num';
588             Spiffy::field 'is_filtered';
589             Spiffy::field 'blocks_object';
590             Spiffy::field 'original_values' => {};
591 110     110   99  
592 1     1   4 sub set_value {
  1         1  
  1         156  
593 110         95 no strict 'refs';
594 110 100       213 my $accessor = shift;
595             block_accessor $accessor
596 110         293 unless defined &$accessor;
597             $self->{$accessor} = [@_];
598             }
599 1     1   2  
600 1         3 sub run_filters {
601 1         3 my $map = $self->_section_map;
602 1 50       23 my $order = $self->_section_order;
603             Carp::croak "Attempt to filter a block twice"
604 1         3 if $self->is_filtered;
605 1         3 for my $type (@$order) {
606 1         5 my $filters = $map->{$type}{filters};
607 1         19 my @value = $self->$type;
608 1         4 $self->original_values->{$type} = $value[0];
609 3 50       7 for my $filter ($self->_get_filters($type, $filters)) {
610             $Test::Base::Filter::arguments =
611 3         7 $filter =~ s/=(.*)$// ? $1 : undef;
612 1     1   5 my $function = "main::$filter";
  1         1  
  1         492  
613 3 100       16 no strict 'refs';
614 1 50 33     10 if (defined &$function) {
615             local $_ =
616             (@value == 1 and not defined($value[0])) ? undef :
617 1         4 join '', @value;
618 1         4 my $old = $_;
619 0 0 0     0 @value = &$function(@value);
      0        
      0        
620             if (not(@value) or
621             @value == 1 and defined($value[0]) and $value[0] =~ /\A(\d+|)\z/
622 0 0 0     0 ) {
623 0         0 if ($value[0] && $_ eq $old) {
624             Test::Base::diag("Filters returning numbers are supposed to do munging \$_: your filter '$function' apparently doesn't.");
625 0         0 }
626             @value = ($_);
627             }
628             }
629 2         41 else {
630 2 50       6 my $filter_object = $self->blocks_object->filter_class->new;
631             die "Can't find a function or method for '$filter' filter\n"
632 2         39 unless $filter_object->can($filter);
633 2         6 $filter_object->current_block($self);
634             @value = $filter_object->$filter(@value);
635             }
636             # Set the value after each filter since other filters may be
637 2         5 # introspecting.
638             $self->set_value($type, @value);
639             }
640 0         0 }
641             $self->is_filtered(1);
642             }
643 1     1   2  
644 1         2 sub _get_filters {
645 1   50     5 my $type = shift;
646 1         4 my $string = shift || '';
647 1         8 $string =~ s/\s*(.*?)\s*/$1/;
648 1   50     18 my @filters = ();
649 1 50       4 my $map_filters = $self->blocks_object->_filters_map->{$type} || [];
650 1         3 $map_filters = [ $map_filters ] unless ref $map_filters;
651 1         2 my @append = ();
652 1         16 for (
653             @{$self->blocks_object->_filters},
654             @$map_filters,
655             split(/\s+/, $string),
656 3         3 ) {
657 3 50       5 my $filter = $_;
658 3 50       9 last unless length $filter;
    50          
659 0         0 if ($filter =~ s/^-//) {
  0         0  
660             @filters = grep { $_ ne $filter } @filters;
661             }
662 0         0 elsif ($filter =~ s/^\+//) {
663             push @append, $filter;
664             }
665 3         5 else {
666             push @filters, $filter;
667             }
668 1         4 }
669             return @filters, @append;
670             }
671              
672             {
673             %$reserved_section_names = map {
674             ($_, 1);
675             } keys(%Test::Base::Block::), qw( new DESTROY );
676             }
677              
678             __DATA__