Mailing-List: contact modperl-cvs-help@perl.apache.org; run by ezmlm
Precedence: bulk
Reply-To: dev@perl.apache.org
Date: 15 Jul 2004 01:32:26 -0000
Message-ID: <20040715013226.72581.qmail@minotaur.apache.org>
From: randyk@apache.org
To: modperl-2.0-cvs@apache.org
Subject: 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;