diff options
Diffstat (limited to 'NPTest.pm')
-rw-r--r-- | NPTest.pm | 34 |
1 files changed, 29 insertions, 5 deletions
@@ -6,7 +6,7 @@ package NPTest; | |||
6 | 6 | ||
7 | require Exporter; | 7 | require Exporter; |
8 | @ISA = qw(Exporter); | 8 | @ISA = qw(Exporter); |
9 | @EXPORT = qw(getTestParameter checkCmd skipMissingCmd); | 9 | @EXPORT = qw(getTestParameter checkCmd skipMissingCmd skipMsg); |
10 | @EXPORT_OK = qw(DetermineTestHarnessDirectory TestsFrom SetCacheFilename); | 10 | @EXPORT_OK = qw(DetermineTestHarnessDirectory TestsFrom SetCacheFilename); |
11 | 11 | ||
12 | use strict; | 12 | use strict; |
@@ -38,8 +38,8 @@ testing. | |||
38 | 38 | ||
39 | =head1 FUNCTIONS | 39 | =head1 FUNCTIONS |
40 | 40 | ||
41 | This module defines three public functions, C<getTestParameter(...)>, | 41 | This module defines four public functions, C<getTestParameter(...)>, |
42 | C<checkCmd(...)> and C<skipMissingCmd(...)>. These are exported by | 42 | C<checkCmd(...)>, C<skipMissingCmd(...)> and C<skipMsg(...)>. These are exported by |
43 | default via the C<use NPTest;> statement. | 43 | default via the C<use NPTest;> statement. |
44 | 44 | ||
45 | =over | 45 | =over |
@@ -185,6 +185,15 @@ of times. | |||
185 | 185 | ||
186 | =back | 186 | =back |
187 | 187 | ||
188 | =item C<skipMsg(...)> | ||
189 | |||
190 | If for any reason the test harness must C<Test::skip()> some | ||
191 | or all of the tests in a given test harness this function provides a | ||
192 | simple iterator to issue an appropriate message the requested number | ||
193 | of times. | ||
194 | |||
195 | =back | ||
196 | |||
188 | =head1 SEE ALSO | 197 | =head1 SEE ALSO |
189 | 198 | ||
190 | L<Test> | 199 | L<Test> |
@@ -304,6 +313,20 @@ sub skipMissingCmd | |||
304 | return $testStatus; | 313 | return $testStatus; |
305 | } | 314 | } |
306 | 315 | ||
316 | sub skipMsg | ||
317 | { | ||
318 | my( $msg, $count ) = @_; | ||
319 | |||
320 | my $testStatus; | ||
321 | |||
322 | for ( 1 .. $count ) | ||
323 | { | ||
324 | $testStatus += skip( $msg, 1 ); | ||
325 | } | ||
326 | |||
327 | return $testStatus; | ||
328 | } | ||
329 | |||
307 | sub getTestParameter | 330 | sub getTestParameter |
308 | { | 331 | { |
309 | my( $param, $envvar, $default, $brief, $scoped ); | 332 | my( $param, $envvar, $default, $brief, $scoped ); |
@@ -627,12 +650,13 @@ sub only_output { | |||
627 | } | 650 | } |
628 | 651 | ||
629 | sub testCmd { | 652 | sub testCmd { |
630 | my $class = shift; | 653 | my $class = shift; |
631 | my $command = shift or die "No command passed to testCmd"; | 654 | my $command = shift or die "No command passed to testCmd"; |
655 | my $timeout = shift || 120; | ||
632 | my $object = $class->new; | 656 | my $object = $class->new; |
633 | 657 | ||
634 | local $SIG{'ALRM'} = sub { die("timeout in command: $command"); }; | 658 | local $SIG{'ALRM'} = sub { die("timeout in command: $command"); }; |
635 | alarm(120); # no test should take longer than 120 seconds | 659 | alarm($timeout); # no test should take longer than 120 seconds |
636 | 660 | ||
637 | my $output = `$command`; | 661 | my $output = `$command`; |
638 | $object->return_code($? >> 8); | 662 | $object->return_code($? >> 8); |