stas 01/10/17 19:44:36
Modified: perl-framework/Apache-Test README
perl-framework/Apache-Test/lib/Apache TestConfig.pm
TestRun.pm
Log:
- enforce the leading --? for config options in ARGV
- split the remaining ARGV after Getopts into Apache::TestRequest,
Apache::TestConfig and tests groups
- pospone the -e test for test dirs and files until after autogenerated .t
are created
- update docs
Revision Changes Path
1.14 +12 -9 httpd-test/perl-framework/Apache-Test/README
Index: README
===================================================================
RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/README,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- README 2001/10/17 01:30:40 1.13
+++ README 2001/10/18 02:44:36 1.14
@@ -7,6 +7,9 @@
see t/TEST as an example test harness
+For an extensive documentation see
+modperl-2.0/docs/src/devel/writing_tests/writing_tests.pod.
+
see t/*.t for example tests
if the file t/conf/httpd.conf.in exists, it will be used instead of
@@ -45,16 +48,16 @@
% t/TEST -configure
run as user nobody:
-% t/TEST User nobody
+% t/TEST -User nobody
run on a different port:
-% t/TEST Port 8799
+% t/TEST -Port 8799
configure an httpd other than the default (that apxs figures out)
-% t/TEST httpd ~/ap/httpd-2.0/httpd
+% t/TEST -httpd ~/ap/httpd-2.0/httpd
switch to another apxs
-% t/TEST apxs ~/ap/httpd-2.0-prefork/bin/apxs
+% t/TEST -apxs ~/ap/httpd-2.0-prefork/bin/apxs
turn on tracing
% t/TEST -preamble "PerlTrace all"
@@ -69,19 +72,19 @@
% t/TEST -head
GET url with authentication credentials
-% t/TEST -get /server-info username dougm password foo
+% t/TEST -get /server-info -username dougm -password foo
POST url (read content from string)
-% t/TEST -post /TestApache::post content 'name=dougm&company=covalent'
+% t/TEST -post /TestApache::post -content 'name=dougm&company=covalent'
POST url (read content from stdin)
-% t/TEST -post /TestApache::post content - < foo.txt
+% t/TEST -post /TestApache::post -content - < foo.txt
POST url (generate a body of data 1024 bytes in length)
-% t/TEST -post /TestApache::post content x1024
+% t/TEST -post /TestApache::post -content x1024
POST url (only print headers, e.g. useful to just check Content-length)
-% t/TEST -post -head /TestApache::post content x100000
+% t/TEST -post -head /TestApache::post -content x100000
GET url (only print headers, e.g. useful to just check Content-length)
% t/TEST -get -head /foo
1.77 +3 -2
httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
Index: TestConfig.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.76
retrieving revision 1.77
diff -u -r1.76 -r1.77
--- TestConfig.pm 2001/10/17 20:06:25 1.76
+++ TestConfig.pm 2001/10/18 02:44:36 1.77
@@ -68,8 +68,9 @@
}
while (my($key, $val) = splice @filter, 0, 2) {
- if ($wanted_args->{$key}) {
- $keep{$key} = $val;
+ if ($key =~ /^-?-?(.+)/ # optinal - or -- prefix
+ && exists $wanted_args->{$1}) {
+ $keep{$1} = $val;
}
else {
push @pass, $key, $val;
1.60 +41 -24
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
Index: TestRun.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -r1.59 -r1.60
--- TestRun.pm 2001/10/17 02:56:24 1.59
+++ TestRun.pm 2001/10/18 02:44:36 1.60
@@ -82,11 +82,12 @@
#so we dont slurp arguments that are not tests, example:
# httpd $HOME/apache-2.0/bin/httpd
-sub split_args {
- my($self, $argv) = @_;
+sub split_test_args {
+ my($self) = @_;
- my(@tests, @args);
+ my(@tests);
+ my $argv = $self->{argv};
for (@$argv) {
my $arg = $_;
#need the t/ for stat-ing, but dont want to include it in test output
@@ -116,12 +117,9 @@
next;
}
}
-
- push @args, $_;
}
$self->{tests} = [EMAIL PROTECTED];
- $self->{args} = [EMAIL PROTECTED];
}
sub passenv {
@@ -134,13 +132,15 @@
sub getopts {
my($self, $argv) = @_;
-
- $self->split_args($argv);
- #dont count test files/dirs as @ARGV arguments
- local *ARGV = $self->{args};
+ local *ARGV = $argv;
my(%opts, %vopts, %conf_opts);
+ # permute : optional values can come before the options
+ # pass_through : all unknown things are to be left in @ARGV
+ Getopt::Long::Configure(qw(pass_through permute));
+
+ # grab from @ARGV only the options that we expect
GetOptions(\%opts, @flag_opts, @help_opts,
(map "$_:s", @debug_opts, @request_opts, @ostring_opts),
(map "$_=s", @string_opts),
@@ -150,16 +150,38 @@
$opts{$_} = $vopts{$_} for keys %vopts;
- #force regeneration of httpd.conf if commandline args want to modify it
+ # separate configuration options and test files/dirs
+ my $req_wanted_args = Apache::TestRequest::wanted_args();
+ my @argv = ();
+ my %req_args = ();
+ while (@ARGV) {
+ my $val = shift @ARGV;
+ if ($val =~ /^--?(.+)/) { # must have a leading - or --
+ my $key = lc $1;
+ # a known config option?
+ if (exists $Apache::TestConfig::Usage{$key}) {
+ $conf_opts{$key} = shift @ARGV;
+ } # a TestRequest config option?
+ elsif (exists $req_wanted_args->{$key}) {
+ $req_args{$key} = shift @ARGV;
+ }
+ }
+ else {
+ push @argv, $val;
+ }
+ }
+
+ $opts{req_args} = \%req_args;
+
+ # only test files/dirs if any at all are left in argv
+ $self->{argv} = [EMAIL PROTECTED];
+
+ # force regeneration of httpd.conf if commandline args want to modify it
$self->{reconfigure} = $opts{configure} ||
(grep { $opts{$_}->[0] } qw(preamble postamble)) ||
- (grep { $Apache::TestConfig::Usage{$_} } @ARGV) ||
+ (grep { $Apache::TestConfig::Usage{$_} } keys %conf_opts ) ||
$self->passenv() || (! -e 'conf/httpd.conf');
- while (my($key, $val) = splice @ARGV, 0, 2) {
- $conf_opts{lc $key} = $val;
- }
-
if (exists $opts{debug}) {
$opts{debugger} = $opts{debug};
$opts{debug} = 1;
@@ -494,6 +516,8 @@
$self->default_run_opts;
+ $self->split_test_args;
+
$self->start;
$self->run_tests;
@@ -538,14 +562,7 @@
sub run_request {
my($test_config, $opts) = @_;
- my @args = %{ $opts->{header} };
- my $wanted_args = Apache::TestRequest::wanted_args();
-
- while (my($key, $val) = each %{ $test_config->{vars} }) {
- next unless $wanted_args->{$key};
- push @args, $key, $val;
- delete $test_config->{vars}->{$key}; #dont save these
- }
+ my @args = (%{ $opts->{header} }, %{ $opts->{req_args} });
my($request, $url) = ("", "");
