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 |