Remove dependency on psed for MSVC builds.

Modern Perl has removed psed from its core distribution, so it might not
be readily available on some build platforms. We therefore replace its
use with a Perl script generated by s2p, which is equivalent to the sed
script. The latter is retained for non-MSVC builds to avoid creating a
new hard dependency on Perl for non-Windows tarball builds.

Backpatch to all live branches.

Michael Paquier and me.

2 files changed, 250 insertions, 1 deletions

diff --git a/src/backend/utils/Gen_dummy_probes.pl b/src/backend/utils/Gen_dummy_probes.pl
new file mode 100644
index 00000000000..0499a4cbc97
--- /dev/null
+++ b/src/backend/utils/Gen_dummy_probes.pl
@@ -0,0 +1,249 @@
+#! /usr/bin/perl -w
+#-------------------------------------------------------------------------
+#
+# Gen_dummy_probes.pl
+#    Perl script that generates probes.h file when dtrace is not available
+#
+# Portions Copyright (c) 2008-2016, PostgreSQL Global Development Group
+#
+#
+# IDENTIFICATION
+#    src/backend/utils/Gen_dummy_probes.pl
+#
+# This program was generated by running perl's s2p over Gen_dummy_probes.sed
+#
+#-------------------------------------------------------------------------
+
+$0 =~ s/^.*?(\w+)[\.\w+]*$/$1/;
+
+use strict;
+use Symbol;
+use vars qw{ $isEOF $Hold %wFiles @Q $CondReg
+  $doAutoPrint $doOpenWrite $doPrint };
+$doAutoPrint = 1;
+$doOpenWrite = 1;
+
+# prototypes
+sub openARGV();
+sub getsARGV(;\$);
+sub eofARGV();
+sub printQ();
+
+# Run: the sed loop reading input and applying the script
+#
+sub Run()
+{
+	my ($h, $icnt, $s, $n);
+
+	# hack (not unbreakable :-/) to avoid // matching an empty string
+	my $z = "\000";
+	$z =~ /$z/;
+
+	# Initialize.
+	openARGV();
+	$Hold    = '';
+	$CondReg = 0;
+	$doPrint = $doAutoPrint;
+  CYCLE:
+	while (getsARGV())
+	{
+		chomp();
+		$CondReg = 0;    # cleared on t
+	  BOS:;
+
+		# /^[ 	]*probe /!d
+		unless (m /^[ \t]*probe /s)
+		{
+			$doPrint = 0;
+			goto EOS;
+		}
+
+		# s/^[ 	]*probe \([^(]*\)\(.*\);/\1\2/
+		{
+			$s = s /^[ \t]*probe ([^(]*)(.*);/${1}${2}/s;
+			$CondReg ||= $s;
+		}
+
+		# s/__/_/g
+		{
+			$s = s /__/_/sg;
+			$CondReg ||= $s;
+		}
+
+		# y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
+		{ y{abcdefghijklmnopqrstuvwxyz}{ABCDEFGHIJKLMNOPQRSTUVWXYZ}; }
+
+		# s/^/#define TRACE_POSTGRESQL_/
+		{
+			$s = s /^/#define TRACE_POSTGRESQL_/s;
+			$CondReg ||= $s;
+		}
+
+		# s/([^,)]\{1,\})/(INT1)/
+		{
+			$s = s /\([^,)]+\)/(INT1)/s;
+			$CondReg ||= $s;
+		}
+
+		# s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
+		{
+			$s = s /\([^,)]+, [^,)]+\)/(INT1, INT2)/s;
+			$CondReg ||= $s;
+		}
+
+		# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
+		{
+			$s = s /\([^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3)/s;
+			$CondReg ||= $s;
+		}
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
+		{
+			$s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4)/s;
+			$CondReg ||= $s;
+		}
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
+		{
+			$s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5)/s;
+			$CondReg ||= $s;
+		}
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
+		{
+			$s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6)/s;
+			$CondReg ||= $s;
+		}
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
+		{
+			$s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/s;
+			$CondReg ||= $s;
+		}
+
+# s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
+		{
+			$s =
+s /\([^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+, [^,)]+\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/s;
+			$CondReg ||= $s;
+		}
+
+		# P
+		{
+			if (/^(.*)/) { print $1, "\n"; }
+		}
+
+		# s/(.*$/_ENABLED() (0)/
+		{
+			$s = s /\(.*$/_ENABLED() (0)/s;
+			$CondReg ||= $s;
+		}
+	  EOS: if ($doPrint)
+		{
+			print $_, "\n";
+		}
+		else
+		{
+			$doPrint = $doAutoPrint;
+		}
+		printQ() if @Q;
+	}
+
+	exit(0);
+}
+Run();
+
+# openARGV: open 1st input file
+#
+sub openARGV()
+{
+	unshift(@ARGV, '-') unless @ARGV;
+	my $file = shift(@ARGV);
+	open(ARG, "<$file")
+	  || die("$0: can't open $file for reading ($!)\n");
+	$isEOF = 0;
+}
+
+# getsARGV: Read another input line into argument (default: $_).
+#           Move on to next input file, and reset EOF flag $isEOF.
+sub getsARGV(;\$)
+{
+	my $argref = @_ ? shift() : \$_;
+	while ($isEOF || !defined($$argref = <ARG>))
+	{
+		close(ARG);
+		return 0 unless @ARGV;
+		my $file = shift(@ARGV);
+		open(ARG, "<$file")
+		  || die("$0: can't open $file for reading ($!)\n");
+		$isEOF = 0;
+	}
+	1;
+}
+
+# eofARGV: end-of-file test
+#
+sub eofARGV()
+{
+	return @ARGV == 0 && ($isEOF = eof(ARG));
+}
+
+# makeHandle: Generates another file handle for some file (given by its path)
+#             to be written due to a w command or an s command's w flag.
+sub makeHandle($)
+{
+	my ($path) = @_;
+	my $handle;
+	if (!exists($wFiles{$path}) || $wFiles{$path} eq '')
+	{
+		$handle = $wFiles{$path} = gensym();
+		if ($doOpenWrite)
+		{
+			if (!open($handle, ">$path"))
+			{
+				die("$0: can't open $path for writing: ($!)\n");
+			}
+		}
+	}
+	else
+	{
+		$handle = $wFiles{$path};
+	}
+	return $handle;
+}
+
+# printQ: Print queued output which is either a string or a reference
+#         to a pathname.
+sub printQ()
+{
+	for my $q (@Q)
+	{
+		if (ref($q))
+		{
+			# flush open w files so that reading this file gets it all
+			if (exists($wFiles{$$q}) && $wFiles{$$q} ne '')
+			{
+				open($wFiles{$$q}, ">>$$q");
+			}
+
+			# copy file to stdout: slow, but safe
+			if (open(RF, "<$$q"))
+			{
+				while (defined(my $line = <RF>))
+				{
+					print $line;
+				}
+				close(RF);
+			}
+		}
+		else
+		{
+			print $q;
+		}
+	}
+	undef(@Q);
+}
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index ac5f913509b..b3afb807987 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -285,7 +285,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY
 	{
 		print "Generating probes.h...\n";
 		system(
-'psed -f src\backend\utils\Gen_dummy_probes.sed src\backend\utils\probes.d > src\include\utils\probes.h'
+'perl src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h'
 		);
 	}