feat: add utime() override for mocked files

lib/Test/MockFile.pm

@@ -273,6 +273,7 @@ sub file_arg_position_for_command {    # can also be used by user hooks
         'stat'     => 0,
         'sysopen'  => 1,
         'unlink'   => 0,
+        'utime'    => 2,
         'readdir'  => 0,
     };
 
@@ -2429,6 +2430,58 @@ sub __chmod (@) {
     return $num_changed;
 }
 
+sub __utime (@) {
+    my ( $atime, $mtime, @files ) = @_;
+
+    # Not an error, report we changed zero files
+    @files
+      or return 0;
+
+    my %mocked_files   = map +( $_ => _get_file_object($_) ), @files;
+    my @unmocked_files = grep !$mocked_files{$_}, @files;
+    my @mocked_files   = map ref $_ ? $_->{'path'} : (), values %mocked_files;
+
+    if ( @mocked_files && @mocked_files != @files ) {
+        confess(
+            sprintf 'You called utime() on a mix of mocked (%s) and unmocked files (%s) ' . ' - this is very likely a bug on your side',
+            ( join ', ', @mocked_files ),
+            ( join ', ', @unmocked_files ),
+        );
+    }
+
+    # If no files are mocked, fall through to the real utime
+    if ( !@mocked_files ) {
+        _real_file_access_hook( 'utime', \@_ );
+        goto \&CORE::utime if _goto_is_available();
+        return CORE::utime( $atime, $mtime, @files );
+    }
+
+    my $now         = time;
+    my $num_changed = 0;
+    foreach my $file (@files) {
+        my $mock = $mocked_files{$file};
+
+        if ( !$mock ) {
+            _real_file_access_hook( 'utime', \@_ );
+            goto \&CORE::utime if _goto_is_available();
+            return CORE::utime( $atime, $mtime, @files );
+        }
+
+        if ( !$mock->exists() ) {
+            $! = ENOENT;
+            next;
+        }
+
+        $mock->{'atime'} = defined $atime ? $atime : $now;
+        $mock->{'mtime'} = defined $mtime ? $mtime : $now;
+        $mock->{'ctime'} = $now;
+
+        $num_changed++;
+    }
+
+    return $num_changed;
+}
+
 BEGIN {
     *CORE::GLOBAL::glob = !$^V || $^V lt 5.18.0
       ? sub {
@@ -2452,6 +2505,7 @@ BEGIN {
     *CORE::GLOBAL::rmdir = \&__rmdir;
     *CORE::GLOBAL::chown = \&__chown;
     *CORE::GLOBAL::chmod = \&__chmod;
+    *CORE::GLOBAL::utime = \&__utime;
 }
 
 =head1 CAEATS AND LIMITATIONS

t/utime.t

@@ -0,0 +1,164 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Tools::Explain;
+use Test2::Plugin::NoWarnings;
+use Test2::Tools::Exception qw< lives dies >;
+
+use File::Temp qw< tempfile >;
+use Cwd        ();
+use Errno      qw< ENOENT >;
+
+# Create tempfiles before Test::MockFile overrides are installed,
+# so File::Temp's internal stat/chmod calls hit real CORE functions.
+my ( $passthrough_tempfile, $nostrict_tempfile );
+BEGIN {
+    ( undef, $passthrough_tempfile ) = tempfile( UNLINK => 0 );
+    ( undef, $nostrict_tempfile )    = tempfile( UNLINK => 0 );
+}
+
+use Test::MockFile qw< nostrict >;
+
+subtest(
+    'utime on mocked file' => sub {
+        my $file = Test::MockFile->file( '/foo/bar', 'content' );
+        ok( -f '/foo/bar', 'File exists' );
+
+        my $new_atime = 1000000;
+        my $new_mtime = 2000000;
+
+        is( utime( $new_atime, $new_mtime, '/foo/bar' ), 1, 'utime returns 1 for success' );
+
+        my @stat = stat('/foo/bar');
+        is( $stat[8], $new_atime, 'atime was updated' );
+        is( $stat[9], $new_mtime, 'mtime was updated' );
+    }
+);
+
+subtest(
+    'utime updates ctime to current time' => sub {
+        my $file = Test::MockFile->file( '/foo/baz', 'content' );
+
+        my $before = time;
+        utime( 1000, 2000, '/foo/baz' );
+        my $after = time;
+
+        my @stat = stat('/foo/baz');
+        ok( $stat[10] >= $before && $stat[10] <= $after, 'ctime was updated to current time' );
+    }
+);
+
+subtest(
+    'utime with undef uses current time' => sub {
+        my $file = Test::MockFile->file( '/foo/undef_test', 'content' );
+
+        my $before = time;
+        is( utime( undef, undef, '/foo/undef_test' ), 1, 'utime with undef returns 1' );
+        my $after = time;
+
+        my @stat = stat('/foo/undef_test');
+        ok( $stat[8] >= $before && $stat[8] <= $after, 'atime set to current time when undef' );
+        ok( $stat[9] >= $before && $stat[9] <= $after, 'mtime set to current time when undef' );
+    }
+);
+
+subtest(
+    'utime on multiple mocked files' => sub {
+        my $file1 = Test::MockFile->file( '/multi/a', 'aaa' );
+        my $file2 = Test::MockFile->file( '/multi/b', 'bbb' );
+
+        is( utime( 5000, 6000, '/multi/a', '/multi/b' ), 2, 'utime returns 2 for two files' );
+
+        my @stat_a = stat('/multi/a');
+        my @stat_b = stat('/multi/b');
+        is( $stat_a[8], 5000, 'file a atime updated' );
+        is( $stat_a[9], 6000, 'file a mtime updated' );
+        is( $stat_b[8], 5000, 'file b atime updated' );
+        is( $stat_b[9], 6000, 'file b mtime updated' );
+    }
+);
+
+subtest(
+    'utime on nonexistent mocked file' => sub {
+        my $file = Test::MockFile->file('/no/exist');
+        ok( !-f '/no/exist', 'File does not exist' );
+
+        $! = 0;
+        is( utime( 1000, 2000, '/no/exist' ), 0, 'utime returns 0 for nonexistent file' );
+        is( $! + 0, ENOENT, '$! is set to ENOENT' );
+    }
+);
+
+subtest(
+    'utime on mocked directory' => sub {
+        my $dir = Test::MockFile->dir('/mydir');
+        ok( mkdir('/mydir'), 'Created directory' );
+        ok( -d '/mydir',     'Directory exists' );
+
+        is( utime( 3000, 4000, '/mydir' ), 1, 'utime on directory returns 1' );
+
+        my @stat = stat('/mydir');
+        is( $stat[8], 3000, 'dir atime updated' );
+        is( $stat[9], 4000, 'dir mtime updated' );
+    }
+);
+
+subtest(
+    'utime with no files returns 0' => sub {
+        is( utime( 1000, 2000 ), 0, 'utime with no files returns 0' );
+    }
+);
+
+subtest(
+    'utime on mix of mocked and unmocked files' => sub {
+        my $filename = __FILE__;
+        my $mocked   = Cwd::getcwd() . "/$filename";
+        my $unmocked = '/foo_DOES_NOT_EXIST.znxc';
+
+        my $file = Test::MockFile->file( $filename, 'whatevs' );
+
+        like(
+            dies( sub { utime 1000, 2000, $filename, $unmocked } ),
+            qr/^\QYou called utime() on a mix of mocked ($mocked) and unmocked files ($unmocked)\E/xms,
+            'Cannot mix mocked and unmocked files with utime',
+        );
+    }
+);
+
+subtest(
+    'utime on unmocked file passes through' => sub {
+        my $new_atime = 1000000;
+        my $new_mtime = 2000000;
+
+        is( utime( $new_atime, $new_mtime, $passthrough_tempfile ), 1, 'utime on real file returns 1' );
+
+        my @stat = CORE::stat($passthrough_tempfile);
+        is( $stat[8], $new_atime, 'real file atime was updated' );
+        is( $stat[9], $new_mtime, 'real file mtime was updated' );
+
+        CORE::unlink $passthrough_tempfile;
+    }
+);
+
+subtest(
+    'utime on unmocked file while mocked files exist' => sub {
+        my $mock = Test::MockFile->file( '/mocked/for_utime', 'data' );
+
+        my $new_atime = 3000000;
+        my $new_mtime = 4000000;
+
+        is( utime( $new_atime, $new_mtime, $nostrict_tempfile ), 1, 'utime on unmocked file returns 1' );
+
+        my @stat = CORE::stat($nostrict_tempfile);
+        is( $stat[8], $new_atime, 'unmocked file atime was updated' );
+        is( $stat[9], $new_mtime, 'unmocked file mtime was updated' );
+
+        CORE::unlink $nostrict_tempfile;
+    }
+);
+
+done_testing();
+exit;

t/utime_strict.t

@@ -0,0 +1,45 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+
+use Test2::Bundle::Extended;
+use Test2::Plugin::NoWarnings;
+use Test2::Tools::Exception qw< dies lives >;
+
+use File::Temp qw< tempfile >;
+
+my ( $temp_fh, $tempfile );
+BEGIN { ( $temp_fh, $tempfile ) = tempfile( UNLINK => 0 ); close $temp_fh; }
+
+use Test::MockFile;
+
+subtest(
+    'utime on unmocked file in strict mode dies' => sub {
+        like(
+            dies( sub { utime 1000, 2000, $tempfile } ),
+            qr/\Qutime\E/,
+            'utime on unmocked file in strict mode triggers violation',
+        );
+
+        CORE::unlink($tempfile);
+    }
+);
+
+subtest(
+    'utime on mocked file in strict mode succeeds' => sub {
+        my $file = Test::MockFile->file( '/strict/test', 'content' );
+
+        ok(
+            lives( sub { utime 1000, 2000, '/strict/test' } ),
+            'utime on mocked file in strict mode works',
+        ) or note $@;
+
+        my @stat = stat('/strict/test');
+        is( $stat[8], 1000, 'atime set correctly in strict mode' );
+        is( $stat[9], 2000, 'mtime set correctly in strict mode' );
+    }
+);
+
+done_testing();
+exit;