perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject svn commit: r106958 - in perl/modperl/trunk/t: conf filter/TestFilter lib/ModPerl lib/TestCommon response/TestAPI response/TestApache response/TestModperl
Date Mon, 29 Nov 2004 22:10:05 GMT
Author: stas
Date: Mon Nov 29 14:10:03 2004
New Revision: 106958

URL: http://svn.apache.org/viewcvs?view=rev&rev=106958
Log:
refactor modperl_extra.pl which was becoming a big mess
- move the code snippets into subs
- move helper modules into their own files under t/lib

Added:
   perl/modperl/trunk/t/lib/ModPerl/
   perl/modperl/trunk/t/lib/ModPerl/TestFilterDebug.pm
   perl/modperl/trunk/t/lib/ModPerl/TestMemoryLeak.pm
   perl/modperl/trunk/t/lib/ModPerl/TestTiePerlSection.pm
   perl/modperl/trunk/t/lib/TestCommon/Handlers.pm
Modified:
   perl/modperl/trunk/t/conf/extra.last.conf.in
   perl/modperl/trunk/t/conf/modperl_extra.pl
   perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm
   perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm
   perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm
   perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm
   perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm
   perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm
   perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm
   perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm
   perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm
   perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm
   perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm
   perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm
   perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm
   perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm
   perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm
   perl/modperl/trunk/t/lib/TestCommon/Utils.pm
   perl/modperl/trunk/t/response/TestAPI/content_encoding.pm
   perl/modperl/trunk/t/response/TestApache/discard_rbody.pm
   perl/modperl/trunk/t/response/TestApache/post.pm
   perl/modperl/trunk/t/response/TestModperl/post_utf8.pm

Modified: perl/modperl/trunk/t/conf/extra.last.conf.in
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/conf/extra.last.conf.in?view=diff&rev=106958&p1=perl/modperl/trunk/t/conf/extra.last.conf.in&r1=106957&p2=perl/modperl/trunk/t/conf/extra.last.conf.in&r2=106958
==============================================================================
--- perl/modperl/trunk/t/conf/extra.last.conf.in	(original)
+++ perl/modperl/trunk/t/conf/extra.last.conf.in	Mon Nov 29 14:10:03 2004
@@ -14,6 +14,7 @@
 
 <Perl >
 #Test tied %Location
+use ModPerl::TestTiePerlSection ();
 tie %Location, 'ModPerl::TestTiePerlSection';
 $Location{'/tied'} = 'test_tied';
 

Modified: perl/modperl/trunk/t/conf/modperl_extra.pl
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/conf/modperl_extra.pl?view=diff&rev=106958&p1=perl/modperl/trunk/t/conf/modperl_extra.pl&r1=106957&p2=perl/modperl/trunk/t/conf/modperl_extra.pl&r2=106958
==============================================================================
--- perl/modperl/trunk/t/conf/modperl_extra.pl	(original)
+++ perl/modperl/trunk/t/conf/modperl_extra.pl	Mon Nov 29 14:10:03 2004
@@ -1,7 +1,7 @@
 use strict;
 use warnings FATAL => 'all';
 
-use Socket (); #test DynaLoader vs. XSLoader workaround for 5.6.x
+use Socket (); # test DynaLoader vs. XSLoader workaround for 5.6.x
 use IO::File ();
 use File::Spec::Functions qw(canonpath catdir);
 
@@ -10,56 +10,83 @@
 use Apache::ServerRec ();
 use Apache::ServerUtil ();
 use Apache::Process ();
-
-# after Apache2 has pushed blib and core dirs including Apache2 on top
-# reorg @INC to have first devel libs, then blib libs, and only then
-# perl core libs
-my $pool = Apache->server->process->pool;
-my $project_root = canonpath
-    Apache::ServerUtil::server_root_relative($pool, "..");
-my (@a, @b, @c);
-for (@INC) {
-    if (m|^\Q$project_root\E|) {
-        m|blib| ? push @b, $_ : push @a, $_;
-    }
-    else {
-        push @c, $_;
-    }
-}
-@INC = (@a, @b, @c);
-
-use ModPerl::Util (); #for CORE::GLOBAL::exit
-
 use Apache::RequestRec ();
 use Apache::RequestIO ();
 use Apache::RequestUtil ();
-
 use Apache::Connection ();
 use Apache::Log ();
 
+use APR::Table ();
+
+use ModPerl::Util (); #for CORE::GLOBAL::exit
+
 use Apache::Const -compile => ':common';
 use APR::Const    -compile => ':common';
 
-use APR::Table ();
+reorg_INC();
 
-unless ($ENV{MOD_PERL}) {
-    die '$ENV{MOD_PERL} not set!';
+die '$ENV{MOD_PERL} not set!' unless $ENV{MOD_PERL};
+
+END {
+    warn "END in modperl_extra.pl, pid=$$\n";
 }
 
-#see t/modperl/methodobj
-use TestModperl::methodobj ();
-$TestModperl::MethodObj = TestModperl::methodobj->new;
+startup_info();
+
+test_add_config();
+
+test_hooks_startup();
+
+test_method_obj();
+
+test_modperl_env();
+
+test_loglevel();
+
+test_add_version_component();
+
+test_apache_status();
+
+test_perl_ithreads();
+
 
-#see t/response/TestModperl/env.pm
-$ENV{MODPERL_EXTRA_PL} = __FILE__;
 
-my $ap_mods  = scalar grep { /^Apache/ } keys %INC;
-my $apr_mods = scalar grep { /^APR/    } keys %INC;
+### only subs below this line ###
+
+sub reorg_INC {
+    # after Apache2 has pushed blib and core dirs including Apache2 on
+    # top reorg @INC to have first devel libs, then blib libs, and
+    # only then perl core libs
+    my $pool = Apache->server->process->pool;
+    my $project_root = canonpath
+        Apache::ServerUtil::server_root_relative($pool, "..");
+    my (@a, @b, @c);
+    for (@INC) {
+        if (m|^\Q$project_root\E|) {
+            m|blib| ? push @b, $_ : push @a, $_;
+        }
+        else {
+            push @c, $_;
+        }
+    }
+    @INC = (@a, @b, @c);
+}
+
+sub test_method_obj {
+    # see t/modperl/methodobj
+    use TestModperl::methodobj ();
+    $TestModperl::MethodObj = TestModperl::methodobj->new;
+}
+
+sub test_modperl_env {
+    # see t/response/TestModperl/env.pm
+    $ENV{MODPERL_EXTRA_PL} = __FILE__;
+}
 
 # test startup loglevel setting (under threaded mpms loglevel can be
 # changed only before threads are started) so here we test whether we
 # can still set it after restart
-{
+sub test_loglevel {
     use Apache::Const -compile => 'LOG_INFO';
     my $s = Apache->server;
     my $oldloglevel = $s->loglevel(Apache::LOG_INFO);
@@ -67,20 +94,26 @@
     $s->loglevel($oldloglevel);
 }
 
-Apache::Log->info("$ap_mods Apache:: modules loaded");
-Apache::ServerRec->log->info("$apr_mods APR:: modules loaded");
+sub startup_info {
+    my $ap_mods  = scalar grep { /^Apache/ } keys %INC;
+    my $apr_mods = scalar grep { /^APR/    } keys %INC;
+
+    Apache::Log->info("$ap_mods Apache:: modules loaded");
+    Apache::ServerRec->log->info("$apr_mods APR:: modules loaded");
 
-{
     my $server = Apache->server;
     my $vhosts = 0;
     for (my $s = $server->next; $s; $s = $s->next) {
         $vhosts++;
     }
+
     $server->log->info("base server + $vhosts vhosts ready to run tests");
 }
 
-# testing $s->add_config()
-my $conf = <<'EOC';
+
+sub test_add_config {
+    # testing $s->add_config()
+    my $conf = <<'EOC';
 # must use PerlModule here to check for segfaults
 PerlModule Apache::TestHandler
 <Location /apache/add_config>
@@ -88,16 +121,17 @@
   PerlResponseHandler Apache::TestHandler::ok1
 </Location>
 EOC
-Apache->server->add_config([split /\n/, $conf]);
+    Apache->server->add_config([split /\n/, $conf]);
 
-# test a directive that triggers an early startup, so we get an
-# attempt to use perl's mip  early
-Apache->server->add_config(['<Perl >', '1;', '</Perl>']);
+    # test a directive that triggers an early startup, so we get an
+    # attempt to use perl's mip early
+    Apache->server->add_config(['<Perl >', '1;', '</Perl>']);
+}
 
 # cleanup files for TestHooks::startup which can't be done from the
 # test itself because the files are created at the server startup and
 # the test needing these files may run more than once (t/SMOKE)
-{
+sub test_hooks_startup {
     require Apache::Test;
     my $dir = catdir Apache::Test::vars('documentroot'), qw(hooks startup);
     for (<$dir/*>) {
@@ -106,8 +140,7 @@
     }
 }
 
-{
-    # test add_version_component
+sub test_add_version_component {
     Apache->server->push_handlers(
         PerlPostConfigHandler => \&add_my_version);
 
@@ -118,96 +151,31 @@
     }
 }
 
-### Apache::Status tests
-use Apache::Status;
-use Apache::Module;
-Apache::Status->menu_item(
-   'test_menu' => "Test Menu Entry",
-   sub {
-       my($r, $q) = @_; #request and CGI objects
-       return ["This is just a test entry"];
-   }
-) if Apache::Module::loaded('Apache::Status');
-
-
-# this is needed for TestModperl::ithreads
-# one should be able to boot ithreads at the server startup and then
-# access the ithreads setup at run-time when a perl interpreter is
-# running on a different native threads (testing that perl
-# interpreters and ithreads aren't related to the native threads they
-# are running on). This should work starting from perl-5.8.1 and higher.
-use Config;
-if ($] >= 5.008001 && $Config{useithreads}) {
-    eval { require threads; "threads"->import() };
-}
-
-use Apache::TestTrace;
-use Apache::Const -compile => qw(M_POST);
-
-# read the posted body and send it back to the client as is
-sub ModPerl::Test::pass_through_response_handler {
-    my $r = shift;
-
-    if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
-        debug "pass_through_handler read: $data\n";
-        $r->print($data);
+sub test_apache_status {
+    ### Apache::Status tests
+    require Apache::Status;
+    require Apache::Module;
+    Apache::Status->menu_item(
+       'test_menu' => "Test Menu Entry",
+       sub {
+           my($r, $q) = @_; #request and CGI objects
+           return ["This is just a test entry"];
+       }
+    ) if Apache::Module::loaded('Apache::Status');
+}
+
+sub test_perl_ithreads {
+    # this is needed for TestPerl::ithreads
+    # one should be able to boot ithreads at the server startup and
+    # then access the ithreads setup at run-time when a perl
+    # interpreter is running on a different native threads (testing
+    # that perl interpreters and ithreads aren't related to the native
+    # threads they are running on). This should work starting from
+    # perl-5.8.1 and higher.
+    use Config;
+    if ($] >= 5.008001 && $Config{useithreads}) {
+        eval { require threads; "threads"->import() };
     }
-
-    Apache::OK;
-}
-
-use APR::Brigade ();
-use APR::Bucket ();
-use Apache::Filter ();
-
-use Apache::Const -compile => qw(MODE_READBYTES);
-use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
-
-use constant IOBUFSIZE => 8192;
-
-# to enable debug start with: (or simply run with -trace=debug)
-# t/TEST -trace=debug -start
-sub ModPerl::Test::read_post {
-    my $r = shift;
-    my $debug = shift || 0;
-
-    my $bb = APR::Brigade->new($r->pool,
-                               $r->connection->bucket_alloc);
-
-    my $data = '';
-    my $seen_eos = 0;
-    my $count = 0;
-    do {
-        $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
-                                       APR::BLOCK_READ, IOBUFSIZE);
-
-        $count++;
-
-        warn "read_post: bb $count\n" if $debug;
-
-        while (!$bb->is_empty) {
-            my $b = $bb->first;
-
-            if ($b->is_eos) {
-                warn "read_post: EOS bucket:\n" if $debug;
-                $seen_eos++;
-                last;
-            }
-
-            if ($b->read(my $buf)) {
-                warn "read_post: DATA bucket: [$buf]\n" if $debug;
-                $data .= $buf;
-            }
-
-            $b->delete;
-        }
-
-    } while (!$seen_eos);
-
-    $bb->destroy;
-
-    return $data;
 }
 
 sub ModPerl::Test::add_config {
@@ -226,191 +194,6 @@
 
     Apache::OK;
 
-}
-
-END {
-    warn "END in modperl_extra.pl, pid=$$\n";
-}
-
-package ModPerl::TestTiePerlSection;
-
-use strict;
-use warnings FATAL => 'all';
-
-# the following is needed for the tied %Location test in <Perl>
-# sections. Unfortunately it can't be defined in the section itself
-# due to the bug in perl:
-# http://rt.perl.org:80/rt3/Ticket/Display.html?id=29018
-
-use Tie::Hash;
-our @ISA = qw(Tie::StdHash);
-sub FETCH {
-    my($hash, $key) = @_;
-    if ($key eq '/tied') {
-        return 'TIED';
-    }
-    return $hash->{$key};
-}
-
-package ModPerl::TestFilterDebug;
-
-use strict;
-use warnings FATAL => 'all';
-
-use base qw(Apache::Filter);
-use APR::Brigade ();
-use APR::Bucket ();
-use APR::BucketType ();
-
-use Apache::Const -compile => qw(OK DECLINED);
-use APR::Const -compile => ':common';
-
-# to use these functions add any or all of these filter handlers
-# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_request
-# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_connection
-# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_request
-# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_connection
-#
-
-sub snoop_connection : FilterConnectionHandler { snoop("connection", @_) }
-sub snoop_request    : FilterRequestHandler    { snoop("request",    @_) }
-
-sub snoop {
-    my $type = shift;
-    my($filter, $bb, $mode, $block, $readbytes) = @_; # filter args
-
-    # $mode, $block, $readbytes are passed only for input filters
-    my $stream = defined $mode ? "input" : "output";
-
-    # read the data and pass-through the bucket brigades unchanged
-    if (defined $mode) {
-        # input filter
-        my $rv = $filter->next->get_brigade($bb, $mode, $block, $readbytes);
-        return $rv unless $rv == APR::SUCCESS;
-        bb_dump($type, $stream, $bb);
-    }
-    else {
-        # output filter
-        bb_dump($type, $stream, $bb);
-        my $rv = $filter->next->pass_brigade($bb);
-        return $rv unless $rv == APR::SUCCESS;
-    }
-    #if ($bb->is_empty) {
-    #    return -1;
-    #}
-
-    return Apache::OK;
-}
-
-sub bb_dump {
-    my($type, $stream, $bb) = @_;
-
-    my @data;
-    for (my $b = $bb->first; $b; $b = $bb->next($b)) {
-        $b->read(my $bdata);
-        push @data, $b->type->name, $bdata;
-    }
-
-    # send the sniffed info to STDERR so not to interfere with normal
-    # output
-    my $direction = $stream eq 'output' ? ">>>" : "<<<";
-    print STDERR "\n$direction $type $stream filter\n";
-
-    unless (@data) {
-        print STDERR "  No buckets\n";
-        return;
-    }
-
-    my $c = 1;
-    while (my($btype, $data) = splice @data, 0, 2) {
-        print STDERR "    o bucket $c: $btype\n";
-        print STDERR "[$data]\n";
-        $c++;
-    }
-}
-
-package ModPerl::TestMemoryLeak;
-
-# handy functions to measure memory leaks. since it measures the total
-# memory size of the process and not just perl leaks, you get your
-# C/XS leaks discovered too
-#
-# For example to test TestAPR::Pool::handler for leaks, add to its
-# top:
-#
-#  ModPerl::TestMemoryLeak::start();
-#
-# and just before returning from the handler add:
-#
-#  ModPerl::TestMemoryLeak::end();
-#
-# now start the server with only worker server
-#
-#  % t/TEST -maxclients 1 -start
-#
-# of course use maxclients 1 only if your test be handled with one
-# client, e.g. proxy tests need at least two clients. 
-#
-# Now repeat the same test several times (more than 3)
-#
-# % t/TEST -run apr/pool -times=10
-#
-# t/logs/error_log will include something like:
-#
-#    size    vsize resident    share      rss
-#    196k     132k     196k       0M     196k
-#    104k     132k     104k       0M     104k
-#     16k       0k      16k       0k      16k
-#      0k       0k       0k       0k       0k
-#      0k       0k       0k       0k       0k
-#      0k       0k       0k       0k       0k
-#
-# as you can see the first few runs were allocating memory, but the
-# following runs should consume no more memory. The leak tester measures
-# the extra memory allocated by the process since the last test. Notice
-# that perl and apr pools usually allocate more memory than they
-# need, so some leaks can be hard to see, unless many tests (like a
-# hundred) were run.
-
-use strict;
-use warnings FATAL => 'all';
-
-# XXX: as of 5.8.4 when spawning ithreads we get an annoying
-#  Attempt to free unreferenced scalar ... perlbug #24660
-# because of $gtop's CLONE'd object, so pretend that we have no gtop
-# for now if perl is threaded
-# GTop v0.12 is the first version that will work under threaded mpms
-use Config;
-use constant HAS_GTOP => eval { !$Config{useithreads} &&
-                                require GTop && GTop->VERSION >= 0.12 };
-
-my $gtop = HAS_GTOP ? GTop->new : undef;
-my @attrs = qw(size vsize resident share rss);
-my $format = "%8s %8s %8s %8s %8s\n";
-
-my %before;
-
-sub start {
-
-    die "No GTop avaible, bailing out" unless HAS_GTOP;
-
-    unless (keys %before) {
-        my $before = $gtop->proc_mem($$);
-        %before = map { $_ => $before->$_() } @attrs;
-        # print the header once
-        warn sprintf $format, @attrs;
-    }
-}
-
-sub end {
-
-    die "No GTop avaible, bailing out" unless HAS_GTOP;
-
-    my $after = $gtop->proc_mem($$);
-    my %after = map {$_ => $after->$_()} @attrs;
-    warn sprintf $format,
-        map GTop::size_string($after{$_} - $before{$_}), @attrs;
-    %before = %after;
 }
 
 1;

Modified: perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/both_str_native_remove.pm	Mon Nov 29 14:10:03 2004
@@ -12,6 +12,8 @@
 use Apache::Filter ();
 use Apache::FilterRec ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK DECLINED);
 
 # this filter removes the next filter in chain and itself
@@ -91,7 +93,7 @@
 
     $r->content_type('text/plain');
     if ($r->method_number == Apache::M_POST) {
-        $r->print("content: " . ModPerl::Test::read_post($r) ."\n");
+        $r->print("content: " . TestCommon::Utils::read_post($r) ."\n");
     }
 
     my $i=1;

Modified: perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/both_str_req_add.pm	Mon Nov 29 14:10:03 2004
@@ -11,6 +11,8 @@
 
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub header_parser {
@@ -62,7 +64,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     return Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/both_str_req_mix.pm	Mon Nov 29 14:10:03 2004
@@ -70,6 +70,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant DEBUG => 1;
@@ -112,7 +114,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     return Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/both_str_req_proxy.pm	Mon Nov 29 14:10:03 2004
@@ -13,6 +13,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub in_filter {
@@ -48,7 +50,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     return Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_autoload.pm	Mon Nov 29 14:10:03 2004
@@ -30,9 +30,10 @@
 
 __DATA__
 <NoAutoConfig>
+  PerlModule TestCommon::Handlers
   <Location /TestFilter__in_autoload>
       SetHandler modperl
-      PerlResponseHandler    ModPerl::Test::pass_through_response_handler
+      PerlResponseHandler    TestCommon::Handlers::pass_through_response_handler
       # no PerlModule TestFilter::in_load on purpose
       PerlInputFilterHandler TestFilter::in_autoload
   </Location>

Modified: perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_bbs_body.pm	Mon Nov 29 14:10:03 2004
@@ -10,6 +10,8 @@
 use APR::Brigade ();
 use APR::Bucket ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 use APR::Const -compile => ':common';
 
@@ -40,7 +42,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         $r->puts($data);
     }
     else {

Modified: perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_bbs_consume.pm	Mon Nov 29 14:10:03 2004
@@ -14,6 +14,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant READ_SIZE => 26;
@@ -87,7 +89,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         #warn "HANDLER READ: $data\n";
         $r->print($data);
     }

Modified: perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_bbs_inject_header.pm	Mon Nov 29 14:10:03 2004
@@ -38,6 +38,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK DECLINED CONN_KEEPALIVE);
 use APR::Const    -compile => ':common';
 
@@ -237,7 +239,7 @@
         $r->headers_out->set($key => $r->headers_in->get($key)||'');
     }
 
-    my $data = ModPerl::Test::read_post($r);
+    my $data = TestCommon::Utils::read_post($r);
     $r->print($data);
 
     Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_bbs_underrun.pm	Mon Nov 29 14:10:03 2004
@@ -49,6 +49,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant SIZE => 1024*16 + 5; # ~16k
@@ -134,7 +136,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         #warn "HANDLER READ: $data\n";
         my $length = length $data;
         $r->print("read $length chars");

Modified: perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_init_basic.pm	Mon Nov 29 14:10:03 2004
@@ -11,11 +11,12 @@
 
 use base qw(Apache::Filter);
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant READ_SIZE  => 1024;
 
-
 # this filter is expected to be called once
 # it'll set a note, with the count
 sub transparent_init : FilterInitHandler {
@@ -61,7 +62,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     my @keys = qw(init run);

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_bin_data.pm	Mon Nov 29 14:10:03 2004
@@ -12,6 +12,8 @@
 
 use Apache::TestTrace;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub pass_through {
@@ -29,7 +31,7 @@
     my $r = shift;
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         my $length = length $data;
         debug "pass through $length bytes of $data\n";
         $r->print($data);

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_consume.pm	Mon Nov 29 14:10:03 2004
@@ -60,6 +60,8 @@
 use Apache::RequestRec ();
 use Apache::RequestIO ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant READ_BYTES_TOTAL => 105;
@@ -122,7 +124,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
 
         # tell Apache to get rid of the rest of the request body
         # if we don't a client will get a broken pipe and may fail to

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_declined.pm	Mon Nov 29 14:10:03 2004
@@ -11,6 +11,8 @@
 
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK DECLINED M_POST);
 
 # make sure that if the input filter returns DECLINED without
@@ -39,7 +41,7 @@
 
     if ($r->method_number == Apache::M_POST) {
         # consume the data so the input filter is invoked
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         ok t_cmp(length $data, 20000, "the request body received ok");
     }
 

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_lc.pm	Mon Nov 29 14:10:03 2004
@@ -7,6 +7,8 @@
 use Apache::RequestIO ();
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub handler {
@@ -26,7 +28,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         #warn "HANDLER READ: $data\n";
         $r->print($data);
     }

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_msg.pm	Mon Nov 29 14:10:03 2004
@@ -22,6 +22,8 @@
 use Apache::Test;
 use Apache::TestUtil;
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => 'OK';
 use APR::Const -compile => ':common';
 
@@ -76,7 +78,7 @@
 
     plan $r, tests => 1;
 
-    my $received = ModPerl::Test::read_post($r);
+    my $received = TestCommon::Utils::read_post($r);
 
     ok t_cmp($received, $expected,
              "request filter must have upcased the data");

Modified: perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/in_str_sandwich.pm	Mon Nov 29 14:10:03 2004
@@ -10,6 +10,8 @@
 use Apache::RequestIO ();
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub handler {
@@ -40,7 +42,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         #warn "HANDLER READ: $data\n";
         $r->print($data);
     }

Modified: perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/out_init_basic.pm	Mon Nov 29 14:10:03 2004
@@ -11,6 +11,8 @@
 
 use base qw(Apache::Filter);
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant READ_SIZE  => 1024;
@@ -66,7 +68,7 @@
 
     my $data;
     if ($r->method_number == Apache::M_POST) {
-        $data = ModPerl::Test::read_post($r);
+        $data = TestCommon::Utils::read_post($r);
     }
 
     $r->print('init ', $r->notes->get('init'), "\n");

Modified: perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/out_str_req_eos.pm	Mon Nov 29 14:10:03 2004
@@ -10,6 +10,8 @@
 use Apache::RequestIO ();
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 my $prefix = 'PREFIX_';
@@ -57,7 +59,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     return Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/out_str_req_mix.pm	Mon Nov 29 14:10:03 2004
@@ -38,6 +38,8 @@
 
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 sub adjust {
@@ -59,7 +61,7 @@
     $r->content_type('text/plain');
 
     if ($r->method_number == Apache::M_POST) {
-        $r->print(ModPerl::Test::read_post($r));
+        $r->print(TestCommon::Utils::read_post($r));
     }
 
     return Apache::OK;

Modified: perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm&r1=106957&p2=perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm	(original)
+++ perl/modperl/trunk/t/filter/TestFilter/out_str_reverse.pm	Mon Nov 29 14:10:03 2004
@@ -11,6 +11,8 @@
 use Apache::RequestIO ();
 use Apache::Filter ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK M_POST);
 
 use constant BUFF_LEN => 2;
@@ -49,7 +51,7 @@
     # unbuffer stdout, so we get the data split across several bbs
     local $_ = 1; 
     if ($r->method_number == Apache::M_POST) {
-        my $data = ModPerl::Test::read_post($r); 
+        my $data = TestCommon::Utils::read_post($r); 
         $r->print($_) for grep length $_, split /(.{5})/, $data;
     }
 

Added: perl/modperl/trunk/t/lib/ModPerl/TestFilterDebug.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/ModPerl/TestFilterDebug.pm?view=auto&rev=106958
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/lib/ModPerl/TestFilterDebug.pm	Mon Nov 29 14:10:03 2004
@@ -0,0 +1,80 @@
+package ModPerl::TestFilterDebug;
+
+use strict;
+use warnings FATAL => 'all';
+
+use base qw(Apache::Filter);
+use APR::Brigade ();
+use APR::Bucket ();
+use APR::BucketType ();
+
+use Apache::Const -compile => qw(OK DECLINED);
+use APR::Const -compile => ':common';
+
+# to use these functions add any or all of these filter handlers
+# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_request
+# PerlInputFilterHandler  ModPerl::TestFilterDebug::snoop_connection
+# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_request
+# PerlOutputFilterHandler ModPerl::TestFilterDebug::snoop_connection
+#
+
+sub snoop_connection : FilterConnectionHandler { snoop("connection", @_) }
+sub snoop_request    : FilterRequestHandler    { snoop("request",    @_) }
+
+sub snoop {
+    my $type = shift;
+    my($filter, $bb, $mode, $block, $readbytes) = @_; # filter args
+
+    # $mode, $block, $readbytes are passed only for input filters
+    my $stream = defined $mode ? "input" : "output";
+
+    # read the data and pass-through the bucket brigades unchanged
+    if (defined $mode) {
+        # input filter
+        my $rv = $filter->next->get_brigade($bb, $mode, $block, $readbytes);
+        return $rv unless $rv == APR::SUCCESS;
+        bb_dump($type, $stream, $bb);
+    }
+    else {
+        # output filter
+        bb_dump($type, $stream, $bb);
+        my $rv = $filter->next->pass_brigade($bb);
+        return $rv unless $rv == APR::SUCCESS;
+    }
+    #if ($bb->is_empty) {
+    #    return -1;
+    #}
+
+    return Apache::OK;
+}
+
+sub bb_dump {
+    my($type, $stream, $bb) = @_;
+
+    my @data;
+    for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+        $b->read(my $bdata);
+        push @data, $b->type->name, $bdata;
+    }
+
+    # send the sniffed info to STDERR so not to interfere with normal
+    # output
+    my $direction = $stream eq 'output' ? ">>>" : "<<<";
+    print STDERR "\n$direction $type $stream filter\n";
+
+    unless (@data) {
+        print STDERR "  No buckets\n";
+        return;
+    }
+
+    my $c = 1;
+    while (my($btype, $data) = splice @data, 0, 2) {
+        print STDERR "    o bucket $c: $btype\n";
+        print STDERR "[$data]\n";
+        $c++;
+    }
+}
+
+1;
+
+__END__

Added: perl/modperl/trunk/t/lib/ModPerl/TestMemoryLeak.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/ModPerl/TestMemoryLeak.pm?view=auto&rev=106958
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/lib/ModPerl/TestMemoryLeak.pm	Mon Nov 29 14:10:03 2004
@@ -0,0 +1,87 @@
+package ModPerl::TestMemoryLeak;
+
+# handy functions to measure memory leaks. since it measures the total
+# memory size of the process and not just perl leaks, you get your
+# C/XS leaks discovered too
+#
+# For example to test TestAPR::Pool::handler for leaks, add to its
+# top:
+#
+#  ModPerl::TestMemoryLeak::start();
+#
+# and just before returning from the handler add:
+#
+#  ModPerl::TestMemoryLeak::end();
+#
+# now start the server with only worker server
+#
+#  % t/TEST -maxclients 1 -start
+#
+# of course use maxclients 1 only if your test be handled with one
+# client, e.g. proxy tests need at least two clients. 
+#
+# Now repeat the same test several times (more than 3)
+#
+# % t/TEST -run apr/pool -times=10
+#
+# t/logs/error_log will include something like:
+#
+#    size    vsize resident    share      rss
+#    196k     132k     196k       0M     196k
+#    104k     132k     104k       0M     104k
+#     16k       0k      16k       0k      16k
+#      0k       0k       0k       0k       0k
+#      0k       0k       0k       0k       0k
+#      0k       0k       0k       0k       0k
+#
+# as you can see the first few runs were allocating memory, but the
+# following runs should consume no more memory. The leak tester measures
+# the extra memory allocated by the process since the last test. Notice
+# that perl and apr pools usually allocate more memory than they
+# need, so some leaks can be hard to see, unless many tests (like a
+# hundred) were run.
+
+use strict;
+use warnings FATAL => 'all';
+
+# XXX: as of 5.8.4 when spawning ithreads we get an annoying
+#  Attempt to free unreferenced scalar ... perlbug #24660
+# because of $gtop's CLONE'd object, so pretend that we have no gtop
+# for now if perl is threaded
+# GTop v0.12 is the first version that will work under threaded mpms
+use Config;
+use constant HAS_GTOP => eval { !$Config{useithreads} &&
+                                require GTop && GTop->VERSION >= 0.12 };
+
+my $gtop = HAS_GTOP ? GTop->new : undef;
+my @attrs = qw(size vsize resident share rss);
+my $format = "%8s %8s %8s %8s %8s\n";
+
+my %before;
+
+sub start {
+
+    die "No GTop avaible, bailing out" unless HAS_GTOP;
+
+    unless (keys %before) {
+        my $before = $gtop->proc_mem($$);
+        %before = map { $_ => $before->$_() } @attrs;
+        # print the header once
+        warn sprintf $format, @attrs;
+    }
+}
+
+sub end {
+
+    die "No GTop avaible, bailing out" unless HAS_GTOP;
+
+    my $after = $gtop->proc_mem($$);
+    my %after = map {$_ => $after->$_()} @attrs;
+    warn sprintf $format,
+        map GTop::size_string($after{$_} - $before{$_}), @attrs;
+    %before = %after;
+}
+
+1;
+
+__END__

Added: perl/modperl/trunk/t/lib/ModPerl/TestTiePerlSection.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/ModPerl/TestTiePerlSection.pm?view=auto&rev=106958
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/lib/ModPerl/TestTiePerlSection.pm	Mon Nov 29 14:10:03 2004
@@ -0,0 +1,21 @@
+package ModPerl::TestTiePerlSection;
+
+use strict;
+use warnings FATAL => 'all';
+
+# the following is needed for the tied %Location test in <Perl>
+# sections. Unfortunately it can't be defined in the section itself
+# due to the bug in perl:
+# http://rt.perl.org:80/rt3/Ticket/Display.html?id=29018
+
+use Tie::Hash;
+our @ISA = qw(Tie::StdHash);
+sub FETCH {
+    my($hash, $key) = @_;
+    if ($key eq '/tied') {
+        return 'TIED';
+    }
+    return $hash->{$key};
+}
+
+1;

Added: perl/modperl/trunk/t/lib/TestCommon/Handlers.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/TestCommon/Handlers.pm?view=auto&rev=106958
==============================================================================
--- (empty file)
+++ perl/modperl/trunk/t/lib/TestCommon/Handlers.pm	Mon Nov 29 14:10:03 2004
@@ -0,0 +1,61 @@
+package TestCommon::Handlers;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::RequestRec ();
+use Apache::RequestIO ();
+
+use TestCommon::Utils ();
+
+use Apache::TestTrace;
+
+use Apache::Const -compile => qw(M_POST OK);
+
+# read the posted body and send it back to the client as is
+sub pass_through_response_handler {
+    my $r = shift;
+
+    if ($r->method_number == Apache::M_POST) {
+        my $data = TestCommon::Utils::read_post($r);
+        debug "pass_through_handler read: $data\n";
+        $r->print($data);
+    }
+
+    Apache::OK;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+TestCommon::Handlers - Common Handlers
+
+
+
+=head1 Synopsis
+
+  # PerlModule          TestCommon::Handlers
+  # PerlResponseHandler TestCommon::Handlers::pass_through_response_handler
+
+
+=head1 Description
+
+Various commonly used handlers
+
+
+
+
+=head1 API
+
+=head2 pass_through_response_handler
+
+  # PerlModule          TestCommon::Handlers
+  # PerlResponseHandler TestCommon::Handlers::pass_through_response_handler
+
+this is a response handler, which reads the posted body and sends it
+back to the client as is.
+
+=cut

Modified: perl/modperl/trunk/t/lib/TestCommon/Utils.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/lib/TestCommon/Utils.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/lib/TestCommon/Utils.pm&r1=106957&p2=perl/modperl/trunk/t/lib/TestCommon/Utils.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/lib/TestCommon/Utils.pm	(original)
+++ perl/modperl/trunk/t/lib/TestCommon/Utils.pm	Mon Nov 29 14:10:03 2004
@@ -3,6 +3,15 @@
 use strict;
 use warnings FATAL => 'all';
 
+use APR::Brigade ();
+use APR::Bucket ();
+use Apache::Filter ();
+
+use Apache::Const -compile => qw(MODE_READBYTES);
+use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
+
+use constant IOBUFSIZE => 8192;
+
 # perl 5.6.x only triggers taint protection on strings which are at
 # least one char long
 sub is_tainted {
@@ -13,6 +22,50 @@
     };
 }
 
+# to enable debug start with: (or simply run with -trace=debug)
+# t/TEST -trace=debug -start
+sub read_post {
+    my $r = shift;
+    my $debug = shift || 0;
+
+    my $bb = APR::Brigade->new($r->pool,
+                               $r->connection->bucket_alloc);
+
+    my $data = '';
+    my $seen_eos = 0;
+    my $count = 0;
+    do {
+        $r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
+                                       APR::BLOCK_READ, IOBUFSIZE);
+
+        $count++;
+
+        warn "read_post: bb $count\n" if $debug;
+
+        while (!$bb->is_empty) {
+            my $b = $bb->first;
+
+            if ($b->is_eos) {
+                warn "read_post: EOS bucket:\n" if $debug;
+                $seen_eos++;
+                last;
+            }
+
+            if ($b->read(my $buf)) {
+                warn "read_post: DATA bucket: [$buf]\n" if $debug;
+                $data .= $buf;
+            }
+
+            $b->delete;
+        }
+
+    } while (!$seen_eos);
+
+    $bb->destroy;
+
+    return $data;
+}
+
 1;
 
 __END__
@@ -30,9 +83,8 @@
   # test whether some SV is tainted
   $b->read(my $data);
   ok TestCommon::Utils::is_tainted($data);
-
-
-
+  
+  my $data = TestCommon::Utils::read_post($r);
 
 =head1 Description
 
@@ -45,7 +97,7 @@
 
 
 
-=head2 is_tainted()
+=head2 is_tainted
 
   is_tainted(@data);
 
@@ -53,6 +105,15 @@
 I<FALSE> otherwise.
 
 
+
+=head2 read_post
+
+  my $data = TestCommon::Utils::read_post($r);
+  my $data = TestCommon::Utils::read_post($r, $debug);
+
+reads the posted data using bucket brigades manipulation.
+
+To enable debug pass a true argument C<$debug>
 
 
 =cut

Modified: perl/modperl/trunk/t/response/TestAPI/content_encoding.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/content_encoding.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/response/TestAPI/content_encoding.pm&r1=106957&p2=perl/modperl/trunk/t/response/TestAPI/content_encoding.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/response/TestAPI/content_encoding.pm	(original)
+++ perl/modperl/trunk/t/response/TestAPI/content_encoding.pm	Mon Nov 29 14:10:03 2004
@@ -8,6 +8,8 @@
 use Apache::RequestRec ();
 use Apache::RequestUtil ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK DECLINED);
 
 sub handler {
@@ -15,7 +17,7 @@
 
     return Apache::DECLINED unless $r->method_number == Apache::M_POST;
 
-    my $data = ModPerl::Test::read_post($r);
+    my $data = TestCommon::Utils::read_post($r);
 
     require Compress::Zlib;
 

Modified: perl/modperl/trunk/t/response/TestApache/discard_rbody.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestApache/discard_rbody.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/response/TestApache/discard_rbody.pm&r1=106957&p2=perl/modperl/trunk/t/response/TestApache/discard_rbody.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/response/TestApache/discard_rbody.pm	(original)
+++ perl/modperl/trunk/t/response/TestApache/discard_rbody.pm	Mon Nov 29 14:10:03 2004
@@ -13,6 +13,8 @@
 use APR::Brigade ();
 use APR::Error ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => qw(OK MODE_READBYTES);
 use APR::Const    -compile => qw(SUCCESS BLOCK_READ);
 
@@ -38,7 +40,7 @@
     }
     elsif ($test eq 'all') {
         # consume all of the request body
-        my $data = ModPerl::Test::read_post($r);
+        my $data = TestCommon::Utils::read_post($r);
         die "failed to consume all the data" unless length($data) == 100000;
     }
 

Modified: perl/modperl/trunk/t/response/TestApache/post.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestApache/post.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/response/TestApache/post.pm&r1=106957&p2=perl/modperl/trunk/t/response/TestApache/post.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/response/TestApache/post.pm	(original)
+++ perl/modperl/trunk/t/response/TestApache/post.pm	Mon Nov 29 14:10:03 2004
@@ -6,13 +6,15 @@
 use Apache::RequestRec ();
 use Apache::RequestIO ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => 'OK';
 
 sub handler {
     my $r = shift;
     $r->content_type('text/plain');
 
-    my $data = ModPerl::Test::read_post($r) || "";
+    my $data = TestCommon::Utils::read_post($r) || "";
 
     $r->puts(join ':', length($data), $data);
 

Modified: perl/modperl/trunk/t/response/TestModperl/post_utf8.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestModperl/post_utf8.pm?view=diff&rev=106958&p1=perl/modperl/trunk/t/response/TestModperl/post_utf8.pm&r1=106957&p2=perl/modperl/trunk/t/response/TestModperl/post_utf8.pm&r2=106958
==============================================================================
--- perl/modperl/trunk/t/response/TestModperl/post_utf8.pm	(original)
+++ perl/modperl/trunk/t/response/TestModperl/post_utf8.pm	Mon Nov 29 14:10:03 2004
@@ -11,6 +11,8 @@
 use Apache::RequestIO ();
 use APR::Table ();
 
+use TestCommon::Utils ();
+
 use Apache::Const -compile => 'OK';
 
 my $expected_ascii = "I love you, (why lying?), but I belong to another";
@@ -33,7 +35,7 @@
     plan $r, tests => 2,
         need need_min_perl_version(5.008), need_perl('perlio');
 
-    my $received = ModPerl::Test::read_post($r) || "";
+    my $received = TestCommon::Utils::read_post($r) || "";
 
     # workaround for perl-5.8.0, which doesn't decode correctly a
     # tainted variable

Mime
View raw message