summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/App/Prove.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/App/Prove.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/App/Prove.pm157
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