Add more $Test::Builder::Level in the TAP tests

michaelpq · michaelpq · commit d5ab331a339d · 2021-10-12T11:16:30.000+09:00
Incrementing the level of the call stack reported is useful for debugging purposes as it allows to control which part of the test is exactly failing, especially if a test is structured with subroutines that call routines from Test::More. This adds more incrementations of $Test::Builder::Level where debugging gets improved (for example it does not make sense for some paths like pg_rewind where long subroutines are used). A note is added to src/test/perl/README about that, based on a suggestion from Andrew Dunstan and a wording coming from both of us. Usage of Test::Builder::Level has spread in 12, so a backpatch down to this version is done. Reviewed-by: Andrew Dunstan, Peter Eisentraut, Daniel Gustafsson Discussion: https://postgr.es/m/YV1CCFwgM1RV1LeS@paquier.xyz Backpatch-through: 12
diff --git a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
@@ -69,6 +69,8 @@ sub create_files
 
 sub run_check
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($suffix, $test_name) = @_;
 
 	create_files();
diff --git a/src/test/kerberos/t/001_auth.pl b/src/test/kerberos/t/001_auth.pl
@@ -203,6 +203,8 @@ sub test_access
 # As above, but test for an arbitrary query result.
 sub test_query
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($node, $role, $query, $expected, $gssencmode, $test_name) = @_;
 
 	# need to connect over TCP/IP for Kerberos
diff --git a/src/test/perl/README b/src/test/perl/README
@@ -61,9 +61,17 @@ Test::More::like entails use of the qr// operator.  Avoid Perl 5.8.8 bug
 #39185 by not using the "$" regular expression metacharacter in qr// when also
 using the "/m" modifier.  Instead of "$", use "\n" or "(?=\n|\z)".
 
-Read the Test::More documentation for more on how to write tests:
+Test::Builder::Level controls how far up in the call stack a test will look
+at when reporting a failure.  This should be incremented by any subroutine
+which directly or indirectly calls test routines from Test::More, such as
+ok() or is():
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+Read the documentation for more on how to write tests:
 
     perldoc Test::More
+    perldoc Test::Builder
 
 For available PostgreSQL-specific test methods and some example tests read the
 perldoc for the test modules, e.g.:
diff --git a/src/test/recovery/t/001_stream_rep.pl b/src/test/recovery/t/001_stream_rep.pl
@@ -72,6 +72,8 @@
 # target_session_attrs with multiple nodes.
 sub test_target_session_attrs
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $node1       = shift;
 	my $node2       = shift;
 	my $target_node = shift;
diff --git a/src/test/recovery/t/003_recovery_targets.pl b/src/test/recovery/t/003_recovery_targets.pl
@@ -10,6 +10,8 @@
 # count to reach $num_rows, yet not later than the recovery target.
 sub test_recovery_standby
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $test_name       = shift;
 	my $node_name       = shift;
 	my $node_master     = shift;
diff --git a/src/test/recovery/t/007_sync_rep.pl b/src/test/recovery/t/007_sync_rep.pl
@@ -14,6 +14,8 @@
 # the configuration file is reloaded before the test.
 sub test_sync_state
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($self, $expected, $msg, $setting) = @_;
 
 	if (defined($setting))
diff --git a/src/test/recovery/t/009_twophase.pl b/src/test/recovery/t/009_twophase.pl
@@ -11,6 +11,8 @@
 
 sub configure_and_reload
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($node, $parameter) = @_;
 	my $name = $node->name;
 

Original file line number	Diff line number	Diff line change
`@@ -69,6 +69,8 @@ sub create_files`
`69`	`69`
`70`	`70`	`sub run_check`
`71`	`71`	`{`
	`72`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`73`	`+`
`72`	`74`	`my ($suffix, $test_name) = @_;`
`73`	`75`
`74`	`76`	`create_files();`
Original file line number	Diff line number	Diff line change
`@@ -203,6 +203,8 @@ sub test_access`
`203`	`203`	`# As above, but test for an arbitrary query result.`
`204`	`204`	`sub test_query`
`205`	`205`	`{`
	`206`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`207`	`+`
`206`	`208`	`my ($node, $role, $query, $expected, $gssencmode, $test_name) = @_;`
`207`	`209`
`208`	`210`	`# need to connect over TCP/IP for Kerberos`
Original file line number	Diff line number	Diff line change
`@@ -72,6 +72,8 @@`
`72`	`72`	`# target_session_attrs with multiple nodes.`
`73`	`73`	`sub test_target_session_attrs`
`74`	`74`	`{`
	`75`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`76`	`+`
`75`	`77`	`my $node1 = shift;`
`76`	`78`	`my $node2 = shift;`
`77`	`79`	`my $target_node = shift;`
Original file line number	Diff line number	Diff line change
`@@ -10,6 +10,8 @@`
`10`	`10`	`# count to reach $num_rows, yet not later than the recovery target.`
`11`	`11`	`sub test_recovery_standby`
`12`	`12`	`{`
	`13`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`14`	`+`
`13`	`15`	`my $test_name = shift;`
`14`	`16`	`my $node_name = shift;`
`15`	`17`	`my $node_master = shift;`
Original file line number	Diff line number	Diff line change
`@@ -14,6 +14,8 @@`
`14`	`14`	`# the configuration file is reloaded before the test.`
`15`	`15`	`sub test_sync_state`
`16`	`16`	`{`
	`17`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`18`	`+`
`17`	`19`	`my ($self, $expected, $msg, $setting) = @_;`
`18`	`20`
`19`	`21`	`if (defined($setting))`
Original file line number	Diff line number	Diff line change
`@@ -11,6 +11,8 @@`
`11`	`11`
`12`	`12`	`sub configure_and_reload`
`13`	`13`	`{`
	`14`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`15`	`+`
`14`	`16`	`my ($node, $parameter) = @_;`
`15`	`17`	`my $name = $node->name;`
`16`	`18`