vcs.maemo.org Git - pkg-perl/blob - deb-src/libtest-base-perl/libtest-base-perl-0.54/t/internals.t

   1 # Each filter should have access to blocks/block internals.
   2 use Test::Base tests => 20 * 2;
   3
   4 run {};
   5
   6 package Test::Base::Filter;
   7 use Test::More;
   8
   9 sub foo {
  10     my $self = shift;
  11     my $value = shift;
  12
  13 # Test access to Test::Base::Filter object.
  14     ok ref($self),
  15        '$self is an object';
  16     is ref($self),
  17        'Test::Base::Filter',
  18        '$self is a Test:Base::Filter object';
  19     like $value,
  20          qr/^This is some .*text.\z/,
  21          'Filter value is correct';
  22
  23 # Test access to Test::Base::Block object.
  24     my $block = $self->current_block;
  25     is ref($block),
  26        'Test::Base::Block',
  27        'Have a reference to our block object';
  28
  29     ok not($block->is_filtered),
  30        'Block is not completely filtered yet';
  31
  32     my $name = shift || 'One';
  33     is $block->name,
  34        $name,
  35        'name is correct';
  36
  37     my $description = shift || 'One';
  38     is $block->description,
  39        $description,
  40        'description is correct';
  41
  42     my $original = shift || "This is some text.";
  43     is $block->original_values->{xxx},
  44        $original,
  45        'Access to the original value';
  46
  47     my $seq_num = shift || 1;
  48     cmp_ok $block->seq_num,
  49            '==',
  50            $seq_num,
  51            'Sequence number (seq_num) is correct';
  52
  53     my $array_xxx = shift || ["This is some text."];
  54     is_deeply $block->{xxx},
  55               $array_xxx,
  56              'Test raw content of $block->{xxx}';
  57
  58     my $method_xxx = shift || "This is some text.";
  59     is $block->xxx,
  60        $method_xxx,
  61        'Test method content of $block->xxx';
  62
  63 # Test access to Test::Base object.
  64     my $blocks = $block->blocks_object;
  65     my $block_list = $blocks->block_list;
  66     is ref($block_list),
  67        'ARRAY',
  68        'Have an array of all blocks';
  69
  70     is scalar(@$block_list),
  71        '2',
  72        'Is there 2 blocks?';
  73
  74     is $blocks->block_class,
  75        "Test::Base::Block",
  76        'block class';
  77
  78     is $blocks->filter_class,
  79        "Test::Base::Filter",
  80        'filter class';
  81
  82     is_deeply
  83        $blocks->{_filters},
  84        [qw(norm trim)],
  85        'default filters are ok';
  86
  87     is $blocks->block_delim,
  88        '===',
  89        'block delimiter';
  90
  91     is $blocks->data_delim,
  92        '---',
  93        'data delimiter';
  94
  95     my $spec = <<END;
  96 === One
  97 --- xxx foo: This is some text.
  98 === Two
  99 This is the 2nd description.
 100 Right here.
 101
 102 --- xxx chomp bar
 103 This is some more text.
 104
 105 END
 106     is $blocks->spec,
 107        $spec,
 108        'spec is ok';
 109
 110     is $block_list->[$seq_num - 1],
 111        $block,
 112        'test block ref in list';
 113 }
 114
 115 sub bar {
 116     my $self = shift;
 117     my $value = shift;
 118     $self->foo($value,
 119         'Two',
 120         "This is the 2nd description.\nRight here.",
 121         "This is some more text.\n\n",
 122         2,
 123         ["This is some more text."],
 124         "This is some more text.",
 125     );
 126 }
 127
 128 __END__
 129 === One
 130 --- xxx foo: This is some text.
 131 === Two
 132 This is the 2nd description.
 133 Right here.
 134
 135 --- xxx chomp bar
 136 This is some more text.
 137