599bf1bc98
RevBank uses atomic file replacement by creating a new file and renaming it over the old one. The newly created file is always in cwd, and for the atomic rename() to work it must reside on the same filesystem as the file it's replacing. Since File::Temp does the right thing and creates files in /tmp by default, and /tmp is usually on a different filesystem, these unit tests didn't actually work. I don't know why they did work in the past. There doesn't seem to have been any relevant change (or any at all, for that matter) to File::Temp, which has had this behavior for ages. But I can't imagine that my /tmp has only recently become a tmpfs mount either. In any case, the issue is fixed by making File::Temp do the wrong thing, which is to create its files in the cwd.
63 lines
1.5 KiB
Perl
63 lines
1.5 KiB
Perl
# These tests were written by ChatGPT. All four were actually correct the
|
|
# first try.
|
|
|
|
use Test::More;
|
|
use File::Temp;
|
|
|
|
use RevBank::FileIO;
|
|
|
|
# ChatGPT didn't realise that ::FileIO doesn't export its functions
|
|
use RevBank::Global;
|
|
|
|
sub _newtmp {
|
|
File::Temp->new(DIR => "."); # Not /tmp because RevBank::FileIO only does cwd
|
|
}
|
|
|
|
subtest "slurp" => sub {
|
|
my $tmp = _newtmp;
|
|
my $data = "foo\nbar\nbaz\n";
|
|
print $tmp $data;
|
|
close $tmp;
|
|
my @lines = slurp($tmp->filename);
|
|
is_deeply \@lines, ["foo\n", "bar\n", "baz\n"], "slurp works";
|
|
};
|
|
|
|
subtest "spurt" => sub {
|
|
my $tmp = _newtmp;
|
|
spurt($tmp->filename, "foo\nbar\nbaz\n");
|
|
open my $fh, "<", $tmp->filename;
|
|
local $/;
|
|
my $contents = <$fh>;
|
|
close $fh;
|
|
is $contents, "foo\nbar\nbaz\n", "spurt works";
|
|
};
|
|
|
|
subtest "append" => sub {
|
|
my $tmp = _newtmp;
|
|
spurt($tmp->filename, "foo\n");
|
|
append($tmp->filename, "bar\n", "baz\n");
|
|
open my $fh, "<", $tmp->filename;
|
|
local $/;
|
|
my $contents = <$fh>;
|
|
close $fh;
|
|
is $contents, "foo\nbar\nbaz\n", "append works";
|
|
};
|
|
|
|
subtest "rewrite" => sub {
|
|
my $tmp = _newtmp;
|
|
spurt($tmp->filename, "foo\nbar\nbaz\n");
|
|
rewrite($tmp->filename, sub {
|
|
my ($line) = @_;
|
|
if ($line =~ /^bar/) {
|
|
return "quux\n";
|
|
}
|
|
return $line;
|
|
});
|
|
open my $fh, "<", $tmp->filename;
|
|
local $/;
|
|
my $contents = <$fh>;
|
|
close $fh;
|
|
is $contents, "foo\nquux\nbaz\n", "rewrite works";
|
|
};
|
|
|
|
done_testing();
|