Subject: Re: Remove MSVC scripts from the tree

From: Peter Eisentraut <[email-masked]>
Date: Fri, 10 Nov 2023 08:38:21 +0100

On 09.11.23 00:05, Michael Paquier wrote:
>> Attached is a Perl version of the sed script, converted by hand (so not the
>> super-verbose s2p thing).  It's basically just the sed script with
>> semicolons added and the backslashes in the regular expressions moved
>> around.  I think we could use something like that for all platforms now.
> 
> Sounds like a good idea to me now that perl is a hard requirement.
> +1.

How about this patch as a comprehensive solution?
From 47731e486d7356462ce610a6a76c21a0b3619823 Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <[email-masked]>
Date: Fri, 10 Nov 2023 08:07:11 +0100
Subject: [PATCH v1] Replace Gen_dummy_probes.sed with Gen_dummy_probes.pl

---
 .gitattributes                               |   1 -
 src/backend/utils/Gen_dummy_probes.pl        | 275 ++-----------------
 src/backend/utils/Gen_dummy_probes.pl.prolog |  19 --
 src/backend/utils/Gen_dummy_probes.sed       |  24 --
 src/backend/utils/Makefile                   |  15 +-
 src/backend/utils/README.Gen_dummy_probes    |  27 --
 src/include/utils/meson.build                |   2 +-
 src/tools/msvc/Solution.pm                   |   2 +-
 8 files changed, 26 insertions(+), 339 deletions(-)
 delete mode 100644 src/backend/utils/Gen_dummy_probes.pl.prolog
 delete mode 100644 src/backend/utils/Gen_dummy_probes.sed
 delete mode 100644 src/backend/utils/README.Gen_dummy_probes

diff --git a/.gitattributes b/.gitattributes
index 2384956d88..55e6060405 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -14,7 +14,6 @@ README.*	conflict-marker-size=32
 *.data						-whitespace
 contrib/pgcrypto/sql/pgp-armor.sql		whitespace=-blank-at-eol
 src/backend/catalog/sql_features.txt		whitespace=space-before-tab,blank-at-eof,-blank-at-eol
-src/backend/utils/Gen_dummy_probes.pl.prolog	whitespace=-blank-at-eof
 
 # Test output files that contain extra whitespace
 *.out					-whitespace
diff --git a/src/backend/utils/Gen_dummy_probes.pl b/src/backend/utils/Gen_dummy_probes.pl
index f289b19344..f6df82baa5 100644
--- a/src/backend/utils/Gen_dummy_probes.pl
+++ b/src/backend/utils/Gen_dummy_probes.pl
@@ -1,259 +1,28 @@
-#! /usr/bin/perl -w
 #-------------------------------------------------------------------------
+# Perl script to create dummy probes.h file when dtrace is not available
 #
-# Gen_dummy_probes.pl
-#    Perl script that generates probes.h file when dtrace is not available
-#
-# Portions Copyright (c) 2008-2023, 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
+# Copyright (c) 2008-2023, PostgreSQL Global Development Group
 #
+# src/backend/utils/Gen_dummy_probes.pl
 #-------------------------------------------------------------------------
 
-# turn off perlcritic for autogenerated code
-## no critic
-
-$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;
-		}
-
-		# s/$/ do {} while (0)/
-		{
-			$s = s /$/ do {} while (0)/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);
-}
+use warnings;
+
+m/^\s*probe / || next;
+s/^\s*probe ([^(]*)(.*);/$1$2/;
+s/__/_/g;
+y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/;
+s/^/#define TRACE_POSTGRESQL_/;
+s/\([^,)]{1,}\)/(INT1)/;
+s/\([^,)]{1,}, [^,)]{1,}\)/(INT1, INT2)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3, INT4)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3, INT4, INT5)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3, INT4, INT5, INT6)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/;
+s/\([^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}, [^,)]{1,}\)/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/;
+s/$/ do {} while (0)/;
+print;
+s/\(.*$/_ENABLED() (0)/;
+print;
diff --git a/src/backend/utils/Gen_dummy_probes.pl.prolog b/src/backend/utils/Gen_dummy_probes.pl.prolog
deleted file mode 100644
index f5210d684c..0000000000
--- a/src/backend/utils/Gen_dummy_probes.pl.prolog
+++ /dev/null
@@ -1,19 +0,0 @@
-#! /usr/bin/perl -w
-#-------------------------------------------------------------------------
-#
-# Gen_dummy_probes.pl
-#    Perl script that generates probes.h file when dtrace is not available
-#
-# Portions Copyright (c) 2008-2023, 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
-#
-#-------------------------------------------------------------------------
-
-# turn off perlcritic for autogenerated code
-## no critic
-
diff --git a/src/backend/utils/Gen_dummy_probes.sed b/src/backend/utils/Gen_dummy_probes.sed
deleted file mode 100644
index bfc6630628..0000000000
--- a/src/backend/utils/Gen_dummy_probes.sed
+++ /dev/null
@@ -1,24 +0,0 @@
-#-------------------------------------------------------------------------
-# sed script to create dummy probes.h file when dtrace is not available
-#
-# Copyright (c) 2008-2023, PostgreSQL Global Development Group
-#
-# src/backend/utils/Gen_dummy_probes.sed
-#-------------------------------------------------------------------------
-
-/^[ 	]*probe /!d
-s/^[ 	]*probe \([^(]*\)\(.*\);/\1\2/
-s/__/_/g
-y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/
-s/^/#define TRACE_POSTGRESQL_/
-s/([^,)]\{1,\})/(INT1)/
-s/([^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7)/
-s/([^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\}, [^,)]\{1,\})/(INT1, INT2, INT3, INT4, INT5, INT6, INT7, INT8)/
-s/$/ do {} while (0)/
-P
-s/(.*$/_ENABLED() (0)/
diff --git a/src/backend/utils/Makefile b/src/backend/utils/Makefile
index e184e3dfdf..7dfac5465d 100644
--- a/src/backend/utils/Makefile
+++ b/src/backend/utils/Makefile
@@ -63,8 +63,8 @@ probes.h: postprocess_dtrace.sed probes.h.tmp
 probes.h.tmp: probes.d
 	$(DTRACE) -C -h -s $< -o $@
 else
-probes.h: Gen_dummy_probes.sed probes.d
-	sed -f $^ >$@
+probes.h: Gen_dummy_probes.pl probes.d
+	$(PERL) -n $^ >$@
 endif
 
 # These generated headers must be symlinked into src/include/.
@@ -76,17 +76,6 @@ $(top_builddir)/src/include/utils/header-stamp: fmgr-stamp errcodes.h probes.h
 	done
 	touch $@
 
-# Recipe for rebuilding the Perl version of Gen_dummy_probes
-# Nothing depends on it, so it will never be called unless explicitly requested
-# The last two lines of the recipe format the script according to  our
-# standard and put back some blank lines for improved readability.
-Gen_dummy_probes.pl: Gen_dummy_probes.sed Gen_dummy_probes.pl.prolog
-	cp $(srcdir)/Gen_dummy_probes.pl.prolog $@
-	s2p -f $<  | sed -e 1,3d -e '/# #/ d' -e '$$d' >> $@
-	perltidy --profile=$(srcdir)/../../tools/pgindent/perltidyrc $@
-	perl -pi -e '!$$lb && ( /^\t+#/  || /^# prototypes/ ) && print qq{\n};'\
-		-e '$$lb = m/^\n/; ' $@
-
 .PHONY: install-data
 install-data: errcodes.txt installdirs
 	$(INSTALL_DATA) $(srcdir)/errcodes.txt '$(DESTDIR)$(datadir)/errcodes.txt'
diff --git a/src/backend/utils/README.Gen_dummy_probes b/src/backend/utils/README.Gen_dummy_probes
deleted file mode 100644
index e17060ef24..0000000000
--- a/src/backend/utils/README.Gen_dummy_probes
+++ /dev/null
@@ -1,27 +0,0 @@
-# Generating dummy probes
-
-If Postgres isn't configured with dtrace enabled, we need to generate
-dummy probes for the entries in probes.d, that do nothing.
-
-This is accomplished in Unix via the sed script `Gen_dummy_probes.sed`. We
-used to use this in MSVC builds using the perl utility `psed`, which mimicked
-sed. However, that utility disappeared from Windows perl distributions and so
-we converted the sed script to a perl script to be used in MSVC builds.
-
-We still keep the sed script as the authoritative source for generating
-these dummy probes because except on Windows perl is not a hard requirement
-when building from a tarball.
-
-So, if you need to change the way dummy probes are generated, first change
-the sed script, and when it's working generate the perl script. This can
-be accomplished by using the perl utility s2p.
-
-s2p is no longer part of the perl core, so it might not be on your system,
-but it is available on CPAN and also in many package systems. e.g.
-on Fedora it can be installed using `cpan App::s2p` or
-`dnf install perl-App-s2p`.
-
-The Makefile contains a recipe for regenerating Gen_dummy_probes.pl, so all
-you need to do is once you have s2p installed is `make Gen_dummy_probes.pl`
-Note that in a VPATH build this will generate the file in the vpath tree,
-not the source tree.
diff --git a/src/include/utils/meson.build b/src/include/utils/meson.build
index c179478611..3dc54e791f 100644
--- a/src/include/utils/meson.build
+++ b/src/include/utils/meson.build
@@ -49,7 +49,7 @@ else
     input: files('../../backend/utils/probes.d'),
     output: 'probes.h',
     capture: true,
-    command: [sed, '-f', files('../../backend/utils/Gen_dummy_probes.sed'), '@INPUT@'],
+    command: [perl, '-n', files('../../backend/utils/Gen_dummy_probes.pl'), '@INPUT@'],
     install: true,
     install_dir: dir_include_server / 'utils',
   )
diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm
index a50f730260..98a5b5d872 100644
--- a/src/tools/msvc/Solution.pm
+++ b/src/tools/msvc/Solution.pm
@@ -608,7 +608,7 @@ sub GenerateFiles
 	{
 		print "Generating probes.h...\n";
 		system(
-			'perl src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h'
+			'perl -n src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h'
 		);
 	}
 
-- 
2.42.0

---

From: Michael Paquier <[email-masked]>
Date: Mon, 13 Nov 2023 14:30:48 +0900

>  8 files changed, 26 insertions(+), 339 deletions(-)

Thanks for the patch.  The numbers are here, and the patch looks
sensible.

The contents of probes.h without --enable-trace are exactly the same
before and after the patch.

In short, +1 to switch to what you are proposing here.
--
Michael

---

From: Peter Eisentraut <[email-masked]>
Date: Tue, 14 Nov 2023 11:02:40 +0100

done