From d2b30831803eb3edb2e39b2e49b89bc74a65ee37 Mon Sep 17 00:00:00 2001
From: Craig Ringer <craig@2ndquadrant.com>
Date: Wed, 12 Apr 2017 13:25:19 +0800
Subject: [PATCH] Cache initdb runs in TAP tests

---
 src/test/perl/PostgresNode.pm  | 51 +++++++++++++++++++++++++++++++++++++++---
 src/test/perl/RecursiveCopy.pm |  5 +++++
 src/test/perl/TestLib.pm       |  5 +++++
 3 files changed, 58 insertions(+), 3 deletions(-)

diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
index cb84f1f..eef9f66 100644
--- a/src/test/perl/PostgresNode.pm
+++ b/src/test/perl/PostgresNode.pm
@@ -391,13 +391,28 @@ sub init
 
 	$params{allows_streaming} = 0 unless defined $params{allows_streaming};
 	$params{has_archiving}    = 0 unless defined $params{has_archiving};
+	$params{cache_initdb}	  = 1 unless defined $params{cache_initdb};
 
 	mkdir $self->backup_dir;
 	mkdir $self->archive_dir;
 
-	TestLib::system_or_bail('initdb', '-D', $pgdata, '-A', 'trust', '-N',
-		@{ $params{extra} });
-	TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
+	# Respect CACHE_INITDB=0 in the environment if set
+	$params{cache_initdb} = 0
+		if (defined($ENV{'CACHE_INITDB'}) && !$ENV{'CACHE_INITDB'});
+
+	# We don't cache initdb results for non-default runs
+	# and they're too uncommon to care about anyway.
+	$params{cache_initdb} = 0
+		if defined($params{extra});
+
+	if ($params{cache_initdb})
+	{
+		$self->_initdb_cached(%params);
+	}
+	else
+	{
+		$self->_initdb($pgdata, %params);
+	}
 
 	open my $conf, '>>', "$pgdata/postgresql.conf";
 	print $conf "\n# Added by PostgresNode.pm\n";
@@ -446,6 +461,36 @@ sub init
 	$self->enable_archiving     if $params{has_archiving};
 }
 
+# Wrapper to actually run initdb its self
+sub _initdb
+{
+	my ($self, $pgdata, %params) = @_;
+
+	TestLib::system_or_bail('initdb', '-D', $pgdata, '-A', 'trust', '-N',
+		@{ $params{extra} });
+	TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata);
+}
+
+sub _initdb_cached
+{
+	my ($self, %params) = @_;
+	my $pgdata = $self->data_dir;
+
+	my $cachedir = TestLib::tmp_check_dir() . "/initdb_cache";
+
+	if (! -d $cachedir)
+	{
+		print(STDERR "initializing initdb cache\n");
+		# initdb into a tempdir, then rename the result so we don't risk
+		# leaving failed initdb results around
+		my $temp_dbdir = TestLib::tempdir("initdb_cache_");
+		$self->_initdb($temp_dbdir, %params);
+		rename($temp_dbdir, $cachedir);
+	}
+
+	RecursiveCopy::copypath($cachedir, $pgdata);
+}
+
 =pod
 
 =item $node->append_conf(filename, str)
diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm
index 28ecaf6..103b976 100644
--- a/src/test/perl/RecursiveCopy.pm
+++ b/src/test/perl/RecursiveCopy.pm
@@ -22,6 +22,9 @@ use warnings;
 use File::Basename;
 use File::Copy;
 
+# see https://perldoc.perl.org/perlport.html#stat
+${^WIN32_SLOPPY_STAT} = 1;
+
 =pod
 
 =head1 DESCRIPTION
@@ -111,6 +114,8 @@ sub _copypath_recurse
 
 	# Otherwise this is directory: create it on dest and recurse onto it.
 	mkdir($destpath) or die "mkdir($destpath) failed: $!";
+	# It's OK to run this on win32, see perlport
+	chmod((stat $srcpath)[2] & 07777, $destpath) or die "chmod() of $destpath failed: $!";
 
 	opendir(my $directory, $srcpath) or die "could not opendir($srcpath): $!";
 	while (my $entry = readdir($directory))
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
index ae8d178..5187f75 100644
--- a/src/test/perl/TestLib.pm
+++ b/src/test/perl/TestLib.pm
@@ -141,6 +141,11 @@ sub tempdir
 		CLEANUP => 1);
 }
 
+sub tmp_check_dir
+{
+	return $tmp_check;
+}
+
 sub tempdir_short
 {
 
-- 
2.5.5