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/TestCompat apache.pm apache_file.pm apache_table.pm apache_util.pm request.pm request_body.pm compat.pm compat2.pm
Date Thu, 15 Aug 2002 09:35:11 GMT
stas        2002/08/15 02:35:11

  Added:       t/compat request_body.t
               t/response/TestCompat apache.pm apache_file.pm
                        apache_table.pm apache_util.pm request.pm
                        request_body.pm
  Removed:     t/compat compat.t
               t/response/TestCompat compat.pm compat2.pm
  Log:
  split compat tests into small groups by the package they test
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/compat/request_body.t
  
  Index: request_body.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  plan tests => 3;
  
  my $location = "/TestCompat::request_body";
  
  # $r->send_http_header('text/plain');
  {
      my @data = (test => 'content-type');
      ok t_cmp(
          "text/plain",
          HEAD(query(@data))->content_type(),
          q{$r->send_http_header('text/plain')}
          );
  }
  
  # $r->content
  {
      my @data = (test => 'content');
      my $content = join '=', @data;
      ok t_cmp(
          "@data",
          POST_BODY($location, content => $content),
          q{$r->content via POST}
          );
  }
  
  # $r->Apache::args
  {
      my @data = (test => 'args');
      ok t_cmp(
          "@data",
          GET_BODY(query(@data)),
          q{$r->Apache::args}
          );
  }
  
  
  ### helper subs ###
  sub query {
      my(%args) = (@_ % 2) ? %{+shift} : @_;
      "$location?" . join '&', map { "$_=$args{$_}" } keys %args;
  }
  
  # accepts multiline var where, the lines matching:
  # ^ok\n$  results in ok(1)
  # ^nok\n$ results in ok(0)
  # the rest is printed as is
  sub ok_nok {
      for (split /\n/, shift) {
          if (/^ok\n?$/) {
              ok 1;
          } elsif (/^nok\n?$/) {
              ok 0;
          } else {
              print "$_\n";
          }
      }
  }
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/apache.pm
  
  Index: apache.pm
  ===================================================================
  package TestCompat::apache;
  
  # Apache->"method" and Apache::"function" compat layer tests
  
  # these tests are all run and validated on the server side.
  
  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 => 5;
  
      $r->send_http_header('text/plain');
  
      ### Apache-> tests
      my $fh = Apache->gensym;
      ok t_cmp('GLOB', ref($fh), "Apache->gensym");
  
      ok t_cmp(1, Apache->module('mod_perl.c'),
               "Apache::module('mod_perl.c')");
      ok t_cmp(0, Apache->module('mod_ne_exists.c'),
               "Apache::module('mod_ne_exists.c')");
  
  
      ok t_cmp(Apache::exists_config_define('MODPERL2'),
               Apache->define('MODPERL2'),
               'Apache->define');
  
      Apache::log_error("Apache::log_error test ok");
      ok 1;
  
      OK;
  }
  
  1;
  
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/apache_file.pm
  
  Index: apache_file.pm
  ===================================================================
  package TestCompat::apache_file;
  
  # Apache::File compat layer tests
  
  # these tests are all run and validated on the server side.
  
  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 => 18;
  
      $r->send_http_header('text/plain');
  
      my $cfg = Apache::Test::config();
      my $vars = $cfg->{vars};
  
      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();
  #    #TODO
  #    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)");
  
      OK;
  }
  
  1;
  
  __END__
  PerlOptions +GlobalRequest
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/apache_table.pm
  
  Index: apache_table.pm
  ===================================================================
  package TestCompat::apache_table;
  
  # Apache::Table compat layer tests
  
  # these tests are all run and validated on the server side.
  
  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 => 2;
  
      $r->send_http_header('text/plain');
  
      my $t = Apache::Table->new($r);
      my $t_class = ref $t;
  
      ok t_cmp('APR::Table', $t_class, "Apache::Table->new");
  
      ok t_cmp(!$r->main, $r->is_main,
               '$r->is_main');
  
      OK;
  }
  
  1;
  
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/apache_util.pm
  
  Index: apache_util.pm
  ===================================================================
  package TestCompat::apache_util;
  
  # Apache::Util compat layer tests
  
  # these tests are all run and validated on the server side.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestUtil;
  use Apache::Test;
  
  use Apache::compat ();
  use Apache::Constants qw(OK);
  
  my %string_size = (
      '-1'            => "    -",
      0               => "   0k",
      42              => "   1k",
      42_000          => "  41k",
      42_000_000      => "40.1M",
      42_000_000_000  => "40054M",
  );
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 13;
  
      $r->send_http_header('text/plain');
  
      # size_string()
      {
          while (my($k, $v) = each %string_size) {
              ok t_cmp($v, Apache::Util::size_string($k));
          }
      }
  
      # escape_uri(), escape_path(), unescape_uri()
      my $uri = "http://foo.com/a file.html";
      (my $esc_uri = $uri) =~ s/ /\%20/g;
      my $uri2 = $uri;
  
      $uri = Apache::Util::escape_uri($uri);
      $uri2 = Apache::Util::escape_path($uri2, $r->pool);
  
      ok t_cmp($esc_uri, $uri, "Apache::Util::escape_uri");
      ok t_cmp($esc_uri, $uri2, "Apache::Util::escape_path");
  
      ok t_cmp(Apache::unescape_url($uri),
               Apache::Util::unescape_uri($uri2),
               "Apache::URI::unescape_uri vs Apache::Util::unescape_uri");
  
      ok t_cmp($uri,
               $uri2,
               "Apache::URI::unescape_uri vs Apache::Util::unescape_uri");
  
      # escape_html()
      my $html = '<p>"hi"&foo</p>';
      my $esc_html = '&lt;p&gt;&quot;hi&quot;&amp;foo&lt;/p&gt;';
  
      ok t_cmp($esc_html, Apache::Util::escape_html($html),
               "Apache::Util::escape_html");
  
  
      # ht_time(), parsedate()
      my $time = time;
      my $fmtdate = Apache::Util::ht_time($time);
  
      ok t_cmp($fmtdate, $fmtdate, "Apache::Util::ht_time");
  
      my $ptime = Apache::Util::parsedate($fmtdate);
  
      ok t_cmp($time, $ptime, "Apache::Util::parsedate");
  
      # note these are not actually part of the tests since i think on
      # platforms where crypt is not supported, these tests will fail.
      # but at least we can look with t/TEST -v
      my $hash = "aX9eP53k4DGfU";
      t_cmp(1, Apache::Util::validate_password("dougm", $hash));
      t_cmp(0, Apache::Util::validate_password("mguod", $hash));
  
  
      OK;
  }
  
  1;
  
  __END__
  PerlOptions +GlobalRequest
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/request.pm
  
  Index: request.pm
  ===================================================================
  package TestCompat::request;
  
  # $r->"method" compat layer tests
  
  # these tests are all run and validated on the server side.
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestUtil;
  use Apache::Test;
  
  use Apache::compat ();
  use Apache::Constants qw(OK REMOTE_HOST);
  
  sub handler {
      my $r = shift;
  
      plan $r, tests => 15;
  
      $r->send_http_header('text/plain');
  
      # header_in() and header_out() and err_header_out()
      for my $prefix ('err_', '') {
          my @ways = 'out';
          push @ways, 'in' unless $prefix;
          for my $way (@ways) {
              my $sub_test = "${prefix}header_$way";
              my $sub_good = "${prefix}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()");
              }
          }
      }
  
      # get_remote_host()
      ok $r->get_remote_host() || 1;
      ok $r->get_remote_host(Apache::REMOTE_HOST) || 1;
  
      # post_connection()
      $r->post_connection(sub { OK });
      ok 1;
  
  
      OK;
  }
  
  1;
  
  
  
  
  1.1                  modperl-2.0/t/response/TestCompat/request_body.pm
  
  Index: request_body.pm
  ===================================================================
  package TestCompat::request_body;
  
  # $r->"method" tests that are validated by the client
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::TestUtil;
  use Apache::Test ();
  
  use Apache::compat ();
  use Apache::Constants qw(OK M_POST DECLINED);
  
  use subs qw(ok debug);
  my $gr;
  
  sub handler {
      my $r = shift;
      $gr = $r;
  
      $r->send_http_header('text/plain');
  
      my $cfg = Apache::Test::config();
      my $vars = $cfg->{vars};
  
      my %data;
      if ($r->method_number == M_POST) {
          %data = $r->content;
      }
      else {
          %data = $r->Apache::args;
      }
  
      return DECLINED unless exists $data{test};
  
      if ($data{test} eq 'content' || $data{test} eq 'args') {
          $r->print("test $data{test}");
      }
  
      OK;
  }
  
  sub ok    { $gr->print($_[0] ? "ok\n" : "nok\n"); }
  sub debug { $gr->print("# $_\n") for @_; }
  
  1;
  __END__
  PerlOptions +GlobalRequest
  
  
  

Mime
View raw message