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 ); [EMAIL PROTECTED] = qw(t_write_perl_script t_write_shell_script t_chown); [EMAIL PROTECTED] = 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",