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

« back to all changes in this revision

Viewing changes to t/response/TestAPR/table.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:
6
6
use warnings FATAL => 'all';
7
7
 
8
8
use Apache::Test;
9
 
use Apache::TestUtil;
10
 
 
11
 
use APR::Table ();
12
 
 
13
 
use Apache::Const -compile => 'OK';
14
 
use APR::Const    -compile => ':table';
15
 
 
16
 
use constant TABLE_SIZE => 20;
17
 
my $filter_count;
 
9
use Apache2::Const -compile => 'OK';
 
10
 
 
11
use TestAPRlib::table;
18
12
 
19
13
sub handler {
20
14
    my $r = shift;
21
15
 
22
 
    my $tests = 38;
23
 
 
 
16
    my $tests = TestAPRlib::table::num_of_tests();
24
17
    plan $r, tests => $tests;
25
18
 
26
 
    my $table = APR::Table::make($r->pool, TABLE_SIZE);
27
 
 
28
 
    ok UNIVERSAL::isa($table, 'APR::Table');
29
 
 
30
 
    # get on non-existing key
31
 
    {
32
 
        # in scalar context
33
 
        my $val = $table->get('foo');
34
 
        ok t_cmp(undef, $val, '$val = $table->get("no_such_key")');
35
 
 
36
 
        # in list context
37
 
        my @val = $table->get('foo');
38
 
        ok t_cmp(0, +@val, '@val = $table->get("no_such_key")');
39
 
    }
40
 
 
41
 
    # set/add/get/copy normal values
42
 
    {
43
 
        $table->set(foo => 'bar');
44
 
 
45
 
        # get scalar context
46
 
        my $val = $table->get('foo');
47
 
        ok t_cmp('bar', $val, '$val = $table->get("foo")');
48
 
 
49
 
        # add + get list context
50
 
        $table->add(foo => 'tar');
51
 
        $table->add(foo => 'kar');
52
 
        my @val = $table->get('foo');
53
 
        ok @val == 3         &&
54
 
            $val[0] eq 'bar' &&
55
 
            $val[1] eq 'tar' &&
56
 
            $val[2] eq 'kar';
57
 
 
58
 
        # copy
59
 
        $table->set(too => 'boo');
60
 
        my $table_copy = $table->copy($r->pool);
61
 
        my $val_copy = $table->get('too');
62
 
        ok t_cmp('boo', $val_copy, '$val = $table->get("too")');
63
 
        my @val_copy = $table_copy->get('foo');
64
 
        ok @val_copy == 3         &&
65
 
            $val_copy[0] eq 'bar' &&
66
 
            $val_copy[1] eq 'tar' &&
67
 
            $val_copy[2] eq 'kar';
68
 
    }
69
 
 
70
 
    # make sure 0 comes through as 0 and not undef
71
 
    {
72
 
        $table->set(foo => 0);
73
 
        my $zero = $table->get('foo');
74
 
        ok t_cmp(0, $zero, 'table value 0 is not undef');
75
 
    }
76
 
 
77
 
    # unset
78
 
    {
79
 
        $table->set(foo => "bar");
80
 
        $table->unset('foo');
81
 
        ok t_cmp(undef, +$table->get('foo'), '$table->unset("foo")');
82
 
    }
83
 
 
84
 
    # merge
85
 
    {
86
 
        $table->set(  merge => '1');
87
 
        $table->merge(merge => 'a');
88
 
        my $val = $table->get('merge');
89
 
        ok t_cmp("1, a", $val, 'one val $table->merge(...)');
90
 
 
91
 
        # if there is more than one value for the same key, merge does
92
 
        # the job only for the first value
93
 
        $table->add(  merge => '2');
94
 
        $table->merge(merge => 'b');
95
 
        my @val = $table->get('merge');
96
 
        ok t_cmp("1, a, b", $val[0], '$table->merge(...)');
97
 
        ok t_cmp("2",    $val[1], 'two values $table->merge(...)');
98
 
 
99
 
        # if the key is not found, works like set/add
100
 
        $table->merge(miss => 'a');
101
 
        my $val_miss = $table->get('miss');
102
 
        ok t_cmp("a", $val_miss, 'no value $table->merge(...)');
103
 
    }
104
 
 
105
 
    # clear
106
 
    {
107
 
        $table->set(foo => 0);
108
 
        $table->set(bar => 1);
109
 
        $table->clear();
110
 
        # t_cmp forces scalar context on get
111
 
        ok t_cmp(undef, $table->get('foo'), '$table->clear');
112
 
        ok t_cmp(undef, $table->get('bar'), '$table->clear');
113
 
    }
114
 
 
115
 
    # filtering
116
 
    {
117
 
        for (1..TABLE_SIZE) {
118
 
            $table->set(chr($_+97), $_);
119
 
        }
120
 
 
121
 
        # Simple filtering
122
 
        $filter_count = 0;
123
 
        $table->do("my_filter");
124
 
        ok t_cmp(TABLE_SIZE, $filter_count);
125
 
 
126
 
        # Filtering aborting in the middle
127
 
        $filter_count = 0;
128
 
        $table->do("my_filter_stop");
129
 
        ok t_cmp(int(TABLE_SIZE)/2, $filter_count) ;
130
 
 
131
 
        # Filtering with anon sub
132
 
        $filter_count=0;
133
 
        $table->do(sub {
134
 
            my ($key,$value) = @_;
135
 
            $filter_count++;
136
 
            unless ($key eq chr($value+97)) {
137
 
                die "arguments I recieved are bogus($key,$value)";
138
 
            }
139
 
            return 1;
140
 
        });
141
 
 
142
 
        ok t_cmp(TABLE_SIZE, $filter_count, "table size");
143
 
 
144
 
        $filter_count = 0;
145
 
        $table->do("my_filter", "c", "b", "e");
146
 
        ok t_cmp(3, $filter_count, "table size");
147
 
    }
148
 
 
149
 
    #Tied interface
150
 
    {
151
 
        my $table = APR::Table::make($r->pool, TABLE_SIZE);
152
 
 
153
 
        ok UNIVERSAL::isa($table, 'HASH');
154
 
 
155
 
        ok UNIVERSAL::isa($table, 'HASH') && tied(%$table);
156
 
 
157
 
        ok $table->{'foo'} = 'bar';
158
 
 
159
 
        # scalar context
160
 
        ok $table->{'foo'} eq 'bar';
161
 
 
162
 
        ok delete $table->{'foo'} || 1;
163
 
 
164
 
        ok not exists $table->{'foo'};
165
 
 
166
 
        for (1..TABLE_SIZE) {
167
 
            $table->{chr($_+97)} = $_;
168
 
        }
169
 
 
170
 
        $filter_count = 0;
171
 
        foreach my $key (sort keys %$table) {
172
 
            my_filter($key, $table->{$key});
173
 
        }
174
 
        ok $filter_count == TABLE_SIZE;
175
 
    }
176
 
 
177
 
    # overlap and compress routines
178
 
    {
179
 
        my $base = APR::Table::make($r->pool, TABLE_SIZE);
180
 
        my $add  = APR::Table::make($r->pool, TABLE_SIZE);
181
 
 
182
 
        $base->set(foo => 'one');
183
 
        $base->add(foo => 'two');
184
 
 
185
 
        $add->set(foo => 'three');
186
 
        $add->set(bar => 'beer');
187
 
 
188
 
        my $overlay = $base->overlay($add, $r->pool);
189
 
 
190
 
        my @foo = $overlay->get('foo');
191
 
        my @bar = $overlay->get('bar');
192
 
 
193
 
        ok t_cmp(3, +@foo);
194
 
        ok t_cmp('beer', $bar[0]);
195
 
 
196
 
        my $overlay2 = $overlay->copy($r->pool);
197
 
 
198
 
        # compress/merge
199
 
        $overlay->compress(APR::OVERLAP_TABLES_MERGE);
200
 
        # $add first, then $base
201
 
        ok t_cmp($overlay->get('foo'),
202
 
                 'three, one, two',
203
 
                 "\$overlay->compress/merge");
204
 
        ok t_cmp($overlay->get('bar'),
205
 
                 'beer',
206
 
                 "\$overlay->compress/merge");
207
 
 
208
 
        # compress/set
209
 
        $overlay->compress(APR::OVERLAP_TABLES_SET);
210
 
        # $add first, then $base
211
 
        ok t_cmp($overlay2->get('foo'),
212
 
                 'three',
213
 
                 "\$overlay->compress/set");
214
 
        ok t_cmp($overlay2->get('bar'),
215
 
                 'beer',
216
 
                 "\$overlay->compress/set");
217
 
    }
218
 
 
219
 
    # overlap set
220
 
    {
221
 
        my $base = APR::Table::make($r->pool, TABLE_SIZE);
222
 
        my $add  = APR::Table::make($r->pool, TABLE_SIZE);
223
 
 
224
 
        $base->set(bar => 'beer');
225
 
        $base->set(foo => 'one');
226
 
        $base->add(foo => 'two');
227
 
 
228
 
        $add->set(foo => 'three');
229
 
 
230
 
        $base->overlap($add, APR::OVERLAP_TABLES_SET);
231
 
 
232
 
        my @foo = $base->get('foo');
233
 
        my @bar = $base->get('bar');
234
 
 
235
 
        ok t_cmp(1, +@foo, 'overlap/set');
236
 
        ok t_cmp('three', $foo[0]);
237
 
        ok t_cmp('beer', $bar[0]);
238
 
    }
239
 
 
240
 
    # overlap merge
241
 
    {
242
 
        my $base = APR::Table::make($r->pool, TABLE_SIZE);
243
 
        my $add  = APR::Table::make($r->pool, TABLE_SIZE);
244
 
 
245
 
        $base->set(foo => 'one');
246
 
        $base->add(foo => 'two');
247
 
 
248
 
        $add->set(foo => 'three');
249
 
        $add->set(bar => 'beer');
250
 
 
251
 
        $base->overlap($add, APR::OVERLAP_TABLES_MERGE);
252
 
 
253
 
        my @foo = $base->get('foo');
254
 
        my @bar = $base->get('bar');
255
 
 
256
 
        ok t_cmp(1, +@foo, 'overlap/set');
257
 
        ok t_cmp('one, two, three', $foo[0]);
258
 
        ok t_cmp('beer', $bar[0]);
259
 
    }
260
 
 
261
 
    Apache::OK;
262
 
}
263
 
 
264
 
sub my_filter {
265
 
    my($key, $value) = @_;
266
 
    $filter_count++;
267
 
    unless ($key eq chr($value+97)) {
268
 
        die "arguments I received are bogus($key,$value)";
269
 
    }
270
 
    return 1;
271
 
}
272
 
 
273
 
sub my_filter_stop {
274
 
    my($key, $value) = @_;
275
 
    $filter_count++;
276
 
    unless ($key eq chr($value+97)) {
277
 
        die "arguments I received are bogus($key,$value)";
278
 
    }
279
 
    return $filter_count == int(TABLE_SIZE)/2 ? 0 : 1;
 
19
    TestAPRlib::table::test();
 
20
 
 
21
    Apache2::Const::OK;
280
22
}
281
23
 
282
24
1;