Please take our Survey
logo       
<prev   next>

Choosing A Webhost:
A web hosting service is a type of Internet hosting service that allows individuals and organizations to provide their own website accessible via the World Wide Web. Web hosts are companies that provide space on a server they own for use by their clients as well as providing Internet connectivity, typically in a data center. Web hosts can also provide data center space and connectivity to the Internet for servers they do not own to be located in their data center, called colocation. more...

[mp2] apr/apr-ext table test: msg#00203

apache.mod-perl.devel

Subject: [mp2] apr/apr-ext table test

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(+@val, 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(+@foo, 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(+@foo, 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(+@foo, 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(+@val, 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(+@foo, 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(+@foo, 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(+@foo, 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
<Prev in Thread] Current Thread [Next in Thread>
Previous by Date:  [mp2] apr/apr-ext constants test, Randy Kobes
Next by Date:  Re: [mp2] apr/apr-ext constants test, Stas Bekman
Previous by Thread:  [mp2] apr/apr-ext constants test, Randy Kobes
Next by Thread:  Re: [mp2] apr/apr-ext table test, Stas Bekman
Indexes:  [Date] [Thread] [Top] [All Lists]

Google Custom Search
Recently Viewed:
solaris.opensol...    editors.vim/200...    web.turbogears....    jakarta.ant.dev...    mathematics.max...    text.unicode.ge...    lang.ruby.core/...    xfce.announce/2...    network.centeri...    php.cvs.pear/20...    user-groups.lin...    kde.devel.quant...    file-systems.ar...    redhat.fedora.t...    apple.fink.auto...    gnome.orbit.gen...    qplus.devel/200...    culture.transpo...    video.dri.user/...    operators.nanog...   
Home | advertise | OSDir is an inevitable website. super tiny logo

Free Magazines

Cisco News
Receive a free quarterly e-newsletter with exclusive articles on how Cisco IT uses its own products and solutions to enable the business.
subscribe

Systems Management News, the newspaper for IT systems administration and data center managers! Each issue of Systems Management News is chock-full of news and analysis to help you understand what's happening in your field.
subscribe

The Enterprise Newsweekly eWeek is the essential technology information source for builders of e-business.
subscribe

Oracle Magazine Oracle Magazine contains technology strategy articles, sample code, tips, Oracle and partner news, how to articles for developers and DBAs, and more. Oracle (NASDAQ: ORCL) is the world's largest enterprise software company.
subscribe

Total Telecom Total Telecom is "The Economist of the communications industry".
subscribe

Navigation