CI: Add test for mixed readonly/read-write files
This commit is contained in:
parent
8fdf3069ba
commit
2d06e1bd1b
|
@ -23,6 +23,7 @@ our @EXPORT = qw/
|
||||||
are_hardlinked
|
are_hardlinked
|
||||||
file_exists
|
file_exists
|
||||||
filemtime
|
filemtime
|
||||||
|
gen_ident
|
||||||
has_mtime
|
has_mtime
|
||||||
mktempdir
|
mktempdir
|
||||||
prep_tar
|
prep_tar
|
||||||
|
@ -35,14 +36,9 @@ use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplif
|
||||||
sub are_hardlinked {
|
sub are_hardlinked {
|
||||||
my ($starter, @files) = @_;
|
my ($starter, @files) = @_;
|
||||||
|
|
||||||
my $gen_ident = sub {
|
my $starter_ident = gen_ident($starter);
|
||||||
my ($dev, $ino) = stat $_[0];
|
|
||||||
return "$dev:$ino";
|
|
||||||
};
|
|
||||||
|
|
||||||
my $starter_ident = $gen_ident->($starter);
|
|
||||||
foreach my $file (@files) {
|
foreach my $file (@files) {
|
||||||
if ($gen_ident->($file) ne $starter_ident) {
|
if (gen_ident($file) ne $starter_ident) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -64,6 +60,12 @@ sub filemtime {
|
||||||
return (stat $file)[9];
|
return (stat $file)[9];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub gen_ident {
|
||||||
|
my $file = shift;
|
||||||
|
my ($dev, $ino) = stat $file;
|
||||||
|
return "$dev:$ino";
|
||||||
|
}
|
||||||
|
|
||||||
sub has_mtime {
|
sub has_mtime {
|
||||||
my ($mtime, @files) = @_;
|
my ($mtime, @files) = @_;
|
||||||
foreach my $file (@files) {
|
foreach my $file (@files) {
|
||||||
|
|
|
@ -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;
|
||||||
|
}
|
Loading…
Reference in New Issue