Return-Path: 
 <modperl-cvs-return-1829-apmail-modperl-cvs-archive=apache.org@apache.org>
Delivered-To: apmail-modperl-cvs-archive@apache.org
Received: (qmail 76055 invoked by uid 500); 19 Oct 2001 07:42:35 -0000
Mailing-List: contact modperl-cvs-help@apache.org; run by ezmlm
Precedence: bulk
list-help: <mailto:modperl-cvs-help@apache.org>
list-unsubscribe: <mailto:modperl-cvs-unsubscribe@apache.org>
list-post: <mailto:modperl-cvs@apache.org>
Reply-To: dev@perl.apache.org
Delivered-To: mailing list modperl-cvs@apache.org
Received: (qmail 76041 invoked by uid 500); 19 Oct 2001 07:42:35 -0000
Delivered-To: apmail-modperl-2.0-cvs@apache.org
Date: 19 Oct 2001 07:36:13 -0000
Message-ID: <20011019073613.35946.qmail@icarus.apache.org>
From: stas@apache.org
To: modperl-2.0-cvs@apache.org
Subject: cvs commit: modperl-2.0/ModPerl-Registry/t special_blocks.t
X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N

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;
  }