In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/9eccdb0c883aba75b8e69f4550a95d8f90a54cf8?hp=ea701e772a972c7cce818cbe61181453aaa58647>
- Log -----------------------------------------------------------------
commit 9eccdb0c883aba75b8e69f4550a95d8f90a54cf8
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:56:20 2018 -0400
Move subroutine definition to end of file.
Thereby improving readability of main program.
commit b9233c133b593f6f072e2bf0f90888ea32fd4452
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:39:48 2018 -0400
Regularize indents within subroutine definition.
Over decades, the code within the subroutine acquired many different
combinations of tabs and whitespace for indents, thereby making the code
less readable. Standardize on 4 whitespaces.
For readability, comment end of two blocks.
commit 3d5119acb70429e626168902afa6e7fede8d7ab9
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:34:22 2018 -0400
Fully encapsulate check_utime_result()
This will permit us to move the subroutine's definition to the end of
the file, thereby improving readability of main program.
commit bc10a1e298eb3ff63ea0075eb9d3995581309dda
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:19:07 2018 -0400
Remove code commented out since March 2002.
Align indents after removal of comments.
commit 98a1ada1d3c08bde4e8bf02b9044633a9fb169b1
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:07:09 2018 -0400
Repeatedly hard-coding an integer is a mistake.
Place 500000000 in variable $ut.
commit 943937462af807936ae15936e520f3eec3acc8d7
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 17:00:50 2018 -0400
Make descriptions more self-documenting
So that while debugging we can see which 'atime' and 'utime' cases we
are handling.
commit 398bbfb82b1eaa00be42f52712440e992b029a13
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 16:44:31 2018 -0400
Add notes so it's easier to see where we are in test file.
commit 40f909803ebee7624103ac43c37efa8f2ba605ae
Author: James E Keenan <jkee...@cpan.org>
Date: Mon Oct 29 16:35:35 2018 -0400
Use t/test.pl's note() function
... rather than print(), for informational statements.
-----------------------------------------------------------------------
Summary of changes:
t/io/fs.t | 151 +++++++++++++++++++++++++++++++-------------------------------
1 file changed, 75 insertions(+), 76 deletions(-)
diff --git a/t/io/fs.t b/t/io/fs.t
index f35b907d5d..ecab714846 100644
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -120,15 +120,11 @@ SKIP: {
SKIP: {
skip "hard links not that hard in $^O", 1 if $^O eq 'amigaos';
- skip "no mode checks", 1 if $skip_mode_checks;
+ skip "no mode checks", 1 if $skip_mode_checks;
-# if ($^O eq 'cygwin') { # new files on cygwin get rwx instead of rw-
-# is($mode & 0777, 0777, "mode of triply-linked file");
-# } else {
- is(sprintf("0%o", $mode & 0777),
- sprintf("0%o", $a_mode & 0777),
- "mode of triply-linked file");
-# }
+ is(sprintf("0%o", $mode & 0777),
+ sprintf("0%o", $a_mode & 0777),
+ "mode of triply-linked file");
}
}
@@ -197,7 +193,7 @@ SKIP: {
}
is(chmod($newmode, "a"), 1, "fchmod");
$mode = (stat $fh)[2];
- SKIP: {
+ SKIP: {
skip "no mode checks", 1 if $skip_mode_checks;
is($mode & 0777, $newmode, "perm restored");
}
@@ -247,88 +243,33 @@ is($ino, undef, "ino of renamed file a should be undef");
$delta = $accurate_timestamps ? 1 : 2; # Granularity of time on the filesystem
chmod 0777, 'b';
-$foo = (utime 500000000,500000000 + $delta,'b');
+$ut = 500000000;
+
+note("basic check of atime and mtime");
+$foo = (utime $ut,$ut + $delta,'b');
is($foo, 1, "utime");
-check_utime_result();
+check_utime_result($ut, $accurate_timestamps, $delta);
utime undef, undef, 'b';
($atime,$mtime) = (stat 'b')[8,9];
-print "# utime undef, undef --> $atime, $mtime\n";
-isnt($atime, 500000000, 'atime');
-isnt($mtime, 500000000 + $delta, 'mtime');
+note("# utime undef, undef --> $atime, $mtime");
+isnt($atime, $ut, 'atime: utime called with two undefs');
+isnt($mtime, $ut + $delta, 'mtime: utime called with two undefs');
SKIP: {
skip "no futimes", 6 unless ($Config{d_futimes} || "") eq "define";
+ note("check futimes");
open(my $fh, "<", 'b');
- $foo = (utime 500000000,500000000 + $delta, $fh);
+ $foo = (utime $ut,$ut + $delta, $fh);
is($foo, 1, "futime");
- check_utime_result();
+ check_utime_result($ut, $accurate_timestamps, $delta);
# [perl #122703]
close $fh;
- ok(!utime(500000000,500000000 + $delta, $fh),
+ ok(!utime($ut,$ut + $delta, $fh),
"utime fails on a closed file handle");
isnt($!+0, 0, "and errno was set");
}
-
-sub check_utime_result {
- ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('b');
-
- SKIP: {
- skip "bogus inode num", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare');
-
- ok($ino, 'non-zero inode num');
- }
-
- SKIP: {
- skip "filesystem atime/mtime granularity too low", 2
- unless $accurate_timestamps;
-
- if ($^O eq 'vos') {
- skip ("# TODO - hit VOS bug posix-2055 - access time does not
follow POSIX rules for an open file.", 2);
- }
-
- print "# atime - $atime mtime - $mtime delta - $delta\n";
- if($atime == 500000000 && $mtime == 500000000 + $delta) {
- pass('atime');
- pass('mtime');
- }
- else {
- if ($^O =~ /\blinux\b/i) {
- print "# Maybe stat() cannot get the correct atime, ".
- "as happens via NFS on linux?\n";
- $foo = (utime 400000000,500000000 + 2*$delta,'b');
- my ($new_atime, $new_mtime) = (stat('b'))[8,9];
- print "# newatime - $new_atime nemtime - $new_mtime\n";
- if ($new_atime == $atime && $new_mtime - $mtime == $delta) {
- pass("atime - accounted for possible NFS/glibc2.2 bug on
linux");
- pass("mtime - accounted for possible NFS/glibc2.2 bug on
linux");
- }
- else {
- fail("atime - $atime/$new_atime $mtime/$new_mtime");
- fail("mtime - $atime/$new_atime $mtime/$new_mtime");
- }
- }
- elsif ($^O eq 'VMS') {
- # why is this 1 second off?
- is( $atime, 500000001, 'atime' );
- is( $mtime, 500000000 + $delta, 'mtime' );
- }
- elsif ($^O eq 'haiku') {
- SKIP: {
- skip "atime not updated", 1;
- }
- is($mtime, 500000001, 'mtime');
- }
- else {
- fail("atime");
- fail("mtime");
- }
- }
- }
-}
-
SKIP: {
skip "has futimes", 1 if ($Config{d_futimes} || "") eq "define";
open(my $fh, "<", "b") || die;
@@ -532,3 +473,61 @@ SKIP: {
# need to remove $tmpdir if rename() in test 28 failed!
END { rmdir $tmpdir1; rmdir $tmpdir; }
+
+sub check_utime_result {
+ ($ut, $accurate_timestamps, $delta) = @_;
+ ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat('b');
+
+ SKIP: {
+ skip "bogus inode num", 1 if ($^O eq 'MSWin32') || ($^O eq 'NetWare');
+ ok($ino, 'non-zero inode num');
+ }
+
+ SKIP: {
+ skip "filesystem atime/mtime granularity too low", 2
+ unless $accurate_timestamps;
+
+ if ($^O eq 'vos') {
+ skip ("# TODO - hit VOS bug posix-2055 - access time does not
follow POSIX rules for an open file.", 2);
+ }
+
+ note("# atime - $atime mtime - $mtime delta - $delta");
+ if($atime == $ut && $mtime == $ut + $delta) {
+ pass('atime: granularity test');
+ pass('mtime: granularity test');
+ }
+ else {
+ if ($^O =~ /\blinux\b/i) {
+ note("# Maybe stat() cannot get the correct atime, ".
+ "as happens via NFS on linux?");
+ $foo = (utime 400000000,$ut + 2*$delta,'b');
+ my ($new_atime, $new_mtime) = (stat('b'))[8,9];
+ note("# newatime - $new_atime nemtime - $new_mtime");
+ if ($new_atime == $atime && $new_mtime - $mtime == $delta) {
+ pass("atime - accounted for possible NFS/glibc2.2 bug on
linux");
+ pass("mtime - accounted for possible NFS/glibc2.2 bug on
linux");
+ }
+ else {
+ fail("atime - $atime/$new_atime $mtime/$new_mtime");
+ fail("mtime - $atime/$new_atime $mtime/$new_mtime");
+ }
+ }
+ elsif ($^O eq 'VMS') {
+ # why is this 1 second off?
+ is( $atime, $ut + 1, 'atime: VMS' );
+ is( $mtime, $ut + $delta, 'mtime: VMS' );
+ }
+ elsif ($^O eq 'haiku') {
+ SKIP: {
+ skip "atime not updated", 1;
+ }
+ is($mtime, 500000001, 'mtime');
+ }
+ else {
+ fail("atime: default case");
+ fail("mtime: default case");
+ }
+ } # END failed atime mtime 'else' block
+ } # END granularity SKIP block
+}
--
Perl5 Master Repository
