summaryrefslogtreecommitdiffstats
path: root/NPTest.pm
diff options
context:
space:
mode:
Diffstat (limited to 'NPTest.pm')
-rw-r--r--NPTest.pm252
1 files changed, 101 insertions, 151 deletions
diff --git a/NPTest.pm b/NPTest.pm
index f72ed2d..4b2de39 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
@@ -62,17 +62,6 @@ runs will use these values. The user is able to change the values by
62amending the values in the file /var/tmp/NPTest.cache, or by setting 62amending the values in the file /var/tmp/NPTest.cache, or by setting
63the appropriate environment variable before running the test. 63the appropriate environment variable before running the test.
64 64
65The option exists to store parameters in a scoped means, allowing a
66test harness to a localise a parameter should the need arise. This
67allows a parameter of the same name to exist in a test harness
68specific scope, while not affecting the globally scoped parameter. The
69scoping identifier is the name of the test harness sans the trailing
70".t". All cache searches first look to a scoped parameter before
71looking for the parameter at global scope. Thus for a test harness
72called "check_disk.t" requesting the parameter "mountpoint_valid", the
73cache is first searched for "check_disk"/"mountpoint_valid", if this
74fails, then a search is conducted for "mountpoint_valid".
75
76To facilitate quick testing setup, it is possible to accept all the 65To facilitate quick testing setup, it is possible to accept all the
77developer provided defaults by setting the environment variable 66developer provided defaults by setting the environment variable
78"NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note 67"NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note
@@ -249,26 +238,26 @@ sub checkCmd
249 { 238 {
250 if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) ) 239 if ( scalar( grep { $_ == $exitStatus } @{$desiredExitStatus} ) )
251 { 240 {
252 $desiredExitStatus = $exitStatus; 241 $desiredExitStatus = $exitStatus;
253 } 242 }
254 else 243 else
255 { 244 {
256 $desiredExitStatus = -1; 245 $desiredExitStatus = -1;
257 } 246 }
258 } 247 }
259 elsif ( ref $desiredExitStatus eq "HASH" ) 248 elsif ( ref $desiredExitStatus eq "HASH" )
260 { 249 {
261 if ( exists( ${$desiredExitStatus}{$exitStatus} ) ) 250 if ( exists( ${$desiredExitStatus}{$exitStatus} ) )
262 { 251 {
263 if ( defined( ${$desiredExitStatus}{$exitStatus} ) ) 252 if ( defined( ${$desiredExitStatus}{$exitStatus} ) )
264 { 253 {
265 $testOutput = ${$desiredExitStatus}{$exitStatus}; 254 $testOutput = ${$desiredExitStatus}{$exitStatus};
266 } 255 }
267 $desiredExitStatus = $exitStatus; 256 $desiredExitStatus = $exitStatus;
268 } 257 }
269 else 258 else
270 { 259 {
271 $desiredExitStatus = -1; 260 $desiredExitStatus = -1;
272 } 261 }
273 } 262 }
274 263
@@ -327,78 +316,51 @@ sub skipMsg
327 return $testStatus; 316 return $testStatus;
328} 317}
329 318
330sub getTestParameter 319sub getTestParameter {
331{ 320 my($param, $description, $default) = @_;
332 my( $param, $envvar, $default, $brief, $scoped );
333 my $new_style;
334 if (scalar @_ <= 3) {
335 ($param, $brief, $default) = @_;
336 $envvar = $param;
337 $new_style = 1;
338 } else {
339 ( $param, $envvar, $default, $brief, $scoped ) = @_;
340 $new_style = 0;
341 }
342
343 # Apply default values for optional arguments
344 $scoped = ( defined( $scoped ) && $scoped );
345
346 my $testharness = basename( (caller(0))[1], ".t" ); # used for scoping
347 321
348 if ( defined( $envvar ) && exists( $ENV{$envvar} ) && $ENV{$envvar} ) 322 if($param !~ m/^NP_[A-Z0-9_]+$/mx) {
349 { 323 die("parameter should be all uppercase and start with NP_ (requested from ".(caller(0))[1].")");
350 return $ENV{$envvar};
351 } 324 }
352 325
353 my $cachedValue = SearchCache( $param, $testharness ); 326 return $ENV{$param} if $ENV{$param};
354 if ( defined( $cachedValue ) ) 327
355 { 328 my $cachedValue = SearchCache($param);
356 # This save required to convert to new style because the key required is 329 if(defined $cachedValue) {
357 # changing to the environment variable
358 if ($new_style == 0) {
359 SetCacheParameter( $envvar, undef, $cachedValue );
360 }
361 return $cachedValue; 330 return $cachedValue;
362 } 331 }
363 332
364 my $defaultValid = ( defined( $default ) && $default ); 333 if($ENV{'NPTEST_ACCEPTDEFAULT'}) {
365 my $autoAcceptDefault = ( exists( $ENV{'NPTEST_ACCEPTDEFAULT'} ) && $ENV{'NPTEST_ACCEPTDEFAULT'} ); 334 return $default if $default;
366 335 return "";
367 if ( $autoAcceptDefault && $defaultValid )
368 {
369 return $default;
370 } 336 }
371 337
372 # Set "none" if no terminal attached (eg, tinderbox build servers when new variables set) 338 # Set "none" if no terminal attached (eg, tinderbox build servers when new variables set)
373 return "" unless (-t STDIN); 339 return "" unless (-t STDIN);
374 340
375 my $userResponse = ""; 341 my $userResponse = "";
376 342 while($userResponse eq "") {
377 while ( $userResponse eq "" )
378 {
379 print STDERR "\n"; 343 print STDERR "\n";
380 print STDERR "Test Harness : $testharness\n"; 344 print STDERR "Test File : ".(caller(0))[1]."\n";
381 print STDERR "Test Parameter : $param\n"; 345 print STDERR "Test Parameter : $param\n";
382 print STDERR "Environment Variable : $envvar\n" if ($param ne $envvar); 346 print STDERR "Description : $description\n";
383 print STDERR "Brief Description : $brief\n"; 347 print STDERR "Enter value (or 'none') ", ($default ? "[${default}]" : "[]"), " => ";
384 print STDERR "Enter value (or 'none') ", ($defaultValid ? "[${default}]" : "[]"), " => ";
385 $userResponse = <STDIN>; 348 $userResponse = <STDIN>;
386 $userResponse = "" if ! defined( $userResponse ); # Handle EOF 349 $userResponse = "" if ! defined( $userResponse ); # Handle EOF
387 chomp( $userResponse ); 350 chomp($userResponse);
388 if ( $defaultValid && $userResponse eq "" ) 351 if($default && $userResponse eq "") {
389 {
390 $userResponse = $default; 352 $userResponse = $default;
391 } 353 }
392 } 354 }
393 355
394 print STDERR "\n"; 356 print STDERR "\n";
395 357
396 if ($userResponse =~ /^(na|none)$/) { 358 if($userResponse =~ /^(na|none)$/) {
397 $userResponse = ""; 359 $userResponse = "";
398 } 360 }
399 361
400 # define all user responses at global scope 362 # store user responses
401 SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse ); 363 SetCacheParameter($param, $userResponse);
402 364
403 return $userResponse; 365 return $userResponse;
404} 366}
@@ -407,37 +369,20 @@ sub getTestParameter
407# Internal Cache Management Functions 369# Internal Cache Management Functions
408# 370#
409 371
410sub SearchCache 372sub SearchCache {
411{ 373 my($param) = @_;
412 my( $param, $scope ) = @_;
413 374
414 LoadCache(); 375 LoadCache();
415 376
416 if ( exists( $CACHE{$scope} ) && exists( $CACHE{$scope}{$param} ) ) 377 if(exists $CACHE{$param}) {
417 {
418 return $CACHE{$scope}{$param};
419 }
420
421 if ( exists( $CACHE{$param} ) )
422 {
423 return $CACHE{$param}; 378 return $CACHE{$param};
424 } 379 }
425 return undef; # Need this to say "nothing found" 380 return undef; # Need this to say "nothing found"
426} 381}
427 382
428sub SetCacheParameter 383sub SetCacheParameter {
429{ 384 my($param, $value) = @_;
430 my( $param, $scope, $value ) = @_; 385 $CACHE{$param} = $value;
431
432 if ( defined( $scope ) )
433 {
434 $CACHE{$scope}{$param} = $value;
435 }
436 else
437 {
438 $CACHE{$param} = $value;
439 }
440
441 SaveCache(); 386 SaveCache();
442} 387}
443 388
@@ -475,6 +420,11 @@ sub SaveCache
475 delete $CACHE{'_cache_loaded_'}; 420 delete $CACHE{'_cache_loaded_'};
476 my $oldFileContents = delete $CACHE{'_original_cache'}; 421 my $oldFileContents = delete $CACHE{'_original_cache'};
477 422
423 # clean up old style params
424 for my $key (keys %CACHE) {
425 delete $CACHE{$key} if $key !~ m/^NP_[A-Z0-9_]+$/mx;
426 }
427
478 my($dataDumper) = new Data::Dumper([\%CACHE]); 428 my($dataDumper) = new Data::Dumper([\%CACHE]);
479 $dataDumper->Terse(1); 429 $dataDumper->Terse(1);
480 $dataDumper->Sortkeys(1); 430 $dataDumper->Sortkeys(1);
@@ -486,7 +436,7 @@ sub SaveCache
486 if($oldFileContents ne $data) { 436 if($oldFileContents ne $data) {
487 my($fileHandle) = new IO::File; 437 my($fileHandle) = new IO::File;
488 if (!$fileHandle->open( "> ${CACHEFILENAME}")) { 438 if (!$fileHandle->open( "> ${CACHEFILENAME}")) {
489 print STDERR "NPTest::LoadCache() : Problem saving ${CACHEFILENAME} : $!\n"; 439 print STDERR "NPTest::SaveCache() : Problem saving ${CACHEFILENAME} : $!\n";
490 return; 440 return;
491 } 441 }
492 print $fileHandle $data; 442 print $fileHandle $data;
@@ -542,10 +492,10 @@ sub DetermineTestHarnessDirectory
542 push ( @dirs, "./tests"); 492 push ( @dirs, "./tests");
543 } 493 }
544 494
545 if ( @dirs > 0 ) 495 if ( @dirs > 0 )
546 { 496 {
547 return @dirs; 497 return @dirs;
548 } 498 }
549 499
550 # To be honest I don't understand which case satisfies the 500 # To be honest I don't understand which case satisfies the
551 # original code in test.pl : when $tstdir == `pwd` w.r.t. 501 # original code in test.pl : when $tstdir == `pwd` w.r.t.
@@ -611,73 +561,73 @@ sub TestsFrom
611 561
612# All the new object oriented stuff below 562# All the new object oriented stuff below
613 563
614sub new { 564sub new {
615 my $type = shift; 565 my $type = shift;
616 my $self = {}; 566 my $self = {};
617 return bless $self, $type; 567 return bless $self, $type;
618} 568}
619 569
620# Accessors 570# Accessors
621sub return_code { 571sub return_code {
622 my $self = shift; 572 my $self = shift;
623 if (@_) { 573 if (@_) {
624 return $self->{return_code} = shift; 574 return $self->{return_code} = shift;
625 } else { 575 } else {
626 return $self->{return_code}; 576 return $self->{return_code};
627 } 577 }
628} 578}
629sub output { 579sub output {
630 my $self = shift; 580 my $self = shift;
631 if (@_) { 581 if (@_) {
632 return $self->{output} = shift; 582 return $self->{output} = shift;
633 } else { 583 } else {
634 return $self->{output}; 584 return $self->{output};
635 } 585 }
636} 586}
637 587
638sub perf_output { 588sub perf_output {
639 my $self = shift; 589 my $self = shift;
640 $_ = $self->{output}; 590 $_ = $self->{output};
641 /\|(.*)$/; 591 /\|(.*)$/;
642 return $1 || ""; 592 return $1 || "";
643} 593}
644 594
645sub only_output { 595sub only_output {
646 my $self = shift; 596 my $self = shift;
647 $_ = $self->{output}; 597 $_ = $self->{output};
648 /(.*?)\|/; 598 /(.*?)\|/;
649 return $1 || ""; 599 return $1 || "";
650} 600}
651 601
652sub testCmd { 602sub testCmd {
653 my $class = shift; 603 my $class = shift;
654 my $command = shift or die "No command passed to testCmd"; 604 my $command = shift or die "No command passed to testCmd";
655 my $timeout = shift || 120; 605 my $timeout = shift || 120;
656 my $object = $class->new; 606 my $object = $class->new;
657 607
658 local $SIG{'ALRM'} = sub { die("timeout in command: $command"); }; 608 local $SIG{'ALRM'} = sub { die("timeout in command: $command"); };
659 alarm($timeout); # no test should take longer than 120 seconds 609 alarm($timeout); # no test should take longer than 120 seconds
660 610
661 my $output = `$command`; 611 my $output = `$command`;
662 $object->return_code($? >> 8); 612 $object->return_code($? >> 8);
663 $_ = $? & 127; 613 $_ = $? & 127;
664 if ($_) { 614 if ($_) {
665 die "Got signal $_ for command $command"; 615 die "Got signal $_ for command $command";
666 } 616 }
667 chomp $output; 617 chomp $output;
668 $object->output($output); 618 $object->output($output);
669 619
670 alarm(0); 620 alarm(0);
671 621
672 my ($pkg, $file, $line) = caller(0); 622 my ($pkg, $file, $line) = caller(0);
673 print "Testing: $command", $/; 623 print "Testing: $command", $/;
674 if ($ENV{'NPTEST_DEBUG'}) { 624 if ($ENV{'NPTEST_DEBUG'}) {
675 print "testCmd: Called from line $line in $file", $/; 625 print "testCmd: Called from line $line in $file", $/;
676 print "Output: ", $object->output, $/; 626 print "Output: ", $object->output, $/;
677 print "Return code: ", $object->return_code, $/; 627 print "Return code: ", $object->return_code, $/;
678 } 628 }
679 629
680 return $object; 630 return $object;
681} 631}
682 632
683# do we have ipv6 633# do we have ipv6