You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by ra...@apache.org on 2004/07/15 03:32:26 UTC
cvs commit: modperl-2.0/t/response/TestAPR table.pm
randyk 2004/07/14 18:32:26
Modified: t/apr-ext table.t
t/response/TestAPR table.pm
Added: t/lib/TestAPRlib table.pm
Log:
put common tests for APR::Table under t/lib/TestAPRlib/table.pm,
to be run from both t/apr-ext/table.t and t/apr/table.t.
Revision Changes Path
1.2 +5 -11 modperl-2.0/t/apr-ext/table.t
Index: table.t
===================================================================
RCS file: /home/cvs/modperl-2.0/t/apr-ext/table.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- table.t 16 Jun 2004 03:55:48 -0000 1.1
+++ table.t 15 Jul 2004 01:32:26 -0000 1.2
@@ -1,15 +1,9 @@
+use strict;
+use warnings FATAL => 'all';
use Apache::Test;
-use blib;
-use Apache2;
+use TestAPRlib::table;
-plan tests => 1;
+plan tests => TestAPRlib::table::number();
-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();
1.1 modperl-2.0/t/lib/TestAPRlib/table.pm
Index: table.pm
===================================================================
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;
}
sub number {
return 38;
}
1;
1.16 +3 -261 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.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- table.pm 8 Jul 2004 06:06:33 -0000 1.15
+++ table.pm 15 Jul 2004 01:32:26 -0000 1.16
@@ -6,277 +6,19 @@
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 TestAPRlib::table;
sub handler {
my $r = shift;
- my $tests = 38;
-
+ my $tests = TestAPRlib::table::number();
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;
Re: cvs commit: modperl-2.0/t/response/TestAPR table.pm
Posted by Stas Bekman <st...@stason.org>.
randyk@apache.org wrote:
> randyk 2004/07/14 18:32:26
>
> Modified: t/apr-ext table.t
> t/response/TestAPR table.pm
> Added: t/lib/TestAPRlib table.pm
> Log:
> put common tests for APR::Table under t/lib/TestAPRlib/table.pm,
> to be run from both t/apr-ext/table.t and t/apr/table.t.
>
> Revision Changes Path
> 1.2 +5 -11 modperl-2.0/t/apr-ext/table.t
>
> Index: table.t
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/t/apr-ext/table.t,v
> retrieving revision 1.1
> retrieving revision 1.2
> diff -u -r1.1 -r1.2
> --- table.t 16 Jun 2004 03:55:48 -0000 1.1
> +++ table.t 15 Jul 2004 01:32:26 -0000 1.2
> @@ -1,15 +1,9 @@
> +use strict;
> +use warnings FATAL => 'all';
> use Apache::Test;
>
> -use blib;
> -use Apache2;
> +use TestAPRlib::table;
>
> -plan tests => 1;
> +plan tests => TestAPRlib::table::number();
can this please be something else than number()? It's not quite
intuitive, IMHO. How about ::tests() or ::num_of_tests()?
> Index: table.pm
> ===================================================================
> package TestAPRlib::table;
> use constant TABLE_SIZE => 20;
> my $filter_count;
shouldn't it now become a global in that package?
and at least it needs to be reset at the beginning of 'sub test'.
otherwise if you run the same test twice in the same interpreter you may
have problems if it doesn't get reset.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
Re: cvs commit: modperl-2.0/t/response/TestAPR table.pm
Posted by Stas Bekman <st...@stason.org>.
randyk@apache.org wrote:
> randyk 2004/07/14 18:32:26
>
> Modified: t/apr-ext table.t
> t/response/TestAPR table.pm
> Added: t/lib/TestAPRlib table.pm
> Log:
> put common tests for APR::Table under t/lib/TestAPRlib/table.pm,
> to be run from both t/apr-ext/table.t and t/apr/table.t.
>
> Revision Changes Path
> 1.2 +5 -11 modperl-2.0/t/apr-ext/table.t
>
> Index: table.t
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/t/apr-ext/table.t,v
> retrieving revision 1.1
> retrieving revision 1.2
> diff -u -r1.1 -r1.2
> --- table.t 16 Jun 2004 03:55:48 -0000 1.1
> +++ table.t 15 Jul 2004 01:32:26 -0000 1.2
> @@ -1,15 +1,9 @@
> +use strict;
> +use warnings FATAL => 'all';
> use Apache::Test;
>
> -use blib;
> -use Apache2;
> +use TestAPRlib::table;
>
> -plan tests => 1;
> +plan tests => TestAPRlib::table::number();
can this please be something else than number()? It's not quite
intuitive, IMHO. How about ::tests() or ::num_of_tests()?
> Index: table.pm
> ===================================================================
> package TestAPRlib::table;
> use constant TABLE_SIZE => 20;
> my $filter_count;
shouldn't it now become a global in that package?
and at least it needs to be reset at the beginning of 'sub test'.
otherwise if you run the same test twice in the same interpreter you may
have problems if it doesn't get reset.
--
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org