diff options
Diffstat (limited to 'NPTest.pm')
| -rw-r--r-- | NPTest.pm | 252 |
1 files changed, 101 insertions, 151 deletions
| @@ -53,8 +53,8 @@ developer to interactively request test parameter information from the | |||
| 53 | user. The user can accept the developer's default value or reply "none" | 53 | user. The user can accept the developer's default value or reply "none" |
| 54 | which will then be returned as "" for the test to skip if appropriate. | 54 | which will then be returned as "" for the test to skip if appropriate. |
| 55 | 55 | ||
| 56 | If a parameter needs to be entered and the test is run without a tty | 56 | If a parameter needs to be entered and the test is run without a tty |
| 57 | attached (such as a cronjob), the parameter will be assigned as if it | 57 | attached (such as a cronjob), the parameter will be assigned as if it |
| 58 | was "none". Tests can check for the parameter and skip if not set. | 58 | was "none". Tests can check for the parameter and skip if not set. |
| 59 | 59 | ||
| 60 | Responses are stored in an external, file-based cache so subsequent test | 60 | Responses 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 | |||
| 62 | amending the values in the file /var/tmp/NPTest.cache, or by setting | 62 | amending the values in the file /var/tmp/NPTest.cache, or by setting |
| 63 | the appropriate environment variable before running the test. | 63 | the appropriate environment variable before running the test. |
| 64 | 64 | ||
| 65 | The option exists to store parameters in a scoped means, allowing a | ||
| 66 | test harness to a localise a parameter should the need arise. This | ||
| 67 | allows a parameter of the same name to exist in a test harness | ||
| 68 | specific scope, while not affecting the globally scoped parameter. The | ||
| 69 | scoping identifier is the name of the test harness sans the trailing | ||
| 70 | ".t". All cache searches first look to a scoped parameter before | ||
| 71 | looking for the parameter at global scope. Thus for a test harness | ||
| 72 | called "check_disk.t" requesting the parameter "mountpoint_valid", the | ||
| 73 | cache is first searched for "check_disk"/"mountpoint_valid", if this | ||
| 74 | fails, then a search is conducted for "mountpoint_valid". | ||
| 75 | |||
| 76 | To facilitate quick testing setup, it is possible to accept all the | 65 | To facilitate quick testing setup, it is possible to accept all the |
| 77 | developer provided defaults by setting the environment variable | 66 | developer 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 | ||
| 330 | sub getTestParameter | 319 | sub 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 | ||
| 410 | sub SearchCache | 372 | sub 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 | ||
| 428 | sub SetCacheParameter | 383 | sub 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 | ||
| 614 | sub new { | 564 | sub 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 |
| 621 | sub return_code { | 571 | sub 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 | } |
| 629 | sub output { | 579 | sub 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 | ||
| 638 | sub perf_output { | 588 | sub 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 | ||
| 645 | sub only_output { | 595 | sub 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 | ||
| 652 | sub testCmd { | 602 | sub 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 |
