CI: Add test for mixed readonly/read-write files

This commit is contained in:
Dan Church 2023-07-20 17:36:42 -05:00
parent 8fdf3069ba
commit 2d06e1bd1b
Signed by: h3xx
GPG key ID: EA2BF379CD2CDBD0
2 changed files with 77 additions and 7 deletions

View file

@ -23,6 +23,7 @@ our @EXPORT = qw/
are_hardlinked
file_exists
filemtime
gen_ident
has_mtime
mktempdir
prep_tar
@ -35,14 +36,9 @@ use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplif
sub are_hardlinked {
my ($starter, @files) = @_;
my $gen_ident = sub {
my ($dev, $ino) = stat $_[0];
return "$dev:$ino";
};
my $starter_ident = $gen_ident->($starter);
my $starter_ident = gen_ident($starter);
foreach my $file (@files) {
if ($gen_ident->($file) ne $starter_ident) {
if (gen_ident($file) ne $starter_ident) {
return 0;
}
}
@ -64,6 +60,12 @@ sub filemtime {
return (stat $file)[9];
}
sub gen_ident {
my $file = shift;
my ($dev, $ino) = stat $file;
return "$dev:$ino";
}
sub has_mtime {
my ($mtime, @files) = @_;
foreach my $file (@files) {

68
t/some-files-readonly.t Executable file
View file

@ -0,0 +1,68 @@
#!perl
use strict;
use warnings;
require Data::Dumper;
use Test::More 'no_plan';
use TestFunctions;
my $test_dir = mktempdir();
my %files = (
rw1 => "$test_dir/rw-dir/1",
rw2 => "$test_dir/rw-dir/2",
ro1 => "$test_dir/ro-dir/ro-file",
);
PREP: {
mkdir "$test_dir/ro-dir";
mkdir "$test_dir/rw-dir";
# Create two read-write links
put_file($files{rw1});
link $files{rw1}, $files{rw2};
# Create a new less-linked but read-only file with the same contents
put_file($files{ro1});
# Lastly, make the directory read-only
chmod 0555, "$test_dir/ro-dir";
}
my $ident_ro_before = gen_ident($files{ro1});
my $ident_rw_before = gen_ident($files{rw1});
my ($exit_code, $stdout, $stderr) = run_script_capture('-f', $test_dir);
is $exit_code, 0, 'script should not fail';
ok file_exists(values %files), 'files were not accidentally deleted';
is $ident_ro_before, gen_ident($files{ro1}), 'read-only file should not have been re-linked';
ok are_hardlinked(values %files), 'all files should become hard-linked ' . prettify_file_idents(values %files);
isnt $ident_rw_before, gen_ident($files{rw1}), 'the read-write file should become hard-linked';
sub put_file {
my @files = @_;
my $bytes = 1_048_576; # 1 MB
foreach my $file (@files) {
open my $fh, '>', $file
or croak("Failed to open file $file for writing: $!");
for (my $bytes_written = 0; $bytes_written < $bytes; ++$bytes_written) {
print $fh 'A';
}
close $fh;
}
return;
}
sub prettify_file_idents {
my @files = @_;
my $d = Data::Dumper->new([{
map { ($_, gen_ident($_)) } @files
}]);
$d->Indent(1);
$d->Sortkeys(1);
$d->Terse(1);
return $d->Dump;
}