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/TestApache compat2.pm compat.pm
Date Mon, 21 Jan 2002 08:32:46 GMT
stas        02/01/21 00:32:46

  Modified:    t/apache compat.t
               t/response/TestApache compat.pm
  Added:       t/response/TestApache compat2.pm
  Log:
  - split compat.pm test into compat.pm (for client side validation) and
  compat2.pm (for sub-tests that can be completed on the server side).
  - 2 out of 3 todo tests now pass with recent patches to
  set_content_length, update_mtime, ap_set_last_modified
  
  Revision  Changes    Path
  1.10      +1 -37     modperl-2.0/t/apache/compat.t
  
  Index: compat.t
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/apache/compat.t,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- compat.t	20 Dec 2001 03:54:40 -0000	1.9
  +++ compat.t	21 Jan 2002 08:32:46 -0000	1.10
  @@ -6,7 +6,7 @@
   use Apache::TestUtil;
   use Apache::TestRequest;
   
  -plan tests => 31, todo => [25, 28, 30];
  +plan tests => 3;
   
   my $location = "/TestApache::compat";
   
  @@ -41,48 +41,12 @@
           );
   }
   
  -# Apache->gensym
  -{
  -    my @data = (test => 'gensym');
  -    my $data = GET_BODY query(@data) || '';
  -    ok_nok($data);
  -}
  -
  -# header_in
  -t_header('in','get_scalar',q{scalar ctx: $r->header_in($key)});
  -t_header('in','get_list',  q{list ctx: $r->header_in($key)});
  -t_header('in','set',       q{$r->header_in($key => $val)});
  -t_header('in','unset',     q{$r->header_in($key => undef)});
  -
  -# header_out
  -t_header('out','get_scalar',q{scalar ctx: $r->header_out($key)});
  -t_header('out','get_list',  q{list ctx: $r->header_out($key)});
  -t_header('out','set',       q{$r->header_out($key => $val)});
  -t_header('out','unset',     q{$r->header_out($key => undef)});
  -
  -# Apache::File
  -{
  -    my @data = (test => 'Apache::File');
  -    my $data = GET_BODY query(@data) || '';
  -    ok_nok($data);
  -}
  -
   
   ### helper subs ###
   sub query {
       my(%args) = (@_ % 2) ? %{+shift} : @_;
       "$location?" . join '&', map { "$_=$args{$_}" } keys %args;
   }
  -
  -sub t_header {
  -    my ($way, $what, $comment) = @_;
  -    ok t_cmp(
  -        "ok",
  -        GET_BODY(query(test => 'header', way => $way, what => $what)),
  -        $comment
  -        );
  -}
  -
   
   # accepts multiline var where, the lines matching:
   # ^ok\n$  results in ok(1)
  
  
  
  1.10      +3 -140    modperl-2.0/t/response/TestApache/compat.pm
  
  Index: compat.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestApache/compat.pm,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- compat.pm	20 Dec 2001 01:31:24 -0000	1.9
  +++ compat.pm	21 Jan 2002 08:32:46 -0000	1.10
  @@ -1,5 +1,8 @@
   package TestApache::compat;
   
  +# these Apache::compat tests are all run on the server
  +# side and validated on the client side. See also TestApache::compat2.
  +
   use strict;
   use warnings FATAL => 'all';
   
  @@ -33,146 +36,6 @@
   
       if ($data{test} eq 'content' || $data{test} eq 'args') {
           $r->print("test $data{test}");
  -    }
  -    elsif ($data{test} eq 'gensym') {
  -        debug "Apache->gensym";
  -        my $fh = Apache->gensym;
  -        ok ref $fh eq 'GLOB';
  -    }
  -    elsif ($data{test} eq 'header') {
  -        my $way      = $data{way};
  -        my $sub      = "header_$way";
  -        my $sub_good = "headers_$way";
  -        if ($data{what} eq 'get_scalar') {
  -            # get in scalar ctx
  -            my $key;
  -            if ($way eq 'in') {
  -                $key = "user-agent"; # should exist with lwp
  -            }
  -            else {
  -                # outgoing headers aren't set yet, so we set one
  -                $key = "X-barabara";
  -                $r->$sub_good->set($key, $key x 2);
  -            }
  -            my $exp = $r->$sub_good->get($key);
  -            my $got = $r->$sub($key);
  -            $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
  -        }
  -        elsif ($data{what} eq 'get_list') {
  -            # get in list ctx
  -            my $key = $data{test};
  -            my @exp = qw(foo bar);
  -            $r->$sub_good->add($key => $_) for @exp;
  -            my @got = $r->$sub($key);
  -            $r->print(t_is_equal(\@exp, \@got) ? 'ok' : 'nok');
  -        }
  -        elsif ($data{what} eq 'set') {
  -            # set
  -            my $key = $data{test};
  -            my $exp = $key x 2;
  -            $r->$sub($key => $exp);
  -            my $got = $r->$sub($key);
  -            $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
  -        }
  -        elsif ($data{what} eq 'unset') {
  -            # unset
  -            my $key = $data{test};
  -            my $exp = undef;
  -            $r->$sub($key => $exp);
  -            my $got = $r->$sub($key);
  -            $r->print(t_is_equal($exp, $got) ? 'ok' : 'nok');
  -        }
  -    }
  -    elsif ($data{test} eq 'Apache::File') {
  -        require Apache::File;
  -        my $file = $vars->{t_conf_file};
  -
  -        debug "new Apache::File file object";
  -        ok my $fh = Apache::File->new;
  -
  -        debug "open itself";
  -        if ($fh->open($file)) {
  -            ok 1;
  -            debug "read from file";
  -            my $read = <$fh>;
  -            ok $read;
  -            debug "close file";
  -            ok $fh->close;
  -        }
  -        else {
  -            debug "open $file failed: $!";
  -            ok 0;
  -            debug "ok: cannot read from the closed fh";
  -            ok 1;
  -            debug "ok: close file should fail, wasn't opened";
  -            ok !$fh->close;
  -        }
  -
  -        debug "open non-exists";
  -        ok !$fh->open("$file.nochance");
  -
  -        debug "new+open";
  -        if (my $fh = Apache::File->new($file)) {
  -            ok 1;
  -            $fh->close;
  -        }
  -        else {
  -            ok 0;
  -        }
  -
  -        debug "new+open non-exists";
  -        ok !Apache::File->new("$file.yeahright");
  -
  -        # tmpfile
  -        my ($tmpfile, $tmpfh) = Apache::File->tmpfile;
  -
  -        debug "open tmpfile fh";
  -        ok $tmpfh;
  -
  -        debug "open tmpfile name";
  -        ok $tmpfile;
  -
  -        debug "write/read from tmpfile";
  -        my $write = "test $$";
  -        print $tmpfh $write;
  -        seek $tmpfh, 0, 0;
  -        my $read = <$tmpfh>;
  -        ok $read eq $write;
  -
  -        debug "\$r->discard_request_body";
  -        ok $r->discard_request_body == Apache::OK;
  -
  -        debug "\$r->meets_conditions";
  -        ok $r->meets_conditions == Apache::OK;
  -
  -        debug "\$r->set_content_length";
  -        # XXX: broken
  -        #$r->set_content_length();
  -        ok 0;
  -        $r->set_content_length(10);
  -        my $cl_header = $r->headers_out->{"Content-length"} || '';
  -        ok $cl_header == 10;
  -
  -        # XXX: how to test etag?
  -        debug "\$r->set_etag";
  -        $r->set_etag;
  -        ok 1;
  -
  -        debug "\$r->update_mtime/\$r->mtime";
  -        # XXX: broken
  -        # $r->update_mtime; # just check that it's valid
  -        ok 0;
  -        my $time = time;
  -        $r->update_mtime($time);
  -        ok $r->mtime == $time;
  -
  -        debug "\$r->set_last_modified";
  -        # XXX: broken
  -        # $r->set_last_modified($time);
  -        ok 0;
  -        $time = time;
  -        $r->set_last_modified();
  -        ok $r->mtime == $time;
       }
   
       Apache::OK;
  
  
  
  1.1                  modperl-2.0/t/response/TestApache/compat2.pm
  
  Index: compat2.pm
  ===================================================================
  package TestApache::compat2;
  
  # these Apache::compat tests are all run and validated on the server
  # side. See also TestApache::compat.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestUtil;
  use Apache::Test;
  
  use Apache::compat ();
  use Apache::Constants qw(OK);
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 28, todo => [23];
  
      $r->send_http_header('text/plain');
  
      my $cfg = Apache::Test::config();
      my $vars = $cfg->{vars};
  
      my $fh = Apache->gensym;
      ok t_cmp('GLOB', ref($fh), "Apache->gensym");
  
      # test header_in and header_out
      for my $way (qw(in out)) {
          my $sub_test = "header_$way";
          my $sub_good = "headers_$way";
          my $key = 'header-test';
  
          # scalar context
          {
              my $key;
              if ($way eq 'in') {
                  $key = "user-agent"; # should exist with lwp
              }
              else {
                  # outgoing headers aren't set yet, so we set one
                  $key = "X-barabara";
                  $r->$sub_good->set($key, $key x 2);
              }
  
              ok t_cmp($r->$sub_good->get($key),
                       $r->$sub_test($key),
                       "\$r->$sub_test in scalar context");
          }
  
          # list context
          {
              my @exp = qw(foo bar);
              $r->$sub_good->add($key => $_) for @exp;
              ok t_cmp(\@exp,
                       [ $r->$sub_test($key) ],
                       "\$r->$sub_test in list context");
          }
  
          # set
          {
              my $exp = $key x 2;
              $r->$sub_test($key => $exp);
              my $got = $r->$sub_test($key);
              ok t_cmp($exp, $got, "\$r->$sub_test set()");
          }
  
          # unset
          {
              my $exp = undef;
              $r->$sub_test($key => $exp);
              my $got = $r->$sub_test($key);
              ok t_cmp($exp, $got, "\$r->$sub_test unset()");
          }
      }
  
      # Apache::File
      {
          require Apache::File;
          my $file = $vars->{t_conf_file};
  
          t_debug "new Apache::File file object";
          ok my $fh = Apache::File->new;
  
          t_debug "open itself";
          if ($fh->open($file)) {
              ok 1;
              t_debug "read from file";
              my $read = <$fh>;
              ok $read;
              t_debug "close file";
              ok $fh->close;
          }
          else {
              t_debug "open $file failed: $!";
              ok 0;
              t_debug "ok: cannot read from the closed fh";
              ok 1;
              t_debug "ok: close file should fail, wasn't opened";
              ok !$fh->close;
          }
  
          t_debug "open non-exists";
          ok !$fh->open("$file.nochance");
  
          t_debug "new+open";
          if (my $fh = Apache::File->new($file)) {
              ok 1;
              $fh->close;
          }
          else {
              ok 0;
          }
  
          t_debug "new+open non-exists";
          ok !Apache::File->new("$file.yeahright");
  
          # tmpfile
          my ($tmpfile, $tmpfh) = Apache::File->tmpfile;
  
          t_debug "open tmpfile fh";
          ok $tmpfh;
  
          t_debug "open tmpfile name";
          ok $tmpfile;
  
          my $write = "test $$";
          print $tmpfh $write;
          seek $tmpfh, 0, 0;
          ok t_cmp($write, scalar(<$tmpfh>), "write/read from tmpfile");
  
          ok t_cmp(Apache::OK,
                   $r->discard_request_body,
                   "\$r->discard_request_body");
  
          ok t_cmp(Apache::OK,
                   $r->meets_conditions,
                   "\$r->meets_conditions");
  
          my $csize = 10;
          $r->set_content_length($csize);
          ok t_cmp($csize,
                   $r->headers_out->{"Content-length"},
                   "\$r->set_content_length($csize) w/ setting explicit size");
  
          $r->set_content_length();
          ok t_cmp(0, # XXX: $r->finfo->csize is not available yet
                   $r->headers_out->{"Content-length"},
                   "\$r->set_content_length() w/o setting explicit size");
  
          # XXX: how to test etag?
          t_debug "\$r->set_etag";
          $r->set_etag;
          ok 1;
  
          # $r->update_mtime
          t_debug "\$r->update_mtime()";
          $r->update_mtime; # just check that it's valid
          ok 1;
  
          my $time = time;
          $r->update_mtime($time);
          ok t_cmp($time, $r->mtime, "\$r->update_mtime(\$time)/\$r->mtime");
  
          # $r->set_last_modified
          $r->set_last_modified();
          ok t_cmp($time, $r->mtime, "\$r->set_last_modified()");
  
          $r->set_last_modified($time);
          ok t_cmp($time, $r->mtime, "\$r->set_last_modified(\$time)");
  
      }
  
      Apache::OK;
  }
  
  
  1;
  __END__
  PerlOptions +GlobalRequest
  
  
  

Mime
View raw message