cvs commit: modperl-2.0/ModPerl-Registry/t special_blocks.t

[stas]

stas        01/10/19 00:36:13

  Added:       ModPerl-Registry/t special_blocks.t
  Log:
  - test how registry modules handle BEGIN/END blocks
  
  Revision  Changes    Path
  1.1                  modperl-2.0/ModPerl-Registry/t/special_blocks.t
  
  Index: special_blocks.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  # test BEGIN/END blocks's behavior
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest;
  
  my %modules = (
      registry    => 'ModPerl::Registry',
      registry_ng => 'ModPerl::RegistryNG',
      registry_bb => 'ModPerl::RegistryBB',
      perlrun     => 'ModPerl::PerlRun',
  );
  
  my @aliases = sort keys %modules;
  
  plan tests => @aliases * 4;
  
  {
      # PerlRun always run BEGIN/END since it's never cached
  
      my $alias = "perlrun";
      my $url = "/same_interp/$alias/blocks.pl";
      my $same_interp = Apache::TestRequest::same_interp_tie($url);
  
      ok t_cmp(
               "begin ok",
               req($same_interp, "$url?test=begin"),
               "$modules{$alias} is running BEGIN blocks on the first req",
              );
  
      ok t_cmp(
               "begin ok",
               req($same_interp, "$url?test=begin"),
               "$modules{$alias} is running BEGIN blocks on the second req",
              );
  
      ok t_cmp(
               "end ok",
               req($same_interp, "$url?test=end"),
               "$modules{$alias} is running END blocks on the first req",
              );
  
      ok t_cmp(
               "end ok",
               req($same_interp, "$url?test=end"),
               "$modules{$alias} is running END blocks on the second req",
              );
  }
  
  # To properly test BEGIN/END blocks in registry implmentations
  # that do caching, we need to manually reset the registry* cache
  # for each given script, before starting each group of tests.
  
  
  for my $alias (grep !/^perlrun$/, @aliases) {
      my $url = "/same_interp/$alias/blocks.pl";
      my $same_interp = Apache::TestRequest::same_interp_tie($url);
  
      # clear the cache of the registry package for the script in $url
      req($same_interp, "$url?test=uncache");
  
      ok t_cmp(
               "begin ok",
               req($same_interp, "$url?test=begin"),
               "$modules{$alias} is running BEGIN blocks on the first req",
              );
  
      ok t_cmp(
               "",
               req($same_interp, "$url?test=begin"),
               "$modules{$alias} is not running BEGIN blocks on the second req",
              );
  
      # clear the cache of the registry package for the script in $url
      req($same_interp, "$url?test=uncache");
  
      ok t_cmp(
               "end ok",
               req($same_interp, "$url?test=end"),
               "$modules{$alias} is running END blocks on the first req",
              );
  
      ok t_cmp(
               "end ok",
               req($same_interp, "$url?test=end"),
               "$modules{$alias} is running END blocks on the second req",
              );
  
  }
  
  sub req {
      my($same_interp, $url) = @_;
      my $res = Apache::TestRequest::same_interp_do($same_interp,
                                                    \&GET, $url);
      return $res ? $res->content : undef;
  }