You are viewing a plain text version of this content. The canonical link for it is here.
Posted to test-cvs@httpd.apache.org by do...@apache.org on 2001/10/16 22:30:58 UTC

cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache Test5005compat.pm Test.pm TestConfig.pm TestConfigC.pm TestConfigParse.pm TestConfigPerl.pm TestHarness.pm TestMM.pm TestRequest.pm TestRun.pm TestRunPerl.pm TestServer.pm TestTrace.pm TestUtil.pm

dougm       01/10/16 13:30:58

  Modified:    perl-framework/Apache-Test Makefile.PL
               perl-framework/Apache-Test/lib/Apache Test.pm TestConfig.pm
                        TestConfigC.pm TestConfigParse.pm TestConfigPerl.pm
                        TestHarness.pm TestMM.pm TestRequest.pm TestRun.pm
                        TestRunPerl.pm TestServer.pm TestTrace.pm
                        TestUtil.pm
  Added:       perl-framework/Apache-Test/lib/Apache Test5005compat.pm
  Log:
  backport to 5.005:
  - open my $fh, ... => my $fh = Symbol::gensym(); open $fh, ...
  - our @foo => use vars qw(@foo)
  - create a stub warnings.pm
  - complain if File::Spec::Functions does not exist
  
  Revision  Changes    Path
  1.3       +3 -1      httpd-test/perl-framework/Apache-Test/Makefile.PL
  
  Index: Makefile.PL
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/Makefile.PL,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- Makefile.PL	2001/10/05 03:36:08	1.2
  +++ Makefile.PL	2001/10/16 20:30:57	1.3
  @@ -1,8 +1,10 @@
  -use 5.006;
  +use 5.005;
   
   use ExtUtils::MakeMaker;
   
   use lib qw(lib);
  +
  +use Apache::Test5005compat;
   
   use Apache::TestMM qw(test); #enable 'make test'
   
  
  
  
  1.26      +7 -5      httpd-test/perl-framework/Apache-Test/lib/Apache/Test.pm
  
  Index: Test.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/Test.pm,v
  retrieving revision 1.25
  retrieving revision 1.26
  diff -u -r1.25 -r1.26
  --- Test.pm	2001/09/18 16:44:50	1.25
  +++ Test.pm	2001/10/16 20:30:57	1.26
  @@ -8,12 +8,14 @@
   use Config;
   use Apache::TestConfig ();
   
  -our @ISA = qw(Exporter);
  -our @EXPORT = qw(ok skip sok plan have_lwp have_http11 have_cgi
  -                 have_module have_apache have_perl);
  -our $VERSION = '0.01';
  +use vars qw(@ISA @EXPORT $VERSION %SubTests);
   
  -our %SubTests;
  +@ISA = qw(Exporter);
  +@EXPORT = qw(ok skip sok plan have_lwp have_http11 have_cgi
  +             have_module have_apache have_perl);
  +$VERSION = '0.01';
  +
  +%SubTests = ();
   
   if (my $subtests = $ENV{HTTPD_TEST_SUBTESTS}) {
       %SubTests = map { $_, 1 } split /\s+/, $subtests;
  
  
  
  1.73      +14 -6     httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
  
  Index: TestConfig.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
  retrieving revision 1.72
  retrieving revision 1.73
  diff -u -r1.72 -r1.73
  --- TestConfig.pm	2001/10/15 14:43:01	1.72
  +++ TestConfig.pm	2001/10/16 20:30:57	1.73
  @@ -8,6 +8,7 @@
   use constant NETWARE => $^O eq 'NetWare';
   use constant WINFU   => WIN32 || CYGWIN || NETWARE;
   
  +use Symbol ();
   use File::Copy ();
   use File::Find qw(finddepth);
   use File::Basename qw(dirname);
  @@ -22,7 +23,9 @@
   use Apache::TestServer ();
   use Socket ();
   
  -our %Usage = (
  +use vars qw(%Usage);
  +
  +%Usage = (
      top_dir       => 'top-level directory (default is $PWD)',
      t_dir         => 'the t/ test directory (default is $top_dir/t)',
      t_conf        => 'the conf/ test directory (default is $t_dir/conf)',
  @@ -593,7 +596,8 @@
       my $name = abs2rel $file, $self->{vars}->{t_dir};
       $self->trace("generating $name");
   
  -    open my $fh, '>', $file or die "open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "open $file: $!";
   
       if (my $msg = $self->genwarning($file)) {
           print $fh $msg, "\n";
  @@ -615,7 +619,8 @@
       my $name = abs2rel $file, $self->{vars}->{t_dir};
       $self->trace("generating $name");
   
  -    open my $fh, '>', $file or die "open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "open $file: $!";
   
       if (my $msg = $self->genwarning($file)) {
           print $fh $msg, "\n";
  @@ -669,7 +674,8 @@
       # untaint some %ENV fields
       local @ENV{ qw(PATH IFS CDPATH ENV BASH_ENV) };
   
  -    open my $handle, '-|', $cmd or die "$cmd failed: $!";
  +    my $handle = Symbol::gensym();
  +    open $handle, "$cmd|" or die "$cmd failed: $!";
   
       return $handle;
   }
  @@ -786,7 +792,8 @@
   sub httpd_conf_template {
       my($self, $try) = @_;
   
  -    if (open my $in, $try) {
  +    my $in = Symbol::gensym();
  +    if (open $in, $try) {
           return $in;
       }
       else {
  @@ -812,7 +819,8 @@
   
           next if -e $generated;
   
  -        open(my $in, $file) or next;
  +        my $in = Symbol::gensym();
  +        open($in, $file) or next;
   
           my $out = $self->genfile($generated);
           $self->replace_vars($in, $out);
  
  
  
  1.15      +6 -3      httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm
  
  Index: TestConfigC.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigC.pm,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- TestConfigC.pm	2001/09/19 11:12:06	1.14
  +++ TestConfigC.pm	2001/10/16 20:30:57	1.15
  @@ -16,7 +16,8 @@
       my $dir = $File::Find::dir;
       my $file = catfile $dir, $_;
   
  -    open my $fh, $file or die "open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, $file or die "open $file: $!";
       my $v = <$fh>;
       if ($v =~ /^\#define\s+HTTPD_TEST_REQUIRE_APACHE\s+(\d+)/) {
           unless ($Apache::TestConfigC::apache_rev == $1) {
  @@ -86,7 +87,8 @@
       }
   
       my $file = catfile $self->{cmodules_dir}, 'Makefile';
  -    open my $fh, '>', $file or die "open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "open $file: $!";
   
       print $fh $self->cmodules_makefile_vars;
   
  @@ -125,7 +127,8 @@
   
       my $lib = $self->cmodules_build_so($name);
   
  -    open my $fh, '>', $makefile or die "open $makefile: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$makefile" or die "open $makefile: $!";
   
       print $fh <<EOF;
   APXS=$self->{APXS}
  
  
  
  1.15      +2 -1      httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm
  
  Index: TestConfigParse.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigParse.pm,v
  retrieving revision 1.14
  retrieving revision 1.15
  diff -u -r1.14 -r1.15
  --- TestConfigParse.pm	2001/10/16 00:45:28	1.14
  +++ TestConfigParse.pm	2001/10/16 20:30:57	1.15
  @@ -140,7 +140,8 @@
   
       $self->trace("inheriting config file: $file");
   
  -    open(my $fh, $file) or return;
  +    my $fh = Symbol::gensym();
  +    open($fh, $file) or return;
   
       my $c = $self->{inherit_config};
   
  
  
  
  1.37      +4 -2      httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
  
  Index: TestConfigPerl.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm,v
  retrieving revision 1.36
  retrieving revision 1.37
  diff -u -r1.36 -r1.37
  --- TestConfigPerl.pm	2001/10/06 19:43:15	1.36
  +++ TestConfigPerl.pm	2001/10/16 20:30:57	1.37
  @@ -186,7 +186,8 @@
   #test .pm's can have configuration after the __DATA__ token
   sub add_module_config {
       my($self, $module, $args) = @_;
  -    open(my $fh, $module) or return;
  +    my $fh = Symbol::gensym();
  +    open($fh, $module) or return;
   
       while (<$fh>) {
           last if /^(__(DATA|END)__|\#if CONFIG_FOR_HTTPD_TEST)/;
  @@ -342,7 +343,8 @@
       my ($self, $file, $module) = @_;
   
       local $/;
  -    if (open my $fh, $file) {
  +    my $fh = Symbol::gensym();
  +    if (open $fh, $file) {
           my $content = <$fh>;
           close $fh;
           if ($content =~ /APACHE_TEST_CONFIGURE/m) {
  
  
  
  1.10      +4 -2      httpd-test/perl-framework/Apache-Test/lib/Apache/TestHarness.pm
  
  Index: TestHarness.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestHarness.pm,v
  retrieving revision 1.9
  retrieving revision 1.10
  diff -u -r1.9 -r1.10
  --- TestHarness.pm	2001/09/06 20:58:02	1.9
  +++ TestHarness.pm	2001/10/16 20:30:57	1.10
  @@ -33,7 +33,8 @@
   
       return unless -e $file;
   
  -    open my $fh, $file or die "open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, $file or die "open $file: $!";
       my @skip;
       local $_;
   
  @@ -55,7 +56,8 @@
       my $ran = 0;
       my $cmd = "$^X -Mlib=../Apache-Test/lib $file";
   
  -    open my $h, "$cmd|" or die "open $cmd: $!";
  +    my $h = Symbol::gensym();
  +    open $h, "$cmd|" or die "open $cmd: $!";
   
       local $_;
       while (<$h>) {
  
  
  
  1.13      +4 -2      httpd-test/perl-framework/Apache-Test/lib/Apache/TestMM.pm
  
  Index: TestMM.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestMM.pm,v
  retrieving revision 1.12
  retrieving revision 1.13
  diff -u -r1.12 -r1.13
  --- TestMM.pm	2001/10/14 02:11:36	1.12
  +++ TestMM.pm	2001/10/16 20:30:57	1.13
  @@ -66,8 +66,10 @@
       my $file = shift;
   
       unlink $file if -e $file;
  -    open my $in, "$file.PL" or die "Couldn't open $file.PL: $!";
  -    open my $out, '>', $file or die "Couldn't open $file: $!";
  +    my $in = Symbol::gensym();
  +    my $out = Symbol::gensym();
  +    open $in, "$file.PL" or die "Couldn't open $file.PL: $!";
  +    open $out, ">$file" or die "Couldn't open $file: $!";
   
       print "generating script...$file\n";
   
  
  
  
  1.45      +6 -4      httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
  
  Index: TestRequest.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm,v
  retrieving revision 1.44
  retrieving revision 1.45
  diff -u -r1.44 -r1.45
  --- TestRequest.pm	2001/10/11 19:07:06	1.44
  +++ TestRequest.pm	2001/10/16 20:30:57	1.45
  @@ -37,11 +37,13 @@
       };
   }
   
  +use vars qw(@EXPORT @ISA $RedirectOK $DebugLWP);
  +
   require Exporter;
   *import = \&Exporter::import;
  -our @EXPORT = @HTTP::Request::Common::EXPORT;
  +@EXPORT = @HTTP::Request::Common::EXPORT;
   
  -our @ISA = qw(LWP::UserAgent);
  +@ISA = qw(LWP::UserAgent);
   
   my $UA;
   
  @@ -108,7 +110,7 @@
       \%wanted_args;
   }
   
  -our $RedirectOK = 1;
  +$RedirectOK = 1;
   
   sub redirect_ok {
       my($self, $request) = @_;
  @@ -256,7 +258,7 @@
       $string;
   }
   
  -our $DebugLWP; #1 == print METHOD URL and header response for all requests
  +$DebugLWP = 0; #1 == print METHOD URL and header response for all requests
                  #2 == #1 + response body
                  #other == passed to LWP::Debug->import
   
  
  
  
  1.56      +2 -1      httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm
  
  Index: TestRun.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRun.pm,v
  retrieving revision 1.55
  retrieving revision 1.56
  diff -u -r1.55 -r1.56
  --- TestRun.pm	2001/10/13 18:44:43	1.55
  +++ TestRun.pm	2001/10/16 20:30:57	1.56
  @@ -420,7 +420,8 @@
       return unless -e $binsh;
       $ENV{APACHE_TEST_ULIMIT_SET} = 1;
   
  -    open my $sh, "echo ulimit -a | $binsh|" or die;
  +    my $sh = Symbol::gensym();
  +    open $sh, "echo ulimit -a | $binsh|" or die;
       local $_;
       while (<$sh>) {
           if (/^core file size.*unlimited$/) {
  
  
  
  1.3       +2 -2      httpd-test/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm
  
  Index: TestRunPerl.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRunPerl.pm,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- TestRunPerl.pm	2001/08/19 18:06:43	1.2
  +++ TestRunPerl.pm	2001/10/16 20:30:57	1.3
  @@ -6,8 +6,8 @@
   use Apache::TestRun ();
   
   #subclass of Apache::TestRun that configures mod_perlish things
  -
  -our @ISA = qw(Apache::TestRun);
  +use vars qw(@ISA);
  +@ISA = qw(Apache::TestRun);
   
   sub configure_modperl {
       my $self = shift;
  
  
  
  1.36      +2 -1      httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm
  
  Index: TestServer.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
  retrieving revision 1.35
  retrieving revision 1.36
  diff -u -r1.35 -r1.36
  --- TestServer.pm	2001/10/14 02:17:13	1.35
  +++ TestServer.pm	2001/10/16 20:30:57	1.36
  @@ -219,7 +219,8 @@
   sub pid {
       my $self = shift;
       my $file = $self->pid_file;
  -    open my $fh, $file or do {
  +    my $fh = Symbol::gensym();
  +    open $fh, $file or do {
           return 0;
       };
       chomp(my $pid = <$fh>);
  
  
  
  1.6       +7 -7      httpd-test/perl-framework/Apache-Test/lib/Apache/TestTrace.pm
  
  Index: TestTrace.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestTrace.pm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- TestTrace.pm	2001/09/06 05:05:46	1.5
  +++ TestTrace.pm	2001/10/16 20:30:57	1.6
  @@ -4,21 +4,21 @@
   use warnings FATAL => 'all';
   
   use Exporter ();
  -our (@Levels, @Utils);
  +use vars qw(@Levels @Utils @ISA @EXPORT $VERSION $Level $LogFH);
   
   BEGIN {
       @Levels = qw(emerg alert crit error warning notice info debug);
       @Utils  = qw(todo);
   }
   
  -our @ISA     = qw(Exporter);
  -our @EXPORT  = (@Levels, @Utils);
  -our $VERSION = '0.01';
  -use subs (@Levels,@Utils);
  +@ISA     = qw(Exporter);
  +@EXPORT  = (@Levels, @Utils);
  +$VERSION = '0.01';
  +use subs (@Levels, @Utils);
   
   # default settings overrideable by users
  -our $Level = 'warning';
  -our $LogFH = \*STDERR;
  +$Level = 'warning';
  +$LogFH = \*STDERR;
   
   # private data
   use constant HAS_COLOR  => eval {
  
  
  
  1.8       +11 -7     httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm
  
  Index: TestUtil.pm
  ===================================================================
  RCS file: /home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestUtil.pm,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -r1.7 -r1.8
  --- TestUtil.pm	2001/09/29 18:31:15	1.7
  +++ TestUtil.pm	2001/10/16 20:30:57	1.8
  @@ -7,13 +7,15 @@
   use File::Path ();
   use Exporter ();
   
  -our $VERSION = '0.01';
  -our @ISA     = qw(Exporter);
  -our @EXPORT = qw(t_cmp t_write_file t_open_file t_mkdir t_rmtree
  -                 t_is_equal);
  +use vars qw($VERSION @ISA @EXPORT %CLEAN);
   
  -our %CLEAN = ();
  +$VERSION = '0.01';
  +@ISA     = qw(Exporter);
  +@EXPORT = qw(t_cmp t_write_file t_open_file t_mkdir t_rmtree
  +             t_is_equal);
   
  +%CLEAN = ();
  +
   use constant HAS_DUMPER => eval { require Data::Dumper; };
   use constant INDENT     => 4;
   
  @@ -31,7 +33,8 @@
   sub t_write_file {
       my $file = shift;
       die "must pass a filename" unless defined $file;
  -    open my $fh, ">", $file or die "can't open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "can't open $file: $!";
       print "writing file: $file\n";
       print $fh join '', @_ if @_;
       close $fh;
  @@ -41,7 +44,8 @@
   sub t_open_file {
       my $file = shift;
       die "must pass a filename" unless defined $file;
  -    open my $fh, ">", $file or die "can't open $file: $!";
  +    my $fh = Symbol::gensym();
  +    open $fh, ">$file" or die "can't open $file: $!";
       print "writing file: $file\n";
       $CLEAN{files}{$file}++;
       return $fh;
  
  
  
  1.1                  httpd-test/perl-framework/Apache-Test/lib/Apache/Test5005compat.pm
  
  Index: Test5005compat.pm
  ===================================================================
  package Apache::Test5005compat;
  
  use Symbol ();
  use File::Basename;
  use File::Path;
  use Symbol ();
  
  my %compat_files = (
       'lib/warnings.pm' => \&warnings_pm,
  );
  
  sub import {
      if ($] >= 5.006) {
          #make sure old compat stubs dont wipe out installed versions
          unlink for keys %compat_files;
          return;
      }
  
      eval { require File::Spec::Functions; } or
        die "this is only Perl $], you need to install File-Spec from CPAN";
  
      while (my($file, $sub) = each %compat_files) {
          $sub->($file);
      }
  }
  
  sub open_file {
      my $file = shift;
  
      unless (-d 'lib') {
          $file = "Apache-Test/$file";
      }
  
      my $dir = dirname $file;
  
      unless (-d $dir) {
          mkpath([$dir], 0, 0755);
      }
  
      my $fh = Symbol::gensym();
      print "creating $file\n";
      open $fh, ">$file" or die "open $file: $!";
  
      return $fh;
  }
  
  sub warnings_pm {
      return if eval { require warnings };
  
      my $fh = open_file(shift);
  
      print $fh <<'EOF';
  package warnings;
  
  sub import {}
  
  1;
  EOF
  
      close $fh;
  }
  
  1;