Repository: lucy-clownfish Updated Branches: refs/heads/0.4 c0e6f245f -> ac03eb765
Handle read-only files when setting file time on Windows Strawberry Perl may unpack the files of a CPAN distribution as read-only. Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/ac03eb76 Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/ac03eb76 Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/ac03eb76 Branch: refs/heads/0.4 Commit: ac03eb76588539b5ce180f9253f2bcea86df498a Parents: c0e6f24 Author: Nick Wellnhofer <[email protected]> Authored: Fri Jun 12 15:05:57 2015 +0200 Committer: Nick Wellnhofer <[email protected]> Committed: Fri Jun 12 15:21:25 2015 +0200 ---------------------------------------------------------------------- compiler/perl/t/500-hierarchy.t | 5 +++++ compiler/src/CFCTest.c | 41 ++++++++++++++++++++++++------------ 2 files changed, 32 insertions(+), 14 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ac03eb76/compiler/perl/t/500-hierarchy.t ---------------------------------------------------------------------- diff --git a/compiler/perl/t/500-hierarchy.t b/compiler/perl/t/500-hierarchy.t index 6c2a10c..c63ecdf 100644 --- a/compiler/perl/t/500-hierarchy.t +++ b/compiler/perl/t/500-hierarchy.t @@ -91,6 +91,11 @@ for my $file (@files) { } my $path_to_animal_cf = $animal->cfh_path( $base_dir ); +# Strawberry Perl may unpack the distribution's files as read-only. +if ( ! -w $path_to_animal_cf ) { + chmod( 0644, $path_to_animal_cf ) + or die "chmod for '$path_to_animal_cf' failed"; +} utime( undef, undef, $path_to_animal_cf ) or die "utime for '$path_to_animal_cf' failed"; # touch http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/ac03eb76/compiler/src/CFCTest.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCTest.c b/compiler/src/CFCTest.c index 21cff48..5ddff02 100644 --- a/compiler/src/CFCTest.c +++ b/compiler/src/CFCTest.c @@ -454,26 +454,25 @@ CFCTest_get_file_mtime(const char *path) { return buf.st_mtime; } -#if defined(CHY_HAS_UTIME_H) +#if defined(CHY_HAS_WINDOWS_H) -#include <utime.h> +#include <windows.h> void CFCTest_set_file_times(const char *path, time_t time) { - struct utimbuf buf; - buf.actime = time; - buf.modtime = time; - if (utime(path, &buf)) { - CFCUtil_die("Can't set file time of '%s': %s", path, strerror(errno)); + // Strawberry Perl may unpack the distribution's files as read-only. + DWORD attrs = GetFileAttributes(path); + if (attrs == INVALID_FILE_ATTRIBUTES) { + CFCUtil_die("Can't get file attrs of '%s': %u", path, GetLastError()); + } + if (attrs & FILE_ATTRIBUTE_READONLY) { + attrs &= ~FILE_ATTRIBUTE_READONLY; + if (!SetFileAttributes(path, attrs)) { + CFCUtil_die("Can't make '%s' writable: %u", path, + GetLastError()); + } } -} - -#elif defined(CHY_HAS_WINDOWS_H) - -#include <windows.h> -void -CFCTest_set_file_times(const char *path, time_t time) { HANDLE handle = CreateFile(path, GENERIC_WRITE, FILE_SHARE_READ, NULL, OPEN_EXISTING, 0, NULL); if (handle == INVALID_HANDLE_VALUE) { @@ -489,6 +488,20 @@ CFCTest_set_file_times(const char *path, time_t time) { CloseHandle(handle); } +#elif defined(CHY_HAS_UTIME_H) + +#include <utime.h> + +void +CFCTest_set_file_times(const char *path, time_t time) { + struct utimbuf buf; + buf.actime = time; + buf.modtime = time; + if (utime(path, &buf)) { + CFCUtil_die("Can't set file time of '%s': %s", path, strerror(errno)); + } +} + #else #error Need either utime.h or windows.h
