stas 2004/05/15 20:21:35
Modified: t/response/TestAPR table.pm
Log:
- tidy up the test
- remove useless tests
- add missing tests
Revision Changes Path
1.14 +201 -84 modperl-2.0/t/response/TestAPR/table.pm
Index: table.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -u -r1.13 -r1.14
--- table.pm 16 Feb 2004 19:58:18 -0000 1.13
+++ table.pm 16 May 2004 03:21:35 -0000 1.14
@@ -1,5 +1,7 @@
package TestAPR::table;
+# testing APR::Table API
+
use strict;
use warnings FATAL => 'all';
@@ -9,88 +11,148 @@
use APR::Table ();
use Apache::Const -compile => 'OK';
-use APR::Const -compile => 'OVERLAP_TABLES_MERGE';
+use APR::Const -compile => ':table';
+use constant TABLE_SIZE => 20;
my $filter_count;
-my $TABLE_SIZE = 20;
sub handler {
my $r = shift;
- my $tests = 23;
+ my $tests = 38;
plan $r, tests => $tests;
- my $table = APR::Table::make($r->pool, $TABLE_SIZE);
+ my $table = APR::Table::make($r->pool, TABLE_SIZE);
- ok (UNIVERSAL::isa($table, 'APR::Table'));
+ ok UNIVERSAL::isa($table, 'APR::Table');
- ok $table->set('foo','bar') || 1;
+ # get on non-existing key
+ {
+ # in scalar context
+ my $val = $table->get('foo');
+ ok t_cmp(undef, $val, '$val = $table->get("no_such_key")');
+
+ # in list context
+ my @val = $table->get('foo');
+ ok t_cmp(0, [EMAIL PROTECTED], '@val = $table->get("no_such_key")');
+ }
- # scalar context
- ok $table->get('foo') eq 'bar';
+ # set/add/get/copy normal values
+ {
+ $table->set(foo => 'bar');
- # add + list context
- $table->add(foo => 'tar');
- $table->add(foo => 'kar');
- my @array = $table->get('foo');
- ok @array == 3 &&
- $array[0] eq 'bar' &&
- $array[1] eq 'tar' &&
- $array[2] eq 'kar';
+ # get scalar context
+ my $val = $table->get('foo');
+ ok t_cmp('bar', $val, '$val = $table->get("foo")');
+
+ # add + get list context
+ $table->add(foo => 'tar');
+ $table->add(foo => 'kar');
+ my @val = $table->get('foo');
+ ok @val == 3 &&
+ $val[0] eq 'bar' &&
+ $val[1] eq 'tar' &&
+ $val[2] eq 'kar';
+
+ # copy
+ $table->set(too => 'boo');
+ my $table_copy = $table->copy($r->pool);
+ my $val_copy = $table->get('too');
+ ok t_cmp('boo', $val_copy, '$val = $table->get("too")');
+ my @val_copy = $table_copy->get('foo');
+ ok @val_copy == 3 &&
+ $val_copy[0] eq 'bar' &&
+ $val_copy[1] eq 'tar' &&
+ $val_copy[2] eq 'kar';
+ }
# make sure 0 comes through as 0 and not undef
- $table->set(foo => 0);
- my $zero = $table->get('foo');
+ {
+ $table->set(foo => 0);
+ my $zero = $table->get('foo');
+ ok t_cmp(0, $zero, 'table value 0 is not undef');
+ }
+
+ # unset
+ {
+ $table->set(foo => "bar");
+ $table->unset('foo');
+ ok t_cmp(undef, +$table->get('foo'), '$table->unset("foo")');
+ }
- ok defined $zero;
-
- ok t_cmp(0,
- $zero,
- 'table value 0 is not undef');
-
- ok $table->unset('foo') || 1;
-
- ok not defined $table->get('foo');
-
- for (1..$TABLE_SIZE) {
- $table->set(chr($_+97), $_);
- }
-
- #Simple filtering
- $filter_count = 0;
- $table->do("my_filter");
- ok $filter_count == $TABLE_SIZE;
-
- #Filtering aborting in the middle
- $filter_count = 0;
- $table->do("my_filter_stop");
- ok $filter_count == int($TABLE_SIZE)/2;
-
- #Filtering with anon sub
- $filter_count=0;
- $table->do(sub {
- my ($key,$value) = @_;
- $filter_count++;
- unless ($key eq chr($value+97)) {
- die "arguments I recieved are bogus($key,$value)";
+ # merge
+ {
+ $table->set( merge => '1');
+ $table->merge(merge => 'a');
+ my $val = $table->get('merge');
+ ok t_cmp("1, a", $val, 'one val $table->merge(...)');
+
+ # if there is more than one value for the same key, merge does
+ # the job only for the first value
+ $table->add( merge => '2');
+ $table->merge(merge => 'b');
+ my @val = $table->get('merge');
+ ok t_cmp("1, a, b", $val[0], '$table->merge(...)');
+ ok t_cmp("2", $val[1], 'two values $table->merge(...)');
+
+ # if the key is not found, works like set/add
+ $table->merge(miss => 'a');
+ my $val_miss = $table->get('miss');
+ ok t_cmp("a", $val_miss, 'no value $table->merge(...)');
+ }
+
+ # clear
+ {
+ $table->set(foo => 0);
+ $table->set(bar => 1);
+ $table->clear();
+ # t_cmp forces scalar context on get
+ ok t_cmp(undef, $table->get('foo'), '$table->clear');
+ ok t_cmp(undef, $table->get('bar'), '$table->clear');
+ }
+
+ # filtering
+ {
+ for (1..TABLE_SIZE) {
+ $table->set(chr($_+97), $_);
}
- return 1;
- });
- ok $filter_count == $TABLE_SIZE;
+ # Simple filtering
+ $filter_count = 0;
+ $table->do("my_filter");
+ ok t_cmp(TABLE_SIZE, $filter_count);
+
+ # Filtering aborting in the middle
+ $filter_count = 0;
+ $table->do("my_filter_stop");
+ ok t_cmp(int(TABLE_SIZE)/2, $filter_count) ;
- $filter_count = 0;
- $table->do("my_filter", "c", "b", "e");
- ok $filter_count == 3;
+ # Filtering with anon sub
+ $filter_count=0;
+ $table->do(sub {
+ my ($key,$value) = @_;
+ $filter_count++;
+ unless ($key eq chr($value+97)) {
+ die "arguments I recieved are bogus($key,$value)";
+ }
+ return 1;
+ });
+
+ ok t_cmp(TABLE_SIZE, $filter_count, "table size");
+
+ $filter_count = 0;
+ $table->do("my_filter", "c", "b", "e");
+ ok t_cmp(3, $filter_count, "table size");
+ }
#Tied interface
{
- my $table = APR::Table::make($r->pool, $TABLE_SIZE);
+ my $table = APR::Table::make($r->pool, TABLE_SIZE);
- ok (UNIVERSAL::isa($table, 'HASH'));
+ ok UNIVERSAL::isa($table, 'HASH');
- ok (UNIVERSAL::isa($table, 'HASH')) && tied(%$table);
+ ok UNIVERSAL::isa($table, 'HASH') && tied(%$table);
ok $table->{'foo'} = 'bar';
@@ -101,7 +163,7 @@
ok not exists $table->{'foo'};
- for (1..$TABLE_SIZE) {
+ for (1..TABLE_SIZE) {
$table->{chr($_+97)} = $_;
}
@@ -109,42 +171,98 @@
foreach my $key (sort keys %$table) {
my_filter($key, $table->{$key});
}
- ok $filter_count == $TABLE_SIZE;
+ ok $filter_count == TABLE_SIZE;
}
- # overlay and compress routines
- my $base = APR::Table::make($r->pool, $TABLE_SIZE);
- my $add = APR::Table::make($r->pool, $TABLE_SIZE);
+ # overlap and compress routines
+ {
+ my $base = APR::Table::make($r->pool, TABLE_SIZE);
+ my $add = APR::Table::make($r->pool, TABLE_SIZE);
+
+ $base->set(foo => 'one');
+ $base->add(foo => 'two');
- $base->set(foo => 'one');
- $base->add(foo => 'two');
+ $add->set(foo => 'three');
+ $add->set(bar => 'beer');
- $add->add(foo => 'three');
- $add->add(bar => 'beer');
+ my $overlay = $base->overlay($add, $r->pool);
+
+ my @foo = $overlay->get('foo');
+ my @bar = $overlay->get('bar');
+
+ ok t_cmp(3, [EMAIL PROTECTED]);
+ ok t_cmp('beer', $bar[0]);
+
+ my $overlay2 = $overlay->copy($r->pool);
+
+ # compress/merge
+ $overlay->compress(APR::OVERLAP_TABLES_MERGE);
+ # $add first, then $base
+ ok t_cmp($overlay->get('foo'),
+ 'three, one, two',
+ "\$overlay->compress/merge");
+ ok t_cmp($overlay->get('bar'),
+ 'beer',
+ "\$overlay->compress/merge");
+
+ # compress/set
+ $overlay->compress(APR::OVERLAP_TABLES_SET);
+ # $add first, then $base
+ ok t_cmp($overlay2->get('foo'),
+ 'three',
+ "\$overlay->compress/set");
+ ok t_cmp($overlay2->get('bar'),
+ 'beer',
+ "\$overlay->compress/set");
+ }
- my $overlay = $base->overlay($add, $r->pool);
+ # overlap set
+ {
+ my $base = APR::Table::make($r->pool, TABLE_SIZE);
+ my $add = APR::Table::make($r->pool, TABLE_SIZE);
- my @foo = $overlay->get('foo');
- my @bar = $overlay->get('bar');
+ $base->set(bar => 'beer');
+ $base->set(foo => 'one');
+ $base->add(foo => 'two');
- ok @foo == 3;
- ok $bar[0] eq 'beer';
+ $add->set(foo => 'three');
- $overlay->compress(APR::OVERLAP_TABLES_MERGE);
+ $base->overlap($add, APR::OVERLAP_TABLES_SET);
- # $add first, then $base
- ok t_cmp($overlay->get('foo'),
- 'three, one, two',
- "\$overlay->compress");
- ok t_cmp($overlay->get('bar'),
- 'beer',
- "\$overlay->compress");
+ my @foo = $base->get('foo');
+ my @bar = $base->get('bar');
+
+ ok t_cmp(1, [EMAIL PROTECTED], 'overlap/set');
+ ok t_cmp('three', $foo[0]);
+ ok t_cmp('beer', $bar[0]);
+ }
+
+ # overlap merge
+ {
+ my $base = APR::Table::make($r->pool, TABLE_SIZE);
+ my $add = APR::Table::make($r->pool, TABLE_SIZE);
+
+ $base->set(foo => 'one');
+ $base->add(foo => 'two');
+
+ $add->set(foo => 'three');
+ $add->set(bar => 'beer');
+
+ $base->overlap($add, APR::OVERLAP_TABLES_MERGE);
+
+ my @foo = $base->get('foo');
+ my @bar = $base->get('bar');
+
+ ok t_cmp(1, [EMAIL PROTECTED], 'overlap/set');
+ ok t_cmp('one, two, three', $foo[0]);
+ ok t_cmp('beer', $bar[0]);
+ }
Apache::OK;
}
sub my_filter {
- my ($key,$value) = @_;
+ my($key, $value) = @_;
$filter_count++;
unless ($key eq chr($value+97)) {
die "arguments I received are bogus($key,$value)";
@@ -153,13 +271,12 @@
}
sub my_filter_stop {
- my ($key,$value) = @_;
+ my($key, $value) = @_;
$filter_count++;
unless ($key eq chr($value+97)) {
die "arguments I received are bogus($key,$value)";
}
- return 0 if ($filter_count == int($TABLE_SIZE)/2);
- return 1;
+ return $filter_count == int(TABLE_SIZE)/2 ? 0 : 1;
}
1;
