local-lib5/lib/perl5/Test/Manifest.pm

   1 package Test::Manifest;
   2 use strict;
   3
   4 use warnings;
   5 no warnings;
   6
   7 use base qw(Exporter);
   8 use vars qw(@EXPORT_OK @EXPORT $VERSION);
   9
  10 use Carp qw(carp);
  11 use File::Spec::Functions qw(catfile);
  12
  13 @EXPORT    = qw(run_t_manifest);
  14 @EXPORT_OK = qw(get_t_files make_test_manifest manifest_name);
  15
  16 $VERSION = '1.23';
  17
  18 my $Manifest = catfile( "t", "test_manifest" );
  19 my %SeenInclude = ();
  20 my %SeenTest = ();
  21
  22 require 5.006;
  23
  24 sub MY::test_via_harness
  25         {
  26         my($self, $perl, $tests) = @_;
  27
  28         return qq|\t$perl "-MTest::Manifest" | .
  29                    qq|"-e" "run_t_manifest(\$(TEST_VERBOSE), '\$(INST_LIB)', | .
  30                    qq|'\$(INST_ARCHLIB)', \$(TEST_LEVEL) )"\n|;
  31         };
  32
  33 =head1 NAME
  34
  35 Test::Manifest - interact with a t/test_manifest file
  36
  37 =head1 SYNOPSIS
  38
  39         # in Makefile.PL
  40         eval "use Test::Manifest";
  41
  42         # in the file t/test_manifest, list the tests you want
  43         # to run
  44
  45 =head1 DESCRIPTION
  46
  47 C<Test::Harness> assumes that you want to run all of the F<.t> files in the
  48 F<t/> directory in ascii-betical order during C<make test> unless you say
  49 otherwise.  This leads to some interesting naming schemes for test
  50 files to get them in the desired order. This interesting names ossify
  51 when they get into source control, and get even more interesting as
  52 more tests show up.
  53
  54 C<Test::Manifest> overrides the default behaviour by replacing the
  55 test_via_harness target in the Makefile.  Instead of running at the
  56 F<t/*.t> files in ascii-betical order, it looks in the F<t/test_manifest>
  57 file to find out which tests you want to run and the order in which
  58 you want to run them.  It constructs the right value for MakeMaker to
  59 do the right thing.
  60
  61 In F<t/test_manifest>, simply list the tests that you want to run.  Their
  62 order in the file is the order in which they run.  You can comment
  63 lines with a C<#>, just like in Perl, and C<Test::Manifest> will strip
  64 leading and trailing whitespace from each line.  It also checks that
  65 the specified file is actually in the F<t/> directory.  If the file does
  66 not exist, it does not put its name in the list of test files to run and
  67 it will issue a warning.
  68
  69 Optionally, you can add a number after the test name in test_manifest
  70 to define sets of tests. See C<get_t_files> for more information.
  71
  72 =head2 Functions
  73
  74 =over 4
  75
  76 =item run_t_manifest( TEST_VERBOSE, INST_LIB, INST_ARCHLIB, TEST_LEVEL )
  77
  78 Run all of the files in t/test_manifest through Test::Harness:runtests
  79 in the order they appear in the file.
  80
  81         eval "use Test::Manifest";
  82
  83 =cut
  84
  85 sub run_t_manifest
  86         {
  87         require Test::Harness;
  88         require File::Spec;
  89
  90         $Test::Harness::verbose = shift;
  91
  92         local @INC = @INC;
  93         unshift @INC, map { File::Spec->rel2abs($_) } @_[0,1];
  94
  95         my( $level ) = $_[2] || 0;
  96
  97         print STDERR "Test::Manifest $VERSION\n"
  98                 if $Test::Harness::verbose;
  99
 100         print STDERR "Level is $level\n"
 101                 if $Test::Harness::verbose;
 102
 103         my @files = get_t_files( $level );
 104         print STDERR "Test::Manifest::test_harness found [@files]\n"
 105                 if $Test::Harness::verbose;
 106
 107         Test::Harness::runtests( @files );
 108         }
 109
 110 =item get_t_files( [LEVEL] )
 111
 112 In scalar context it returns a single string that you can use directly
 113 in WriteMakefile(). In list context it returns a list of the files it
 114 found in t/test_manifest.
 115
 116 If a t/test_manifest file does not exist, get_t_files() returns
 117 nothing.
 118
 119 get_t_files() warns you if it can't find t/test_manifest, or if
 120 entries start with "t/". It skips blank lines, and strips Perl
 121 style comments from the file.
 122
 123 Each line in t/test_manifest can have three parts: the test name,
 124 the test level (a floating point number), and a comment. By default,
 125 the test level is 1.
 126
 127         test_name.t 2  #Run this only for level 2 testing
 128
 129 Without an argument, get_t_files() returns all the test files it
 130 finds. With an argument that is true (so you can't use 0 as a level)
 131 and is a number, it skips tests with a level greater than that
 132 argument. You can then define sets of tests and choose a set to
 133 run. For instance, you might create a set for end users, but also
 134 add on a set for deeper testing for developers.
 135
 136 Experimentally, you can include a command to grab test names from
 137 another file. The command starts with a C<;> to distinguish it
 138 from a true filename. The filename (currently) is relative to the
 139 current working directory, unlike the filenames, which are relative
 140 to C<t/>. The filenames in the included are still relative to C<t/>.
 141
 142         ;include t/file_with_other_test_names.txt
 143
 144 Also experimentally, you can stop Test::Manifest from reading filenames
 145 with the C<;skip> directive. Test::Harness will skip the filenames up to
 146 the C<;unskip> directive (or end of file)
 147
 148         run_this1
 149         ;skip
 150         skip_this
 151         ;unskip
 152         run_this2
 153
 154 To select sets of tests, specify the level in the variable TEST_LEVEL
 155 during `make test`.
 156
 157         make test # run all tests no matter the level
 158         make test TEST_LEVEL=2  # run all tests level 2 and below
 159
 160 =cut
 161
 162 sub get_t_files
 163         {
 164         my $upper_bound = shift;
 165         print STDERR "# Test level is $upper_bound\n"
 166                 if $Test::Harness::verbose;
 167
 168         %SeenInclude = ();
 169         %SeenTest    = ();
 170
 171         carp( "$Manifest does not exist!" ) unless -e $Manifest;
 172         my $result = _load_test_manifest($Manifest, $upper_bound);
 173         return unless defined $result;
 174         my @tests = @{$result};
 175
 176         return wantarray ? @tests : join " ", @tests;
 177         }
 178
 179 # Wrapper for loading test manifest files to support including other files
 180 sub _load_test_manifest
 181         {
 182         my $manifest = shift;
 183         return unless open my( $fh ), $manifest;
 184
 185         my $upper_bound = shift || 0;
 186         my @tests = ();
 187
 188         LINE: while( <$fh> )
 189                 {
 190                 s/#.*//; s/^\s+//; s/\s+$//;
 191
 192                 next unless $_;
 193
 194                 my( $command, $arg ) = split/\s+/, $_, 2;
 195                 if( ';' eq substr( $command, 0, 1 ) )
 196                         {
 197                         if( $command eq ';include' )
 198                                 {
 199                                 my $result = _include_file( $arg, $., $upper_bound );
 200                                 push @tests, @$result if defined $result;
 201                                 next;
 202                                 }
 203                         elsif( $command eq ';skip' )
 204                                 {
 205                                 while( <$fh> ) { last if m/^;unskip/ }
 206                                 next LINE;
 207                                 }
 208                         else
 209                                 {
 210                                 croak( "Unknown directive: $command" );
 211                                 }
 212                         }
 213
 214                 my( $test, $level ) = ( $command, $arg );
 215                 $level = 1 unless defined $level;
 216
 217                 next if( $upper_bound and $level > $upper_bound );
 218
 219                 carp( "Bad value for test [$test] level [$level]\n".
 220                         "Level should be a floating-point number\n" )
 221                         unless $level =~ m/^\d+(?:.\d+)?$/;
 222                 carp( "test file begins with t/ [$test]" ) if m|^t/|;
 223
 224                 $test = catfile( "t", $test ) if -e catfile( "t", $test );
 225
 226                 unless( -e $test )
 227                         {
 228                         carp( "test file [$test] does not exist! Skipping!" );
 229                         next;
 230                         }
 231
 232                 # Make sure we don't include a test we've already seen
 233                 next if exists $SeenTest{$test};
 234
 235                 $SeenTest{$test} = 1;
 236                 push @tests, $test;
 237                 }
 238
 239         close $fh;
 240         return \@tests;
 241         }
 242
 243 sub _include_file
 244         {
 245         my( $file, $line, $upper_bound ) = @_;
 246         print STDERR "# Including file $file at line $line\n"
 247                 if $Test::Harness::verbose;
 248
 249         unless( -e $file )
 250                 {
 251                 carp( "$file does not exist" ) ;
 252                 return;
 253                 }
 254
 255         if( exists $SeenInclude{$file} )
 256                 {
 257                 carp( "$file already loaded - skipping" ) ;
 258                 return;
 259                 }
 260
 261         $SeenInclude{$file} = $line;
 262
 263         my $result = _load_test_manifest( $file, $upper_bound );
 264         return unless defined $result;
 265
 266         $result;
 267         }
 268
 269
 270 =item make_test_manifest()
 271
 272 Creates the test_manifest file in the t directory by reading
 273 the contents of the t directory.
 274
 275 TO DO: specify tests in argument lists.
 276
 277 TO DO: specify files to skip.
 278
 279 =cut
 280
 281 sub make_test_manifest()
 282         {
 283         carp( "t/ directory does not exist!" ) unless -d "t";
 284         return unless open my( $fh ), "> $Manifest";
 285
 286         my $count = 0;
 287         while( my $file = glob("t/*.t") )
 288                 {
 289                 $file =~ s|^t/||;
 290                 print $fh "$file\n";
 291                 $count++;
 292                 }
 293         close $fh;
 294
 295         return $count;
 296         }
 297
 298 =item manifest_name()
 299
 300 Returns the name of the test manifest file, relative to t/
 301
 302 =cut
 303
 304 sub manifest_name
 305         {
 306         return $Manifest;
 307         }
 308
 309 =back
 310
 311 =head1 SOURCE AVAILABILITY
 312
 313 This source is in Github:
 314
 315         http://github.com/briandfoy/Test-Manifest/tree/master
 316
 317 =head1 CREDITS
 318
 319 Matt Vanderpol suggested and supplied a patch for the ;include
 320 feature.
 321
 322 =head1 AUTHOR
 323
 324 brian d foy, C<< <bdfoy@cpan.org> >>
 325
 326 =head1 COPYRIGHT AND LICENSE
 327
 328 Copyright (c) 2002-2009 brian d foy.  All rights reserved.
 329
 330 This program is free software; you can redistribute it and/or modify
 331 it under the same terms as Perl itself.
 332
 333 =cut
 334
 335
 336 1;