randyk 2004/06/01 19:13:24
Modified: perl-framework/Apache-Test/lib/Apache TestUtil.pm
t/response/TestAPI server_const.pm server_util.pm
t/response/TestCompat apache.pm
Log:
Reviewed by: stas
For the benefit of Win32, use the new function t_filepath_cmp()
in Apache::TestUtil to compare two filepaths. On non-Win32 this
is the same as t_cmp(), but on Win32, this first converts both paths
to their DOS long pathname before invoking t_cmp(). This avoids
spurious failures in cases when one of the paths is represented
by its long name and the other by its short name.
Revision Changes Path
1.39 +24 -1 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.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- TestUtil.pm 12 Apr 2004 19:53:42 -0000 1.38
+++ TestUtil.pm 2 Jun 2004 02:13:23 -0000 1.39
@@ -35,7 +35,7 @@
@ISA = qw(Exporter);
@EXPORT = qw(t_cmp t_debug t_append_file t_write_file t_open_file
- t_mkdir t_rmtree t_is_equal
+ t_mkdir t_rmtree t_is_equal t_filepath_cmp
t_server_log_error_is_expected t_server_log_warn_is_expected
t_client_log_error_is_expected t_client_log_warn_is_expected
);
@@ -106,6 +106,18 @@
return t_is_equal($_[0], $_[1]);
}
+# Essentially t_cmp, but on Win32, first converts pathnames
+# to their DOS long name.
+sub t_filepath_cmp ($$;$) {
+ my @a = (shift, shift);
+ if (Apache::TestConfig::WIN32) {
+ $a[0] = Win32::GetLongPathName($a[0]) if defined $a[0];
+ $a[1] = Win32::GetLongPathName($a[1]) if defined $a[1];
+ }
+ return @_ == 1 ? t_cmp($a[0], $a[1], $_[0]) : t_cmp($a[0], $a[1]);
+}
+
+
*expand = HAS_DUMPER ?
sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
sub { @_ };
@@ -438,6 +450,17 @@
will do:
"abcd" =~ /^abc/;
+
+This function is exported by default.
+
+=item t_filepath_cmp()
+
+This function is used to compare two filepaths via t_cmp().
+For non-Win32, it simply uses t_cmp() for the comparison,
+but for Win32, Win32::GetLongPathName() is invoked to convert
+the first two arguments to their DOS long pathname. This is useful
+when there is a possibility the two paths being compared
+are not both represented by their long or short pathname.
This function is exported by default.
1.4 +3 -3 modperl-2.0/t/response/TestAPI/server_const.pm
Index: server_const.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/server_const.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- server_const.pm 5 Mar 2004 18:19:15 -0000 1.3
+++ server_const.pm 2 Jun 2004 02:13:24 -0000 1.4
@@ -28,9 +28,9 @@
# test Apache::Server constant subroutines
- ok t_cmp(canonpath($root),
- canonpath(Apache::server_root),
- 'Apache::server_root()');
+ ok t_filepath_cmp(canonpath($root),
+ canonpath(Apache::server_root),
+ 'Apache::server_root()');
ok t_cmp($built,
1.15 +20 -20 modperl-2.0/t/response/TestAPI/server_util.pm
Index: server_util.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/server_util.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- server_util.pm 5 Mar 2004 18:19:15 -0000 1.14
+++ server_util.pm 2 Jun 2004 02:13:24 -0000 1.15
@@ -71,18 +71,18 @@
foreach my $p (keys %pools) {
- ok t_cmp(catfile($serverroot, 'conf'),
- canonpath(Apache::server_root_relative($pools{$p},
- 'conf')),
- "Apache:::server_root_relative($p, 'conf')");
+ ok t_filepath_cmp(catfile($serverroot, 'conf'),
+ canonpath(Apache::server_root_relative($pools{$p},
+ 'conf')),
+ "Apache:::server_root_relative($p, 'conf')");
}
# dig out the pool from valid objects
foreach my $obj (keys %objects) {
- ok t_cmp(catfile($serverroot, 'conf'),
- canonpath($objects{$obj}->server_root_relative('conf')),
- "$obj->server_root_relative('conf')");
+ ok t_filepath_cmp(catfile($serverroot, 'conf'),
+ canonpath($objects{$obj}->server_root_relative('conf')),
+ "$obj->server_root_relative('conf')");
}
# syntax - unrecognized objects don't segfault
@@ -96,26 +96,26 @@
}
# no file argument gives ServerRoot
- ok t_cmp(canonpath($serverroot),
- canonpath($r->server_root_relative),
- '$r->server_root_relative()');
-
- ok t_cmp(canonpath($serverroot),
- canonpath(Apache::server_root_relative($r->pool)),
- 'Apache::server_root_relative($r->pool)');
+ ok t_filepath_cmp(canonpath($serverroot),
+ canonpath($r->server_root_relative),
+ '$r->server_root_relative()');
+
+ ok t_filepath_cmp(canonpath($serverroot),
+ canonpath(Apache::server_root_relative($r->pool)),
+ 'Apache::server_root_relative($r->pool)');
# Apache::server_root is also the ServerRoot constant
- ok t_cmp(canonpath(Apache::server_root),
- canonpath($r->server_root_relative),
- 'Apache::server_root');
+ ok t_filepath_cmp(canonpath(Apache::server_root),
+ canonpath($r->server_root_relative),
+ 'Apache::server_root');
{
# absolute paths should resolve to themselves
my $dir = $r->server_root_relative('logs');
- ok t_cmp($r->server_root_relative($dir),
- $dir,
- "\$r->server_root_relative($dir)");
+ ok t_filepath_cmp($r->server_root_relative($dir),
+ $dir,
+ "\$r->server_root_relative($dir)");
}
t_debug('registering method FOO');
1.12 +15 -15 modperl-2.0/t/response/TestCompat/apache.pm
Index: apache.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestCompat/apache.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- apache.pm 5 Mar 2004 18:19:15 -0000 1.11
+++ apache.pm 2 Jun 2004 02:13:24 -0000 1.12
@@ -64,29 +64,29 @@
'Apache->httpd_conf');
$r->server->server_admin($admin);
- ok t_cmp(canonpath($Apache::Server::CWD),
- canonpath(Apache::Test::config()->{vars}->{serverroot}),
- '$Apache::Server::CWD');
+ ok t_filepath_cmp(canonpath($Apache::Server::CWD),
+ canonpath(Apache::Test::config()->{vars}->{serverroot}),
+ '$Apache::Server::CWD');
- ok t_cmp(canonpath($Apache::Server::CWD),
- canonpath($r->server_root_relative),
- '$r->server_root_relative()');
+ ok t_filepath_cmp(canonpath($Apache::Server::CWD),
+ canonpath($r->server_root_relative),
+ '$r->server_root_relative()');
- ok t_cmp(catfile($Apache::Server::CWD, 'conf'),
- canonpath($r->server_root_relative('conf')),
- "\$r->server_root_relative('conf')");
+ ok t_filepath_cmp(catfile($Apache::Server::CWD, 'conf'),
+ canonpath($r->server_root_relative('conf')),
+ "\$r->server_root_relative('conf')");
# Apache->server_root_relative
{
Apache::compat::override_mp2_api('Apache::server_root_relative');
- ok t_cmp(catfile($Apache::Server::CWD, 'conf'),
- canonpath(Apache->server_root_relative('conf')),
- "Apache->server_root_relative('conf')");
+ ok t_filepath_cmp(catfile($Apache::Server::CWD, 'conf'),
+ canonpath(Apache->server_root_relative('conf')),
+ "Apache->server_root_relative('conf')");
- ok t_cmp(canonpath($Apache::Server::CWD),
- canonpath(Apache->server_root_relative),
- 'Apache->server_root_relative()');
+ ok t_filepath_cmp(canonpath($Apache::Server::CWD),
+ canonpath(Apache->server_root_relative),
+ 'Apache->server_root_relative()');
Apache::compat::restore_mp2_api('Apache::server_root_relative');
}
