cvs commit: modperl-2.0/ModPerl-Registry/t basic.t redirect.t

[ra...@apache.org]

randyk      2003/12/03 23:20:29

  Modified:    perl-framework/Apache-Test/lib/Apache TestUtil.pm
               ModPerl-Registry/t basic.t redirect.t
  Log:
  Reviewed by:	stas
  Apache uses a Unix-style specification for files, in particular the
  forward slash for directory separators. This causes problems in comparing
  such files to those constructed with File::Spec->catfile, which may
  use a different directory separator on a non-Unix platform. For such
  cases we introduce a function t_catfile_apache in Apache::TestUtil which
  is essentially File::Spec::Unix->catfile, with an allowance made to
  return the long path name on Win32 if the path is absolute.
  
  Revision  Changes    Path
  1.32      +39 -2     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.31
  retrieving revision 1.32
  diff -u -r1.31 -r1.32
  --- TestUtil.pm	29 Apr 2003 08:04:04 -0000	1.31
  +++ TestUtil.pm	4 Dec 2003 07:20:29 -0000	1.32
  @@ -9,7 +9,7 @@
   use Carp ();
   use Config;
   use File::Basename qw(dirname);
  -use File::Spec::Functions qw(catfile);
  +use File::Spec::Functions qw(catfile file_name_is_absolute);
   use Symbol ();
   
   use Apache::Test ();
  @@ -26,7 +26,8 @@
       t_client_log_error_is_expected t_client_log_warn_is_expected
   );
   
  -@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown);
  +@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
  +               t_catfile_apache t_catfile);
   
   %CLEAN = ();
   
  @@ -304,6 +305,26 @@
       }
   }
   
  +# essentially File::Spec->catfile, but on Win32
  +# returns the long path name, if the file is absolute
  +sub t_catfile {
  +    my $f = catfile(@_);
  +    return $f unless file_name_is_absolute($f);
  +    return Apache::TestConfig::WIN32 ?
  +        Win32::GetLongPathName($f) : $f;
  +}
  +
  +# Apache uses a Unix-style specification for files, with
  +# forward slashes for directory separators. This is
  +# essentially File::Spec::Unix->catfile, but on Win32
  +# returns the long path name, if the file is absolute
  +sub t_catfile_apache {
  +    my $f = File::Spec::Unix->catfile(@_);
  +    return $f unless file_name_is_absolute($f);
  +    return Apache::TestConfig::WIN32 ?
  +        Win32::GetLongPathName($f) : $f;
  +}
  +
   1;
   __END__
   
  @@ -617,6 +638,22 @@
   details.
   
   This function is exported by default.
  +
  +=item t_catfile('a', 'b', 'c')
  +
  +This function is essentially C<File::Spec-E<gt>catfile>, but
  +on Win32 will use C<Win32::GetLongpathName()> to convert the
  +result to a long path name (if the result is an absolute file).
  +The function is not exported by default.
  +
  +=item t_catfile_apache('a', 'b', 'c')
  +
  +This function is essentially C<File::Spec::Unix-E<gt>catfile>, but
  +on Win32 will use C<Win32::GetLongpathName()> to convert the
  +result to a long path name (if the result is an absolute file).
  +It is useful when comparing something to that returned by Apache,
  +which uses a Unix-style specification with forward slashes for
  +directory separators. The function is not exported by default.
   
   =back
   
  
  
  
  1.16      +2 -2      modperl-2.0/ModPerl-Registry/t/basic.t
  
  Index: basic.t
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/basic.t,v
  retrieving revision 1.15
  retrieving revision 1.16
  diff -u -r1.15 -r1.16
  --- basic.t	23 Nov 2003 21:01:50 -0000	1.15
  +++ basic.t	4 Dec 2003 07:20:29 -0000	1.16
  @@ -6,7 +6,7 @@
   use Apache::TestRequest qw(GET GET_BODY HEAD);
   use Apache::TestConfig ();
   
  -use File::Spec::Functions qw(catfile);
  +use Apache::TestUtil qw(t_catfile_apache);
   
   my %modules = (
       registry    => 'ModPerl::Registry',
  @@ -19,7 +19,7 @@
   plan tests => @aliases * 4 + 3;
   
   my $vars = Apache::Test::config()->{vars};
  -my $script_file = catfile $vars->{serverroot}, 'cgi-bin', 'basic.pl';
  +my $script_file = t_catfile_apache $vars->{serverroot}, 'cgi-bin', 'basic.pl';
   
   # very basic compilation/response test
   for my $alias (@aliases) {
  
  
  
  1.7       +2 -2      modperl-2.0/ModPerl-Registry/t/redirect.t
  
  Index: redirect.t
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/redirect.t,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -r1.6 -r1.7
  --- redirect.t	23 Nov 2003 21:01:50 -0000	1.6
  +++ redirect.t	4 Dec 2003 07:20:29 -0000	1.7
  @@ -5,7 +5,7 @@
   use Apache::TestUtil;
   use Apache::TestRequest qw(GET_BODY HEAD);
   
  -use File::Spec::Functions qw(catfile);
  +use Apache::TestUtil qw(t_catfile_apache);
   
   plan tests => 4, have_lwp;
   
  @@ -16,7 +16,7 @@
       my $redirect_path = "/registry/basic.pl";
       my $url = "$base_url?$redirect_path";
       my $vars = Apache::Test::config()->{vars};
  -    my $script_file = catfile $vars->{serverroot}, 'cgi-bin', 'basic.pl';
  +    my $script_file = t_catfile_apache $vars->{serverroot}, 'cgi-bin', 'basic.pl';
   
       ok t_cmp(
           "ok $script_file",