Fix potential test suite hangs due to pipelined response deadlocks
Patch by Zefram <zefram@fysh.org> from https://rt.cpan.org/Ticket/Display.html?id=82409
git-svn-id: https://svn.apache.org/repos/asf/perl/modperl/trunk@1867454 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/t/filter/TestFilter/in_str_declined.pm b/t/filter/TestFilter/in_str_declined.pm
index 6b0f17b..07bd69e 100644
--- a/t/filter/TestFilter/in_str_declined.pm
+++ b/t/filter/TestFilter/in_str_declined.pm
@@ -36,13 +36,17 @@
sub response {
my $r = shift;
+ my $data;
+ if ($r->method_number == Apache2::Const::M_POST) {
+ # consume the data so the input filter is invoked
+ $data = TestCommon::Utils::read_post($r);
+ }
+
plan $r, tests => 2;
$r->content_type('text/plain');
if ($r->method_number == Apache2::Const::M_POST) {
- # consume the data so the input filter is invoked
- my $data = TestCommon::Utils::read_post($r);
ok t_cmp(length $data, 20000, "the request body received ok");
}
diff --git a/t/filter/TestFilter/in_str_declined_read.pm b/t/filter/TestFilter/in_str_declined_read.pm
index 1a242c5..06b9a9d 100644
--- a/t/filter/TestFilter/in_str_declined_read.pm
+++ b/t/filter/TestFilter/in_str_declined_read.pm
@@ -32,14 +32,19 @@
sub response {
my $r = shift;
+ my $err;
+ if ($r->method_number == Apache2::Const::M_POST) {
+ # this should fail, because of the failing filter
+ eval { TestCommon::Utils::read_post($r) };
+ $err = $@;
+ }
+
plan $r, tests => 1;
$r->content_type('text/plain');
if ($r->method_number == Apache2::Const::M_POST) {
- # this should fail, because of the failing filter
- eval { TestCommon::Utils::read_post($r) };
- ok $@;
+ ok $err;
}
Apache2::Const::OK;
diff --git a/t/filter/TestFilter/in_str_msg.pm b/t/filter/TestFilter/in_str_msg.pm
index e3a4733..e4582e2 100644
--- a/t/filter/TestFilter/in_str_msg.pm
+++ b/t/filter/TestFilter/in_str_msg.pm
@@ -77,10 +77,10 @@
sub response {
my $r = shift;
- plan $r, tests => 1;
-
my $received = TestCommon::Utils::read_post($r);
+ plan $r, tests => 1;
+
ok t_cmp($received, $expected,
"request filter must have upcased the data");
diff --git a/t/response/TestModperl/post_utf8.pm b/t/response/TestModperl/post_utf8.pm
index 5544bc1..48d7aa2 100644
--- a/t/response/TestModperl/post_utf8.pm
+++ b/t/response/TestModperl/post_utf8.pm
@@ -30,14 +30,14 @@
# $r->content_type("text/plain; charset=utf-8");
# $r->print("expected: $expected_utf8\n");
+ my $received = TestCommon::Utils::read_post($r) || "";
+
# utf encode/decode was added only in 5.8.0
# XXX: currently binmode is only available with perlio (used on the
# server side on the tied/perlio STDOUT)
plan $r, tests => 2,
need need_min_perl_version(5.008), need_perl('perlio');
- my $received = TestCommon::Utils::read_post($r) || "";
-
# workaround for perl-5.8.0, which doesn't decode correctly a
# tainted variable
require ModPerl::Util;
