perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/t/response/TestAPR table.pm
Date Sun, 16 May 2004 03:21:35 GMT
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, +@val, '@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, +@foo);
  +        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, +@foo, '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, +@foo, '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;
  
  
  

Mime
View raw message