stas 02/01/21 00:32:46
Modified: t/apache compat.t
t/response/TestApache compat.pm
Added: t/response/TestApache compat2.pm
Log:
- split compat.pm test into compat.pm (for client side validation) and
compat2.pm (for sub-tests that can be completed on the server side).
- 2 out of 3 todo tests now pass with recent patches to
set_content_length, update_mtime, ap_set_last_modified
Revision Changes Path
1.10 +1 -37 modperl-2.0/t/apache/compat.t
Index: compat.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/apache/compat.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- compat.t 20 Dec 2001 03:54:40 -0000 1.9
+++ compat.t 21 Jan 2002 08:32:46 -0000 1.10
@@ -6,7 +6,7 @@
use Apache::TestUtil;
use Apache::TestRequest;
-plan tests => 31, todo => [25, 28, 30];
+plan tests => 3;
my $location = "/TestApache::compat";
@@ -41,48 +41,12 @@
);
}
-# Apache->gensym
-{
- my @data = (test => 'gensym');
- my $data = GET_BODY query(@data) || '';
- ok_nok($data);
-}
-
-# header_in
-t_header('in','get_scalar',q{scalar ctx: $r->header_in($key)});
-t_header('in','get_list', q{list ctx: $r->header_in($key)});
-t_header('in','set', q{$r->header_in($key => $val)});
-t_header('in','unset', q{$r->header_in($key => undef)});
-
-# header_out
-t_header('out','get_scalar',q{scalar ctx: $r->header_out($key)});
-t_header('out','get_list', q{list ctx: $r->header_out($key)});
-t_header('out','set', q{$r->header_out($key => $val)});
-t_header('out','unset', q{$r->header_out($key => undef)});
-
-# Apache::File
-{
- my @data = (test => 'Apache::File');
- my $data = GET_BODY query(@data) || '';
- ok_nok($data);
-}
-
### helper subs ###
sub query {
my(%args) = (@_ % 2) ? %{+shift} : @_;
"$location?" . join '&', map { "$_=$args{$_}" } keys %args;
}
-
-sub t_header {
- my ($way, $what, $comment) = @_;
- ok t_cmp(
- "ok",
- GET_BODY(query(test => 'header', way => $way, what => $what)),
- $comment
- );
-}
-
# accepts multiline var where, the lines matching:
# ^ok\n$ results in ok(1)
1.10 +3 -140 modperl-2.0/t/response/TestApache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestApache/compat.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- compat.pm 20 Dec 2001 01:31:24 -0000 1.9
+++ compat.pm 21 Jan 2002 08:32:46 -0000 1.10
@@ -1,5 +1,8 @@
package TestApache::compat;
+# these Apache::compat tests are all run on the server
+# side and validated on the client side. See also TestApache::compat2.
+
use strict;
use warnings FATAL => 'all';
@@ -33,146 +36,6 @@
if ($data{test} eq 'content' || $data{test} eq 'args') {
$r->print("test $data{test}");
- }
- elsif ($data{test} eq 'gensym') {
- debug "Apache->gensym";
- my $fh = Apache->gensym;
- ok ref $fh eq 'GLOB';
- }
- elsif ($data{test} eq 'header') {
- my $way = $data{way};
- my $sub = "header_$way";
- my $sub_good = "headers_$way";
- if ($data{what} eq 'get_scalar') {
- # get in scalar ctx
- my $key;
- if ($way eq 'in') {
- $key = "user-agent"; # should exist with lwp
- }
- else {
- # outgoing headers aren't set yet, so we set one
- $key = "X-barabara";
- $r->$sub_good->set($key, $key x 2);
- }
- my $exp = $r->$sub_good->get($key);
- my $got = $r->$sub($key);
- $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
- }
- elsif ($data{what} eq 'get_list') {
- # get in list ctx
- my $key = $data{test};
- my @exp = qw(foo bar);
- $r->$sub_good->add($key => $_) for @exp;
- my @got = $r->$sub($key);
- $r->print(t_is_equal(\@exp, \@got) ? 'ok' : 'nok');
- }
- elsif ($data{what} eq 'set') {
- # set
- my $key = $data{test};
- my $exp = $key x 2;
- $r->$sub($key => $exp);
- my $got = $r->$sub($key);
- $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
- }
- elsif ($data{what} eq 'unset') {
- # unset
- my $key = $data{test};
- my $exp = undef;
- $r->$sub($key => $exp);
- my $got = $r->$sub($key);
- $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
- }
- }
- elsif ($data{test} eq 'Apache::File') {
- require Apache::File;
- my $file = $vars->{t_conf_file};
-
- debug "new Apache::File file object";
- ok my $fh = Apache::File->new;
-
- debug "open itself";
- if ($fh->open($file)) {
- ok 1;
- debug "read from file";
- my $read = <$fh>;
- ok $read;
- debug "close file";
- ok $fh->close;
- }
- else {
- debug "open $file failed: $!";
- ok 0;
- debug "ok: cannot read from the closed fh";
- ok 1;
- debug "ok: close file should fail, wasn't opened";
- ok !$fh->close;
- }
-
- debug "open non-exists";
- ok !$fh->open("$file.nochance");
-
- debug "new+open";
- if (my $fh = Apache::File->new($file)) {
- ok 1;
- $fh->close;
- }
- else {
- ok 0;
- }
-
- debug "new+open non-exists";
- ok !Apache::File->new("$file.yeahright");
-
- # tmpfile
- my ($tmpfile, $tmpfh) = Apache::File->tmpfile;
-
- debug "open tmpfile fh";
- ok $tmpfh;
-
- debug "open tmpfile name";
- ok $tmpfile;
-
- debug "write/read from tmpfile";
- my $write = "test $$";
- print $tmpfh $write;
- seek $tmpfh, 0, 0;
- my $read = <$tmpfh>;
- ok $read eq $write;
-
- debug "\$r->discard_request_body";
- ok $r->discard_request_body == Apache::OK;
-
- debug "\$r->meets_conditions";
- ok $r->meets_conditions == Apache::OK;
-
- debug "\$r->set_content_length";
- # XXX: broken
- #$r->set_content_length();
- ok 0;
- $r->set_content_length(10);
- my $cl_header = $r->headers_out->{"Content-length"} || '';
- ok $cl_header == 10;
-
- # XXX: how to test etag?
- debug "\$r->set_etag";
- $r->set_etag;
- ok 1;
-
- debug "\$r->update_mtime/\$r->mtime";
- # XXX: broken
- # $r->update_mtime; # just check that it's valid
- ok 0;
- my $time = time;
- $r->update_mtime($time);
- ok $r->mtime == $time;
-
- debug "\$r->set_last_modified";
- # XXX: broken
- # $r->set_last_modified($time);
- ok 0;
- $time = time;
- $r->set_last_modified();
- ok $r->mtime == $time;
}
Apache::OK;
1.1 modperl-2.0/t/response/TestApache/compat2.pm
Index: compat2.pm
===================================================================
package TestApache::compat2;
# these Apache::compat tests are all run and validated on the server
# side. See also TestApache::compat.
use strict;
use warnings FATAL => 'all';
use Apache::TestUtil;
use Apache::Test;
use Apache::compat ();
use Apache::Constants qw(OK);
sub handler {
my $r = shift;
plan $r, tests => 28, todo => [23];
$r->send_http_header('text/plain');
my $cfg = Apache::Test::config();
my $vars = $cfg->{vars};
my $fh = Apache->gensym;
ok t_cmp('GLOB', ref($fh), "Apache->gensym");
# test header_in and header_out
for my $way (qw(in out)) {
my $sub_test = "header_$way";
my $sub_good = "headers_$way";
my $key = 'header-test';
# scalar context
{
my $key;
if ($way eq 'in') {
$key = "user-agent"; # should exist with lwp
}
else {
# outgoing headers aren't set yet, so we set one
$key = "X-barabara";
$r->$sub_good->set($key, $key x 2);
}
ok t_cmp($r->$sub_good->get($key),
$r->$sub_test($key),
"\$r->$sub_test in scalar context");
}
# list context
{
my @exp = qw(foo bar);
$r->$sub_good->add($key => $_) for @exp;
ok t_cmp(\@exp,
[ $r->$sub_test($key) ],
"\$r->$sub_test in list context");
}
# set
{
my $exp = $key x 2;
$r->$sub_test($key => $exp);
my $got = $r->$sub_test($key);
ok t_cmp($exp, $got, "\$r->$sub_test set()");
}
# unset
{
my $exp = undef;
$r->$sub_test($key => $exp);
my $got = $r->$sub_test($key);
ok t_cmp($exp, $got, "\$r->$sub_test unset()");
}
}
# Apache::File
{
require Apache::File;
my $file = $vars->{t_conf_file};
t_debug "new Apache::File file object";
ok my $fh = Apache::File->new;
t_debug "open itself";
if ($fh->open($file)) {
ok 1;
t_debug "read from file";
my $read = <$fh>;
ok $read;
t_debug "close file";
ok $fh->close;
}
else {
t_debug "open $file failed: $!";
ok 0;
t_debug "ok: cannot read from the closed fh";
ok 1;
t_debug "ok: close file should fail, wasn't opened";
ok !$fh->close;
}
t_debug "open non-exists";
ok !$fh->open("$file.nochance");
t_debug "new+open";
if (my $fh = Apache::File->new($file)) {
ok 1;
$fh->close;
}
else {
ok 0;
}
t_debug "new+open non-exists";
ok !Apache::File->new("$file.yeahright");
# tmpfile
my ($tmpfile, $tmpfh) = Apache::File->tmpfile;
t_debug "open tmpfile fh";
ok $tmpfh;
t_debug "open tmpfile name";
ok $tmpfile;
my $write = "test $$";
print $tmpfh $write;
seek $tmpfh, 0, 0;
ok t_cmp($write, scalar(<$tmpfh>), "write/read from tmpfile");
ok t_cmp(Apache::OK,
$r->discard_request_body,
"\$r->discard_request_body");
ok t_cmp(Apache::OK,
$r->meets_conditions,
"\$r->meets_conditions");
my $csize = 10;
$r->set_content_length($csize);
ok t_cmp($csize,
$r->headers_out->{"Content-length"},
"\$r->set_content_length($csize) w/ setting explicit size");
$r->set_content_length();
ok t_cmp(0, # XXX: $r->finfo->csize is not available yet
$r->headers_out->{"Content-length"},
"\$r->set_content_length() w/o setting explicit size");
# XXX: how to test etag?
t_debug "\$r->set_etag";
$r->set_etag;
ok 1;
# $r->update_mtime
t_debug "\$r->update_mtime()";
$r->update_mtime; # just check that it's valid
ok 1;
my $time = time;
$r->update_mtime($time);
ok t_cmp($time, $r->mtime, "\$r->update_mtime(\$time)/\$r->mtime");
# $r->set_last_modified
$r->set_last_modified();
ok t_cmp($time, $r->mtime, "\$r->set_last_modified()");
$r->set_last_modified($time);
ok t_cmp($time, $r->mtime, "\$r->set_last_modified(\$time)");
}
Apache::OK;
}
1;
__END__
PerlOptions +GlobalRequest
