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;