You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by do...@hyperreal.org on 1999/01/21 01:38:25 UTC

cvs commit: modperl/t/net/perl dirty-script.cgi dirty-test.cgi

dougm       99/01/20 16:38:25

  Modified:    .        Changes
               lib/Apache PerlRun.pm
               t/docs   startup.pl
               t/net/perl dirty-script.cgi dirty-test.cgi
  Log:
  do not undef subroutines when flushing Apache::PerlRun::handler
  namespace unless subroutine lives in that namespace, i.e. not imported
  (no undef happens unless `B' module is loaded)
  
  Revision  Changes    Path
  1.252     +4 -0      modperl/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /export/home/cvs/modperl/Changes,v
  retrieving revision 1.251
  retrieving revision 1.252
  diff -u -r1.251 -r1.252
  --- Changes	1999/01/21 00:03:14	1.251
  +++ Changes	1999/01/21 00:38:20	1.252
  @@ -9,6 +9,10 @@
   
   =item 1.17_01-dev
   
  +do not undef subroutines when flushing Apache::PerlRun::handler
  +namespace unless subroutine lives in that namespace, i.e. not imported
  +(no undef happens unless `B' module is loaded)
  +
   untaint Apache::File->tmpfile (if $ENV{TMPDIR,TEMP} are used)
   
   'make test' fixups:
  
  
  
  1.14      +12 -1     modperl/lib/Apache/PerlRun.pm
  
  Index: PerlRun.pm
  ===================================================================
  RCS file: /export/home/cvs/modperl/lib/Apache/PerlRun.pm,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -r1.13 -r1.14
  --- PerlRun.pm	1998/11/02 19:23:47	1.13
  +++ PerlRun.pm	1999/01/21 00:38:22	1.14
  @@ -286,12 +286,23 @@
   	no strict;
   	my $tab = \%{$package.'::'};
           foreach (keys %$tab) {
  -	    undef &{$tab->{$_}} if defined &{$tab->{$_}};
  +	    if(defined &{$tab->{$_}}) {
  +		undef_cv_if_owner($package, \&{$tab->{$_}});
  +	    } 
   	}
   	%$tab = ();
       }
   
       return $rc;
  +}
  +
  +sub undef_cv_if_owner {
  +    return unless $INC{'B.pm'};
  +    my($package, $cv) = @_;
  +    my $obj    = B::svref_2object($cv);
  +    my $stash  = $obj->GV->STASH->NAME;
  +    return unless $package eq $stash;
  +    undef &$cv;
   }
   
   1;
  
  
  
  1.34      +2 -0      modperl/t/docs/startup.pl
  
  Index: startup.pl
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/docs/startup.pl,v
  retrieving revision 1.33
  retrieving revision 1.34
  diff -u -r1.33 -r1.34
  --- startup.pl	1999/01/20 23:16:33	1.33
  +++ startup.pl	1999/01/21 00:38:22	1.34
  @@ -100,6 +100,8 @@
   
   $ENV{GATEWAY_INTERFACE} =~ /^CGI-Perl/ or die "GATEWAY_INTERFACE not set!";
   
  +sub Outside::imported {4}
  +
   #will be redef'd during tests
   sub PerlTransHandler::handler {-1}
   
  
  
  
  1.4       +1 -0      modperl/t/net/perl/dirty-script.cgi
  
  Index: dirty-script.cgi
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/dirty-script.cgi,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- dirty-script.cgi	1998/09/17 17:09:43	1.3
  +++ dirty-script.cgi	1999/01/21 00:38:24	1.4
  @@ -10,6 +10,7 @@
   open FH, $0 or die $!;
   
   sub subroutine {}
  +*imported = \&Outside::imported;
   
   push @array, 1;
   
  
  
  
  1.3       +2 -1      modperl/t/net/perl/dirty-test.cgi
  
  Index: dirty-test.cgi
  ===================================================================
  RCS file: /export/home/cvs/modperl/t/net/perl/dirty-test.cgi,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- dirty-test.cgi	1998/09/17 17:09:43	1.2
  +++ dirty-test.cgi	1999/01/21 00:38:24	1.3
  @@ -10,7 +10,7 @@
   
   print "Content-type: text/plain\n\n";
   
  -print "1..5\n";
  +print "1..6\n";
   
   my $i = 0;
   
  @@ -19,5 +19,6 @@
   test ++$i, not defined %hash;
   test ++$i, not defined $scalar;
   test ++$i, not defined fileno(FH);
  +test ++$i, Outside::imported() == 4;