← Back to branch summary

~ubuntu-branches/ubuntu/edgy/libapache2-mod-perl2/edgy

« back to all changes in this revision

Viewing changes to t/response/TestError/runtime.pm

  • Committer: Bazaar Package Importer
  • Author(s): Andres Salomon
  • Date: 2005-08-12 01:40:38 UTC
  • mfrom: (1.1.2 upstream) (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20050812014038-gjigefs55pqx4qc8
Tags: 2.0.1-3
Grr.  Really include perl.conf file; it got lost due to diff not
wanting to add an empty file.

Show diffs side-by-side

added added

removed removed

Lines of Context:
t/response/TestError/runtime.pm
3
3
use strict;
4
4
use warnings FATAL => 'all';
5
5
 
6
 
use Apache::RequestRec ();
7
 
use Apache::RequestIO ();
8
 
use Apache::Connection ();
 
6
use Apache2::RequestRec ();
 
7
use Apache2::RequestIO ();
 
8
use Apache2::Connection ();
9
9
use APR::Socket ();
 
10
use APR::Status ();
10
11
 
11
12
use Apache::TestUtil;
12
13
 
13
 
use Apache::Const -compile => qw(OK);
14
 
use APR::Const    -compile => qw(TIMEUP);
 
14
use Apache2::Const -compile => qw(OK);
 
15
use APR::Const     -compile => qw(EACCES);
15
16
 
16
17
use constant SIZE => 2048;
17
18
 
22
23
 
23
24
    $r->content_type('text/plain');
24
25
 
25
 
    # set timeout to 1 usec (microsec!) which makes sure that any
26
 
    # socket read call will fail
27
 
    $socket->timeout_set(1);
 
26
    # set timeout to 0 to make sure that any socket read call will
 
27
    # fail
 
28
    $socket->timeout_set(0);
28
29
 
29
30
    no strict 'refs';
30
31
    $args->($r, $socket);
31
32
 
32
 
    return Apache::OK;
 
33
    return Apache2::Const::OK;
 
34
}
 
35
 
 
36
sub overload_test {
 
37
    my($r, $socket) = @_;
 
38
 
 
39
    eval { mp_error($socket) };
 
40
 
 
41
    die "there should have been an exception" unless $@;
 
42
 
 
43
    die "the exception should have been an APR::Error object"
 
44
        unless ref $@ eq 'APR::Error';
 
45
 
 
46
    # == && != (expecting an EAGAIN error)
 
47
    die "APR::Status is broken"   unless APR::Status::is_EAGAIN($@);
 
48
    die "'==' overload is broken" unless $@ == $@;
 
49
    die "'!=' overload is broken" unless $@ != APR::Const::EACCES;
 
50
    die "'!=' overload is broken" unless APR::Const::EACCES != $@;
 
51
    die "'!=' overload is broken" if     $@ != $@;
 
52
 
 
53
    # XXX: add more overload tests
 
54
 
 
55
    $r->print("ok overload_test");
 
56
 
33
57
}
34
58
 
35
59
sub plain_mp_error {
74
98
 
75
99
sub eval_block_mp_error {
76
100
    my($r, $socket) = @_;
77
 
    eval { mp_error($socket) };
78
 
    if ($@ && ref($@) && $@ == APR::TIMEUP) {
79
 
        $r->print("ok eval_block_mp_error");
 
101
 
 
102
    # throw in some retry attempts
 
103
    my $tries = 0;
 
104
    RETRY: eval { mp_error($socket) };
 
105
    if ($@ && ref($@) && APR::Status::is_EAGAIN($@)) {
 
106
        if ($tries++ < 3) {
 
107
            goto RETRY;
 
108
        }
 
109
        else {
 
110
            $r->print("ok eval_block_mp_error");
 
111
        }
80
112
    }
81
113
    else {
82
114
        die "eval block has failed: $@";
85
117
 
86
118
sub eval_string_mp_error {
87
119
    my($r, $socket) = @_;
88
 
    eval "\$socket->recv(SIZE)";
89
 
    if ($@ && ref($@) && $@ == APR::TIMEUP) {
 
120
    eval '$socket->recv(my $buffer, SIZE)';
 
121
    if ($@ && ref($@) && APR::Status::is_EAGAIN($@)) {
90
122
        $r->print("ok eval_string_mp_error");
91
123
    }
92
124
    else {
121
153
# fails because of the timeout set earlier in the handler
122
154
sub mp_error {
123
155
    my $socket = shift;
124
 
    $socket->recv(SIZE);
 
156
    $socket->recv(my $buffer, SIZE);
125
157
}
126
158
 
127
159
1;