From 2d06e1bd1b4240694b9d6d796b2622759c9f8574 Mon Sep 17 00:00:00 2001
From: Dan Church <amphetamachine@gmail.com>
Date: Thu, 20 Jul 2023 17:36:42 -0500
Subject: [PATCH] CI: Add test for mixed readonly/read-write files

---
 t/TestFunctions.pm      | 16 +++++-----
 t/some-files-readonly.t | 68 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 7 deletions(-)
 create mode 100755 t/some-files-readonly.t

diff --git a/t/TestFunctions.pm b/t/TestFunctions.pm
index fc68193..c930840 100644
--- a/t/TestFunctions.pm
+++ b/t/TestFunctions.pm
@@ -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) {
diff --git a/t/some-files-readonly.t b/t/some-files-readonly.t
new file mode 100755
index 0000000..7120ca0
--- /dev/null
+++ b/t/some-files-readonly.t
@@ -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;
+}