FileUtils.pm

Branch :

Show log
Commit
Author : Zack Weinberg
Date : 2023-12-10 09:50:51
Hash : cfdb83d4
Message : automake: again revise file mtime resolution support. This patch is from https://bugs.gnu.org/67670. In order for the Automake testsuite to be able to use sub-second delays to control whether certain files are considered newer than others, five(!) separate pieces of software all need to cooperate: automake itself, autoconf's internal `autom4te' utility, the Perl interpreter and its libraries, the sleep(1) shell utility, and finally the filesystem hosting the build directory. The existing tests for this are a combination of inadequate and incorrect. This patch, in conjunction with a patch just committed to Autoconf trunk, https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=39d96e6fff7ceae63b823872602caf4d255a38c8 should make everything much more robust, as follows: - _AM_FILESYSTEM_TIMESTAMP_RESOLUTION is completely rewritten. It no longer looks for autom4te at all, because this macro is invoked unconditionally from AM_INIT, so *every* project that uses Automake would get this test that's only relevant to Automake's own testsuite. Also, it tries sleeping for as little as one millisecond (smaller delays consistently get rounded up to 1ms on my computer and I expect that's universal), it should accurately detect FAT's two-second resolution now, and it should not be tripped up anymore by running at precisely the moment that will make a 0.1s sleep cross a 1s boundary (this may sound unlikely but it used to cause a couple of test failures *every time* I ran the automake testsuite on a network filesystem that only supported 1s resolution). - In support of the above, the test for working ls -t moved from AM_SANITY_CHECK to _AM_FILESYSTEM_TIMESTAMP_RESOLUTION. This allowed me to simplify the test for $srcdir/configure being older than a freshly created file. - If automake is capable of reading high-resolution file modification timestamps from the operating system, it prints `Features: subsecond-mtime' as the second line of --version output. (We can't just assume this works for sufficiently new automake, because it depends on whether the Perl interpreter provides this capability, and that's not a simple question of which version of Perl you have, either.) - The Autoconf patch mentioned above adds the same annotation to the output of autom4te --version. - Finally, t/ax/test-defs.in looks for the `Features: subsecond-mtime' string from both automake and autom4te and resets the sleep time to one second if it's not there. There might be a better place to put this, somewhere it'll execute every time the *overall testsuite* is invoked rather than once for each test, but I couldn't find one. Tested on x86-64-linux with development automake and development autoconf. Previous discussion: - https://lists.gnu.org/archive/html/automake/2023-03/msg00000.html - https://lists.gnu.org/archive/html/automake/2023-04/msg00002.html - https://lists.gnu.org/archive/html/automake/2023-12/msg00005.html - https://debbugs.gnu.org/cgi/bugreport.cgi?bug=64756 * m4/sanity.m4 (_AM_FILESYSTEM_TIMESTAMP_RESOLUTION): Rewrite for greater reliability. Don't probe autom4te at all here. Check for working ls -t here. (AM_SANITY_CHECK): Do not cache the result. Do not check for working `ls -t' here. Disentangle control flow in the loop probing the relative ages of build and source directory. * lib/Automake/FileUtils.pm: Sync from autoconf. * bin/automake.in (version): Include `Features: subsecond-mtime' in the output if $Automake::FileUtils::subsecond_mtime is true. * configure.ac: Rename the substitution variable MODIFICATION_DELAY to MTIME_RESOLUTION. * t/ax/test-defs.in: Require both $AUTOMAKE and $AUTOM4TE to report support for high-resolution timestamps before setting $sleep to delay for less than one second. * NEWS: Update info.

lib/Automake/FileUtils.pm

# Copyright (C) 2003-2023 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <https://www.gnu.org/licenses/>.

###############################################################
# The main copy of this file is in Automake's git repository. #
# Updates should be sent to automake-patches@gnu.org.         #
###############################################################

package Automake::FileUtils;

=head1 NAME

Automake::FileUtils - handling files

=head1 SYNOPSIS

  use Automake::FileUtils

=head1 DESCRIPTION

This perl module provides various general purpose file handling functions.

=cut

use 5.006;
use strict;
use warnings FATAL => 'all';

BEGIN
{
  require Exporter;
  our @ISA = qw (Exporter);
  our @EXPORT = qw (&contents
		    &find_file &mtime
		    &update_file
		    &xsystem &xsystem_hint &xqx
		    &dir_has_case_matching_file &reset_dir_cache
		    &set_dir_cache_file);
}

# Use sub-second resolution file timestamps if available, carry on
# with one-second resolution timestamps if Time::HiRes is not available.
#
# Unfortunately, even if Time::HiRes is available, we don't get
# timestamps to the full precision recorded by the operating system,
# because Time::HiRes converts timestamps to floating-point, and the
# rounding error is hundreds of nanoseconds for circa-2023 timestamps
# in IEEE double precision.  But this is the best we can do without
# dropping down to C.
#
# $subsecond_mtime is not exported, but is intended for external
# consumption, as $Automake::FileUtils::subsecond_mtime.
BEGIN
{
  our $subsecond_mtime = 0;
  eval
    {
      require Time::HiRes;
      import Time::HiRes qw(stat);
      $subsecond_mtime = 1;
    }
}

use IO::File;
use Automake::Channels;
use Automake::ChannelDefs;

=over 4

=item C<find_file ($file_name, @include)>

Return the first path for a C<$file_name> in the C<include>s.

We match exactly the behavior of GNU M4: first look in the current
directory (which includes the case of absolute file names), and then,
if the file name is not absolute, look in C<@include>.

If the file is flagged as optional (ends with C<?>), then return undef
if absent, otherwise exit with error.

=cut

# $FILE_NAME
# find_file ($FILE_NAME, @INCLUDE)
# --------------------------------
sub find_file ($@)
{
  use File::Spec;

  my ($file_name, @include) = @_;
  my $optional = 0;

  $optional = 1
    if $file_name =~ s/\?$//;

  return File::Spec->canonpath ($file_name)
    if -e $file_name;

  if (!File::Spec->file_name_is_absolute ($file_name))
    {
      foreach my $path (@include)
	{
	  return File::Spec->canonpath (File::Spec->catfile ($path, $file_name))
	    if -e File::Spec->catfile ($path, $file_name)
	}
    }

  fatal "$file_name: no such file or directory"
    unless $optional;
  return undef;
}

=item C<mtime ($file)>

Return the mtime of C<$file>.  Missing files, or C<-> standing for
C<STDIN> or C<STDOUT> are "obsolete", i.e., as old as possible.

=cut

# $MTIME
# MTIME ($FILE)
# -------------
sub mtime ($)
{
  my ($file) = @_;

  return 0
    if $file eq '-' || ! -f $file;

  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks) = stat ($file)
    or fatal "cannot stat $file: $!";

  return $mtime;
}


=item C<update_file ($from, $to, [$force])>

Rename C<$from> as C<$to>, preserving C<$to> timestamp if it has not
changed, unless C<$force> is true (defaults to false).  Recognize
C<$to> = C<-> standing for C<STDIN>.  C<$from> is always
removed/renamed.

=cut

# &update_file ($FROM, $TO; $FORCE)
# ---------------------------------
sub update_file ($$;$)
{
  my ($from, $to, $force) = @_;
  $force = 0
    unless defined $force;
  my $SIMPLE_BACKUP_SUFFIX = $ENV{'SIMPLE_BACKUP_SUFFIX'} || '~';
  use File::Compare;
  use File::Copy;

  if ($to eq '-')
    {
      my $in = new IO::File $from, "<";
      my $out = new IO::File (">-");
      while ($_ = $in->getline)
	{
	  print $out $_;
	}
      $in->close;
      unlink ($from) || fatal "cannot remove $from: $!";
      return;
    }

  if (!$force && -f "$to" && compare ("$from", "$to") == 0)
    {
      # File didn't change, so don't update its mod time.
      msg 'note', "'$to' is unchanged";
      unlink ($from)
        or fatal "cannot remove $from: $!";
      return
    }

  if (-f "$to")
    {
      # Back up and install the new one.
      move ("$to",  "$to$SIMPLE_BACKUP_SUFFIX")
	or fatal "cannot backup $to: $!";
      move ("$from", "$to")
	or fatal "cannot rename $from as $to: $!";
      msg 'note', "'$to' is updated";
    }
  else
    {
      move ("$from", "$to")
	or fatal "cannot rename $from as $to: $!";
      msg 'note', "'$to' is created";
    }
}


=item C<handle_exec_errors ($command, [$expected_exit_code = 0], [$hint])>

Display an error message for C<$command>, based on the content of
C<$?> and C<$!>.  Be quiet if the command exited normally
with C<$expected_exit_code>.  If C<$hint> is given, display that as well
if the command failed to run at all.

=cut

sub handle_exec_errors ($;$$)
{
  my ($command, $expected, $hint) = @_;
  $expected = 0 unless defined $expected;
  if (defined $hint)
    {
      $hint = "\n" . $hint;
    }
  else
    {
      $hint = '';
    }

  $command = (split (' ', $command))[0];
  if ($!)
    {
      fatal "failed to run $command: $!" . $hint;
    }
  else
    {
      use POSIX qw (WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG);

      if (WIFEXITED ($?))
	{
	  my $status = WEXITSTATUS ($?);
	  # Propagate exit codes.
	  fatal ('',
		 "$command failed with exit status: $status",
		 exit_code => $status)
	    unless $status == $expected;
	}
      elsif (WIFSIGNALED ($?))
	{
	  my $signal = WTERMSIG ($?);
	  fatal "$command terminated by signal: $signal";
	}
      else
	{
	  fatal "$command exited abnormally";
	}
    }
}

=item C<xqx ($command)>

Same as C<qx> (but in scalar context), but fails on errors.

=cut

# xqx ($COMMAND)
# --------------
sub xqx ($)
{
  my ($command) = @_;

  verb "running: $command";

  $! = 0;
  my $res = `$command`;
  handle_exec_errors $command
    if $?;

  return $res;
}


=item C<xsystem (@argv)>

Same as C<system>, but fails on errors, and reports the C<@argv>
in verbose mode.

=cut

sub xsystem (@)
{
  my (@command) = @_;

  verb "running: @command";

  $! = 0;
  handle_exec_errors "@command"
    if system @command;
}


=item C<xsystem_hint ($msg, @argv)>

Same as C<xsystem>, but allows to pass a hint that will be displayed
in case the command failed to run at all.

=cut

sub xsystem_hint (@)
{
  my ($hint, @command) = @_;

  verb "running: @command";

  $! = 0;
  handle_exec_errors "@command", 0, $hint
    if system @command;
}


=item C<contents ($file_name)>

Return the contents of C<$file_name>.

=cut

# contents ($FILE_NAME)
# ---------------------
sub contents ($)
{
  my ($file) = @_;
  verb "reading $file";
  local $/;			# Turn on slurp-mode.
  my $f = new Automake::XFile $file, "<";
  my $contents = $f->getline;
  $f->close;
  return $contents;
}


=item C<dir_has_case_matching_file ($DIRNAME, $FILE_NAME)>

Return true iff $DIR contains a file name that matches $FILE_NAME case
insensitively.

We need to be cautious on case-insensitive case-preserving file
systems (e.g. Mac OS X's HFS+).  On such systems C<-f 'Foo'> and C<-f
'foO'> answer the same thing.  Hence if a package distributes its own
F<CHANGELOG> file, but has no F<ChangeLog> file, automake would still
try to distribute F<ChangeLog> (because it thinks it exists) in
addition to F<CHANGELOG>, although it is impossible for these two
files to be in the same directory (the two file names designate the
same file).

=cut

our %_directory_cache;
sub dir_has_case_matching_file ($$)
{
  # Note that print File::Spec->case_tolerant returns 0 even on MacOS
  # X (with Perl v5.8.1-RC3 at least), so do not try to shortcut this
  # function using that.

  my ($dirname, $file_name) = @_;
  return 0 unless -f "$dirname/$file_name";

  # The file appears to exist, however it might be a mirage if the
  # system is case insensitive.  Let's browse the directory and check
  # whether the file is really in.  We maintain a cache of directories
  # so Automake doesn't spend all its time reading the same directory
  # again and again.
  if (!exists $_directory_cache{$dirname})
    {
      error "failed to open directory '$dirname'"
	unless opendir (DIR, $dirname);
      $_directory_cache{$dirname} = { map { $_ => 1 } readdir (DIR) };
      closedir (DIR);
    }
  return exists $_directory_cache{$dirname}{$file_name};
}

=item C<reset_dir_cache ($dirname)>

Clear C<dir_has_case_matching_file>'s cache for C<$dirname>.

=cut

sub reset_dir_cache ($)
{
  delete $_directory_cache{$_[0]};
}

=item C<set_dir_cache_file ($dirname, $file_name)>

State that C<$dirname> contains C<$file_name> now.

=cut

sub set_dir_cache_file ($$)
{
  my ($dirname, $file_name) = @_;
  $_directory_cache{$dirname}{$file_name} = 1
    if exists $_directory_cache{$dirname};
}

=back

=cut

1; # for require

### Setup "GNU" style for perl-mode and cperl-mode.
## Local Variables:
## perl-indent-level: 2
## perl-continued-statement-offset: 2
## perl-continued-brace-offset: 0
## perl-brace-offset: 0
## perl-brace-imaginary-offset: 0
## perl-label-offset: -2
## cperl-indent-level: 2
## cperl-brace-offset: 0
## cperl-continued-brace-offset: 0
## cperl-label-offset: -2
## cperl-extra-newline-before-brace: t
## cperl-merge-trailing-else: nil
## cperl-continued-statement-offset: 2
## End:

kc3-lang/automake/lib/Automake/FileUtils.pm

Commit

kc3-lang/automake /lib/Automake/FileUtils.pm