From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Andrew Dunstan <andrew@dunslane.net>
Date: Tue, 3 Mar 2026 00:00:00 +0000
Subject: [PATCH] Split pg_waldump TAP tests into directory and archive files

The original 001_basic.pl mixed directory and tar archive tests in a
single SKIP loop with a hardcoded skip count of 3, but each scenario
actually runs ~19 assertions.  When tar is unavailable the skip count
was wrong, and the directory scenario was also wrongly guarded by the
tar-availability check.

Move all archive-related tests (tar, tar.gz) into a new
003_archive.pl that uses plan skip_all when tar is unavailable,
cleanly skipping the entire file.  001_basic.pl retains only
directory-based tests with no SKIP blocks needed.
---
 src/bin/pg_waldump/meson.build       |   1 +
 src/bin/pg_waldump/t/001_basic.pl    | 221 ++++++++++-----------------
 src/bin/pg_waldump/t/003_archive.pl  | 320 +++++++++++++++++++++++++++++++++++
 3 files changed, 396 insertions(+), 146 deletions(-)
 create mode 100644 src/bin/pg_waldump/t/003_archive.pl

diff --git a/src/bin/pg_waldump/meson.build b/src/bin/pg_waldump/meson.build
index 5296f21b82c..d2b4bd0c048 100644
--- a/src/bin/pg_waldump/meson.build
+++ b/src/bin/pg_waldump/meson.build
@@ -34,6 +34,7 @@ tests += {
     'tests': [
       't/001_basic.pl',
       't/002_save_fullpage.pl',
+      't/003_archive.pl',
     ],
   },
 }
diff --git a/src/bin/pg_waldump/t/001_basic.pl b/src/bin/pg_waldump/t/001_basic.pl
index 9854c939007..282c9a37221 100644
--- a/src/bin/pg_waldump/t/001_basic.pl
+++ b/src/bin/pg_waldump/t/001_basic.pl
@@ -3,13 +3,9 @@
 
 use strict;
 use warnings FATAL => 'all';
-use Cwd;
 use PostgreSQL::Test::Cluster;
 use PostgreSQL::Test::Utils;
 use Test::More;
-use List::Util qw(shuffle);
-
-my $tar = $ENV{TAR};
 
 program_help_ok('pg_waldump');
 program_version_ok('pg_waldump');
@@ -195,8 +191,8 @@ END
 $$;
 });
 
-my $contrecord_lsn = $node->safe_psql('postgres',
-	'SELECT pg_current_wal_insert_lsn()');
+my $contrecord_lsn =
+  $node->safe_psql('postgres', 'SELECT pg_current_wal_insert_lsn()');
 # Generate contrecord record
 $node->safe_psql('postgres',
 	qq{SELECT pg_logical_emit_message(true, 'test 026', repeat('xyzxz', 123456))}
@@ -299,145 +295,78 @@ sub test_pg_waldump
 	return @lines;
 }
 
-# Create a tar archive, sorting the file order
-sub generate_archive
-{
-	my ($archive, $directory, $compression_flags) = @_;
-
-	my @files;
-	opendir my $dh, $directory or die "opendir: $!";
-	while (my $entry = readdir $dh) {
-		# Skip '.' and '..'
-		next if $entry eq '.' || $entry eq '..';
-		push @files, $entry;
-	}
-	closedir $dh;
-
-	@files = shuffle @files;
-
-	# move into the WAL directory before archiving files
-	my $cwd = getcwd;
-	chdir($directory) || die "chdir: $!";
-	command_ok([$tar, $compression_flags, $archive, @files]);
-	chdir($cwd) || die "chdir: $!";
-}
-
-my $tmp_dir = PostgreSQL::Test::Utils::tempdir_short();
-
-my @scenarios = (
-	{
-		'path' => $node->data_dir,
-		'is_archive' => 0,
-		'enabled' => 1
-	},
-	{
-		'path' => "$tmp_dir/pg_wal.tar",
-		'compression_method' => 'none',
-		'compression_flags' => '-cf',
-		'is_archive' => 1,
-		'enabled' => 1
-	},
-	{
-		'path' => "$tmp_dir/pg_wal.tar.gz",
-		'compression_method' => 'gzip',
-		'compression_flags' => '-czf',
-		'is_archive' => 1,
-		'enabled' => check_pg_config("#define HAVE_LIBZ 1")
-	});
-
-for my $scenario (@scenarios)
-{
-	my $path = $scenario->{'path'};
-
-	SKIP:
-	{
-		skip "tar command is not available", 3
-		  if !defined $tar;
-		skip "$scenario->{'compression_method'} compression not supported by this build", 3
-		  if !$scenario->{'enabled'} && $scenario->{'is_archive'};
-
-		  # create pg_wal archive
-		  if ($scenario->{'is_archive'})
-		  {
-			  generate_archive($path,
-				  $node->data_dir . '/pg_wal',
-				  $scenario->{'compression_flags'});
-		  }
-
-		command_fails_like(
-			[ 'pg_waldump', '--path' => $path ],
-			qr/error: no start WAL location given/,
-			'path option requires start location');
-		command_like(
-			[
-				'pg_waldump',
-				'--path' => $path,
-				'--start' => $start_lsn,
-				'--end' => $end_lsn,
-			],
-			qr/./,
-			'runs with path option and start and end locations');
-		command_fails_like(
-			[
-				'pg_waldump',
-				'--path' => $path,
-				'--start' => $start_lsn,
-			],
-			qr/error: error in WAL record at/,
-			'falling off the end of the WAL results in an error');
-
-		command_fails_like(
-			[
-				'pg_waldump', '--quiet',
-				'--path' => $path,
-				'--start' => $start_lsn
-			],
-			qr/error: error in WAL record at/,
-			'errors are shown with --quiet');
-
-		test_pg_waldump_skip_bytes($path, $start_lsn, $end_lsn);
-
-		my @lines = test_pg_waldump($path, $start_lsn, $end_lsn);
-		is(grep(!/^rmgr: \w/, @lines), 0, 'all output lines are rmgr lines');
-
-		@lines = test_pg_waldump($path, $contrecord_lsn, $end_lsn);
-		is(grep(!/^rmgr: \w/, @lines), 0, 'all output lines are rmgr lines');
-
-		test_pg_waldump_skip_bytes($path, $contrecord_lsn, $end_lsn);
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--limit' => 6);
-		is(@lines, 6, 'limit option observed');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--fullpage');
-		is(grep(!/^rmgr:.*\bFPW\b/, @lines), 0, 'all output lines are FPW');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--stats');
-		like($lines[0], qr/WAL statistics/, "statistics on stdout");
-		is(grep(/^rmgr:/, @lines), 0, 'no rmgr lines output');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--stats=record');
-		like($lines[0], qr/WAL statistics/, "statistics on stdout");
-		is(grep(/^rmgr:/, @lines), 0, 'no rmgr lines output');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--rmgr' => 'Btree');
-		is(grep(!/^rmgr: Btree/, @lines), 0, 'only Btree lines');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--fork' => 'init');
-		is(grep(!/fork init/, @lines), 0, 'only init fork lines');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn,
-			'--relation' => "$default_ts_oid/$postgres_db_oid/$rel_t1_oid");
-		is(grep(!/rel $default_ts_oid\/$postgres_db_oid\/$rel_t1_oid/, @lines),
-			0, 'only lines for selected relation');
-
-		@lines = test_pg_waldump($path, $start_lsn, $end_lsn,
-			'--relation' => "$default_ts_oid/$postgres_db_oid/$rel_i1a_oid",
-			'--block' => 1);
-		is(grep(!/\bblk 1\b/, @lines), 0, 'only lines for selected block');
-
-		# Cleanup.
-		unlink $path if $scenario->{'is_archive'};
-	}
-}
+my $path = $node->data_dir;
+
+command_fails_like(
+	[ 'pg_waldump', '--path' => $path ],
+	qr/error: no start WAL location given/,
+	'path option requires start location');
+command_like(
+	[
+		'pg_waldump',
+		'--path' => $path,
+		'--start' => $start_lsn,
+		'--end' => $end_lsn,
+	],
+	qr/./,
+	'runs with path option and start and end locations');
+command_fails_like(
+	[
+		'pg_waldump',
+		'--path' => $path,
+		'--start' => $start_lsn,
+	],
+	qr/error: error in WAL record at/,
+	'falling off the end of the WAL results in an error');
+
+command_fails_like(
+	[
+		'pg_waldump', '--quiet',
+		'--path' => $path,
+		'--start' => $start_lsn
+	],
+	qr/error: error in WAL record at/,
+	'errors are shown with --quiet');
+
+test_pg_waldump_skip_bytes($path, $start_lsn, $end_lsn);
+
+my @lines = test_pg_waldump($path, $start_lsn, $end_lsn);
+is(grep(!/^rmgr: \w/, @lines), 0, 'all output lines are rmgr lines');
+
+@lines = test_pg_waldump($path, $contrecord_lsn, $end_lsn);
+is(grep(!/^rmgr: \w/, @lines), 0, 'all output lines are rmgr lines');
+
+test_pg_waldump_skip_bytes($path, $contrecord_lsn, $end_lsn);
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--limit' => 6);
+is(@lines, 6, 'limit option observed');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--fullpage');
+is(grep(!/^rmgr:.*\bFPW\b/, @lines), 0, 'all output lines are FPW');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--stats');
+like($lines[0], qr/WAL statistics/, "statistics on stdout");
+is(grep(/^rmgr:/, @lines), 0, 'no rmgr lines output');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--stats=record');
+like($lines[0], qr/WAL statistics/, "statistics on stdout");
+is(grep(/^rmgr:/, @lines), 0, 'no rmgr lines output');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--rmgr' => 'Btree');
+is(grep(!/^rmgr: Btree/, @lines), 0, 'only Btree lines');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--fork' => 'init');
+is(grep(!/fork init/, @lines), 0, 'only init fork lines');
+
+@lines = test_pg_waldump($path, $start_lsn, $end_lsn,
+	'--relation' => "$default_ts_oid/$postgres_db_oid/$rel_t1_oid");
+is(grep(!/rel $default_ts_oid\/$postgres_db_oid\/$rel_t1_oid/, @lines),
+	0, 'only lines for selected relation');
+
+@lines = test_pg_waldump(
+	$path, $start_lsn, $end_lsn,
+	'--relation' => "$default_ts_oid/$postgres_db_oid/$rel_i1a_oid",
+	'--block' => 1);
+is(grep(!/\bblk 1\b/, @lines), 0, 'only lines for selected block');
 
 done_testing();
new file mode 100644
index 00000000000..c615713efd4
--- /dev/null
+++ b/src/bin/pg_waldump/t/003_archive.pl
@@ -0,0 +1,320 @@
+
+# Copyright (c) 2021-2026, PostgreSQL Global Development Group
+
+# Test pg_waldump's ability to read WAL from tar archives.
+
+use strict;
+use warnings FATAL => 'all';
+use Cwd;
+use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Utils;
+use Test::More;
+use List::Util qw(shuffle);
+
+my $tar = $ENV{TAR};
+
+if (!defined $tar)
+{
+	plan skip_all => 'tar command is not available';
+}
+
+my $node = PostgreSQL::Test::Cluster->new('main');
+$node->init;
+$node->append_conf(
+	'postgresql.conf', q{
+autovacuum = off
+checkpoint_timeout = 1h
+
+# for standbydesc
+archive_mode=on
+archive_command=''
+
+# for XLOG_HEAP_TRUNCATE
+wal_level=logical
+});
+$node->start;
+
+my ($start_lsn, $start_walfile) = split /\|/,
+  $node->safe_psql('postgres',
+	q{SELECT pg_current_wal_insert_lsn(), pg_walfile_name(pg_current_wal_insert_lsn())}
+  );
+
+$node->safe_psql(
+	'postgres', q{
+-- heap, btree, hash, sequence
+CREATE TABLE t1 (a int GENERATED ALWAYS AS IDENTITY, b text);
+CREATE INDEX i1a ON t1 USING btree (a);
+CREATE INDEX i1b ON t1 USING hash (b);
+INSERT INTO t1 VALUES (default, 'one'), (default, 'two');
+DELETE FROM t1 WHERE b = 'one';
+TRUNCATE t1;
+
+-- abort
+START TRANSACTION;
+INSERT INTO t1 VALUES (default, 'three');
+ROLLBACK;
+
+-- unlogged/init fork
+CREATE UNLOGGED TABLE t2 (x int);
+CREATE INDEX i2 ON t2 USING btree (x);
+INSERT INTO t2 SELECT generate_series(1, 10);
+
+-- gin
+CREATE TABLE gin_idx_tbl (id bigserial PRIMARY KEY, data jsonb);
+CREATE INDEX gin_idx ON gin_idx_tbl USING gin (data);
+INSERT INTO gin_idx_tbl
+    WITH random_json AS (
+        SELECT json_object_agg(key, trunc(random() * 10)) as json_data
+            FROM unnest(array['a', 'b', 'c']) as u(key))
+          SELECT generate_series(1,500), json_data FROM random_json;
+
+-- gist, spgist
+CREATE TABLE gist_idx_tbl (p point);
+CREATE INDEX gist_idx ON gist_idx_tbl USING gist (p);
+CREATE INDEX spgist_idx ON gist_idx_tbl USING spgist (p);
+INSERT INTO gist_idx_tbl (p) VALUES (point '(1, 1)'), (point '(3, 2)'), (point '(6, 3)');
+
+-- brin
+CREATE TABLE brin_idx_tbl (col1 int, col2 text, col3 text );
+CREATE INDEX brin_idx ON brin_idx_tbl USING brin (col1, col2, col3) WITH (autosummarize=on);
+INSERT INTO brin_idx_tbl SELECT generate_series(1, 10000), 'dummy', 'dummy';
+UPDATE brin_idx_tbl SET col2 = 'updated' WHERE col1 BETWEEN 1 AND 5000;
+SELECT brin_summarize_range('brin_idx', 0);
+SELECT brin_desummarize_range('brin_idx', 0);
+
+VACUUM;
+
+-- logical message
+SELECT pg_logical_emit_message(true, 'foo', 'bar');
+
+-- relmap
+VACUUM FULL pg_authid;
+
+-- database
+CREATE DATABASE d1;
+DROP DATABASE d1;
+});
+
+my $tblspc_path = PostgreSQL::Test::Utils::tempdir_short();
+
+$node->safe_psql(
+	'postgres', qq{
+CREATE TABLESPACE ts1 LOCATION '$tblspc_path';
+DROP TABLESPACE ts1;
+});
+
+# Consume all remaining room in the current WAL segment, leaving space enough
+# only for the start of a largish record, to test contrecord decoding.
+$node->safe_psql(
+	'postgres', q{
+DO $$
+DECLARE
+    wal_segsize int := setting::int FROM pg_settings WHERE name = 'wal_segment_size';
+    remain int;
+    iters  int := 0;
+BEGIN
+    LOOP
+        INSERT into t1(b)
+        select repeat(encode(sha256(g::text::bytea), 'hex'), (random() * 15 + 1)::int)
+        from generate_series(1, 10) g;
+
+        remain := wal_segsize - (pg_current_wal_insert_lsn() - '0/0') % wal_segsize;
+        IF remain < 2 * setting::int from pg_settings where name = 'block_size' THEN
+            RAISE log 'exiting after % iterations, % bytes to end of WAL segment', iters, remain;
+            EXIT;
+        END IF;
+        iters := iters + 1;
+    END LOOP;
+END
+$$;
+});
+
+my $contrecord_lsn =
+  $node->safe_psql('postgres', 'SELECT pg_current_wal_insert_lsn()');
+$node->safe_psql('postgres',
+	qq{SELECT pg_logical_emit_message(true, 'test 026', repeat('xyzxz', 123456))}
+);
+
+my ($end_lsn, $end_walfile) = split /\|/,
+  $node->safe_psql('postgres',
+	q{SELECT pg_current_wal_insert_lsn(), pg_walfile_name(pg_current_wal_insert_lsn())}
+  );
+
+$node->stop;
+
+
+sub test_pg_waldump_skip_bytes
+{
+	my ($path, $startlsn, $endlsn) = @_;
+
+	my ($part1, $part2) = split qr{/}, $startlsn;
+	my $lsn2 = hex $part2;
+	$lsn2++;
+	my $new_start = sprintf("%s/%X", $part1, $lsn2);
+
+	my ($stdout, $stderr);
+
+	my $result = IPC::Run::run [
+		'pg_waldump',
+		'--start' => $new_start,
+		'--end' => $endlsn,
+		'--path' => $path,
+	  ],
+	  '>' => \$stdout,
+	  '2>' => \$stderr;
+	ok($result, "runs with start segment and start LSN specified");
+	like($stderr, qr/first record is after/, 'info message printed');
+}
+
+sub test_pg_waldump
+{
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+	my ($path, $startlsn, $endlsn, @opts) = @_;
+
+	my ($stdout, $stderr);
+
+	my $result = IPC::Run::run [
+		'pg_waldump',
+		'--start' => $startlsn,
+		'--end' => $endlsn,
+		'--path' => $path,
+		@opts
+	  ],
+	  '>' => \$stdout,
+	  '2>' => \$stderr;
+	ok($result, "pg_waldump @opts: runs ok");
+	is($stderr, '', "pg_waldump @opts: no stderr");
+	my @lines = split /\n/, $stdout;
+	ok(@lines > 0, "pg_waldump @opts: some lines are output");
+	return @lines;
+}
+
+sub generate_archive
+{
+	my ($archive, $directory, $compression_flags) = @_;
+
+	my @files;
+	opendir my $dh, $directory or die "opendir: $!";
+	while (my $entry = readdir $dh)
+	{
+		next if $entry eq '.' || $entry eq '..';
+		push @files, $entry;
+	}
+	closedir $dh;
+
+	@files = shuffle @files;
+
+	my $cwd = getcwd;
+	chdir($directory) || die "chdir: $!";
+	command_ok([ $tar, $compression_flags, $archive, @files ],
+		"create archive $archive");
+	chdir($cwd) || die "chdir: $!";
+}
+
+
+my $tmp_dir = PostgreSQL::Test::Utils::tempdir_short();
+
+my @scenarios = (
+	{
+		'path' => "$tmp_dir/pg_wal.tar",
+		'compression_method' => 'none',
+		'compression_flags' => '-cf',
+		'enabled' => 1,
+	},
+	{
+		'path' => "$tmp_dir/pg_wal.tar.gz",
+		'compression_method' => 'gzip',
+		'compression_flags' => '-czf',
+		'enabled' => check_pg_config("#define HAVE_LIBZ 1"),
+	});
+
+for my $scenario (@scenarios)
+{
+	my $path = $scenario->{'path'};
+	my $method = $scenario->{'compression_method'};
+
+  SKIP:
+	{
+		skip "$method compression not supported by this build", 1
+		  if !$scenario->{'enabled'};
+
+		generate_archive(
+			$path,
+			$node->data_dir . '/pg_wal',
+			$scenario->{'compression_flags'});
+
+		command_fails_like(
+			[ 'pg_waldump', '--path' => $path ],
+			qr/error: no start WAL location given/,
+			"$method: path option requires start location");
+		command_like(
+			[
+				'pg_waldump',
+				'--path' => $path,
+				'--start' => $start_lsn,
+				'--end' => $end_lsn,
+			],
+			qr/./,
+			"$method: runs with path option and start and end locations");
+		command_fails_like(
+			[
+				'pg_waldump',
+				'--path' => $path,
+				'--start' => $start_lsn,
+			],
+			qr/error: error in WAL record at/,
+			"$method: falling off the end of the WAL results in an error");
+
+		command_fails_like(
+			[
+				'pg_waldump', '--quiet',
+				'--path' => $path,
+				'--start' => $start_lsn
+			],
+			qr/error: error in WAL record at/,
+			"$method: errors are shown with --quiet");
+
+		test_pg_waldump_skip_bytes($path, $start_lsn, $end_lsn);
+
+		my @lines = test_pg_waldump($path, $start_lsn, $end_lsn);
+		is(grep(!/^rmgr: \w/, @lines),
+			0, "$method: all output lines are rmgr lines");
+
+		@lines = test_pg_waldump($path, $contrecord_lsn, $end_lsn);
+		is(grep(!/^rmgr: \w/, @lines),
+			0, "$method: contrecord - all output lines are rmgr lines");
+
+		test_pg_waldump_skip_bytes($path, $contrecord_lsn, $end_lsn);
+
+		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--limit' => 6);
+		is(@lines, 6, "$method: limit option observed");
+
+		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--fullpage');
+		is(grep(!/^rmgr:.*\bFPW\b/, @lines),
+			0, "$method: all output lines are FPW");
+
+		@lines = test_pg_waldump($path, $start_lsn, $end_lsn, '--stats');
+		like($lines[0], qr/WAL statistics/, "$method: statistics on stdout");
+		is(grep(/^rmgr:/, @lines), 0, "$method: no rmgr lines output");
+
+		@lines =
+		  test_pg_waldump($path, $start_lsn, $end_lsn, '--stats=record');
+		like($lines[0], qr/WAL statistics/,
+			"$method: stats=record on stdout");
+		is(grep(/^rmgr:/, @lines),
+			0, "$method: no rmgr lines with stats=record");
+
+		@lines =
+		  test_pg_waldump($path, $start_lsn, $end_lsn, '--rmgr' => 'Btree');
+		is(grep(!/^rmgr: Btree/, @lines), 0, "$method: only Btree lines");
+
+		@lines =
+		  test_pg_waldump($path, $start_lsn, $end_lsn, '--fork' => 'init');
+		is(grep(!/fork init/, @lines), 0, "$method: only init fork lines");
+
+		# Cleanup.
+		unlink $path;
+	}
+}
+
+done_testing();