stas 2002/08/15 02:35:11 Added: t/compat request_body.t t/response/TestCompat apache.pm apache_file.pm apache_table.pm apache_util.pm request.pm request_body.pm Removed: t/compat compat.t t/response/TestCompat compat.pm compat2.pm Log: split compat tests into small groups by the package they test Revision Changes Path 1.1 modperl-2.0/t/compat/request_body.t Index: request_body.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestUtil; use Apache::TestRequest; plan tests => 3; my $location = "/TestCompat::request_body"; # $r->send_http_header('text/plain'); { my @data = (test => 'content-type'); ok t_cmp( "text/plain", HEAD(query(@data))->content_type(), q{$r->send_http_header('text/plain')} ); } # $r->content { my @data = (test => 'content'); my $content = join '=', @data; ok t_cmp( "@data", POST_BODY($location, content => $content), q{$r->content via POST} ); } # $r->Apache::args { my @data = (test => 'args'); ok t_cmp( "@data", GET_BODY(query(@data)), q{$r->Apache::args} ); } ### helper subs ### sub query { my(%args) = (@_ % 2) ? %{+shift} : @_; "$location?" . join '&', map { "$_=$args{$_}" } keys %args; } # accepts multiline var where, the lines matching: # ^ok\n$ results in ok(1) # ^nok\n$ results in ok(0) # the rest is printed as is sub ok_nok { for (split /\n/, shift) { if (/^ok\n?$/) { ok 1; } elsif (/^nok\n?$/) { ok 0; } else { print "$_\n"; } } } 1.1 modperl-2.0/t/response/TestCompat/apache.pm Index: apache.pm =================================================================== package TestCompat::apache; # Apache->"method" and Apache::"function" compat layer tests # these tests are all run and validated on the server side. 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 => 5; $r->send_http_header('text/plain'); ### Apache-> tests my $fh = Apache->gensym; ok t_cmp('GLOB', ref($fh), "Apache->gensym"); ok t_cmp(1, Apache->module('mod_perl.c'), "Apache::module('mod_perl.c')"); ok t_cmp(0, Apache->module('mod_ne_exists.c'), "Apache::module('mod_ne_exists.c')"); ok t_cmp(Apache::exists_config_define('MODPERL2'), Apache->define('MODPERL2'), 'Apache->define'); Apache::log_error("Apache::log_error test ok"); ok 1; OK; } 1; 1.1 modperl-2.0/t/response/TestCompat/apache_file.pm Index: apache_file.pm =================================================================== package TestCompat::apache_file; # Apache::File compat layer tests # these tests are all run and validated on the server side. 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 => 18; $r->send_http_header('text/plain'); my $cfg = Apache::Test::config(); my $vars = $cfg->{vars}; 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(); # #TODO # 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)"); OK; } 1; __END__ PerlOptions +GlobalRequest 1.1 modperl-2.0/t/response/TestCompat/apache_table.pm Index: apache_table.pm =================================================================== package TestCompat::apache_table; # Apache::Table compat layer tests # these tests are all run and validated on the server side. 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 => 2; $r->send_http_header('text/plain'); my $t = Apache::Table->new($r); my $t_class = ref $t; ok t_cmp('APR::Table', $t_class, "Apache::Table->new"); ok t_cmp(!$r->main, $r->is_main, '$r->is_main'); OK; } 1; 1.1 modperl-2.0/t/response/TestCompat/apache_util.pm Index: apache_util.pm =================================================================== package TestCompat::apache_util; # Apache::Util compat layer tests # these tests are all run and validated on the server side. use strict; use warnings FATAL => 'all'; use Apache::TestUtil; use Apache::Test; use Apache::compat (); use Apache::Constants qw(OK); my %string_size = ( '-1' => " -", 0 => " 0k", 42 => " 1k", 42_000 => " 41k", 42_000_000 => "40.1M", 42_000_000_000 => "40054M", ); sub handler { my $r = shift; plan $r, tests => 13; $r->send_http_header('text/plain'); # size_string() { while (my($k, $v) = each %string_size) { ok t_cmp($v, Apache::Util::size_string($k)); } } # escape_uri(), escape_path(), unescape_uri() my $uri = "http://foo.com/a file.html"; (my $esc_uri = $uri) =~ s/ /\%20/g; my $uri2 = $uri; $uri = Apache::Util::escape_uri($uri); $uri2 = Apache::Util::escape_path($uri2, $r->pool); ok t_cmp($esc_uri, $uri, "Apache::Util::escape_uri"); ok t_cmp($esc_uri, $uri2, "Apache::Util::escape_path"); ok t_cmp(Apache::unescape_url($uri), Apache::Util::unescape_uri($uri2), "Apache::URI::unescape_uri vs Apache::Util::unescape_uri"); ok t_cmp($uri, $uri2, "Apache::URI::unescape_uri vs Apache::Util::unescape_uri"); # escape_html() my $html = '<p>"hi"&foo</p>'; my $esc_html = '<p>"hi"&foo</p>'; ok t_cmp($esc_html, Apache::Util::escape_html($html), "Apache::Util::escape_html"); # ht_time(), parsedate() my $time = time; my $fmtdate = Apache::Util::ht_time($time); ok t_cmp($fmtdate, $fmtdate, "Apache::Util::ht_time"); my $ptime = Apache::Util::parsedate($fmtdate); ok t_cmp($time, $ptime, "Apache::Util::parsedate"); # note these are not actually part of the tests since i think on # platforms where crypt is not supported, these tests will fail. # but at least we can look with t/TEST -v my $hash = "aX9eP53k4DGfU"; t_cmp(1, Apache::Util::validate_password("dougm", $hash)); t_cmp(0, Apache::Util::validate_password("mguod", $hash)); OK; } 1; __END__ PerlOptions +GlobalRequest 1.1 modperl-2.0/t/response/TestCompat/request.pm Index: request.pm =================================================================== package TestCompat::request; # $r->"method" compat layer tests # these tests are all run and validated on the server side. use strict; use warnings FATAL => 'all'; use Apache::TestUtil; use Apache::Test; use Apache::compat (); use Apache::Constants qw(OK REMOTE_HOST); sub handler { my $r = shift; plan $r, tests => 15; $r->send_http_header('text/plain'); # header_in() and header_out() and err_header_out() for my $prefix ('err_', '') { my @ways = 'out'; push @ways, 'in' unless $prefix; for my $way (@ways) { my $sub_test = "${prefix}header_$way"; my $sub_good = "${prefix}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()"); } } } # get_remote_host() ok $r->get_remote_host() || 1; ok $r->get_remote_host(Apache::REMOTE_HOST) || 1; # post_connection() $r->post_connection(sub { OK }); ok 1; OK; } 1; 1.1 modperl-2.0/t/response/TestCompat/request_body.pm Index: request_body.pm =================================================================== package TestCompat::request_body; # $r->"method" tests that are validated by the client use strict; use warnings FATAL => 'all'; use Apache::TestUtil; use Apache::Test (); use Apache::compat (); use Apache::Constants qw(OK M_POST DECLINED); use subs qw(ok debug); my $gr; sub handler { my $r = shift; $gr = $r; $r->send_http_header('text/plain'); my $cfg = Apache::Test::config(); my $vars = $cfg->{vars}; my %data; if ($r->method_number == M_POST) { %data = $r->content; } else { %data = $r->Apache::args; } return DECLINED unless exists $data{test}; if ($data{test} eq 'content' || $data{test} eq 'args') { $r->print("test $data{test}"); } OK; } sub ok { $gr->print($_[0] ? "ok\n" : "nok\n"); } sub debug { $gr->print("# $_\n") for @_; } 1; __END__ PerlOptions +GlobalRequest