Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Tagging 3.03, version bump

  • Loading branch information...
commit e6a3cd902328a01101bcb93e5ce66caf924415df 1 parent e5eb02c
Andy Armstrong AndyA authored
5 Changes
... ... @@ -1,8 +1,11 @@
1 1 Revision history for Test-Harness
2 2
3   -NEXT
  3 +3.03 2007-11-17
4 4 - Fixed some little bugs-waiting-to-happen inside
5 5 TAP::Parser::Grammar.
  6 + - Added parser_args callback to TAP::Harness.
  7 + - Made @INC propagation even more compatible with 2.64 so that
  8 + parrot still works *and* #30796 is fixed.
6 9
7 10 3.02 2007-11-15
8 11 - Process I/O now unbuffered, uses sysread, plays better with
29 META.yml
... ... @@ -1,7 +1,6 @@
1 1 ---
2 2 name: Test-Harness
3 3 version: 3.03
4   -
5 4 author:
6 5 - 'Andy Armstrong C<< <andy@hexten.net> >>'
7 6 abstract: Run Perl standard test scripts with statistics
@@ -20,115 +19,87 @@ provides:
20 19 App::Prove:
21 20 file: lib/App/Prove.pm
22 21 version: 3.03
23   -
24 22 TAP::Base:
25 23 file: lib/TAP/Base.pm
26 24 version: 3.03
27   -
28 25 TAP::Formatter::Color:
29 26 file: lib/TAP/Formatter/Color.pm
30 27 version: 3.03
31   -
32 28 TAP::Formatter::Console:
33 29 file: lib/TAP/Formatter/Console.pm
34 30 version: 3.03
35   -
36 31 TAP::Formatter::Console::ParallelSession:
37 32 file: lib/TAP/Formatter/Console/ParallelSession.pm
38 33 version: 3.03
39   -
40 34 TAP::Formatter::Console::Session:
41 35 file: lib/TAP/Formatter/Console/Session.pm
42 36 version: 3.03
43   -
44 37 TAP::Harness:
45 38 file: lib/TAP/Harness.pm
46 39 version: 3.03
47   -
48 40 TAP::Parser:
49 41 file: lib/TAP/Parser.pm
50 42 version: 3.03
51   -
52 43 TAP::Parser::Aggregator:
53 44 file: lib/TAP/Parser/Aggregator.pm
54 45 version: 3.03
55   -
56 46 TAP::Parser::Grammar:
57 47 file: lib/TAP/Parser/Grammar.pm
58 48 version: 3.03
59   -
60 49 TAP::Parser::Iterator:
61 50 file: lib/TAP/Parser/Iterator.pm
62 51 version: 3.03
63   -
64 52 TAP::Parser::Iterator::Array:
65 53 file: lib/TAP/Parser/Iterator/Array.pm
66 54 version: 3.03
67   -
68 55 TAP::Parser::Iterator::Process:
69 56 file: lib/TAP/Parser/Iterator/Process.pm
70 57 version: 3.03
71   -
72 58 TAP::Parser::Iterator::Stream:
73 59 file: lib/TAP/Parser/Iterator/Stream.pm
74 60 version: 3.03
75   -
76 61 TAP::Parser::Multiplexer:
77 62 file: lib/TAP/Parser/Multiplexer.pm
78 63 version: 3.03
79   -
80 64 TAP::Parser::Result:
81 65 file: lib/TAP/Parser/Result.pm
82 66 version: 3.03
83   -
84 67 TAP::Parser::Result::Bailout:
85 68 file: lib/TAP/Parser/Result/Bailout.pm
86 69 version: 3.03
87   -
88 70 TAP::Parser::Result::Comment:
89 71 file: lib/TAP/Parser/Result/Comment.pm
90 72 version: 3.03
91   -
92 73 TAP::Parser::Result::Plan:
93 74 file: lib/TAP/Parser/Result/Plan.pm
94 75 version: 3.03
95   -
96 76 TAP::Parser::Result::Test:
97 77 file: lib/TAP/Parser/Result/Test.pm
98 78 version: 3.03
99   -
100 79 TAP::Parser::Result::Unknown:
101 80 file: lib/TAP/Parser/Result/Unknown.pm
102 81 version: 3.03
103   -
104 82 TAP::Parser::Result::Version:
105 83 file: lib/TAP/Parser/Result/Version.pm
106 84 version: 3.03
107   -
108 85 TAP::Parser::Result::YAML:
109 86 file: lib/TAP/Parser/Result/YAML.pm
110 87 version: 3.03
111   -
112 88 TAP::Parser::Source:
113 89 file: lib/TAP/Parser/Source.pm
114 90 version: 3.03
115   -
116 91 TAP::Parser::Source::Perl:
117 92 file: lib/TAP/Parser/Source/Perl.pm
118 93 version: 3.03
119   -
120 94 TAP::Parser::YAMLish::Reader:
121 95 file: lib/TAP/Parser/YAMLish/Reader.pm
122 96 version: 3.03
123   -
124 97 TAP::Parser::YAMLish::Writer:
125 98 file: lib/TAP/Parser/YAMLish/Writer.pm
126 99 version: 3.03
127   -
128 100 Test::Harness:
129 101 file: lib/Test/Harness.pm
130 102 version: 3.03
131   -
132 103 generated_by: Module::Build version 0.2808
133 104 meta-spec:
134 105 url: http://module-build.sourceforge.net/META-spec-v1.2.html
5 lib/TAP/Harness.pm
@@ -222,6 +222,7 @@ Any keys for which the value is C<undef> will be ignored.
222 222
223 223 {
224 224 my @legal_callback = qw(
  225 + parser_args
225 226 made_parser
226 227 before_runtests
227 228 after_runtests
@@ -535,7 +536,9 @@ overridden in subclasses.
535 536 sub make_parser {
536 537 my ( $self, $test ) = @_;
537 538
538   - my $parser = TAP::Parser->new( $self->_get_parser_args($test) );
  539 + my $args = $self->_get_parser_args($test);
  540 + $self->_make_callback( 'parser_args', $test, $args );
  541 + my $parser = TAP::Parser->new($args);
539 542
540 543 $self->_make_callback( 'made_parser', $parser );
541 544 my $session = $self->formatter->open_test( $test, $parser );
68 lib/TAP/Parser/Source/Perl.pm
@@ -189,6 +189,64 @@ sub _libs2switches {
189 189 return map {"-I$_"} grep {$_} @_;
190 190 }
191 191
  192 +=head3 C<shebang>
  193 +
  194 +Get the shebang line for a script file.
  195 +
  196 + my $shebang = TAP::Parser::Source::Perl->shebang( $some_script );
  197 +
  198 +May be called as a class method
  199 +
  200 +=cut
  201 +
  202 +{
  203 +
  204 + # Global shebang cache.
  205 + my %shebang_for;
  206 +
  207 + sub _read_shebang {
  208 + my $file = shift;
  209 + local *TEST;
  210 + my $shebang;
  211 + if ( open( TEST, $file ) ) {
  212 + $shebang = <TEST>;
  213 + close(TEST) or print "Can't close $file. $!\n";
  214 + }
  215 + else {
  216 + print "Can't open $file. $!\n";
  217 + }
  218 + return $shebang;
  219 + }
  220 +
  221 + sub shebang {
  222 + my ( $class, $file ) = @_;
  223 + unless ( exists $shebang_for{$file} ) {
  224 + $shebang_for{$file} = _read_shebang($file);
  225 + }
  226 + return $shebang_for{$file};
  227 + }
  228 +}
  229 +
  230 +=head3 C<get_taint>
  231 +
  232 +Decode any taint switches from a Perl shebang line.
  233 +
  234 + # $taint will be 't'
  235 + my $taint = TAP::Parser::Source::Perl->get_taint( '#!/usr/bin/perl -t' );
  236 +
  237 + # $untaint will be undefined
  238 + my $untaint = TAP::Parser::Source::Perl->get_taint( '#!/usr/bin/perl' );
  239 +
  240 +=cut
  241 +
  242 +sub get_taint {
  243 + my ( $class, $shebang ) = @_;
  244 + return
  245 + unless defined $shebang
  246 + && $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/;
  247 + return $1;
  248 +}
  249 +
192 250 sub _switches {
193 251 my $self = shift;
194 252 my $file = $self->source_file;
@@ -196,15 +254,11 @@ sub _switches {
196 254 $self->switches,
197 255 );
198 256
199   - local *TEST;
200   - open( TEST, $file ) or print "can't open $file. $!\n";
201   - my $shebang = <TEST>;
202   - close(TEST) or print "can't close $file. $!\n";
203   -
  257 + my $shebang = $self->shebang($file);
204 258 return unless defined $shebang;
205 259
206   - my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ );
207   - push @switches, "-$1" if $taint;
  260 + my $taint = $self->get_taint($shebang);
  261 + push @switches, "-$taint" if defined $taint;
208 262
209 263 # Quote the argument if there's any whitespace in it, or if
210 264 # we're VMS, since VMS requires all parms quoted. Also, don't quote
21 lib/Test/Harness.pm
@@ -7,8 +7,9 @@ use strict;
7 7 use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
8 8 use constant IS_VMS => ( $^O eq 'VMS' );
9 9
10   -use TAP::Harness ();
11   -use TAP::Parser::Aggregator ();
  10 +use TAP::Harness ();
  11 +use TAP::Parser::Aggregator ();
  12 +use TAP::Parser::Source::Perl ();
12 13
13 14 use Config;
14 15 use Exporter;
@@ -108,6 +109,12 @@ one of the messages in the DIAGNOSTICS section.
108 109
109 110 =cut
110 111
  112 +sub _has_taint {
  113 + my $test = shift;
  114 + return TAP::Parser::Source::Perl->get_taint(
  115 + TAP::Parser::Source::Perl->shebang($test) );
  116 +}
  117 +
111 118 sub _aggregate {
112 119 my ( $harness, $aggregate, @tests ) = @_;
113 120
@@ -125,6 +132,16 @@ sub _aggregate {
125 132 my $path_pat = qr{$path_sep};
126 133 my @extra_inc = _filtered_inc();
127 134
  135 + # Supply -I switches in taint mode
  136 + $harness->callback(
  137 + parser_args => sub {
  138 + my ( $test, $args ) = @_;
  139 + if ( _has_taint($test) ) {
  140 + push @{ $args->{switches} }, map {"-I$_"} _filtered_inc();
  141 + }
  142 + }
  143 + );
  144 +
128 145 my $previous = $ENV{PERL5LIB};
129 146 local $ENV{PERL5LIB};
130 147
4 t/harness.t
@@ -299,7 +299,7 @@ foreach my $test_args ( get_arg_sets() ) {
299 299
300 300 my @callback_log = ();
301 301
302   - for my $evt (qw(made_parser before_runtests after_runtests)) {
  302 + for my $evt (qw(parser_args made_parser before_runtests after_runtests)) {
303 303 $harness->callback(
304 304 $evt => sub {
305 305 push @callback_log, $evt;
@@ -363,7 +363,7 @@ foreach my $test_args ( get_arg_sets() ) {
363 363 cmp_ok( $callback_count, '==', 1, 'callback called once' );
364 364 is_deeply(
365 365 \@callback_log,
366   - [ 'before_runtests', 'made_parser', 'after_runtests' ],
  366 + [ 'before_runtests', 'parser_args', 'made_parser', 'after_runtests' ],
367 367 'callback log matches'
368 368 );
369 369 isa_ok $parser, 'TAP::Parser';
2  t/parse.t
@@ -519,7 +519,7 @@ END_TAP
519 519
520 520 is @die, 1, 'coverage testing for _initialize';
521 521
522   - like pop @die, qr/PANIC: could not determine stream at/,
  522 + like pop @die, qr/PANIC:\s+could not determine stream at/,
523 523 '...and it failed as expected';
524 524
525 525 @die = ();

0 comments on commit e6a3cd9

Please sign in to comment.
Something went wrong with that request. Please try again.