/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
|