diff options
author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 06:33:51 +0000 |
---|---|---|
committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 06:33:51 +0000 |
commit | 4f0770f3df78ecd5dcaefbd214f7a1415366bca6 (patch) | |
tree | 72661b8f81594b855bcc967b819263f63fa30e17 /debian/perl-framework/t/apache/leaks.t | |
parent | Adding upstream version 2.4.56. (diff) | |
download | apache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.tar.xz apache2-4f0770f3df78ecd5dcaefbd214f7a1415366bca6.zip |
Adding debian version 2.4.56-1~deb11u2.debian/2.4.56-1_deb11u2
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'debian/perl-framework/t/apache/leaks.t')
-rw-r--r-- | debian/perl-framework/t/apache/leaks.t | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/debian/perl-framework/t/apache/leaks.t b/debian/perl-framework/t/apache/leaks.t new file mode 100644 index 0000000..bb7b329 --- /dev/null +++ b/debian/perl-framework/t/apache/leaks.t @@ -0,0 +1,63 @@ +use strict; +use warnings FATAL => 'all'; + +use Apache::Test; +use Apache::TestRequest; +use Apache::TestUtil; + +my $url = "/memory_track"; +my $init_iters = 2000; +my $iters = 500; + +my $active = GET_RC($url) == 200; + +my $num_tests = $init_iters + $iters * 2; +plan tests => $num_tests, + need { "mod_memory_track not activated" => $active }; + +### this doesn't seem sufficient to force all requests over a single +### persistent connection any more, is there a better trick? +Apache::TestRequest::user_agent(keep_alive => 1); +Apache::TestRequest::scheme('http'); + +my $cid = -1; +my $mem; + +# initial iterations should get workers to steady-state memory use. +foreach (1..$init_iters) { + ok t_cmp(GET_RC($url), 200, "200 response"); +} + +# now test whether c->pool memory is increasing for further +# requests on a given conn_rec (matched by id)... could track them +# all with a bit more effort. +foreach (1..$iters) { + my $r = GET $url; + + print "# iter $_\n"; + + ok t_cmp($r->code, 200, "got response"); + + my $content = $r->content; + chomp $content; + my ($key, $id, $bytes) = split ',', $content; + + print "# $key, $id, $bytes\n"; + + if ($cid == -1) { + $cid = $id; + $mem = $bytes; + ok 1; + } + elsif ($cid != $id) { + skip "using wrong connection"; + } + elsif ($bytes > $mem) { + print "# error: pool memory increased from $mem to $bytes!\n"; + ok 0; + } + else { + ok 1; + } +} + |