Here's a diff for making the code for the APR::Table
test run from both t/apr/ and t/apr-ext/.
=========================================================
Index: t/apr-ext/table.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/apr-ext/table.t,v
retrieving revision 1.1
diff -u -r1.1 table.t
--- t/apr-ext/table.t 16 Jun 2004 03:55:48 -0000 1.1
+++ t/apr-ext/table.t 14 Jul 2004 02:31:19 -0000
@@ -1,15 +1,10 @@
+use strict;
+use warnings FATAL => 'all';
use Apache::Test;
-use blib;
-use Apache2;
+use lib q(t/lib);
+require TestAPRlib::table;
-plan tests => 1;
+plan tests => 38;
-require APR;
-require APR::Table;
-require APR::Pool;
-
-my $p = APR::Pool->new;
-
-my $table = APR::Table::make($p, 2);
-ok ref $table eq 'APR::Table';
+TestAPRlib::table::test();
Index: t/lib/TestAPRlib/table.pm
===================================================================
RCS file: t/lib/TestAPRlib/table.pm
diff -N t/lib/TestAPRlib/table.pm
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ t/lib/TestAPRlib/table.pm 14 Jul 2004 02:31:19 -0000
@@ -0,0 +1,276 @@
+package TestAPRlib::table;
+
+# testing APR::Table API
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+
+use APR::Table ();
+use APR::Pool ();
+
+use APR::Const -compile => ':table';
+
+use constant TABLE_SIZE => 20;
+my $filter_count;
+
+sub test {
+
+ my $pool = APR::Pool->new();
+ my $table = APR::Table::make($pool, TABLE_SIZE);
+
+ ok UNIVERSAL::isa($table, 'APR::Table');
+
+ # get on non-existing key
+ {
+ # in scalar context
+ my $val = $table->get('foo');
+ ok t_cmp($val, undef, '$val = $table->get("no_such_key")');
+
+ # in list context
+ my @val = $table->get('foo');
+ ok t_cmp([EMAIL PROTECTED], 0, '@val = $table->get("no_such_key")');
+ }
+
+ # set/add/get/copy normal values
+ {
+ $table->set(foo => 'bar');
+
+ # get scalar context
+ my $val = $table->get('foo');
+ ok t_cmp($val, 'bar', '$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($pool);
+ my $val_copy = $table->get('too');
+ ok t_cmp($val_copy, 'boo', '$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');
+ ok t_cmp($zero, 0, 'table value 0 is not undef');
+ }
+
+ # unset
+ {
+ $table->set(foo => "bar");
+ $table->unset('foo');
+ ok t_cmp(+$table->get('foo'), undef, '$table->unset("foo")');
+ }
+
+ # merge
+ {
+ $table->set( merge => '1');
+ $table->merge(merge => 'a');
+ my $val = $table->get('merge');
+ ok t_cmp($val, "1, a", '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($val[0], "1, a, b", '$table->merge(...)');
+ ok t_cmp($val[1], "2", '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($val_miss, "a", '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($table->get('foo'), undef, '$table->clear');
+ ok t_cmp($table->get('bar'), undef, '$table->clear');
+ }
+
+ # filtering
+ {
+ for (1..TABLE_SIZE) {
+ $table->set(chr($_+97), $_);
+ }
+
+ # Simple filtering
+ $filter_count = 0;
+ $table->do("my_filter");
+ ok t_cmp($filter_count, TABLE_SIZE);
+
+ # Filtering aborting in the middle
+ $filter_count = 0;
+ $table->do("my_filter_stop");
+ ok t_cmp($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)";
+ }
+ return 1;
+ });
+
+ ok t_cmp($filter_count, TABLE_SIZE, "table size");
+
+ $filter_count = 0;
+ $table->do("my_filter", "c", "b", "e");
+ ok t_cmp($filter_count, 3, "table size");
+ }
+
+ #Tied interface
+ {
+ my $table = APR::Table::make($pool, TABLE_SIZE);
+
+ ok UNIVERSAL::isa($table, 'HASH');
+
+ ok UNIVERSAL::isa($table, 'HASH') && tied(%$table);
+
+ ok $table->{'foo'} = 'bar';
+
+ # scalar context
+ ok $table->{'foo'} eq 'bar';
+
+ ok delete $table->{'foo'} || 1;
+
+ ok not exists $table->{'foo'};
+
+ for (1..TABLE_SIZE) {
+ $table->{chr($_+97)} = $_;
+ }
+
+ $filter_count = 0;
+ foreach my $key (sort keys %$table) {
+ my_filter($key, $table->{$key});
+ }
+ ok $filter_count == TABLE_SIZE;
+ }
+
+ # overlap and compress routines
+ {
+ my $base = APR::Table::make($pool, TABLE_SIZE);
+ my $add = APR::Table::make($pool, TABLE_SIZE);
+
+ $base->set(foo => 'one');
+ $base->add(foo => 'two');
+
+ $add->set(foo => 'three');
+ $add->set(bar => 'beer');
+
+ my $overlay = $base->overlay($add, $pool);
+
+ my @foo = $overlay->get('foo');
+ my @bar = $overlay->get('bar');
+
+ ok t_cmp([EMAIL PROTECTED], 3);
+ ok t_cmp($bar[0], 'beer');
+
+ my $overlay2 = $overlay->copy($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");
+ }
+
+ # overlap set
+ {
+ my $base = APR::Table::make($pool, TABLE_SIZE);
+ my $add = APR::Table::make($pool, TABLE_SIZE);
+
+ $base->set(bar => 'beer');
+ $base->set(foo => 'one');
+ $base->add(foo => 'two');
+
+ $add->set(foo => 'three');
+
+ $base->overlap($add, APR::OVERLAP_TABLES_SET);
+
+ my @foo = $base->get('foo');
+ my @bar = $base->get('bar');
+
+ ok t_cmp([EMAIL PROTECTED], 1, 'overlap/set');
+ ok t_cmp($foo[0], 'three');
+ ok t_cmp($bar[0], 'beer');
+ }
+
+ # overlap merge
+ {
+ my $base = APR::Table::make($pool, TABLE_SIZE);
+ my $add = APR::Table::make($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([EMAIL PROTECTED], 1, 'overlap/set');
+ ok t_cmp($foo[0], 'one, two, three');
+ ok t_cmp($bar[0], 'beer');
+ }
+}
+
+sub my_filter {
+ my($key, $value) = @_;
+ $filter_count++;
+ unless ($key eq chr($value+97)) {
+ die "arguments I received are bogus($key,$value)";
+ }
+ return 1;
+}
+
+sub my_filter_stop {
+ my($key, $value) = @_;
+ $filter_count++;
+ unless ($key eq chr($value+97)) {
+ die "arguments I received are bogus($key,$value)";
+ }
+ return $filter_count == int(TABLE_SIZE)/2 ? 0 : 1;
+}
+
+1;
Index: t/response/TestAPR/table.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/table.pm,v
retrieving revision 1.15
diff -u -r1.15 table.pm
--- t/response/TestAPR/table.pm 8 Jul 2004 06:06:33 -0000 1.15
+++ t/response/TestAPR/table.pm 14 Jul 2004 02:31:19 -0000
@@ -6,15 +6,10 @@
use warnings FATAL => 'all';
use Apache::Test;
-use Apache::TestUtil;
-
-use APR::Table ();
-
use Apache::Const -compile => 'OK';
-use APR::Const -compile => ':table';
-use constant TABLE_SIZE => 20;
-my $filter_count;
+use lib q(t/lib);
+require TestAPRlib::table;
sub handler {
my $r = shift;
@@ -23,260 +18,9 @@
plan $r, tests => $tests;
- my $table = APR::Table::make($r->pool, TABLE_SIZE);
-
- ok UNIVERSAL::isa($table, 'APR::Table');
-
- # get on non-existing key
- {
- # in scalar context
- my $val = $table->get('foo');
- ok t_cmp($val, undef, '$val = $table->get("no_such_key")');
-
- # in list context
- my @val = $table->get('foo');
- ok t_cmp([EMAIL PROTECTED], 0, '@val = $table->get("no_such_key")');
- }
-
- # set/add/get/copy normal values
- {
- $table->set(foo => 'bar');
-
- # get scalar context
- my $val = $table->get('foo');
- ok t_cmp($val, 'bar', '$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($val_copy, 'boo', '$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');
- ok t_cmp($zero, 0, 'table value 0 is not undef');
- }
-
- # unset
- {
- $table->set(foo => "bar");
- $table->unset('foo');
- ok t_cmp(+$table->get('foo'), undef, '$table->unset("foo")');
- }
-
- # merge
- {
- $table->set( merge => '1');
- $table->merge(merge => 'a');
- my $val = $table->get('merge');
- ok t_cmp($val, "1, a", '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($val[0], "1, a, b", '$table->merge(...)');
- ok t_cmp($val[1], "2", '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($val_miss, "a", '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($table->get('foo'), undef, '$table->clear');
- ok t_cmp($table->get('bar'), undef, '$table->clear');
- }
-
- # filtering
- {
- for (1..TABLE_SIZE) {
- $table->set(chr($_+97), $_);
- }
-
- # Simple filtering
- $filter_count = 0;
- $table->do("my_filter");
- ok t_cmp($filter_count, TABLE_SIZE);
-
- # Filtering aborting in the middle
- $filter_count = 0;
- $table->do("my_filter_stop");
- ok t_cmp($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)";
- }
- return 1;
- });
-
- ok t_cmp($filter_count, TABLE_SIZE, "table size");
-
- $filter_count = 0;
- $table->do("my_filter", "c", "b", "e");
- ok t_cmp($filter_count, 3, "table size");
- }
-
- #Tied interface
- {
- my $table = APR::Table::make($r->pool, TABLE_SIZE);
-
- ok UNIVERSAL::isa($table, 'HASH');
-
- ok UNIVERSAL::isa($table, 'HASH') && tied(%$table);
-
- ok $table->{'foo'} = 'bar';
-
- # scalar context
- ok $table->{'foo'} eq 'bar';
-
- ok delete $table->{'foo'} || 1;
-
- ok not exists $table->{'foo'};
-
- for (1..TABLE_SIZE) {
- $table->{chr($_+97)} = $_;
- }
-
- $filter_count = 0;
- foreach my $key (sort keys %$table) {
- my_filter($key, $table->{$key});
- }
- ok $filter_count == 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');
-
- $add->set(foo => 'three');
- $add->set(bar => 'beer');
-
- my $overlay = $base->overlay($add, $r->pool);
-
- my @foo = $overlay->get('foo');
- my @bar = $overlay->get('bar');
-
- ok t_cmp([EMAIL PROTECTED], 3);
- ok t_cmp($bar[0], 'beer');
-
- 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");
- }
-
- # overlap set
- {
- my $base = APR::Table::make($r->pool, TABLE_SIZE);
- my $add = APR::Table::make($r->pool, TABLE_SIZE);
-
- $base->set(bar => 'beer');
- $base->set(foo => 'one');
- $base->add(foo => 'two');
-
- $add->set(foo => 'three');
-
- $base->overlap($add, APR::OVERLAP_TABLES_SET);
-
- my @foo = $base->get('foo');
- my @bar = $base->get('bar');
-
- ok t_cmp([EMAIL PROTECTED], 1, 'overlap/set');
- ok t_cmp($foo[0], 'three');
- ok t_cmp($bar[0], 'beer');
- }
-
- # 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([EMAIL PROTECTED], 1, 'overlap/set');
- ok t_cmp($foo[0], 'one, two, three');
- ok t_cmp($bar[0], 'beer');
- }
+ TestAPRlib::table::test();
Apache::OK;
-}
-
-sub my_filter {
- my($key, $value) = @_;
- $filter_count++;
- unless ($key eq chr($value+97)) {
- die "arguments I received are bogus($key,$value)";
- }
- return 1;
-}
-
-sub my_filter_stop {
- my($key, $value) = @_;
- $filter_count++;
- unless ($key eq chr($value+97)) {
- die "arguments I received are bogus($key,$value)";
- }
- return $filter_count == int(TABLE_SIZE)/2 ? 0 : 1;
}
1;
=================================================================
--
best regards,
randy
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
