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