=head1 VERSION
-Version 3.07
+Version 3.08
=cut
-$VERSION = '3.07';
+$VERSION = '3.08';
=head1 DESCRIPTION
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 test_args state
+ show_version test_args state dry
);
for my $attr (@ATTR) {
no strict 'refs';
'color!' => \$self->{color},
'colour!' => \$self->{color},
'c' => \$self->{color},
+ 'D|dry' => \$self->{dry},
'harness=s' => \$self->{harness},
'formatter=s' => \$self->{formatter},
'r|recurse' => \$self->{recurse},
elsif ( $self->show_version ) {
$self->print_version;
}
+ elsif ( $self->dry ) {
+ print "$_\n" for $self->_get_tests;
+ }
else {
$self->_load_extensions( $self->modules );
$self->_load_extensions( $self->plugins, PLUGINS );
- my $state = $self->{_state};
- if ( defined( my $state_switch = $self->state ) ) {
- $state->apply_switch(@$state_switch);
- }
-
- my @tests = $state->get_tests( $self->recurse, @{ $self->argv } );
-
- $self->_shuffle(@tests) if $self->shuffle;
- @tests = reverse @tests if $self->backwards;
local $ENV{TEST_VERBOSE} = 1 if $self->verbose;
- $self->_runtests( $self->_get_args, @tests );
+ $self->_runtests( $self->_get_args, $self->_get_tests );
}
return;
}
+sub _get_tests {
+ my $self = shift;
+
+ my $state = $self->{_state};
+ if ( defined( my $state_switch = $self->state ) ) {
+ $state->apply_switch(@$state_switch);
+ }
+
+ my @tests = $state->get_tests( $self->recurse, @{ $self->argv } );
+
+ $self->_shuffle(@tests) if $self->shuffle;
+ @tests = reverse @tests if $self->backwards;
+
+ return @tests;
+}
+
sub _runtests {
my ( $self, $args, $harness_class, @tests ) = @_;
my $harness = $harness_class->new($args);
=item C<directives>
+=item C<dry>
+
=item C<exec>
=item C<failures>
use vars qw{$VERSION};
-$VERSION = '3.07';
+$VERSION = '3.08';
my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
+my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
my @UNPRINTABLE = qw(
z x01 x02 x03 x04 x05 x06 a
sub _enc_scalar {
my $self = shift;
my $val = shift;
+ my $rule = shift;
return '~' unless defined $val;
- if ( $val =~ /$ESCAPE_CHAR/ ) {
+ if ( $val =~ /$rule/ ) {
$val =~ s/\\/\\\\/g;
$val =~ s/"/\\"/g;
$val =~ s/ ( [\x00-\x1f] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex;
for my $key ( sort keys %$obj ) {
my $value = $obj->{$key};
$self->_write_obj(
- $pad . $self->_enc_scalar($key) . ':',
+ $pad . $self->_enc_scalar( $key, $ESCAPE_KEY ) . ':',
$value, $indent + 1
);
}
}
}
else {
- $self->_put( $prefix, ' ', $self->_enc_scalar($obj) );
+ $self->_put( $prefix, ' ', $self->_enc_scalar( $obj, $ESCAPE_CHAR ) );
}
}
=head1 VERSION
-Version 3.07
+Version 3.08
=head1 SYNOPSIS
=head1 VERSION
-Version 3.07
+Version 3.08
=cut
-$VERSION = '3.07';
+$VERSION = '3.08';
# Backwards compatibility for exportable variable names.
*verbose = *Verbose;
}
sub _new_harness {
+ my $sub_args = shift || {};
if ( defined( my $env_sw = $ENV{HARNESS_PERL_SWITCHES} ) ) {
$Switches .= ' ' . $env_sw if ( length($env_sw) );
verbosity => $verbosity,
};
+ $args->{stdout} = $sub_args->{out}
+ if exists $sub_args->{out};
+
if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
for my $opt ( split /:/, $env_opt ) {
if ( $opt =~ /^j(\d*)$/ ) {
sub execute_tests {
my %args = @_;
- # TODO: Handle out option
-
- my $harness = _new_harness();
+ my $harness = _new_harness( \%args );
my $aggregate = TAP::Parser::Aggregator->new();
my %tot = (
-s, --shuffle Run the tests in random order.
-c, --color Colored test output (default).
--nocolor Do not color test output.
+ -D --dry Dry run. Show test that would have run.
-f, --failures Only show failed tests.
--fork Fork to run harness in multiple processes
-m, --merge Merge test scripts' STDERR with their STDOUT.
'...',
],
},
+ { name => 'Funky hash key',
+ in => { './frob' => 'is_frob' },
+ out => [
+ '---',
+ '"./frob": is_frob',
+ '...',
+ ]
+ },
{ name => 'Complex',
in => {
'bill-to' => {
my $yr = TAP::Parser::YAMLish::Reader->new;
# Now try parsing it
- my $reader = sub { shift @$got };
+ my $reader = sub { shift @$got };
my $parsed = eval { $yr->read($reader) };
ok !$@, "$name: no error" or diag "$@";
projects / p5sagit/p5-mst-13.2.git / commitdiff