From ff4913b2d43624852b79d916aead88fd88dc43a3 Mon Sep 17 00:00:00 2001 From: Jelte Fennema-Nio Date: Mon, 26 Jan 2026 10:04:44 +0100 Subject: [PATCH v4 4/5] perl tap: Use croak instead of die in our perl helper modules Many of our helpers called die, but that means that the line number reported on exit is the line number in Cluster.pm or Utils.pm. This starts using croak everywhere (except for INIT) in our Cluster.pm and Utils.pm files. That way the line number of the caller is reported instead. As an example, this is the new output the safe_psql call that fails: die: error running SQL: 'psql::2: ERROR: unterminated quoted string at or near "'" LINE 1: GRANT ALL ON sysuser_data TO scram_role ' ^' while running 'psql --no-psqlrc --no-align --tuples-only --quiet --dbname port=26578 host=/tmp/KaOjou8HJa dbname='postgres' --file - --variable ON_ERROR_STOP=1' with sql 'CREATE TABLE sysuser_data (n) AS SELECT NULL FROM generate_series(1, 10); GRANT ALL ON sysuser_data TO scram_role '' at /home/jelte/work/postgres-3/src/test/authentication/t/001_password.pl line 144. Looks like your test exited with 29 just after 21. --- src/test/perl/PostgreSQL/Test/Cluster.pm | 108 +++++++++++------------ src/test/perl/PostgreSQL/Test/Utils.pm | 26 +++--- 2 files changed, 67 insertions(+), 67 deletions(-) diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm index e267ba868fe..b62aaa58cc4 100644 --- a/src/test/perl/PostgreSQL/Test/Cluster.pm +++ b/src/test/perl/PostgreSQL/Test/Cluster.pm @@ -57,7 +57,7 @@ PostgreSQL::Test::Cluster - class representing PostgreSQL server instance # run query every second until it returns 't' # or times out $node->poll_query_until('postgres', q|SELECT random() < 0.1;|') - or die "timed out"; + or croak "timed out"; # Do an online pg_basebackup my $ret = $node->backup('testbackup1'); @@ -339,7 +339,7 @@ sub raw_connect $socket = IO::Socket::UNIX->new( Type => SOCK_STREAM(), Peer => $path, - ) or die "Cannot create socket - $IO::Socket::errstr\n"; + ) or croak "Cannot create socket - $IO::Socket::errstr\n"; } else { @@ -347,7 +347,7 @@ sub raw_connect PeerHost => $pghost, PeerPort => $pgport, Proto => 'tcp' - ) or die "Cannot create socket - $IO::Socket::errstr\n"; + ) or croak "Cannot create socket - $IO::Socket::errstr\n"; } return $socket; } @@ -406,7 +406,7 @@ sub group_access my $dir_stat = stat($self->data_dir); defined($dir_stat) - or die('unable to stat ' . $self->data_dir); + or croak('unable to stat ' . $self->data_dir); return (S_IMODE($dir_stat->mode) == 0750); } @@ -508,7 +508,7 @@ sub config_data my $result = IPC::Run::run [ $self->installed_command('pg_config'), @options ], '>', \$stdout, '2>', \$stderr - or die "could not execute pg_config"; + or croak "could not execute pg_config"; # standardize line endings $stdout =~ s/\r(?=\n)//g; # no options, scalar context: just hand back the output @@ -542,7 +542,7 @@ sub info { my ($self) = @_; my $_info = ''; - open my $fh, '>', \$_info or die; + open my $fh, '>', \$_info or croak; print $fh "Name: " . $self->name . "\n"; print $fh "Version: " . $self->{_pg_version} . "\n" if $self->{_pg_version}; @@ -553,7 +553,7 @@ sub info print $fh "Log file: " . $self->logfile . "\n"; print $fh "Install Path: ", $self->{_install_path} . "\n" if $self->{_install_path}; - close $fh or die; + close $fh or croak; return $_info; } @@ -583,7 +583,7 @@ sub set_replication_conf $self->host eq $test_pghost or croak "set_replication_conf only works with the default host"; - open my $hba, '>>', "$pgdata/pg_hba.conf" or die $!; + open my $hba, '>>', "$pgdata/pg_hba.conf" or croak $!; print $hba "\n# Allow replication (set up by PostgreSQL::Test::Cluster.pm)\n"; if ($PostgreSQL::Test::Utils::windows_os @@ -707,7 +707,7 @@ sub init PostgreSQL::Test::Utils::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata, @{ $params{auth_extra} }); - open my $conf, '>>', "$pgdata/postgresql.conf" or die $!; + open my $conf, '>>', "$pgdata/postgresql.conf" or croak $!; print $conf "\n# Added by PostgreSQL::Test::Cluster.pm\n"; print $conf "fsync = off\n"; print $conf "restart_after_crash = off\n"; @@ -764,7 +764,7 @@ sub init close $conf; chmod($self->group_access ? 0640 : 0600, "$pgdata/postgresql.conf") - or die("unable to set permissions for $pgdata/postgresql.conf"); + or croak("unable to set permissions for $pgdata/postgresql.conf"); $self->set_replication_conf if $params{allows_streaming}; $self->enable_archiving if $params{has_archiving}; @@ -793,7 +793,7 @@ sub append_conf PostgreSQL::Test::Utils::append_to_file($conffile, $str . "\n"); chmod($self->group_access() ? 0640 : 0600, $conffile) - or die("unable to set permissions for $conffile"); + or croak("unable to set permissions for $conffile"); return; } @@ -839,7 +839,7 @@ sub adjust_conf close $fh; chmod($self->group_access() ? 0640 : 0600, $conffile) - or die("unable to set permissions for $conffile"); + or croak("unable to set permissions for $conffile"); } =pod @@ -995,7 +995,7 @@ sub init_from_backup } elsif (defined $params{tar_program}) { - mkdir($data_path) || die "mkdir $data_path: $!"; + mkdir($data_path) || croak "mkdir $data_path: $!"; PostgreSQL::Test::Utils::system_or_bail( $params{tar_program}, 'xf' => $backup_path . '/base.tar', @@ -1007,7 +1007,7 @@ sub init_from_backup # We need to generate a tablespace_map file. open(my $tsmap, ">", "$data_path/tablespace_map") - || die "$data_path/tablespace_map: $!"; + || croak "$data_path/tablespace_map: $!"; # Extract tarfiles and add tablespace_map entries my @tstars = grep { /^\d+.tar/ } @@ -1017,12 +1017,12 @@ sub init_from_backup my $tsoid = $tstar; $tsoid =~ s/\.tar$//; - die "no tablespace mapping for $tstar" + croak "no tablespace mapping for $tstar" if !exists $params{tablespace_map} || !exists $params{tablespace_map}{$tsoid}; my $newdir = $params{tablespace_map}{$tsoid}; - mkdir($newdir) || die "mkdir $newdir: $!"; + mkdir($newdir) || croak "mkdir $newdir: $!"; PostgreSQL::Test::Utils::system_or_bail( $params{tar_program}, 'xf' => $backup_path . '/' . $tstar, @@ -1061,12 +1061,12 @@ sub init_from_backup { # We need to generate a tablespace_map file. open(my $tsmap, ">", "$data_path/tablespace_map") - || die "$data_path/tablespace_map: $!"; + || croak "$data_path/tablespace_map: $!"; # Now use the list of tablespace links to copy each tablespace. for my $tsoid (@tsoids) { - die "no tablespace mapping for $tsoid" + croak "no tablespace mapping for $tsoid" if !exists $params{tablespace_map} || !exists $params{tablespace_map}{$tsoid}; @@ -1083,7 +1083,7 @@ sub init_from_backup close($tsmap); } } - chmod(0700, $data_path) or die $!; + chmod(0700, $data_path) or croak $!; # Base configuration for this node $self->append_conf( @@ -1906,7 +1906,7 @@ sub can_bind my $paddr = sockaddr_in($port, $iaddr); socket(SOCK, PF_INET, SOCK_STREAM, 0) - or die "socket failed: $!"; + or croak "socket failed: $!"; # As in postmaster, don't use SO_REUSEADDR on Windows setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) @@ -1924,9 +1924,9 @@ sub _reserve_port # open in rw mode so we don't have to reopen it and lose the lock my $filename = "$portdir/$port.rsv"; sysopen(my $portfile, $filename, O_RDWR | O_CREAT) - || die "opening port file $filename: $!"; + || croak "opening port file $filename: $!"; # take an exclusive lock to avoid concurrent access - flock($portfile, LOCK_EX) || die "locking port file $filename: $!"; + flock($portfile, LOCK_EX) || croak "locking port file $filename: $!"; # see if someone else has or had a reservation of this port my $pid = <$portfile> || "0"; chomp $pid; @@ -1935,16 +1935,16 @@ sub _reserve_port if (kill 0, $pid) { # process exists and is owned by us, so we can't reserve this port - flock($portfile, LOCK_UN) || die $!; + flock($portfile, LOCK_UN) || croak $!; close($portfile); return 0; } } # All good, go ahead and reserve the port - seek($portfile, 0, SEEK_SET) || die $!; + seek($portfile, 0, SEEK_SET) || croak $!; # print the pid with a fixed width so we don't leave any trailing junk print $portfile sprintf("%10d\n", $$); - flock($portfile, LOCK_UN) || die $!; + flock($portfile, LOCK_UN) || croak $!; close($portfile); push(@port_reservation_files, $filename); return 1; @@ -2246,13 +2246,13 @@ sub psql # IPC::Run::run threw an exception. re-throw unless it's a # timeout, which we'll handle by testing is_expired - die $exc_save + croak $exc_save if (blessed($exc_save) || $exc_save !~ /^\Q$timeout_exception\E/); $ret = undef; - die "Got timeout exception '$exc_save' but timer not expired?!" + croak "Got timeout exception '$exc_save' but timer not expired?!" unless $timeout->is_expired; if (defined($params{timed_out})) @@ -2261,7 +2261,7 @@ sub psql } else { - die "psql timed out: stderr: '$$stderr'\n" + croak "psql timed out: stderr: '$$stderr'\n" . "while running '@psql_params'"; } } @@ -2284,7 +2284,7 @@ sub psql if (defined $ret) { my $core = $ret & 128 ? " (core dumped)" : ""; - die "psql exited with signal " + croak "psql exited with signal " . ($ret & 127) . "$core: '$$stderr' while running '@psql_params'" if $ret & 127; @@ -2293,14 +2293,14 @@ sub psql if ($ret && $params{on_error_die}) { - die "psql error: stderr: '$$stderr'\nwhile running '@psql_params'" + croak "psql error: stderr: '$$stderr'\nwhile running '@psql_params'" if $ret == 1; - die "connection error: '$$stderr'\nwhile running '@psql_params'" + croak "connection error: '$$stderr'\nwhile running '@psql_params'" if $ret == 2; - die + croak "error running SQL: '$$stderr'\nwhile running '@psql_params' with sql '$sql'" if $ret == 3; - die "psql returns $ret: '$$stderr'\nwhile running '@psql_params'"; + croak "psql returns $ret: '$$stderr'\nwhile running '@psql_params'"; } if (wantarray) @@ -2501,7 +2501,7 @@ sub _pgbench_make_files if (-e $filename) { ok(0, "$filename must not already exist"); - unlink $filename or die "cannot unlink $filename: $!"; + unlink $filename or croak "cannot unlink $filename: $!"; } PostgreSQL::Test::Utils::append_to_file($filename, $$files{$fn}); } @@ -3123,8 +3123,8 @@ sub write_wal my $path = sprintf("%s/pg_wal/%08X%08X%08X", $self->data_dir, $tli, 0, $segment); - open my $fh, "+<:raw", $path or die "could not open WAL segment $path"; - seek($fh, $offset, SEEK_SET) or die "could not seek WAL segment $path"; + open my $fh, "+<:raw", $path or croak "could not open WAL segment $path"; + seek($fh, $offset, SEEK_SET) or croak "could not seek WAL segment $path"; print $fh $data; close $fh; @@ -3288,7 +3288,7 @@ sub wait_for_event SELECT count(*) > 0 FROM pg_stat_activity WHERE backend_type = '$backend_type' AND wait_event = '$wait_event_name' ]) - or die + or croak qq(timed out when waiting for $backend_type to reach wait event '$wait_event_name'); return; @@ -3325,7 +3325,7 @@ poll_query_until timeout. Requires that the 'postgres' db exists and is accessible. -This is not a test. It die()s on failure. +This is not a test. It croak()s on failure. =cut @@ -3409,7 +3409,7 @@ The replication connection must be in a streaming state. Requires that the 'postgres' db exists and is accessible. -This is not a test. It die()s on failure. +This is not a test. It croak()s on failure. =cut @@ -3429,7 +3429,7 @@ be 'restart' or 'confirmed_flush'. Requires that the 'postgres' db exists and is accessible. -This is not a test. It die()s on failure. +This is not a test. It croak()s on failure. If the slot is not active, will time out after poll_query_until's timeout. @@ -3484,7 +3484,7 @@ creating a new subscription. If there is no active replication connection from this peer, wait until poll_query_until timeout. -This is not a test. It die()s on failure. +This is not a test. It croak()s on failure. =cut @@ -3624,7 +3624,7 @@ Disallows pg_recvlogical from internally retrying on error by passing --no-loop. Plugin options are passed as additional keyword arguments. -If called in scalar context, returns stdout, and die()s on timeout or nonzero return. +If called in scalar context, returns stdout, and croak()s on timeout or nonzero return. If called in array context, returns a tuple of (retval, stdout, stderr, timeout). timeout is the IPC::Run::Timeout object whose is_expired method can be tested @@ -3680,15 +3680,15 @@ sub pg_recvlogical_upto # IPC::Run::run threw an exception. re-throw unless it's a # timeout, which we'll handle by testing is_expired - die $exc_save + croak $exc_save if (blessed($exc_save) || $exc_save !~ qr/$timeout_exception/); $ret = undef; - die "Got timeout exception '$exc_save' but timer not expired?!" + croak "Got timeout exception '$exc_save' but timer not expired?!" unless $timeout->is_expired; - die + croak "$exc_save waiting for endpos $endpos with stdout '$stdout', stderr '$stderr'" unless wantarray; } @@ -3700,7 +3700,7 @@ sub pg_recvlogical_upto } else { - die + croak "pg_recvlogical exited with code '$ret', stdout '$stdout' and stderr '$stderr'" if $ret; return $stdout; @@ -3725,14 +3725,14 @@ sub corrupt_page_checksum my $pgdata = $self->data_dir; my $pageheader; - open my $fh, '+<', "$pgdata/$file" or die "open($file) failed: $!"; + open my $fh, '+<', "$pgdata/$file" or croak "open($file) failed: $!"; binmode $fh; - sysseek($fh, $page_offset, 0) or die "sysseek failed: $!"; - sysread($fh, $pageheader, 24) or die "sysread failed: $!"; + sysseek($fh, $page_offset, 0) or croak "sysseek failed: $!"; + sysread($fh, $pageheader, 24) or croak "sysread failed: $!"; # This inverts the pd_checksum field (only); see struct PageHeaderData $pageheader ^= "\0\0\0\0\0\0\0\0\xff\xff"; - sysseek($fh, $page_offset, 0) or die "sysseek failed: $!"; - syswrite($fh, $pageheader) or die "syswrite failed: $!"; + sysseek($fh, $page_offset, 0) or croak "sysseek failed: $!"; + syswrite($fh, $pageheader) or croak "syswrite failed: $!"; close $fh; return; @@ -3760,7 +3760,7 @@ sub log_standby_snapshot SELECT restart_lsn IS NOT NULL FROM pg_catalog.pg_replication_slots WHERE slot_name = '$slot_name' ]) - or die + or croak "timed out waiting for logical slot to calculate its restart_lsn"; # Then arrange for the xl_running_xacts record for which the standby is @@ -3802,7 +3802,7 @@ sub create_logical_slot_on_standby is($self->slot($slot_name)->{'slot_type'}, 'logical', $slot_name . ' on standby created') - or die "could not create slot" . $slot_name; + or croak "could not create slot" . $slot_name; } =pod @@ -3833,7 +3833,7 @@ sub validate_slot_inactive_since ), 't', "last inactive time for slot $slot_name is valid on node $name") - or die "could not validate captured inactive_since for slot $slot_name"; + or croak "could not validate captured inactive_since for slot $slot_name"; return $inactive_since; } diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm index 22c9078daa9..0a121ec21ce 100644 --- a/src/test/perl/PostgreSQL/Test/Utils.pm +++ b/src/test/perl/PostgreSQL/Test/Utils.pm @@ -636,7 +636,7 @@ sub read_head_tail return ([], []) if $line_count <= 0; - open my $fh, '<', $filename or die "couldn't open file: $filename\n"; + open my $fh, '<', $filename or croak "couldn't open file: $filename\n"; my @lines = <$fh>; close $fh; @@ -701,7 +701,7 @@ sub check_mode_recursive } else { - die $msg; + croak $msg; } } @@ -740,7 +740,7 @@ sub check_mode_recursive # Else something we can't handle else { - die "unknown file type for $File::Find::name"; + croak "unknown file type for $File::Find::name"; } } }, @@ -772,7 +772,7 @@ sub chmod_recursive chmod( S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode, $File::Find::name - ) or die "unable to chmod $File::Find::name"; + ) or croak "unable to chmod $File::Find::name"; } } }, @@ -798,11 +798,11 @@ sub scan_server_header my $result = IPC::Run::run [ 'pg_config', '--includedir-server' ], '>' => \$stdout, '2>' => \$stderr - or die "could not execute pg_config"; + or croak "could not execute pg_config"; chomp($stdout); $stdout =~ s/\r$//; - open my $header_h, '<', "$stdout/$header_path" or die "$!"; + open my $header_h, '<', "$stdout/$header_path" or croak "$!"; my @match = undef; while (<$header_h>) @@ -816,7 +816,7 @@ sub scan_server_header } close $header_h; - die "could not find match in header $header_path\n" + croak "could not find match in header $header_path\n" unless @match; return @match; } @@ -837,11 +837,11 @@ sub check_pg_config my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>' => \$stdout, '2>' => \$stderr - or die "could not execute pg_config"; + or croak "could not execute pg_config"; chomp($stdout); $stdout =~ s/\r$//; - open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!"; + open my $pg_config_h, '<', "$stdout/pg_config.h" or croak "$!"; my $match = (grep { /^$regexp/ } <$pg_config_h>); close $pg_config_h; return $match; @@ -946,13 +946,13 @@ sub dir_symlink # need some indirection on msys $cmd = qq{echo '$cmd' | \$COMSPEC /Q}; } - system($cmd) == 0 or die; + system($cmd) == 0 or croak; } else { - symlink $oldname, $newname or die $!; + symlink $oldname, $newname or croak $!; } - die "No $newname" unless -e $newname; + croak "No $newname" unless -e $newname; } # Log command output. Truncates to first/last 30 lines if over 60 lines. @@ -1276,7 +1276,7 @@ sub command_checks_all # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR my $ret = $?; - die "command exited with signal " . ($ret & 127) + croak "command exited with signal " . ($ret & 127) if $ret & 127; $ret = $ret >> 8; -- 2.53.0