cpan/Test-Harness/lib/App/Prove.pm

   1 package App::Prove;
   2
   3 use strict;
   4 use warnings;
   5
   6 use TAP::Harness;
   7 use Text::ParseWords qw(shellwords);
   8 use File::Spec;
   9 use Getopt::Long;
  10 use App::Prove::State;
  11 use Carp;
  12
  13 use parent 'TAP::Object';
  14
  15 =head1 NAME
  16
  17 App::Prove - Implements the C<prove> command.
  18
  19 =head1 VERSION
  20
  21 Version 3.29
  22
  23 =cut
  24
  25 our $VERSION = '3.29';
  26
  27 =head1 DESCRIPTION
  28
  29 L<Test::Harness> provides a command, C<prove>, which runs a TAP based
  30 test suite and prints a report. The C<prove> command is a minimal
  31 wrapper around an instance of this module.
  32
  33 =head1 SYNOPSIS
  34
  35     use App::Prove;
  36
  37     my $app = App::Prove->new;
  38     $app->process_args(@ARGV);
  39     $app->run;
  40
  41 =cut
  42
  43 use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
  44 use constant IS_VMS => $^O eq 'VMS';
  45 use constant IS_UNIXY => !( IS_VMS || IS_WIN32 );
  46
  47 use constant STATE_FILE => IS_UNIXY ? '.prove'   : '_prove';
  48 use constant RC_FILE    => IS_UNIXY ? '.proverc' : '_proverc';
  49
  50 use constant PLUGINS => 'App::Prove::Plugin';
  51
  52 my @ATTR;
  53
  54 BEGIN {
  55     @ATTR = qw(
  56       archive argv blib show_count color directives exec failures comments
  57       formatter harness includes modules plugins jobs lib merge parse quiet
  58       really_quiet recurse backwards shuffle taint_fail taint_warn timer
  59       verbose warnings_fail warnings_warn show_help show_man show_version
  60       state_class test_args state dry extensions ignore_exit rules state_manager
  61       normalize sources tapversion trap
  62     );
  63     __PACKAGE__->mk_methods(@ATTR);
  64 }
  65
  66 =head1 METHODS
  67
  68 =head2 Class Methods
  69
  70 =head3 C<new>
  71
  72 Create a new C<App::Prove>. Optionally a hash ref of attribute
  73 initializers may be passed.
  74
  75 =cut
  76
  77 # new() implementation supplied by TAP::Object
  78
  79 sub _initialize {
  80     my $self = shift;
  81     my $args = shift || {};
  82
  83     my @is_array = qw(
  84       argv rc_opts includes modules state plugins rules sources
  85     );
  86
  87     # setup defaults:
  88     for my $key (@is_array) {
  89         $self->{$key} = [];
  90     }
  91     $self->{harness_class} = 'TAP::Harness';
  92
  93     for my $attr (@ATTR) {
  94         if ( exists $args->{$attr} ) {
  95
  96             # TODO: Some validation here
  97             $self->{$attr} = $args->{$attr};
  98         }
  99     }
 100
 101     my %env_provides_default = (
 102         HARNESS_TIMER => 'timer',
 103     );
 104
 105     while ( my ( $env, $attr ) = each %env_provides_default ) {
 106         $self->{$attr} = 1 if $ENV{$env};
 107     }
 108     $self->state_class('App::Prove::State');
 109     return $self;
 110 }
 111
 112 =head3 C<state_class>
 113
 114 Getter/setter for the name of the class used for maintaining state.  This
 115 class should either subclass from C<App::Prove::State> or provide an identical
 116 interface.
 117
 118 =head3 C<state_manager>
 119
 120 Getter/setter for the instance of the C<state_class>.
 121
 122 =cut
 123
 124 =head3 C<add_rc_file>
 125
 126     $prove->add_rc_file('myproj/.proverc');
 127
 128 Called before C<process_args> to prepend the contents of an rc file to
 129 the options.
 130
 131 =cut
 132
 133 sub add_rc_file {
 134     my ( $self, $rc_file ) = @_;
 135
 136     local *RC;
 137     open RC, "<$rc_file" or croak "Can't read $rc_file ($!)";
 138     while ( defined( my $line = <RC> ) ) {
 139         push @{ $self->{rc_opts} },
 140           grep { defined and not /^#/ }
 141           $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg;
 142     }
 143     close RC;
 144 }
 145
 146 =head3 C<process_args>
 147
 148     $prove->process_args(@args);
 149
 150 Processes the command-line arguments. Attributes will be set
 151 appropriately. Any filenames may be found in the C<argv> attribute.
 152
 153 Dies on invalid arguments.
 154
 155 =cut
 156
 157 sub process_args {
 158     my $self = shift;
 159
 160     my @rc = RC_FILE;
 161     unshift @rc, glob '~/' . RC_FILE if IS_UNIXY;
 162
 163     # Preprocess meta-args.
 164     my @args;
 165     while ( defined( my $arg = shift ) ) {
 166         if ( $arg eq '--norc' ) {
 167             @rc = ();
 168         }
 169         elsif ( $arg eq '--rc' ) {
 170             defined( my $rc = shift )
 171               or croak "Missing argument to --rc";
 172             push @rc, $rc;
 173         }
 174         elsif ( $arg =~ m{^--rc=(.+)$} ) {
 175             push @rc, $1;
 176         }
 177         else {
 178             push @args, $arg;
 179         }
 180     }
 181
 182     # Everything after the arisdottle '::' gets passed as args to
 183     # test programs.
 184     if ( defined( my $stop_at = _first_pos( '::', @args ) ) ) {
 185         my @test_args = splice @args, $stop_at;
 186         shift @test_args;
 187         $self->{test_args} = \@test_args;
 188     }
 189
 190     # Grab options from RC files
 191     $self->add_rc_file($_) for grep -f, @rc;
 192     unshift @args, @{ $self->{rc_opts} };
 193
 194     if ( my @bad = map {"-$_"} grep {/^-(man|help)$/} @args ) {
 195         die "Long options should be written with two dashes: ",
 196           join( ', ', @bad ), "\n";
 197     }
 198
 199     # And finally...
 200
 201     {
 202         local @ARGV = @args;
 203         Getopt::Long::Configure(qw(no_ignore_case bundling pass_through));
 204
 205         # Don't add coderefs to GetOptions
 206         GetOptions(
 207             'v|verbose'  => \$self->{verbose},
 208             'f|failures' => \$self->{failures},
 209             'o|comments' => \$self->{comments},
 210             'l|lib'      => \$self->{lib},
 211             'b|blib'     => \$self->{blib},
 212             's|shuffle'  => \$self->{shuffle},
 213             'color!'     => \$self->{color},
 214             'colour!'    => \$self->{color},
 215             'count!'     => \$self->{show_count},
 216             'c'          => \$self->{color},
 217             'D|dry'      => \$self->{dry},
 218             'ext=s@'     => sub {
 219                 my ( $opt, $val ) = @_;
 220
 221                 # Workaround for Getopt::Long 2.25 handling of
 222                 # multivalue options
 223                 push @{ $self->{extensions} ||= [] }, $val;
 224             },
 225             'harness=s'    => \$self->{harness},
 226             'ignore-exit'  => \$self->{ignore_exit},
 227             'source=s@'    => $self->{sources},
 228             'formatter=s'  => \$self->{formatter},
 229             'r|recurse'    => \$self->{recurse},
 230             'reverse'      => \$self->{backwards},
 231             'p|parse'      => \$self->{parse},
 232             'q|quiet'      => \$self->{quiet},
 233             'Q|QUIET'      => \$self->{really_quiet},
 234             'e|exec=s'     => \$self->{exec},
 235             'm|merge'      => \$self->{merge},
 236             'I=s@'         => $self->{includes},
 237             'M=s@'         => $self->{modules},
 238             'P=s@'         => $self->{plugins},
 239             'state=s@'     => $self->{state},
 240             'directives'   => \$self->{directives},
 241             'h|help|?'     => \$self->{show_help},
 242             'H|man'        => \$self->{show_man},
 243             'V|version'    => \$self->{show_version},
 244             'a|archive=s'  => \$self->{archive},
 245             'j|jobs=i'     => \$self->{jobs},
 246             'timer'        => \$self->{timer},
 247             'T'            => \$self->{taint_fail},
 248             't'            => \$self->{taint_warn},
 249             'W'            => \$self->{warnings_fail},
 250             'w'            => \$self->{warnings_warn},
 251             'normalize'    => \$self->{normalize},
 252             'rules=s@'     => $self->{rules},
 253             'tapversion=s' => \$self->{tapversion},
 254             'trap'         => \$self->{trap},
 255         ) or croak('Unable to continue');
 256
 257         # Stash the remainder of argv for later
 258         $self->{argv} = [@ARGV];
 259     }
 260
 261     return;
 262 }
 263
 264 sub _first_pos {
 265     my $want = shift;
 266     for ( 0 .. $#_ ) {
 267         return $_ if $_[$_] eq $want;
 268     }
 269     return;
 270 }
 271
 272 sub _help {
 273     my ( $self, $verbosity ) = @_;
 274
 275     eval('use Pod::Usage 1.12 ()');
 276     if ( my $err = $@ ) {
 277         die 'Please install Pod::Usage for the --help option '
 278           . '(or try `perldoc prove`.)'
 279           . "\n ($@)";
 280     }
 281
 282     Pod::Usage::pod2usage( { -verbose => $verbosity } );
 283
 284     return;
 285 }
 286
 287 sub _color_default {
 288     my $self = shift;
 289
 290     return -t STDOUT && !$ENV{HARNESS_NOTTY} && !IS_WIN32;
 291 }
 292
 293 sub _get_args {
 294     my $self = shift;
 295
 296     my %args;
 297
 298     $args{trap} = 1 if $self->trap;
 299
 300     if ( defined $self->color ? $self->color : $self->_color_default ) {
 301         $args{color} = 1;
 302     }
 303     if ( !defined $self->show_count ) {
 304         $args{show_count} = 1;
 305     }
 306     else {
 307         $args{show_count} = $self->show_count;
 308     }
 309
 310     if ( $self->archive ) {
 311         $self->require_harness( archive => 'TAP::Harness::Archive' );
 312         $args{archive} = $self->archive;
 313     }
 314
 315     if ( my $jobs = $self->jobs ) {
 316         $args{jobs} = $jobs;
 317     }
 318
 319     if ( my $harness_opt = $self->harness ) {
 320         $self->require_harness( harness => $harness_opt );
 321     }
 322
 323     if ( my $formatter = $self->formatter ) {
 324         $args{formatter_class} = $formatter;
 325     }
 326
 327     for my $handler ( @{ $self->sources } ) {
 328         my ( $name, $config ) = $self->_parse_source($handler);
 329         $args{sources}->{$name} = $config;
 330     }
 331
 332     if ( $self->ignore_exit ) {
 333         $args{ignore_exit} = 1;
 334     }
 335
 336     if ( $self->taint_fail && $self->taint_warn ) {
 337         die '-t and -T are mutually exclusive';
 338     }
 339
 340     if ( $self->warnings_fail && $self->warnings_warn ) {
 341         die '-w and -W are mutually exclusive';
 342     }
 343
 344     for my $a (qw( lib switches )) {
 345         my $method = "_get_$a";
 346         my $val    = $self->$method();
 347         $args{$a} = $val if defined $val;
 348     }
 349
 350     # Handle verbose, quiet, really_quiet flags
 351     my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, );
 352
 353     my @verb_adj = grep {$_} map { $self->$_() ? $verb_map{$_} : 0 }
 354       keys %verb_map;
 355
 356     die "Only one of verbose, quiet or really_quiet should be specified\n"
 357       if @verb_adj > 1;
 358
 359     $args{verbosity} = shift @verb_adj || 0;
 360
 361     for my $a (qw( merge failures comments timer directives normalize )) {
 362         $args{$a} = 1 if $self->$a();
 363     }
 364
 365     $args{errors} = 1 if $self->parse;
 366
 367     # defined but zero-length exec runs test files as binaries
 368     $args{exec} = [ split( /\s+/, $self->exec ) ]
 369       if ( defined( $self->exec ) );
 370
 371     $args{version} = $self->tapversion if defined( $self->tapversion );
 372
 373     if ( defined( my $test_args = $self->test_args ) ) {
 374         $args{test_args} = $test_args;
 375     }
 376
 377     if ( @{ $self->rules } ) {
 378         my @rules;
 379         for ( @{ $self->rules } ) {
 380             if (/^par=(.*)/) {
 381                 push @rules, $1;
 382             }
 383             elsif (/^seq=(.*)/) {
 384                 push @rules, { seq => $1 };
 385             }
 386         }
 387         $args{rules} = { par => [@rules] };
 388     }
 389
 390     return ( \%args, $self->{harness_class} );
 391 }
 392
 393 sub _find_module {
 394     my ( $self, $class, @search ) = @_;
 395
 396     croak "Bad module name $class"
 397       unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
 398
 399     for my $pfx (@search) {
 400         my $name = join( '::', $pfx, $class );
 401         eval "require $name";
 402         return $name unless $@;
 403     }
 404
 405     eval "require $class";
 406     return $class unless $@;
 407     return;
 408 }
 409
 410 sub _load_extension {
 411     my ( $self, $name, @search ) = @_;
 412
 413     my @args = ();
 414     if ( $name =~ /^(.*?)=(.*)/ ) {
 415         $name = $1;
 416         @args = split( /,/, $2 );
 417     }
 418
 419     if ( my $class = $self->_find_module( $name, @search ) ) {
 420         $class->import(@args);
 421         if ( $class->can('load') ) {
 422             $class->load( { app_prove => $self, args => [@args] } );
 423         }
 424     }
 425     else {
 426         croak "Can't load module $name";
 427     }
 428 }
 429
 430 sub _load_extensions {
 431     my ( $self, $ext, @search ) = @_;
 432     $self->_load_extension( $_, @search ) for @$ext;
 433 }
 434
 435 sub _parse_source {
 436     my ( $self, $handler ) = @_;
 437
 438     # Load any options.
 439     ( my $opt_name = lc $handler ) =~ s/::/-/g;
 440     local @ARGV = @{ $self->{argv} };
 441     my %config;
 442     Getopt::Long::GetOptions(
 443         "$opt_name-option=s%" => sub {
 444             my ( $name, $k, $v ) = @_;
 445             if ( $v =~ /(?<!\\)=/ ) {
 446
 447                 # It's a hash option.
 448                 croak "Option $name must be consistently used as a hash"
 449                   if exists $config{$k} && ref $config{$k} ne 'HASH';
 450                 $config{$k} ||= {};
 451                 my ( $hk, $hv ) = split /(?<!\\)=/, $v, 2;
 452                 $config{$k}{$hk} = $hv;
 453             }
 454             else {
 455                 $v =~ s/\\=/=/g;
 456                 if ( exists $config{$k} ) {
 457                     $config{$k} = [ $config{$k} ]
 458                       unless ref $config{$k} eq 'ARRAY';
 459                     push @{ $config{$k} } => $v;
 460                 }
 461                 else {
 462                     $config{$k} = $v;
 463                 }
 464             }
 465         }
 466     );
 467     $self->{argv} = \@ARGV;
 468     return ( $handler, \%config );
 469 }
 470
 471 =head3 C<run>
 472
 473 Perform whatever actions the command line args specified. The C<prove>
 474 command line tool consists of the following code:
 475
 476     use App::Prove;
 477
 478     my $app = App::Prove->new;
 479     $app->process_args(@ARGV);
 480     exit( $app->run ? 0 : 1 );  # if you need the exit code
 481
 482 =cut
 483
 484 sub run {
 485     my $self = shift;
 486
 487     unless ( $self->state_manager ) {
 488         $self->state_manager(
 489             $self->state_class->new( { store => STATE_FILE } ) );
 490     }
 491
 492     if ( $self->show_help ) {
 493         $self->_help(1);
 494     }
 495     elsif ( $self->show_man ) {
 496         $self->_help(2);
 497     }
 498     elsif ( $self->show_version ) {
 499         $self->print_version;
 500     }
 501     elsif ( $self->dry ) {
 502         print "$_\n" for $self->_get_tests;
 503     }
 504     else {
 505
 506         $self->_load_extensions( $self->modules );
 507         $self->_load_extensions( $self->plugins, PLUGINS );
 508
 509         local $ENV{TEST_VERBOSE} = 1 if $self->verbose;
 510
 511         return $self->_runtests( $self->_get_args, $self->_get_tests );
 512     }
 513
 514     return 1;
 515 }
 516
 517 sub _get_tests {
 518     my $self = shift;
 519
 520     my $state = $self->state_manager;
 521     my $ext   = $self->extensions;
 522     $state->extensions($ext) if defined $ext;
 523     if ( defined( my $state_switch = $self->state ) ) {
 524         $state->apply_switch(@$state_switch);
 525     }
 526
 527     my @tests = $state->get_tests( $self->recurse, @{ $self->argv } );
 528
 529     $self->_shuffle(@tests) if $self->shuffle;
 530     @tests = reverse @tests if $self->backwards;
 531
 532     return @tests;
 533 }
 534
 535 sub _runtests {
 536     my ( $self, $args, $harness_class, @tests ) = @_;
 537     my $harness = $harness_class->new($args);
 538
 539     my $state = $self->state_manager;
 540
 541     $harness->callback(
 542         after_test => sub {
 543             $state->observe_test(@_);
 544         }
 545     );
 546
 547     $harness->callback(
 548         after_runtests => sub {
 549             $state->commit(@_);
 550         }
 551     );
 552
 553     my $aggregator = $harness->runtests(@tests);
 554
 555     return !$aggregator->has_errors;
 556 }
 557
 558 sub _get_switches {
 559     my $self = shift;
 560     my @switches;
 561
 562     # notes that -T or -t must be at the front of the switches!
 563     if ( $self->taint_fail ) {
 564         push @switches, '-T';
 565     }
 566     elsif ( $self->taint_warn ) {
 567         push @switches, '-t';
 568     }
 569     if ( $self->warnings_fail ) {
 570         push @switches, '-W';
 571     }
 572     elsif ( $self->warnings_warn ) {
 573         push @switches, '-w';
 574     }
 575
 576     push @switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} ) if defined $ENV{HARNESS_PERL_SWITCHES};
 577
 578     return @switches ? \@switches : ();
 579 }
 580
 581 sub _get_lib {
 582     my $self = shift;
 583     my @libs;
 584     if ( $self->lib ) {
 585         push @libs, 'lib';
 586     }
 587     if ( $self->blib ) {
 588         push @libs, 'blib/lib', 'blib/arch';
 589     }
 590     if ( @{ $self->includes } ) {
 591         push @libs, @{ $self->includes };
 592     }
 593
 594     #24926
 595     @libs = map { File::Spec->rel2abs($_) } @libs;
 596
 597     # Huh?
 598     return @libs ? \@libs : ();
 599 }
 600
 601 sub _shuffle {
 602     my $self = shift;
 603
 604     # Fisher-Yates shuffle
 605     my $i = @_;
 606     while ($i) {
 607         my $j = rand $i--;
 608         @_[ $i, $j ] = @_[ $j, $i ];
 609     }
 610     return;
 611 }
 612
 613 =head3 C<require_harness>
 614
 615 Load a harness replacement class.
 616
 617   $prove->require_harness($for => $class_name);
 618
 619 =cut
 620
 621 sub require_harness {
 622     my ( $self, $for, $class ) = @_;
 623
 624     my ($class_name) = $class =~ /^(\w+(?:::\w+)*)/;
 625
 626     # Emulate Perl's -MModule=arg1,arg2 behaviour
 627     $class =~ s!^(\w+(?:::\w+)*)=(.*)$!$1 split(/,/,q{$2})!;
 628
 629     eval("use $class;");
 630     die "$class_name is required to use the --$for feature: $@" if $@;
 631
 632     $self->{harness_class} = $class_name;
 633
 634     return;
 635 }
 636
 637 =head3 C<print_version>
 638
 639 Display the version numbers of the loaded L<TAP::Harness> and the
 640 current Perl.
 641
 642 =cut
 643
 644 sub print_version {
 645     my $self = shift;
 646     printf(
 647         "TAP::Harness v%s and Perl v%vd\n",
 648         $TAP::Harness::VERSION, $^V
 649     );
 650
 651     return;
 652 }
 653
 654 1;
 655
 656 # vim:ts=4:sw=4:et:sta
 657
 658 __END__
 659
 660 =head2 Attributes
 661
 662 After command line parsing the following attributes reflect the values
 663 of the corresponding command line switches. They may be altered before
 664 calling C<run>.
 665
 666 =over
 667
 668 =item C<archive>
 669
 670 =item C<argv>
 671
 672 =item C<backwards>
 673
 674 =item C<blib>
 675
 676 =item C<color>
 677
 678 =item C<directives>
 679
 680 =item C<dry>
 681
 682 =item C<exec>
 683
 684 =item C<extensions>
 685
 686 =item C<failures>
 687
 688 =item C<comments>
 689
 690 =item C<formatter>
 691
 692 =item C<harness>
 693
 694 =item C<ignore_exit>
 695
 696 =item C<includes>
 697
 698 =item C<jobs>
 699
 700 =item C<lib>
 701
 702 =item C<merge>
 703
 704 =item C<modules>
 705
 706 =item C<parse>
 707
 708 =item C<plugins>
 709
 710 =item C<quiet>
 711
 712 =item C<really_quiet>
 713
 714 =item C<recurse>
 715
 716 =item C<rules>
 717
 718 =item C<show_count>
 719
 720 =item C<show_help>
 721
 722 =item C<show_man>
 723
 724 =item C<show_version>
 725
 726 =item C<shuffle>
 727
 728 =item C<state>
 729
 730 =item C<state_class>
 731
 732 =item C<taint_fail>
 733
 734 =item C<taint_warn>
 735
 736 =item C<test_args>
 737
 738 =item C<timer>
 739
 740 =item C<verbose>
 741
 742 =item C<warnings_fail>
 743
 744 =item C<warnings_warn>
 745
 746 =item C<tapversion>
 747
 748 =item C<trap>
 749
 750 =back
 751
 752 =head1 PLUGINS
 753
 754 C<App::Prove> provides support for 3rd-party plugins.  These are currently
 755 loaded at run-time, I<after> arguments have been parsed (so you can not
 756 change the way arguments are processed, sorry), typically with the
 757 C<< -PI<plugin> >> switch, eg:
 758
 759   prove -PMyPlugin
 760
 761 This will search for a module named C<App::Prove::Plugin::MyPlugin>, or failing
 762 that, C<MyPlugin>.  If the plugin can't be found, C<prove> will complain & exit.
 763
 764 You can pass an argument to your plugin by appending an C<=> after the plugin
 765 name, eg C<-PMyPlugin=foo>.  You can pass multiple arguments using commas:
 766
 767   prove -PMyPlugin=foo,bar,baz
 768
 769 These are passed in to your plugin's C<load()> class method (if it has one),
 770 along with a reference to the C<App::Prove> object that is invoking your plugin:
 771
 772   sub load {
 773       my ($class, $p) = @_;
 774
 775       my @args = @{ $p->{args} };
 776       # @args will contain ( 'foo', 'bar', 'baz' )
 777       $p->{app_prove}->do_something;
 778       ...
 779   }
 780
 781 Note that the user's arguments are also passed to your plugin's C<import()>
 782 function as a list, eg:
 783
 784   sub import {
 785       my ($class, @args) = @_;
 786       # @args will contain ( 'foo', 'bar', 'baz' )
 787       ...
 788   }
 789
 790 This is for backwards compatibility, and may be deprecated in the future.
 791
 792 =head2 Sample Plugin
 793
 794 Here's a sample plugin, for your reference:
 795
 796   package App::Prove::Plugin::Foo;
 797
 798   # Sample plugin, try running with:
 799   # prove -PFoo=bar -r -j3
 800   # prove -PFoo -Q
 801   # prove -PFoo=bar,My::Formatter
 802
 803   use strict;
 804   use warnings;
 805
 806   sub load {
 807       my ($class, $p) = @_;
 808       my @args = @{ $p->{args} };
 809       my $app  = $p->{app_prove};
 810
 811       print "loading plugin: $class, args: ", join(', ', @args ), "\n";
 812
 813       # turn on verbosity
 814       $app->verbose( 1 );
 815
 816       # set the formatter?
 817       $app->formatter( $args[1] ) if @args > 1;
 818
 819       # print some of App::Prove's state:
 820       for my $attr (qw( jobs quiet really_quiet recurse verbose )) {
 821           my $val = $app->$attr;
 822           $val    = 'undef' unless defined( $val );
 823           print "$attr: $val\n";
 824       }
 825
 826       return 1;
 827   }
 828
 829   1;
 830
 831 =head1 SEE ALSO
 832
 833 L<prove>, L<TAP::Harness>
 834
 835 =cut