diff --git a/NPTest.pm b/NPTest.pm
index 440e7343e36ebb4505797402fe0109925e8a6c33..54a535e77808b167741ba30ca744fcb3266acc5c 100644 (file)
--- a/NPTest.pm
+++ b/NPTest.pm
use Test;
use vars qw($VERSION);
use Test;
use vars qw($VERSION);
-$VERSION = do { my @r = (q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; # must be all one line, for MakeMaker
+$VERSION = "1556."; # must be all one line, for MakeMaker
=head1 NAME
=head1 NAME
=over
=over
-=item C<getTestParameter(...)>
+=item getTestParameter( "ENV_VARIABLE", $brief_description, $default )
-A flexible and user override-able method of collecting, storing and
-retrieving test parameters. This function allows the test harness
+$default is optional.
+
+This function allows the test harness
developer to interactively request test parameter information from the
developer to interactively request test parameter information from the
-user, when the no means of obtaining the information automatically has
-been successful. The user is provided with the option of accepting
-test harness developer's default value for the parameter, if a suggested
-default is provided.
-
-User supplied responses are stored in an external (file-based)
-cache. These values are retrieved on subsequent runs alleviating the
-user of reconfirming the previous entered responses. The user is able
-to override the value of a parameter on any given run by setting the
-associated environment variable. These environment variable based
-overrides are not stored in the cache, allowing one-time and what-if
-based tests on the command line without polluting the cache.
+user. The user can accept the developer's default value or reply "none"
+which will then be returned as "" for the test to skip if appropriate.
+
+If a parameter needs to be entered and the test is run without a tty
+attached (such as a cronjob), the parameter will be assigned as if it
+was "none". Tests can check for the parameter and skip if not set.
+
+Responses are stored in an external, file-based cache so subsequent test
+runs will use these values. The user is able to change the values by
+amending the values in the file /var/tmp/NPTest.cache, or by setting
+the appropriate environment variable before running the test.
The option exists to store parameters in a scoped means, allowing a
test harness to a localise a parameter should the need arise. This
The option exists to store parameters in a scoped means, allowing a
test harness to a localise a parameter should the need arise. This
cache is first searched for "check_disk"/"mountpoint_valid", if this
fails, then a search is conducted for "mountpoint_valid".
cache is first searched for "check_disk"/"mountpoint_valid", if this
fails, then a search is conducted for "mountpoint_valid".
-The facilitate quick testing setup, it is possible to accept all the
+To facilitate quick testing setup, it is possible to accept all the
developer provided defaults by setting the environment variable
"NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note
that, such defaults are not stored in the cache, as there is currently
developer provided defaults by setting the environment variable
"NPTEST_ACCEPTDEFAULT" to "1" (or any other perl truth value). Note
that, such defaults are not stored in the cache, as there is currently
sub getTestParameter
{
sub getTestParameter
{
- my( $param, $envvar, $default, $brief, $scoped ) = @_;
+ my( $param, $envvar, $default, $brief, $scoped );
+ my $new_style;
+ if (scalar @_ <= 3) {
+ ($param, $brief, $default) = @_;
+ $envvar = $param;
+ $new_style = 1;
+ } else {
+ ( $param, $envvar, $default, $brief, $scoped ) = @_;
+ $new_style = 0;
+ }
# Apply default values for optional arguments
$scoped = ( defined( $scoped ) && $scoped );
# Apply default values for optional arguments
$scoped = ( defined( $scoped ) && $scoped );
}
my $cachedValue = SearchCache( $param, $testharness );
}
my $cachedValue = SearchCache( $param, $testharness );
- if ( defined( $cachedValue ) && $cachedValue )
+ if ( defined( $cachedValue ) )
{
{
+ # This save required to convert to new style because the key required is
+ # changing to the environment variable
+ if ($new_style == 0) {
+ SetCacheParameter( $envvar, undef, $cachedValue );
+ }
return $cachedValue;
}
return $cachedValue;
}
return $default;
}
return $default;
}
+ # Set "none" if no terminal attached (eg, tinderbox build servers when new variables set)
+ return "" unless (-t STDERR);
+
my $userResponse = "";
while ( $userResponse eq "" )
my $userResponse = "";
while ( $userResponse eq "" )
print STDERR "\n";
print STDERR "Test Harness : $testharness\n";
print STDERR "Test Parameter : $param\n";
print STDERR "\n";
print STDERR "Test Harness : $testharness\n";
print STDERR "Test Parameter : $param\n";
- print STDERR "Environment Variable : $envvar\n";
+ print STDERR "Environment Variable : $envvar\n" if ($param ne $envvar);
print STDERR "Brief Description : $brief\n";
print STDERR "Brief Description : $brief\n";
- print STDERR "Enter value ", ($defaultValid ? "[${default}]" : "[]"), " => ";
+ print STDERR "Enter value (or 'none') ", ($defaultValid ? "[${default}]" : "[]"), " => ";
$userResponse = <STDIN>;
$userResponse = "" if ! defined( $userResponse ); # Handle EOF
chomp( $userResponse );
$userResponse = <STDIN>;
$userResponse = "" if ! defined( $userResponse ); # Handle EOF
chomp( $userResponse );
print STDERR "\n";
print STDERR "\n";
+ if ($userResponse =~ /^(na|none)$/) {
+ $userResponse = "";
+ }
+
# define all user responses at global scope
SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse );
# define all user responses at global scope
SetCacheParameter( $param, ( $scoped ? $testharness : undef ), $userResponse );
{
return $CACHE{$param};
}
{
return $CACHE{$param};
}
+ return undef; # Need this to say "nothing found"
}
sub SetCacheParameter
}
sub SetCacheParameter
closedir( DIR );
closedir( DIR );
- return @tests;
+ return sort @tests;
}
# All the new object oriented stuff below
}
# All the new object oriented stuff below
}
}
}
}
+sub perf_output {
+ my $self = shift;
+ $_ = $self->{output};
+ /\|(.*)$/;
+ return $1 || "";
+}
+
+sub only_output {
+ my $self = shift;
+ $_ = $self->{output};
+ /(.*?)\|/;
+ return $1 || "";
+}
+
sub testCmd {
my $class = shift;
my $command = shift or die "No command passed to testCmd";
my $object = $class->new;
my $output = `$command`;
sub testCmd {
my $class = shift;
my $command = shift or die "No command passed to testCmd";
my $object = $class->new;
my $output = `$command`;
+ $object->return_code($? >> 8);
+ $_ = $? & 127;
+ if ($_) {
+ die "Got signal $_ for command $command";
+ }
chomp $output;
chomp $output;
-
$object->output($output);
$object->output($output);
- $object->return_code($? >> 8);
+ my ($pkg, $file, $line) = caller(0);
+ print "Testing: $command", $/;
if ($ENV{'NPTEST_DEBUG'}) {
if ($ENV{'NPTEST_DEBUG'}) {
- my ($pkg, $file, $line) = caller(0);
print "testCmd: Called from line $line in $file", $/;
print "testCmd: Called from line $line in $file", $/;
- print "Testing: $command", $/;
print "Output: ", $object->output, $/;
print "Return code: ", $object->return_code, $/;
}
print "Output: ", $object->output, $/;
print "Return code: ", $object->return_code, $/;
}