testutil: use croak() instead of die() for more useful errors

This commit is contained in:
Adam Spiers 2024-04-01 23:31:36 +01:00
parent 1282acf6b5
commit 67081cec02

View file

@ -66,7 +66,7 @@ sub uncapture_stderr {
} }
sub init_test_dirs { sub init_test_dirs {
-d "t" or die "Was expecting tests to be run from root of repo\n"; -d "t" or croak "Was expecting tests to be run from root of repo\n";
# Create a run_from/ subdirectory for tests which want to run # Create a run_from/ subdirectory for tests which want to run
# from a separate directory outside the Stow directory or # from a separate directory outside the Stow directory or
@ -112,12 +112,12 @@ sub make_link {
if (-l $target) { if (-l $target) {
my $old_source = readlink join('/', parent($target), $source) my $old_source = readlink join('/', parent($target), $source)
or die "$target is already a link but could not read link $target/$source"; or croak "$target is already a link but could not read link $target/$source";
if ($old_source ne $source) { if ($old_source ne $source) {
die "$target already exists but points elsewhere\n"; croak "$target already exists but points elsewhere\n";
} }
} }
die "$target already exists and is not a link\n" if -e $target; croak "$target already exists and is not a link\n" if -e $target;
my $abs_target = File::Spec->rel2abs($target); my $abs_target = File::Spec->rel2abs($target);
my $target_container = dirname($abs_target); my $target_container = dirname($abs_target);
my $abs_source = File::Spec->rel2abs($source, $target_container); my $abs_source = File::Spec->rel2abs($source, $target_container);
@ -131,7 +131,7 @@ sub make_link {
unless $invalid; unless $invalid;
} }
symlink $source, $target symlink $source, $target
or die "could not create link $target => $source ($!)\n"; or croak "could not create link $target => $source ($!)\n";
} }
#===== SUBROUTINE =========================================================== #===== SUBROUTINE ===========================================================
@ -161,11 +161,11 @@ sub make_file {
my ($path, $contents) = @_; my ($path, $contents) = @_;
if (-e $path and ! -f $path) { if (-e $path and ! -f $path) {
die "a non-file already exists at $path\n"; croak "a non-file already exists at $path\n";
} }
open my $FILE ,'>', $path open my $FILE ,'>', $path
or die "could not create file: $path ($!)\n"; or croak "could not create file: $path ($!)\n";
print $FILE $contents if defined $contents; print $FILE $contents if defined $contents;
close $FILE; close $FILE;
} }
@ -182,9 +182,9 @@ sub make_file {
sub remove_link { sub remove_link {
my ($path) = @_; my ($path) = @_;
if (not -l $path) { if (not -l $path) {
die qq(remove_link() called with a non-link: $path); croak qq(remove_link() called with a non-link: $path);
} }
unlink $path or die "could not remove link: $path ($!)\n"; unlink $path or croak "could not remove link: $path ($!)\n";
return; return;
} }
@ -199,9 +199,9 @@ sub remove_link {
sub remove_file { sub remove_file {
my ($path) = @_; my ($path) = @_;
if (-z $path) { if (-z $path) {
die "file at $path is non-empty\n"; croak "file at $path is non-empty\n";
} }
unlink $path or die "could not remove empty file: $path ($!)\n"; unlink $path or croak "could not remove empty file: $path ($!)\n";
return; return;
} }
@ -217,10 +217,10 @@ sub remove_dir {
my ($dir) = @_; my ($dir) = @_;
if (not -d $dir) { if (not -d $dir) {
die "$dir is not a directory"; croak "$dir is not a directory";
} }
opendir my $DIR, $dir or die "cannot read directory: $dir ($!)\n"; opendir my $DIR, $dir or croak "cannot read directory: $dir ($!)\n";
my @listing = readdir $DIR; my @listing = readdir $DIR;
closedir $DIR; closedir $DIR;
@ -231,16 +231,16 @@ sub remove_dir {
my $path = "$dir/$node"; my $path = "$dir/$node";
if (-l $path or (-f $path and -z $path) or $node eq $Stow::LOCAL_IGNORE_FILE) { if (-l $path or (-f $path and -z $path) or $node eq $Stow::LOCAL_IGNORE_FILE) {
unlink $path or die "cannot unlink $path ($!)\n"; unlink $path or croak "cannot unlink $path ($!)\n";
} }
elsif (-d "$path") { elsif (-d "$path") {
remove_dir($path); remove_dir($path);
} }
else { else {
die "$path is not a link, directory, or empty file\n"; croak "$path is not a link, directory, or empty file\n";
} }
} }
rmdir $dir or die "cannot rmdir $dir ($!)\n"; rmdir $dir or croak "cannot rmdir $dir ($!)\n";
return; return;
} }
@ -255,7 +255,7 @@ sub remove_dir {
#============================================================================ #============================================================================
sub cd { sub cd {
my ($dir) = @_; my ($dir) = @_;
chdir $dir or die "Failed to chdir($dir): $!\n"; chdir $dir or croak "Failed to chdir($dir): $!\n";
} }
#===== SUBROUTINE =========================================================== #===== SUBROUTINE ===========================================================
@ -268,7 +268,7 @@ sub cd {
#============================================================================ #============================================================================
sub cat_file { sub cat_file {
my ($file) = @_; my ($file) = @_;
open F, $file or die "Failed to open($file): $!\n"; open F, $file or croak "Failed to open($file): $!\n";
my $contents = join '', <F>; my $contents = join '', <F>;
close(F); close(F);
return $contents; return $contents;