randyk 2004/07/15 08:28:03
Modified: t/response/TestAPR finfo.pm
Added: t/apr-ext finfo.t
t/lib/TestAPRlib finfo.pm
Log:
Reviewed by: stas
put common finfo tests under t/lib/TestAPRlib/, and call
them from both t/apr/ and t/apr-ext/.
Revision Changes Path
1.1 modperl-2.0/t/apr-ext/finfo.t
Index: finfo.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use TestAPRlib::finfo;
plan tests => TestAPRlib::finfo::num_of_tests();
TestAPRlib::finfo::test();
1.1 modperl-2.0/t/lib/TestAPRlib/finfo.pm
Index: finfo.pm
===================================================================
package TestAPRlib::finfo;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestTrace;
use Apache::TestConfig;
use constant WIN32 => Apache::TestConfig::WIN32;
use constant OSX => Apache::TestConfig::OSX;
use constant APACHE_2_0_49 => have_apache_version('2.0.49');
use File::Spec::Functions qw(catfile);
use Fcntl qw(:mode);
use APR::Finfo ();
use APR::Pool ();
use APR::Const -compile => qw(SUCCESS FINFO_NORM REG
WREAD WWRITE WEXECUTE);
sub num_of_tests {
return 15;
}
sub test {
my $file = __FILE__;
my $pool = APR::Pool->new();
# populate the finfo struct first
my $finfo = APR::Finfo::stat($file, APR::FINFO_NORM, $pool);
ok $finfo->isa('APR::Finfo');
# stat tests (same as perl's stat)
{
# now, get information from perl's stat()
our ($device, $inode, $protection, $nlink, $user, $group,
undef, $size, $atime, $mtime, $ctime) = stat $file;
# skip certain tests on Win32 and others
my %skip = ();
if (WIN32) {
# atime is wrong on NTFS, but OK on FAT32
%skip = map {$_ => 1} qw(device inode user group atime);
}
elsif (OSX) {
# XXX both apr and perl report incorrect group values. sometimes.
# XXX skip until we can really figure out what is going on.
%skip = (group => 1);
}
# compare stat fields between perl and apr_stat
{
no strict qw(refs);
foreach my $method (qw(device inode nlink user group
size atime mtime ctime)) {
if ($skip{$method}) {
skip "different file semantics", 0;
}
else {
ok t_cmp($finfo->$method(),
${$method},
"\$finfo->$method()");
}
}
}
# match world bits
ok t_cmp($finfo->protection & APR::WREAD,
$protection & S_IROTH,
'$finfo->protection() & APR::WREAD');
ok t_cmp($finfo->protection & APR::WWRITE,
$protection & S_IWOTH,
'$finfo->protection() & APR::WWRITE');
if (WIN32) {
skip "different file semantics", 0;
}
else {
ok t_cmp($finfo->protection & APR::WEXECUTE,
$protection & S_IXOTH,
'$finfo->protection() & APR::WEXECUTE');
}
}
# tests for stuff not in perl's stat
{
# BACK_COMPAT_MARKER - fixed as of 2.0.49.
if (WIN32 && !APACHE_2_0_49) {
skip "finfo.fname requires Apache 2.0.49 or later", 0;
}
else {
ok t_cmp($finfo->fname,
$file,
'$finfo->fname()');
}
ok t_cmp($finfo->filetype,
APR::REG,
'$finfo->filetype()');
}
}
1;
1.13 +4 -89 modperl-2.0/t/response/TestAPR/finfo.pm
Index: finfo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPR/finfo.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- finfo.pm 8 Jul 2004 06:06:33 -0000 1.12
+++ finfo.pm 15 Jul 2004 15:28:03 -0000 1.13
@@ -5,27 +5,18 @@
use Apache::Test;
use Apache::TestUtil;
-use Apache::TestTrace;
-use Apache::TestConfig;
-use constant WIN32 => Apache::TestConfig::WIN32;
-use constant OSX => Apache::TestConfig::OSX;
-use constant APACHE_2_0_49 => have_apache_version('2.0.49');
+use TestAPRlib::finfo;
-use Apache::RequestRec ();
use APR::Finfo ();
-use File::Spec::Functions qw(catfile);
-use Fcntl qw(:mode);
-
use Apache::Const -compile => 'OK';
-use APR::Const -compile => qw(SUCCESS FINFO_NORM REG
- WREAD WWRITE WEXECUTE);
sub handler {
my $r = shift;
- plan $r, tests => 17;
+ my $tests = 2 + TestAPRlib::finfo::num_of_tests();
+ plan $r, tests => $tests;
{
my $finfo = $r->finfo;
@@ -43,83 +34,7 @@
ok $isa;
}
- my $file = $r->server_root_relative(catfile qw(htdocs index.html));
- # populate the finfo struct first
- my $finfo = APR::Finfo::stat($file, APR::FINFO_NORM, $r->pool);
-
- ok $finfo->isa('APR::Finfo');
-
- # stat tests (same as perl's stat)
- {
- # now, get information from perl's stat()
- our ($device, $inode, $protection, $nlink, $user, $group,
- undef, $size, $atime, $mtime, $ctime) = stat $file;
-
- # skip certain tests on Win32 and others
- my %skip = ();
-
- if (WIN32) {
- # atime is wrong on NTFS, but OK on FAT32
- %skip = map {$_ => 1} qw(device inode user group atime);
- }
- elsif (OSX) {
- # XXX both apr and perl report incorrect group values. sometimes.
- # XXX skip until we can really figure out what is going on.
- %skip = (group => 1);
- }
-
- # compare stat fields between perl and apr_stat
- {
- no strict qw(refs);
- foreach my $method (qw(device inode nlink user group
- size atime mtime ctime)) {
- if ($skip{$method}) {
- skip "different file semantics", 0;
- }
- else {
- ok t_cmp($finfo->$method(),
- ${$method},
- "\$finfo->$method()");
- }
- }
- }
-
- # match world bits
-
- ok t_cmp($finfo->protection & APR::WREAD,
- $protection & S_IROTH,
- '$finfo->protection() & APR::WREAD');
-
- ok t_cmp($finfo->protection & APR::WWRITE,
- $protection & S_IWOTH,
- '$finfo->protection() & APR::WWRITE');
-
- if (WIN32) {
- skip "different file semantics", 0;
- }
- else {
- ok t_cmp($finfo->protection & APR::WEXECUTE,
- $protection & S_IXOTH,
- '$finfo->protection() & APR::WEXECUTE');
- }
- }
-
- # tests for stuff not in perl's stat
- {
- # BACK_COMPAT_MARKER - fixed as of 2.0.49.
- if (WIN32 && !APACHE_2_0_49) {
- skip "finfo.fname requires Apache 2.0.49 or later", 0;
- }
- else {
- ok t_cmp($finfo->fname,
- $file,
- '$finfo->fname()');
- }
-
- ok t_cmp($finfo->filetype,
- APR::REG,
- '$finfo->filetype()');
- }
+ TestAPRlib::finfo::test();
Apache::OK;
}
