Author:     Noah Misch <noah@leadboat.com>
Commit:     Noah Misch <noah@leadboat.com>

    

diff --git a/src/test/subscription/t/080_step_equalTupleDescs.pl b/src/test/subscription/t/080_step_equalTupleDescs.pl
new file mode 100644
index 0000000..a4dec82
--- /dev/null
+++ b/src/test/subscription/t/080_step_equalTupleDescs.pl
@@ -0,0 +1,223 @@
+# run with: make -C src/test/subscription check PROVE_TESTS=t/080_step_equalTupleDescs.pl
+# email src/test/subscription/tmp_check/log/regress_log_080_step_equalTupleDescs
+
+use strict;
+use warnings;
+use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Utils;
+use Test::More tests => 4;
+use IPC::Run;
+use Time::HiRes qw(usleep);
+
+my $node = PostgreSQL::Test::Cluster->new('main');
+$node->init;
+my $gdb_start_witness = $node->basedir . '/gdb_started.txt';
+
+$ENV{PATH} =~ /^([^:]*):/;
+my $bindir = $1;
+die "could not guess bindir from PATH=$ENV{PATH}" unless $1;
+
+# I seem to recall gdb vintages where different attach methods had different
+# ability to find source code.  Try that.
+my @attach_methods = (
+	# --pid alone
+	sub {
+		my $pid = shift;
+		return (
+			['--pid', $pid],
+			'');
+	},
+	# --pid w/ explicit symbol-file
+	sub {
+		my $pid = shift;
+		return (
+			['--pid', $pid],
+			"symbol-file -readnow $bindir/postgres");
+	},
+	# "attach" alone
+	sub {
+		my $pid = shift;
+		return (
+			[],
+			"attach $pid");
+	},
+	# "attach" w/ explicit symbol-file
+	sub {
+		my $pid = shift;
+		return (
+			[],
+			"symbol-file -readnow $bindir/postgres\nattach $pid");
+	},
+);
+
+foreach my $method (@attach_methods)
+{
+	poll_start($node);
+	$node->safe_psql('postgres', 'DROP TABLE IF EXISTS attmp');
+	unlink $gdb_start_witness;
+
+	my $in    = '';
+	my $out   = '';
+	my $timer = IPC::Run::timeout(180);
+	my $psql  = $node->background_psql('postgres', \$in, \$out, $timer,
+		on_error_stop => 0);
+
+	$in .= q{
+SELECT pg_backend_pid(), 'after_pid';
+};
+	$psql->pump until $out =~ /^([0-9]*)\|after_pid/m;
+	my $pid = $1;
+	print "backend pid: $pid\n";
+
+	my($attach_args, $attach_cmd) = $method->($pid);
+	my $gdb_in = '';
+	my $gdb_cmdline = [ qw(gdb --nx), @$attach_args, "$bindir/postgres" ];
+	print("# Running: " . join(" ", @{$gdb_cmdline}) . "\n");
+	my $gdb = IPC::Run::start($gdb_cmdline, '<', \$gdb_in, $timer);
+
+	print("# Using attach command: $attach_cmd\n");
+	$gdb_in = q{
+set width 0
+#
+} . $attach_cmd . q{
+#
+b equalTupleDescs
+ignore 1 9
+#
+set logging file } . $gdb_start_witness . q{
+set logging on
+set logging off
+#
+echo disassembly attempts, not sure which will work on HP gdb 6.1\n
+disassemble /m equalTupleDescs
+disassemble 0x40000000003fcb50,0x40000000003fdfff
+disassemble 0x40000000003fcb50 0x40000000003fdfff
+echo source listing attempts -\
+ try it, but gdb is seeing line numbers for main.c and toasting.c only\n
+list *0x40000000003fdc30
+list *0x40000000003fdc30:2
+};
+	$gdb->pump until $gdb_in eq '';
+	sleep .1 while !-f $gdb_start_witness;
+
+	# first 28 lines of src/test/regress/sql/alter_table.sql
+	$in .= q{
+--
+-- ALTER_TABLE
+--
+
+-- Clean up in case a prior regression run failed
+SET client_min_messages TO 'warning';
+DROP ROLE IF EXISTS regress_alter_table_user1;
+RESET client_min_messages;
+
+CREATE USER regress_alter_table_user1;
+
+--
+-- add attribute
+--
+
+CREATE TABLE attmp (initial int4);
+
+COMMENT ON TABLE attmp_wrong IS 'table comment';
+COMMENT ON TABLE attmp IS 'table comment';
+COMMENT ON TABLE attmp IS NULL;
+
+ALTER TABLE attmp ADD COLUMN xmin integer; -- fails
+
+ALTER TABLE attmp ADD COLUMN a int4 default 3;
+
+ALTER TABLE attmp ADD COLUMN b name;
+
+ALTER TABLE attmp ADD COLUMN c text;
+};
+
+	$in .= q{
+\q
+};
+
+	$gdb_in .= q{
+echo Reach breakpoint.\n
+continue
+#
+echo On gharial, args are properly setup after a 10-instr preamble.  Advance\
+ 11 instructions (in case I counted wrong) before capturing data.\n
+set $loopvar = 11
+while ($loopvar--)
+  stepi
+  x/i $pc
+end
+#
+echo Print any interesting memory state.\n
+p *tupdesc1
+p *tupdesc2
+p tupdesc1->attrs[0]
+p tupdesc1->attrs[1]
+p tupdesc1->attrs[2]
+p tupdesc2->attrs[0]
+p tupdesc2->attrs[1]
+p tupdesc2->attrs[2]
+p *tupdesc1->constr
+p *tupdesc2->constr
+p tupdesc1->constr->defval[0]
+p tupdesc2->constr->defval[0]
+backtrace full
+info proc mappings
+set $loopvar = 25
+while ($loopvar--)
+  frame $loopvar
+  info frame
+end
+#
+echo Advance to SIGSEGV, or give up after 25000 instructions.\n
+set $loopvar = 25000
+while ($loopvar--)
+  stepi
+  x/i $pc
+end
+maintenance info sections ALLOBJ
+info proc mappings
+quit
+};
+
+	for (;;)
+	{
+		$psql->pump_nb;
+		$gdb->pump_nb;
+		last if $in eq '' && $gdb_in eq '';
+		sleep .1;
+	}
+
+	$psql->finish;
+	$gdb->finish;
+	ok(1);
+
+	# Like $node->kill9, but don't care if a crash already downed the node.
+	kill(9, $node->{_pid});
+	$node->{_pid} = undef;
+}
+
+
+# copied from 017_shm.pl
+sub poll_start
+{
+	my ($node) = @_;
+
+	my $max_attempts = 180 * 10;
+	my $attempts     = 0;
+
+	while ($attempts < $max_attempts)
+	{
+		$node->start(fail_ok => 1) && return 1;
+
+		# Wait 0.1 second before retrying.
+		usleep(100_000);
+
+		$attempts++;
+	}
+
+	# No success within 180 seconds.  Try one last time without fail_ok, which
+	# will BAIL_OUT unless it succeeds.
+	$node->start && return 1;
+	return 0;
+}