cvs commit: modperl-2.0/t/response/TestDirective perlrequire.pm

[stas]

stas        01/09/17 19:00:19

  Added:       t/directive perlrequire.t
               t/response/TestDirective perlrequire.pm
  Log:
  - add a PerlRequire test
  
  Revision  Changes    Path
  1.1                  modperl-2.0/t/directive/perlrequire.t
  
  Index: perlrequire.t
  ===================================================================
  # this test tests PerlRequire configuration directive
  ########################################################################
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest ();
  
  my %checks =
      (
       'default'                    => 'PerlRequired by Parent',
       'TestDirective::perlrequire' => 'PerlRequired by VirtualHost',
      );
  
  plan tests => scalar keys %checks;
  
  for my $module (sort keys %checks) {
      Apache::TestRequest::module($module);
  
      my $config   = Apache::Test::config();
      my $hostport = Apache::TestRequest::hostport($config);
      print "connecting to $hostport\n";
  
      ok t_cmp(
               $checks{$module},
               $config->http_raw_get("/TestDirective::perlrequire", undef),
               "testing PerlRequire in $module",
              );
  }
  
  
  
  1.1                  modperl-2.0/t/response/TestDirective/perlrequire.pm
  
  Index: perlrequire.pm
  ===================================================================
  package TestDirective::perlrequire;
  
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test ();
  use Apache::Const -compile => 'OK';
  use File::Spec::Functions qw(catfile);
  
  sub handler {
      my $r = shift;
  
      $r->content_type('text/plain');
      $r->puts($My::PerlRequireTest::MAGIC || '');
  
      Apache::OK;
  }
  
  my %require_tests = 
      (
       main => 'PerlRequired by Parent',
       vh   => 'PerlRequired by VirtualHost',
      );
  
  sub APACHE_TEST_CONFIGURE {
      my ($class, $self) = @_;
  
      my $vars = $self->{vars};
      my $target_dir = catfile $vars->{documentroot}, 'testdirective';
  
      # create two different PerlRequireTest.pm packages to be loaded by
      # vh and main interpreters, on the fly before the tests start
      while (my($test, $magic) = each %require_tests) {
          my $content = <<EOF;
  package My::PerlRequireTest;
  \$My::PerlRequireTest::MAGIC = '$magic';
  1;
  EOF
          my $file = catfile $target_dir, $test, 'PerlRequireTest.pm';
          $self->writefile($file, $content, 1);
      }
  }
  
  1;
  __END__
  PerlSwitches -Mlib=@documentroot@/testdirective/main
  PerlRequire "PerlRequireTest.pm"
  
  <VirtualHost TestDirective::perlrequire>
  
    # a new interpreter pool
    PerlOptions +Parent
  
    # use test system's @INC
    PerlSwitches -Mlib=@serverroot@
    PerlRequire "conf/modperl_startup.pl"
  
    PerlSwitches -Mlib=@documentroot@/testdirective/vh
    PerlRequire "PerlRequireTest.pm"
  
    <Location /TestDirective::perlrequire>
       SetHandler modperl
       PerlResponseHandler TestDirective::perlrequire
    </Location>
  </VirtualHost>