File Coverage

blib/lib/Test/Manifest.pm
Criterion Covered Total %
statement 74 104 71.1
branch 30 52 57.6
condition 5 7 71.4
subroutine 11 15 73.3
pod 6 6 100.0
total 126 184 68.4


line stmt bran cond sub pod time code
1             package Test::Manifest;
2 4     4   230960 use strict;
  4         44  
  4         119  
3              
4 4     4   20 use warnings;
  4         8  
  4         92  
5 4     4   20 no warnings;
  4         7  
  4         136  
6              
7 4     4   21 use Exporter qw(import);
  4         7  
  4         145  
8              
9 4     4   22 use Carp qw(carp);
  4         8  
  4         194  
10 4     4   2147 use File::Spec::Functions qw(catfile);
  4         3490  
  4         5804  
11              
12             our @EXPORT = qw(run_t_manifest);
13             our @EXPORT_OK = qw(get_t_files make_test_manifest manifest_name);
14              
15             our $VERSION = '2.022';
16              
17             my %SeenInclude = ();
18             my %SeenTest = ();
19              
20             require 5.008;
21              
22             sub MY::test_via_harness {
23 0     0   0 my($self, $perl, $tests) = @_;
24              
25 0         0 return qq|\t$perl "-MTest::Manifest" | .
26             qq|"-e" "run_t_manifest(\$(TEST_VERBOSE), '\$(INST_LIB)', | .
27             qq|'\$(INST_ARCHLIB)', \$(TEST_LEVEL) )"\n|;
28             };
29              
30             =encoding utf8
31              
32             =head1 NAME
33              
34             Test::Manifest - interact with a t/test_manifest file
35              
36             =head1 SYNOPSIS
37              
38             # in Makefile.PL
39             eval "use Test::Manifest 2.00";
40              
41             # in Build.PL
42             my $class = do {
43             if( eval 'use Test::Manifest 2.00; 1' ) {
44             Test::Manifest->get_module_build_subclass;
45             }
46             else {
47             'Module::Build';
48             }
49             };
50              
51             my $build = $class->new( ... )
52              
53             # in the file t/test_manifest, list the tests you want
54             # to run in the order you want to run them
55              
56             =head1 DESCRIPTION
57              
58             C assumes that you want to run all of the F<.t> files
59             in the F directory in ASCII-betical order during C or
60             C<./Build test> unless you say otherwise. This leads to some
61             interesting naming schemes for test files to get them in the desired
62             order. These interesting names ossify when they get into source
63             control, and get even more interesting as more tests show up.
64              
65             C overrides the default test file order. Instead of
66             running all of the F files in ASCII-betical order, it looks in
67             the F file to find out which tests you want to run
68             and the order in which you want to run them. It constructs the right
69             value for the build system to do the right thing.
70              
71             In F, simply list the tests that you want to run.
72             Their order in the file is the order in which they run. You can
73             comment lines with a C<#>, just like in Perl, and C
74             will strip leading and trailing whitespace from each line. It also
75             checks that the specified file is actually in the F directory. If
76             the file does not exist, it does not put its name in the list of test
77             files to run and it will issue a warning.
78              
79             Optionally, you can add a number after the test name in test_manifest
80             to define sets of tests. See C for more information.
81              
82             =head2 ExtUtils::MakeMaker
83              
84             To override the test order behaviour in C, C
85             inserts itself in the C step by providing its own
86             test runner. In C, all you have to do is load C
87             before you call C. To make it optional, load it in an eval:
88              
89             eval "use Test::Manifest";
90              
91             =head2 Module::Build
92              
93             Overiding parts of C is tricker if you want to use the
94             subclassing mechanism and still make C optional. If you
95             can load C (version 2.00 or later), C can
96             create the subclass for you.
97              
98             my $class = do {
99             if( eval 'use Test::Manifest 2.00; 1' ) {
100             Test::Manifest->get_module_build_subclass;
101             }
102             else {
103             'Module::Build' # if Test::Manifest isn't there
104             }
105             };
106              
107             $class->new( ... );
108             $class->create_build_file;
109              
110             This is a bit of a problem when you already have your own subclass.
111             C overrides C, so you can get just
112             that code to add to your own subclass code string:
113              
114             my $code = eval 'use Test::Manifest 2.00; 1'
115             ?
116             Test::Manifest->get_module_build_code_string
117             :
118             '';
119              
120             my $class = Module::Build->subclass(
121             ...,
122             code => "$code\n...your subclass code string...",
123             );
124              
125             =head2 Class methods
126              
127             =over 4
128              
129             =item get_module_build_subclass
130              
131             For C only.
132              
133             Returns a C subclass that overrides C. If
134             you want to have your own C subclass and still use
135             C, you can get just the code string with
136             C.
137              
138             =cut
139              
140             sub get_module_build_subclass {
141 0     0 1 0 my( $class ) = @_;
142              
143              
144 0         0 require Module::Build;
145              
146 0         0 my $class = Module::Build->subclass(
147             class => 'Test::Manifest::MB',
148              
149             code => $class->get_module_build_code_string,
150             );
151              
152 0         0 $class->log_info( "Using Test::Manifest $VERSION\n" );
153              
154 0         0 $class;
155             }
156              
157             =item get_module_build_code_string
158              
159             For C only.
160              
161             Returns the overridden C as Perl code in a string suitable
162             for the C key in Csubclass()>. You can add this to other
163             bits you are overriding or extending.
164              
165             See C to see the base implementation.
166              
167             =cut
168              
169             sub get_module_build_code_string {
170 0     0 1 0 q{
171             sub find_test_files {
172             my $self = shift;
173             my $p = $self->{properties};
174              
175             my( $level ) = grep { defined } (
176             $ENV{TEST_LEVEL},
177             $p->{ 'testlevel' },
178             0
179             );
180              
181             $self->log_verbose( "Test level is $level\n" );
182              
183             require Test::Manifest;
184             my @files = Test::Manifest::get_t_files( $level );
185             \@files;
186             }
187             }
188             }
189              
190             =back
191              
192             =head2 Functions
193              
194             =over 4
195              
196             =item run_t_manifest( TEST_VERBOSE, INST_LIB, INST_ARCHLIB, TEST_LEVEL )
197              
198             For C only. You don't have to mess with this at the user
199             level.
200              
201             Run all of the files in F through C
202             in the order they appear in the file. This is inserted automatically
203              
204             eval "use Test::Manifest";
205              
206             =cut
207              
208             sub run_t_manifest {
209 0     0 1 0 require Test::Harness;
210 0         0 require File::Spec;
211              
212 0         0 $Test::Harness::verbose = shift;
213              
214 0         0 local @INC = @INC;
215 0         0 unshift @INC, map { File::Spec->rel2abs($_) } @_[0,1];
  0         0  
216              
217 0   0     0 my( $level ) = $_[2] || 0;
218              
219 0 0       0 print STDERR "Test::Manifest $VERSION\n"
220             if $Test::Harness::verbose;
221              
222 0 0       0 print STDERR "Level is $level\n"
223             if $Test::Harness::verbose;
224              
225 0         0 my @files = get_t_files( $level );
226 0 0       0 print STDERR "Test::Manifest::test_harness found [@files]\n"
227             if $Test::Harness::verbose;
228              
229 0         0 Test::Harness::runtests( @files );
230             }
231              
232             =item get_t_files( [LEVEL] )
233              
234             In scalar context it returns a single string that you can use directly
235             in C. In list context it returns a list of the files it
236             found in F.
237              
238             If a F file does not exist, C returns
239             nothing.
240              
241             C warns you if it can't find F, or if
242             entries start with F. It skips blank lines, and strips Perl
243             style comments from the file.
244              
245             Each line in F can have three parts: the test name,
246             the test level (a floating point number), and a comment. By default,
247             the test level is 1.
248              
249             test_name.t 2 #Run this only for level 2 testing
250              
251             Without an argument, C returns all the test files it
252             finds. With an argument that is true (so you can't use 0 as a level)
253             and is a number, it skips tests with a level greater than that
254             argument. You can then define sets of tests and choose a set to
255             run. For instance, you might create a set for end users, but also
256             add on a set for deeper testing for developers.
257              
258             Experimentally, you can include a command to grab test names from
259             another file. The command starts with a C<;> to distinguish it
260             from a true filename. The filename (currently) is relative to the
261             current working directory, unlike the filenames, which are relative
262             to C. The filenames in the included are still relative to C.
263              
264             ;include t/file_with_other_test_names.txt
265              
266             Also experimentally, you can stop C from reading
267             filenames with the C<;skip> directive. C will skip the
268             filenames up to the C<;unskip> directive (or end of file):
269              
270             run_this1
271             ;skip
272             skip_this
273             ;unskip
274             run_this2
275              
276             To select sets of tests, specify the level in the environment variable
277             C:
278              
279             make test # run all tests no matter the level
280             make test TEST_LEVEL=2 # run all tests level 2 and below
281              
282             Eventually this will end up as an option to F:
283              
284             ./Build test --testlevel=2 # Not yet supported
285              
286             =cut
287              
288             sub get_t_files {
289 10     10 1 9318 my $upper_bound = shift;
290 10 100       111 print STDERR "# Test level is $upper_bound\n"
291             if $Test::Harness::verbose;
292              
293 10         25 %SeenInclude = ();
294 10         22 %SeenTest = ();
295              
296 10         27 my $Manifest = manifest_name();
297 10 100       435 carp( "$Manifest does not exist!" ) unless -e $Manifest;
298 10         43 my $result = _load_test_manifest( $Manifest, $upper_bound );
299 10 100       32 return unless defined $result;
300 8         13 my @tests = @{$result};
  8         23  
301              
302 8 100       53 return wantarray ? @tests : join " ", @tests;
303             }
304              
305             # Wrapper for loading test manifest files to support including other files
306             sub _load_test_manifest {
307 12     12   23 my $manifest = shift;
308 12 100       393 return unless open my( $fh ), '<', $manifest;
309              
310 10   100     69 my $upper_bound = shift || 0;
311 10         23 my @tests = ();
312              
313 10         211 LINE: while( <$fh> ) {
314 58         177 s/#.*//; s/^\s+//; s/\s+$//;
  58         133  
  58         184  
315              
316 58 100       136 next unless $_;
317              
318 46         140 my( $command, $arg ) = split /\s+/, $_, 2;
319 46 100       127 if( ';' eq substr( $command, 0, 1 ) ) {
320 2 50       7 if( $command eq ';include' ) {
    0          
321 2         6 my $result = _include_file( $arg, $., $upper_bound );
322 2 50       7 push @tests, @$result if defined $result;
323 2         9 next;
324             }
325             elsif( $command eq ';skip' ) {
326 0 0       0 while( <$fh> ) { last if m/^;unskip/ }
  0         0  
327 0         0 next LINE;
328             }
329             else {
330 0         0 croak( "Unknown directive: $command" );
331             }
332             }
333              
334 44         81 my( $test, $level ) = ( $command, $arg );
335 44 100       83 $level = 1 unless defined $level;
336              
337 44 100 100     155 next if( $upper_bound and $level > $upper_bound );
338              
339 36 50       135 carp( "Bad value for test [$test] level [$level]\n".
340             "Level should be a floating-point number\n" )
341             unless $level =~ m/^\d+(?:.\d+)?$/;
342 36 50       77 carp( "test file begins with t/ [$test]" ) if m|^t/|;
343              
344 36 50       530 if( -e catfile( "t", $test ) ) {
345 36         186 $test = catfile( "t", $test )
346             }
347             else {
348 0         0 carp( "test file [$test] does not exist! Skipping!" );
349 0         0 next;
350             }
351              
352             # Make sure we don't include a test we've already seen
353 36 50       113 next if exists $SeenTest{$test};
354              
355 36         90 $SeenTest{$test} = 1;
356 36         204 push @tests, $test;
357             }
358              
359 10         96 close $fh;
360 10         60 return \@tests;
361             }
362              
363             sub _include_file {
364 2     2   7 my( $file, $line, $upper_bound ) = @_;
365 2 50       6 print STDERR "# Including file $file at line $line\n"
366             if $Test::Harness::verbose;
367              
368 2 50       35 unless( -e $file ) {
369 0         0 carp( "$file does not exist" ) ;
370 0         0 return;
371             }
372              
373 2 50       8 if( exists $SeenInclude{$file} ) {
374 0         0 carp( "$file already loaded - skipping" ) ;
375 0         0 return;
376             }
377              
378 2         5 $SeenInclude{$file} = $line;
379              
380 2         7 my $result = _load_test_manifest( $file, $upper_bound );
381 2 50       6 return unless defined $result;
382              
383 2         5 $result;
384             }
385              
386              
387             =item make_test_manifest()
388              
389             Creates the test_manifest file in the t directory by reading the
390             contents of the F directory.
391              
392             TO DO: specify tests in argument lists.
393              
394             TO DO: specify files to skip.
395              
396             =cut
397              
398             sub make_test_manifest() {
399 1 50   1 1 4237 carp( "t/ directory does not exist!" ) unless -d "t";
400 1 50       19 return unless open my( $fh ), '>', manifest_name();
401              
402 1         5 my $count = 0;
403 1         147 while( my $file = glob("t/*.t") ) {
404 8         29 $file =~ s|^t/||;
405 8         31 print $fh "$file\n";
406 8         24 $count++;
407             }
408 1         30 close $fh;
409              
410 1         20 return $count;
411             }
412              
413             =item manifest_name()
414              
415             Returns the name of the test manifest file, relative to F.
416              
417             =cut
418              
419             {
420             my $Manifest = catfile( "t", "test_manifest" );
421              
422             sub manifest_name {
423 17     17 1 26501 return $Manifest;
424             }
425             }
426              
427             =back
428              
429             =head1 SOURCE AVAILABILITY
430              
431             This source is in Github:
432              
433             http://github.com/briandfoy/test-manifest/
434              
435             =head1 CREDITS
436              
437             Matt Vanderpol suggested and supplied a patch for the C<;include>
438             feature.
439              
440             Olivier Mengué supplied a documentation patch.
441              
442             =head1 AUTHOR
443              
444             brian d foy, C<< >>
445              
446             =head1 COPYRIGHT AND LICENSE
447              
448             Copyright © 2002-2021, brian d foy . All rights reserved.
449              
450             This program is free software; you can redistribute it and/or modify
451             it under the terms of the Artistic License 2.0.
452              
453             =cut
454              
455              
456             1;