summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--NPTest.pm146
1 files changed, 73 insertions, 73 deletions
diff --git a/NPTest.pm b/NPTest.pm
index f72ed2df..2248e8ec 100644
--- a/NPTest.pm
+++ b/NPTest.pm
@@ -53,8 +53,8 @@ developer to interactively request test parameter information from the
53user. The user can accept the developer's default value or reply "none" 53user. The user can accept the developer's default value or reply "none"
54which will then be returned as "" for the test to skip if appropriate. 54which will then be returned as "" for the test to skip if appropriate.
55 55
56If a parameter needs to be entered and the test is run without a tty 56If a parameter needs to be entered and the test is run without a tty
57attached (such as a cronjob), the parameter will be assigned as if it 57attached (such as a cronjob), the parameter will be assigned as if it
58was "none". Tests can check for the parameter and skip if not set. 58was "none". Tests can check for the parameter and skip if not set.
59 59
60Responses are stored in an external, file-based cache so subsequent test 60Responses are stored in an external, file-based cache so subsequent test
@@ -249,26 +249,26 @@ sub checkCmd
249 { 249 {
250 if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) ) 250 if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) )
251 { 251 {
252 $desiredExitStatus = $exitStatus; 252 $desiredExitStatus = $exitStatus;
253 } 253 }
254 else 254 else
255 { 255 {
256 $desiredExitStatus = -1; 256 $desiredExitStatus = -1;
257 } 257 }
258 } 258 }
259 elsif ( ref $desiredExitStatus eq "HASH" ) 259 elsif ( ref $desiredExitStatus eq "HASH" )
260 { 260 {
261 if ( exists( ${$desiredExitStatus}{$exitStatus} ) ) 261 if ( exists( ${$desiredExitStatus}{$exitStatus} ) )
262 { 262 {
263 if ( defined( ${$desiredExitStatus}{$exitStatus} ) ) 263 if ( defined( ${$desiredExitStatus}{$exitStatus} ) )
264 { 264 {
265 $testOutput = ${$desiredExitStatus}{$exitStatus}; 265 $testOutput = ${$desiredExitStatus}{$exitStatus};
266 } 266 }
267 $desiredExitStatus = $exitStatus; 267 $desiredExitStatus = $exitStatus;
268 } 268 }
269 else 269 else
270 { 270 {
271 $desiredExitStatus = -1; 271 $desiredExitStatus = -1;
272 } 272 }
273 } 273 }
274 274
@@ -332,12 +332,12 @@ sub getTestParameter
332 my( $param, $envvar, $default, $brief, $scoped ); 332 my( $param, $envvar, $default, $brief, $scoped );
333 my $new_style; 333 my $new_style;
334 if (scalar @_ <= 3) { 334 if (scalar @_ <= 3) {
335 ($param, $brief, $default) = @_; 335 ($param, $brief, $default) = @_;
336 $envvar = $param; 336 $envvar = $param;
337 $new_style = 1; 337 $new_style = 1;
338 } else { 338 } else {
339 ( $param, $envvar, $default, $brief, $scoped ) = @_; 339 ( $param, $envvar, $default, $brief, $scoped ) = @_;
340 $new_style = 0; 340 $new_style = 0;
341 } 341 }
342 342
343 # Apply default values for optional arguments 343 # Apply default values for optional arguments
@@ -394,7 +394,7 @@ sub getTestParameter
394 print STDERR "\n"; 394 print STDERR "\n";
395 395
396 if ($userResponse =~ /^(na|none)$/) { 396 if ($userResponse =~ /^(na|none)$/) {
397 $userResponse = ""; 397 $userResponse = "";
398 } 398 }
399 399
400 # define all user responses at global scope 400 # define all user responses at global scope
@@ -422,7 +422,7 @@ sub SearchCache
422 { 422 {
423 return $CACHE{$param}; 423 return $CACHE{$param};
424 } 424 }
425 return undef; # Need this to say "nothing found" 425 return undef; # Need this to say "nothing found"
426} 426}
427 427
428sub SetCacheParameter 428sub SetCacheParameter
@@ -542,10 +542,10 @@ sub DetermineTestHarnessDirectory
542 push ( @dirs, "./tests"); 542 push ( @dirs, "./tests");
543 } 543 }
544 544
545 if ( @dirs > 0 ) 545 if ( @dirs > 0 )
546 { 546 {
547 return @dirs; 547 return @dirs;
548 } 548 }
549 549
550 # To be honest I don't understand which case satisfies the 550 # To be honest I don't understand which case satisfies the
551 # original code in test.pl : when $tstdir == `pwd` w.r.t. 551 # original code in test.pl : when $tstdir == `pwd` w.r.t.
@@ -611,73 +611,73 @@ sub TestsFrom
611 611
612# All the new object oriented stuff below 612# All the new object oriented stuff below
613 613
614sub new { 614sub new {
615 my $type = shift; 615 my $type = shift;
616 my $self = {}; 616 my $self = {};
617 return bless $self, $type; 617 return bless $self, $type;
618} 618}
619 619
620# Accessors 620# Accessors
621sub return_code { 621sub return_code {
622 my $self = shift; 622 my $self = shift;
623 if (@_) { 623 if (@_) {
624 return $self->{return_code} = shift; 624 return $self->{return_code} = shift;
625 } else { 625 } else {
626 return $self->{return_code}; 626 return $self->{return_code};
627 } 627 }
628} 628}
629sub output { 629sub output {
630 my $self = shift; 630 my $self = shift;
631 if (@_) { 631 if (@_) {
632 return $self->{output} = shift; 632 return $self->{output} = shift;
633 } else { 633 } else {
634 return $self->{output}; 634 return $self->{output};
635 } 635 }
636} 636}
637 637
638sub perf_output { 638sub perf_output {
639 my $self = shift; 639 my $self = shift;
640 $_ = $self->{output}; 640 $_ = $self->{output};
641 /\|(.*)$/; 641 /\|(.*)$/;
642 return $1 || ""; 642 return $1 || "";
643} 643}
644 644
645sub only_output { 645sub only_output {
646 my $self = shift; 646 my $self = shift;
647 $_ = $self->{output}; 647 $_ = $self->{output};
648 /(.*?)\|/; 648 /(.*?)\|/;
649 return $1 || ""; 649 return $1 || "";
650} 650}
651 651
652sub testCmd { 652sub testCmd {
653 my $class = shift; 653 my $class = shift;
654 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; 655 my $timeout = shift || 120;
656 my $object = $class->new; 656 my $object = $class->new;
657 657
658 local $SIG{'ALRM'} = sub { die("timeout in command: $command"); }; 658 local $SIG{'ALRM'} = sub { die("timeout in command: $command"); };
659 alarm($timeout); # no test should take longer than 120 seconds 659 alarm($timeout); # no test should take longer than 120 seconds
660 660
661 my $output = `$command`; 661 my $output = `$command`;
662 $object->return_code($? >> 8); 662 $object->return_code($? >> 8);
663 $_ = $? & 127; 663 $_ = $? & 127;
664 if ($_) { 664 if ($_) {
665 die "Got signal $_ for command $command"; 665 die "Got signal $_ for command $command";
666 } 666 }
667 chomp $output; 667 chomp $output;
668 $object->output($output); 668 $object->output($output);
669 669
670 alarm(0); 670 alarm(0);
671 671
672 my ($pkg, $file, $line) = caller(0); 672 my ($pkg, $file, $line) = caller(0);
673 print "Testing: $command", $/; 673 print "Testing: $command", $/;
674 if ($ENV{'NPTEST_DEBUG'}) { 674 if ($ENV{'NPTEST_DEBUG'}) {
675 print "testCmd: Called from line $line in $file", $/; 675 print "testCmd: Called from line $line in $file", $/;
676 print "Output: ", $object->output, $/; 676 print "Output: ", $object->output, $/;
677 print "Return code: ", $object->return_code, $/; 677 print "Return code: ", $object->return_code, $/;
678 } 678 }
679 679
680 return $object; 680 return $object;
681} 681}
682 682
683# do we have ipv6 683# do we have ipv6