diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/App/Prove.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/App/Prove.pm | 157 |
1 files changed, 109 insertions, 48 deletions
diff --git a/Master/tlpkg/tlperl/lib/App/Prove.pm b/Master/tlpkg/tlperl/lib/App/Prove.pm index fd431ed2f05..0e74fb4cacb 100644 --- a/Master/tlpkg/tlperl/lib/App/Prove.pm +++ b/Master/tlpkg/tlperl/lib/App/Prove.pm @@ -17,11 +17,11 @@ App::Prove - Implements the C<prove> command. =head1 VERSION -Version 3.17 +Version 3.23 =cut -$VERSION = '3.17'; +$VERSION = '3.23'; =head1 DESCRIPTION @@ -58,8 +58,8 @@ BEGIN { formatter harness includes modules plugins jobs lib merge parse quiet really_quiet recurse backwards shuffle taint_fail taint_warn timer verbose warnings_fail warnings_warn show_help show_man show_version - state_class test_args state dry extension ignore_exit rules state_manager - normalize + state_class test_args state dry extensions ignore_exit rules state_manager + normalize sources tapversion trap ); __PACKAGE__->mk_methods(@ATTR); } @@ -81,8 +81,12 @@ sub _initialize { my $self = shift; my $args = shift || {}; + my @is_array = qw( + argv rc_opts includes modules state plugins rules sources + ); + # setup defaults: - for my $key (qw( argv rc_opts includes modules state plugins rules )) { + for my $key (@is_array) { $self->{$key} = []; } $self->{harness_class} = 'TAP::Harness'; @@ -197,49 +201,57 @@ sub process_args { { local @ARGV = @args; - Getopt::Long::Configure( 'no_ignore_case', 'bundling' ); + Getopt::Long::Configure(qw(no_ignore_case bundling pass_through)); # Don't add coderefs to GetOptions GetOptions( - 'v|verbose' => \$self->{verbose}, - 'f|failures' => \$self->{failures}, - 'o|comments' => \$self->{comments}, - 'l|lib' => \$self->{lib}, - 'b|blib' => \$self->{blib}, - 's|shuffle' => \$self->{shuffle}, - 'color!' => \$self->{color}, - 'colour!' => \$self->{color}, - 'count!' => \$self->{show_count}, - 'c' => \$self->{color}, - 'D|dry' => \$self->{dry}, - 'ext=s' => \$self->{extension}, - 'harness=s' => \$self->{harness}, - 'ignore-exit' => \$self->{ignore_exit}, - 'formatter=s' => \$self->{formatter}, - 'r|recurse' => \$self->{recurse}, - 'reverse' => \$self->{backwards}, - 'p|parse' => \$self->{parse}, - 'q|quiet' => \$self->{quiet}, - 'Q|QUIET' => \$self->{really_quiet}, - 'e|exec=s' => \$self->{exec}, - 'm|merge' => \$self->{merge}, - 'I=s@' => $self->{includes}, - 'M=s@' => $self->{modules}, - 'P=s@' => $self->{plugins}, - 'state=s@' => $self->{state}, - 'directives' => \$self->{directives}, - 'h|help|?' => \$self->{show_help}, - 'H|man' => \$self->{show_man}, - 'V|version' => \$self->{show_version}, - 'a|archive=s' => \$self->{archive}, - 'j|jobs=i' => \$self->{jobs}, - 'timer' => \$self->{timer}, - 'T' => \$self->{taint_fail}, - 't' => \$self->{taint_warn}, - 'W' => \$self->{warnings_fail}, - 'w' => \$self->{warnings_warn}, - 'normalize' => \$self->{normalize}, - 'rules=s@' => $self->{rules}, + 'v|verbose' => \$self->{verbose}, + 'f|failures' => \$self->{failures}, + 'o|comments' => \$self->{comments}, + 'l|lib' => \$self->{lib}, + 'b|blib' => \$self->{blib}, + 's|shuffle' => \$self->{shuffle}, + 'color!' => \$self->{color}, + 'colour!' => \$self->{color}, + 'count!' => \$self->{show_count}, + 'c' => \$self->{color}, + 'D|dry' => \$self->{dry}, + 'ext=s@' => sub { + my ( $opt, $val ) = @_; + # Workaround for Getopt::Long 2.25 handling of + # multivalue options + push @{ $self->{extensions} ||= [] }, $val; + }, + 'harness=s' => \$self->{harness}, + 'ignore-exit' => \$self->{ignore_exit}, + 'source=s@' => $self->{sources}, + 'formatter=s' => \$self->{formatter}, + 'r|recurse' => \$self->{recurse}, + 'reverse' => \$self->{backwards}, + 'p|parse' => \$self->{parse}, + 'q|quiet' => \$self->{quiet}, + 'Q|QUIET' => \$self->{really_quiet}, + 'e|exec=s' => \$self->{exec}, + 'm|merge' => \$self->{merge}, + 'I=s@' => $self->{includes}, + 'M=s@' => $self->{modules}, + 'P=s@' => $self->{plugins}, + 'state=s@' => $self->{state}, + 'directives' => \$self->{directives}, + 'h|help|?' => \$self->{show_help}, + 'H|man' => \$self->{show_man}, + 'V|version' => \$self->{show_version}, + 'a|archive=s' => \$self->{archive}, + 'j|jobs=i' => \$self->{jobs}, + 'timer' => \$self->{timer}, + 'T' => \$self->{taint_fail}, + 't' => \$self->{taint_warn}, + 'W' => \$self->{warnings_fail}, + 'w' => \$self->{warnings_warn}, + 'normalize' => \$self->{normalize}, + 'rules=s@' => $self->{rules}, + 'tapversion=s' => \$self->{tapversion}, + 'trap' => \$self->{trap}, ) or croak('Unable to continue'); # Stash the remainder of argv for later @@ -283,6 +295,8 @@ sub _get_args { my %args; + $args{trap} = 1 if $self->trap; + if ( defined $self->color ? $self->color : $self->_color_default ) { $args{color} = 1; } @@ -310,6 +324,11 @@ sub _get_args { $args{formatter_class} = $formatter; } + for my $handler ( @{ $self->sources } ) { + my ( $name, $config ) = $self->_parse_source($handler); + $args{sources}->{$name} = $config; + } + if ( $self->ignore_exit ) { $args{ignore_exit} = 1; } @@ -349,6 +368,8 @@ sub _get_args { $args{exec} = [ split( /\s+/, $self->exec ) ] if ( defined( $self->exec ) ); + $args{version} = $self->tapversion if defined( $self->tapversion ); + if ( defined( my $test_args = $self->test_args ) ) { $args{test_args} = $test_args; } @@ -411,6 +432,42 @@ sub _load_extensions { $self->_load_extension( $_, @search ) for @$ext; } +sub _parse_source { + my ( $self, $handler ) = @_; + + # Load any options. + ( my $opt_name = lc $handler ) =~ s/::/-/g; + local @ARGV = @{ $self->{argv} }; + my %config; + Getopt::Long::GetOptions( + "$opt_name-option=s%" => sub { + my ( $name, $k, $v ) = @_; + if ( $v =~ /(?<!\\)=/ ) { + + # It's a hash option. + croak "Option $name must be consistently used as a hash" + if exists $config{$k} && ref $config{$k} ne 'HASH'; + $config{$k} ||= {}; + my ( $hk, $hv ) = split /(?<!\\)=/, $v, 2; + $config{$k}{$hk} = $hv; + } + else { + $v =~ s/\\=/=/g; + if ( exists $config{$k} ) { + $config{$k} = [ $config{$k} ] + unless ref $config{$k} eq 'ARRAY'; + push @{ $config{$k} } => $v; + } + else { + $config{$k} = $v; + } + } + } + ); + $self->{argv} = \@ARGV; + return ( $handler, \%config ); +} + =head3 C<run> Perform whatever actions the command line args specified. The C<prove> @@ -461,8 +518,8 @@ sub _get_tests { my $self = shift; my $state = $self->state_manager; - my $ext = $self->extension; - $state->extension($ext) if defined $ext; + my $ext = $self->extensions; + $state->extensions($ext) if defined $ext; if ( defined( my $state_switch = $self->state ) ) { $state->apply_switch(@$state_switch); } @@ -624,7 +681,7 @@ calling C<run>. =item C<exec> -=item C<extension> +=item C<extensions> =item C<failures> @@ -686,6 +743,10 @@ calling C<run>. =item C<warnings_warn> +=item C<tapversion> + +=item C<trap> + =back =head1 PLUGINS |