cvs commit: modperl-2.0/ModPerl-Registry/t/cgi-bin perlrun_decl.pm perlrun_extload.pl perlrun_nondecl.pl lib.pl perlrun_require.pl

[st...@apache.org]

stas        2004/03/08 22:35:34

  Added:       ModPerl-Registry/t perlrun_extload.t
               ModPerl-Registry/t/cgi-bin perlrun_decl.pm
                        perlrun_extload.pl perlrun_nondecl.pl
  Removed:     ModPerl-Registry/t perlrun_require.t
               ModPerl-Registry/t/cgi-bin lib.pl perlrun_require.pl
  Log:
  expand the perlrun require/use test to include various function prototypes
  and a lack of in modules that declare and don't declare their own
  package. also add 'warning expected' banners.
  
  Revision  Changes    Path
  1.1                  modperl-2.0/ModPerl-Registry/t/perlrun_extload.t
  
  Index: perlrun_extload.t
  ===================================================================
  use strict;
  use warnings FATAL => 'all';
  
  use Apache::Test;
  use Apache::TestUtil;
  use Apache::TestRequest qw(GET);
  
  plan tests => 2;
  
  my $url = "/same_interp/perlrun/perlrun_extload.pl";
  my $same_interp = Apache::TestRequest::same_interp_tie($url);
  
  for (1..2) {
      # should not fail on the second request
      my $res = get_body($same_interp, $url);
      skip_not_same_interp(
          !defined($res),
          "01234",
          $res,
          "PerlRun requiring an external lib with subs",
      );
  }
  
  # if we fail to find the same interpreter, return undef (this is not
  # an error)
  sub get_body {
      my($same_interp, $url) = @_;
      my $res = eval {
          Apache::TestRequest::same_interp_do($same_interp, \&GET, $url);
      };
      return undef if $@ =~ /unable to find interp/;
      return $res->content if $res;
      die $@ if $@;
  }
  
  # make the tests resistant to a failure of finding the same perl
  # interpreter, which happens randomly and not an error.
  # the first argument is used to decide whether to skip the sub-test,
  # the rest of the arguments are passed to 'ok t_cmp';
  sub skip_not_same_interp {
      my $skip_cond = shift;
      if ($skip_cond) {
          skip "Skip couldn't find the same interpreter", 0;
      }
      else {
          my($package, $filename, $line) = caller;
          # trick ok() into reporting the caller filename/line when a
          # sub-test fails in sok()
          return eval <<EOE;
  #line $line $filename
      ok &t_cmp;
  EOE
      }
  }
  
  
  
  1.1                  modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_decl.pm
  
  Index: perlrun_decl.pm
  ===================================================================
  package perlrun_decl;
  
  use warnings;
  use strict;
  
  use base qw(Exporter);
  our @EXPORT = qw(decl_proto);
  
  sub decl_proto ($;$) { my $x = shift; $x*"0"; }
  
  1;
  
  
  
  1.1                  modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_extload.pl
  
  Index: perlrun_extload.pl
  ===================================================================
  use warnings;
  use strict;
  
  # XXX: add the warning/error expected prints
  
  use Apache::Test ();
  use Apache::TestUtil;
  use File::Spec::Functions qw(catfile catdir);
  
  #my $dir;# = catdir Apache::Test::vars('serverroot'), 'cgi-bin';
  #BEGIN { $dir = catdir Apache::Test::vars('serverroot'), 'cgi-bin' }
  #use lib $dir;
  #my $require = catfile $dir, 'perlrun_nondecl.pl';
  
  use lib catdir Apache::Test::vars('serverroot'), 'cgi-bin';
  my $require = catfile Apache::Test::vars('serverroot'), 'cgi-bin', 'perlrun_nondecl.pl';
  
  # require a module w/ package declaration (it doesn't get reloaded
  # because it declares the package). But we still have a problem with
  # subs declaring prototypes. When perlrun_decl->import is called, the
  # original function's prototype doesn't match the aliases prototype.
  # see decl_proto()
  BEGIN { t_server_log_warn_is_expected() if perlrun_decl->can("decl_proto"); }
  use perlrun_decl;
  
  # require a lib w/o package declaration. Functions in that lib get
  # automatically aliased to the functions in the current package.
  require "$require";
  
  print "Content-type: text/plain\n\n";
  
  ### declared package module
  print decl_proto(0);
  
  ### non-declared package module
  # they all get redefined warning inside perlrun_nondecl.pl, since that
  # lib loads it into main::, vs. PerlRun undefs the current __PACKAGE__
  print nondecl_no_proto();
  print nondecl_proto(2);
  print nondecl_proto_empty("whatever");
  print nondecl_const();
  
  
  
  
  
  
  1.1                  modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_nondecl.pl
  
  Index: perlrun_nondecl.pl
  ===================================================================
  # we use this file to test how the files w/o package declaration,
  # required from perlrun, work
  
  use Apache::TestUtil;
  
  my $num;
  
  use subs qw(warn_exp);
  
  # all subs in tis file get 'redefined' warning because they are
  # reloaded in the main:: package, which is not under PerlRun's
  # control.
  
  BEGIN {
      t_server_log_warn_is_expected()
          if defined *{"nondecl_no_proto"}{CODE};
  }
  # normal sub, no prototype
  sub nondecl_no_proto        { 1 }
  
  BEGIN {
      t_server_log_warn_is_expected()
          if defined *{"nondecl_proto"}{CODE};
  }
  # sub with a scalar proto
  sub nondecl_proto       ($) { $num = shift }
  
  BEGIN {
      t_server_log_warn_is_expected()
          if defined *{"nondecl_proto_empty"}{CODE};
  }
  # sub with an empty proto, but not a constant
  sub nondecl_proto_empty ()  { $num + 1 }
  
  # besides the the constant sub will generate two warnings for nondecl_const:
  # - one for main::
  # - another for perlrun's virtual package
  BEGIN {
      t_server_log_warn_is_expected(2);
  }
  # a constant.
  sub nondecl_const       ()  { 4 }
  
  
  
  1;