This file is indexed.

/usr/share/perl5/Test/Block.pm is in libtest-block-perl 0.11-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
#! /usr/bin/perl

use strict;
use warnings;

package Test::Block;
use base qw(Exporter);

our @EXPORT_OK = qw($Plan);

use Carp;
use Test::Builder;
use Scalar::Util qw( looks_like_number );
use overload 
    q{""} => \&remaining,
    q{+0} => \&remaining, 
    fallback => 1;

our $VERSION = '0.11';

my $Last_test_in_previous_block = 0;
my $Active_block_count = 0;

my $Test_builder = Test::Builder->new;
sub builder { $Test_builder };

my $Block_count = 0;
sub block_count { $Block_count };

sub plan {
    my $class = shift;
    my ($expected_tests, $name) = (pop, pop);
    croak "need expected number of tests"
        unless $expected_tests && $expected_tests =~ /^\d+$/s;
    $Block_count++;
    $Active_block_count++;
    return bless {
        name            => defined $name ? $name : $Block_count,
        expected_tests  => $expected_tests,
        initial_test    => $Test_builder->current_test,
    }, $class;
}

sub _tests_run_in_block {
    my $self = shift;
    return $Test_builder->current_test - $self->{initial_test}
}

sub remaining { 
    my $self = shift;
    return $self->{expected_tests} - _tests_run_in_block($self);
}

sub DESTROY {
    my $self = shift;
    $Active_block_count--;
    $Last_test_in_previous_block = $Test_builder->current_test;
    my $expected = $self->{expected_tests};
    my $name = $self->{name};
    my $tests_ran = _tests_run_in_block($self);
    $name = "'$name'" unless looks_like_number( $name );
    $Test_builder->ok(
        0, 
        "block $name expected $expected test(s) and ran $tests_ran"
    ) unless $tests_ran == $expected;
}


my $All_tests_in_block = 1;
sub all_in_block { 
    return unless $All_tests_in_block;
    return 1 if $Active_block_count > 0;
    $All_tests_in_block = 
        $Last_test_in_previous_block == $Test_builder->current_test;
    return $All_tests_in_block
}


{
    package Test::Block::Plan;
    use Tie::Scalar;
    use base qw(Tie::StdScalar);    

    sub STORE {
        my ($self, $plan) = @_;
        if ( defined($plan) && ! eval { $plan->isa( 'Test::Block' ) } ) {
            $plan = Test::Block->plan( ref($plan) ? %$plan : $plan );
        };
        $self->SUPER::STORE($plan);
    }
}

our $Plan;
tie $Plan, 'Test::Block::Plan';

1;
__END__

=head1 NAME

Test::Block - Specify fine granularity test plans

=head1 SYNOPSIS

  use Test::More 'no_plan';
  use Test::Block qw($Plan);

  {
      # This block should run exactly two tests
      local $Plan = 2;
      pass 'first test';
      # oops. forgot second test
  };

  SKIP: {
      local $Plan = 3;
      pass('first test in second block');
      skip "skip remaining tests" => $Plan;
  };

  ok( Test::Block->all_in_block, 'all test run in blocks' );
  is( Test::Block->block_count, 2, 'two blocks ran' );

  # This produces...
  
  ok 1 - first test
  not ok 2 - block expected 2 test(s) and ran 1
  #     Failed test (foo.pl at line 6)
  ok 3 - first test in second block
  ok 4 # skip skip remaining tests
  ok 5 # skip skip remaining tests
  ok 6 - all test run in blocks
  ok 7 - two blocks ran
  1..7
  # Looks like you failed 1 tests of 7.


=head1 DESCRIPTION

This module allows you to specify the number of expected tests at a finer level of granularity than an entire test script. It is built with L<Test::Builder> and plays happily with L<Test::More> and friends.

If you are not already familiar with L<Test::More> now would be the time to go take a look.


=head2 Creating test blocks

Test::Block supplies a special variable C<$Plan> that you can localize to specify the number of tests in a block like this:

    use Test::More 'no_plan';
    use Test::Block qw($Plan);
    
    {
        local $Plan = 2;
        pass('first test');
        pass('second test');
    };
    
=head2 What if the block runs a different number of tests?
    
If a block doesn't run the number of tests specified in C<$Plan> then Test::Block will automatically produce a failing test. For example:

    {
        local $Plan = 2;
        pass('first test');
        # oops - forgot second test
    };

will output

    ok 1 - first test
    not ok 2 - block 1 expected 2 test(s) and ran 1

=head2 Tracking the number of remaining tests

During the execution of a block C<$Plan> will contain the number of remaining tests that are expected to run so:

    {
        local $Plan = 2;
        diag "$Plan tests to run";
        pass('first test');
        diag "$Plan tests to run";
        pass('second test');
        diag "$Plan tests to run";
    };

will produce

    # 2 tests to run
    ok 1 - first test
    # 1 tests to run
    ok 2 - second test
    # 0 tests to run

This can make skip blocks easier to write and maintain, for example:

    SKIP: {
        local $Plan = 5;
        pass('first test');
        pass('second test');
        skip "debug tests" => $Plan unless DEBUG > 0;
        pass('third test');
        pass('fourth test');
        skip "high level debug tests" => $Plan unless DEBUG > 2;
        pass('fifth test');
    };


=head2 Named blocks

To make debugging easier you can give your blocks an optional name like this:

    {
        local $Plan = { example => 2 };
        pass('first test');
        # oops - forgot second test
    };

which would output

    ok 1 - first test
    not ok 2 - block example expected 2 test(s) and ran 1


=head2 Test::Block objects

The C<$Plan> is implemented using a tied variable that stores and retrieves Test::Block objects. If you want to avoid the tied interface you can use Test::Block objects directly.

=over 4

=item B<plan>

  # create a block expecting 4 tests
  my $block = Test::Block->plan(4);

  # create a named block with two tests
  my $block = Test::Block->plan('test name' => 2);

You create Test::Block objects with the C<plan> method. When the object is destroyed it outputs a failing test if the expected number of tests have not run. 


=item B<remaining>

You can find out the number of remaining tests in the block by calling the C<remaining> method on the object. 

Test::Block objects overload C<""> and C<0+> to return the result of the remaining method.


=item B<builder>

Returns L<Test::Builder> object used by Test::Block. For example:

  Test::Block->builder->skip('skip a test');

See L<Test::Builder> for more information.


=item B<block_count>

A class method that returns the number of blocks that have been created. You can use this to check that the expected number of blocks have run by doing something like:

  is( Test::Block->block_count, 5, 'five blocks run' );

at the end of your test script.


=item B<all_in_block>

Returns true if all tests so far run have been inside the scope of a Test::Block object.

  ok( Test::Block->all_in_block, 'all tests run in blocks' );

=back


=head1 BUGS

None known at the time of writing. 

If you find any please let me know by e-mail, or report the problem with L<http://rt.cpan.org/>.


=head1 COMMUNITY

=over 4

=item perl-qa

If you are interested in testing using Perl I recommend you visit L<http://qa.perl.org/> and join the excellent perl-qa mailing list. See L<http://lists.perl.org/showlist.cgi?name=perl-qa> for details on how to subscribe.

=item perlmonks

You can find users of Test::Block, including the module author, on  L<http://www.perlmonks.org/>. Feel free to ask questions on Test::Block there.

=item CPAN::Forum

The CPAN Forum is a web forum for discussing Perl's CPAN modules.   The Test::Block forum can be found at L<http://www.cpanforum.com/dist/Test-Block>.

=item AnnoCPAN

AnnoCPAN is a web site that allows community annotations of Perl module documentation. The Test::Block annotations can be found at L<http://annocpan.org/~ADIE/Test-Block/>.

=back

=head1 TO DO

If you think this module should do something that it doesn't (or does something that it shouldn't) please let me know.

You can see my current to do list at L<http://adrianh.tadalist.com/lists/public/15423>, with an RSS feed of changes at L<http://adrianh.tadalist.com/lists/feed_public/15423>.


=head1 ACKNOWLEDGMENTS

Thanks to chromatic and Michael G Schwern for the excellent Test::Builder, without which this module wouldn't be possible.

Thanks to Michael G Schwern and Tony Bowden for the mails on perl-qa@perl.org that sparked the idea for this module. Thanks to Fergal Daly for suggesting named blocks. Thanks to Michael G Schwern for suggesting $Plan. Thanks to Nadim Khemir for feedback.


=head1 AUTHOR

Adrian Howard <adrianh@quietstars.com>

If you can spare the time, please drop me a line if you find this module useful.


=head1 SEE ALSO

=over 4

=item L<Test::Group>

A framework for grouping related tests in a test suite

=item L<Test::Class>

Test::Class is an xUnit testing framework for Perl. It allows you to group tests into methods with independent test plans.

=item L<Test::Builder>

Support module for building test libraries.

=item L<Test::Simple> & L<Test::More>

Basic utilities for writing tests.

=item L<http://qa.perl.org/test-modules.html>

Overview of some of the many testing modules available on CPAN.

=back


=head1 LICENCE

Copyright 2003-2006 Adrian Howard, All Rights Reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=cut