Date: Thu, 23 Jun 2022 22:45:40 -0700
From: Noah Misch <noah@leadboat.com>
To: Andrew Dunstan <andrew@dunslane.net>
Cc: Michael Paquier <michael@paquier.xyz>, Tom Lane <tgl@sss.pgh.pa.us>,
	Andres Freund <andres@anarazel.de>, Erik Rijkers <er@xs4all.nl>,
	Robert Haas <robertmhaas@gmail.com>,
	Alvaro Herrera <alvherre@alvh.no-ip.org>,
	Mark Dilger <mark.dilger@enterprisedb.com>,
	PostgreSQL Hackers <pgsql-hackers@lists.postgresql.org>
Subject: Re: Postgres perl module namespace
Message-ID: <20220624054540.GA853010@rfd.leadboat.com>
References: <d74da58b-cfee-4fea-a31a-439921c0feb0@dunslane.net>
 <2361941.1650303832@sss.pgh.pa.us>
 <02188900-ba1e-8c6c-c7dd-98294f39c23f@dunslane.net>
 <2364418.1650305263@sss.pgh.pa.us>
 <f0d10209-7921-365a-aa7d-066e8cb8062e@dunslane.net>
 <03909eb8-21ce-ca68-fea0-cd338e35ad59@dunslane.net>
 <Yl86JyFPzbZQXmYa@paquier.xyz>
 <6790e47f-aa12-e28b-e123-3fbe46f78513@dunslane.net>
 <20220622072144.GD4167527@rfd.leadboat.com>
 <e4801823-d7bb-04b7-8a03-4f841e6d6bd0@dunslane.net>
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="LpQ9ahxlCli8rRTG"
Content-Disposition: inline
In-Reply-To: <e4801823-d7bb-04b7-8a03-4f841e6d6bd0@dunslane.net>
User-Agent: Mutt/1.5.24 (2015-08-30)
Archived-At: 
 <https://www.postgresql.org/message-id/20220624054540.GA853010%40rfd.leadboat.com>
Precedence: bulk


--LpQ9ahxlCli8rRTG
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline

On Wed, Jun 22, 2022 at 11:03:22AM -0400, Andrew Dunstan wrote:
> On 2022-06-22 We 03:21, Noah Misch wrote:
> > On Tue, Apr 19, 2022 at 07:24:58PM -0400, Andrew Dunstan wrote:
> >> On 2022-04-19 Tu 18:39, Michael Paquier wrote:
> >>> +*generate_ascii_string = *TestLib::generate_ascii_string;
> >>> +*slurp_dir = *TestLib::slurp_dir;
> >>> +*slurp_file = *TestLib::slurp_file;
> >>>
> >>> I am not sure if it is possible and my perl-fu is limited in this
> >>> area, but could a failure be enforced when loading this path if a new
> >>> routine added in TestLib.pm is forgotten in this list?
> >> Not very easily that I'm aware of, but maybe some superior perl wizard
> >> will know better.
> > One can alias the symbol table, like https://metacpan.org/pod/Package::Alias
> > does.  I'm attaching what I plan to use.  Today, check-world fails after
> >
> >   sed -i 's/TestLib/PostgreSQL::Test::Utils/g; s/PostgresNode/PostgreSQL::Test::Cluster/g' **/*.pl
> >
> > on REL_14_STABLE, because today's alias list is incomplete.  With this change,
> > the same check-world passes.

The patch wasn't sufficient to make that experiment pass for REL_10_STABLE,
where 017_shm.pl uses the %params argument of get_new_node().  The problem
call stack had PostgreSQL::Test::Cluster->get_new_code calling
PostgreSQL::Test::Cluster->new, which needs v14- semantics.  Here's a fixed
version, just changing the new() hack.

I suspect v1 also misbehaved for non-core tests that subclass PostgresNode
(via the approach from commit 54dacc7) or PostgreSQL::Test::Cluster.  I expect
this version will work with subclasses written for v14- and with subclasses
written for v15+.  I didn't actually write dummy subclasses to test, and the
relevant permutations are numerous (e.g. whether or not the subclass overrides
new(), whether or not the subclass overrides get_new_node()).

> Nice. 30 years of writing perl and I'm still learning of nifty features.

Thanks for reviewing. 

--LpQ9ahxlCli8rRTG
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename="alias-perl-symbol-tables-v2.patch"

commit 5155e0f
Author:     Noah Misch <noah@leadboat.com>
AuthorDate: Thu Jun 23 15:31:41 2022 -0700
Commit:     Noah Misch <noah@leadboat.com>
CommitDate: Thu Jun 23 15:31:41 2022 -0700

    For PostgreSQL::Test compatibility, alias entire package symbol tables.
    
    Remove the need to edit back-branch-specific code sites when
    back-patching the addition of a PostgreSQL::Test::Utils symbol.  Replace
    per-symbol, incomplete alias lists.  Give old and new package names the
    same EXPORT and EXPORT_OK semantics.  Back-patch to v10 (all supported
    versions).
    
    Reviewed by Andrew Dunstan.
    
    Discussion: https://postgr.es/m/20220622072144.GD4167527@rfd.leadboat.com
---
 src/test/perl/PostgreSQL/Test/Cluster.pm |  9 ++++---
 src/test/perl/PostgreSQL/Test/Utils.pm   | 40 +++---------------------------
 src/test/perl/PostgresNode.pm            | 23 +++++++----------
 src/test/perl/TestLib.pm                 | 42 --------------------------------
 4 files changed, 19 insertions(+), 95 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 12339c2..a855fbc 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -1,9 +1,9 @@
 
 # Copyright (c) 2022, PostgreSQL Global Development Group
 
-# allow use of release 15+ perl namespace in older branches
-# just 'use' the older module name.
-# See PostgresNode.pm for function implementations
+# Allow use of release 15+ Perl package name in older branches, by giving that
+# package the same symbol table as the older package.  See PostgresNode::new
+# for behavior reacting to the class name.
 
 package PostgreSQL::Test::Cluster;
 
@@ -11,5 +11,8 @@ use strict;
 use warnings;
 
 use PostgresNode;
+BEGIN { *PostgreSQL::Test::Cluster:: = \*PostgresNode::; }
+
+use Exporter 'import';
 
 1;
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index bdbbd6e..e743bdf 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -1,48 +1,16 @@
 # Copyright (c) 2022, PostgreSQL Global Development Group
 
-# allow use of release 15+ perl namespace in older branches
-# just 'use' the older module name.
-# We export the same names as the v15 module.
-# See TestLib.pm for alias assignment that makes this all work.
+# Allow use of release 15+ Perl package name in older branches, by giving that
+# package the same symbol table as the older package.
 
 package PostgreSQL::Test::Utils;
 
 use strict;
 use warnings;
 
-use Exporter 'import';
-
 use TestLib;
+BEGIN { *PostgreSQL::Test::Utils:: = \*TestLib::; }
 
-our @EXPORT = qw(
-  generate_ascii_string
-  slurp_dir
-  slurp_file
-  append_to_file
-  check_mode_recursive
-  chmod_recursive
-  check_pg_config
-  dir_symlink
-  system_or_bail
-  system_log
-  run_log
-  run_command
-  pump_until
-
-  command_ok
-  command_fails
-  command_exit_is
-  program_help_ok
-  program_version_ok
-  program_options_handling_ok
-  command_like
-  command_like_safe
-  command_fails_like
-  command_checks_all
-
-  $windows_os
-  $is_msys2
-  $use_unix_sockets
-);
+use Exporter 'import';
 
 1;
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index be90963..41bb582 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -149,6 +149,15 @@ of finding port numbers, registering instances for cleanup, etc.
 sub new
 {
 	my ($class, $name, $pghost, $pgport) = @_;
+
+	# Use release 15+ semantics when the arguments look like (node_name,
+	# %params).  We can't use $class to decide, because get_new_node() passes
+	# a v14- argument list regardless of the class.  $class might be an
+	# out-of-core subclass.  $class->isa('PostgresNode') returns true even for
+	# descendants of PostgreSQL::Test::Cluster, so it doesn't help.
+	return $class->get_new_node(@_[ 1 .. $#_ ])
+		if !$pghost or !$pgport or $pghost =~ /^[a-zA-Z0-9_]$/;
+
 	my $testname = basename($0);
 	$testname =~ s/\.[^.]+$//;
 	my $self = {
@@ -2796,18 +2805,4 @@ sub corrupt_page_checksum
 
 =cut
 
-# support release 15+ perl module namespace
-
-package PostgreSQL::Test::Cluster; ## no critic (ProhibitMultiplePackages)
-
-sub new
-{
-	shift; # remove class param from args
-	return PostgresNode->get_new_node(@_);
-}
-
-no warnings 'once';
-
-*get_free_port = *PostgresNode::get_free_port;
-
 1;
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index f3ee20a..610050e 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -979,46 +979,4 @@ sub command_checks_all
 
 =cut
 
-# support release 15+ perl module namespace
-
-package PostgreSQL::Test::Utils; ## no critic (ProhibitMultiplePackages)
-
-# we don't want to export anything here, but we want to support things called
-# via this package name explicitly.
-
-# use typeglobs to alias these functions and variables
-
-no warnings qw(once);
-
-*generate_ascii_string = *TestLib::generate_ascii_string;
-*slurp_dir = *TestLib::slurp_dir;
-*slurp_file = *TestLib::slurp_file;
-*append_to_file = *TestLib::append_to_file;
-*check_mode_recursive = *TestLib::check_mode_recursive;
-*chmod_recursive = *TestLib::chmod_recursive;
-*check_pg_config = *TestLib::check_pg_config;
-*dir_symlink = *TestLib::dir_symlink;
-*system_or_bail = *TestLib::system_or_bail;
-*system_log = *TestLib::system_log;
-*run_log = *TestLib::run_log;
-*run_command = *TestLib::run_command;
-*command_ok = *TestLib::command_ok;
-*command_fails = *TestLib::command_fails;
-*command_exit_is = *TestLib::command_exit_is;
-*program_help_ok = *TestLib::program_help_ok;
-*program_version_ok = *TestLib::program_version_ok;
-*program_options_handling_ok = *TestLib::program_options_handling_ok;
-*command_like = *TestLib::command_like;
-*command_like_safe = *TestLib::command_like_safe;
-*command_fails_like = *TestLib::command_fails_like;
-*command_checks_all = *TestLib::command_checks_all;
-
-*windows_os = *TestLib::windows_os;
-*is_msys2 = *TestLib::is_msys2;
-*use_unix_sockets = *TestLib::use_unix_sockets;
-*timeout_default = *TestLib::timeout_default;
-*tmp_check = *TestLib::tmp_check;
-*log_path = *TestLib::log_path;
-*test_logfile = *TestLib::test_log_file;
-
 1;

--LpQ9ahxlCli8rRTG--