File Coverage

inc/Test/Base.pm
Criterion Covered Total %
statement 211 378 55.8
branch 52 188 27.6
condition 11 83 13.2
subroutine 40 63 63.4
pod 0 29 0.0
total 314 741 42.3


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