Replace Gen_dummy_probes.sed with Gen_dummy_probes.pl

To generate a dummy probes.h file when dtrace is not available, we had
two different scripts: A sed version, which is the original version,
and a Perl version, which was generated by s2p.  This split was
necessary because Perl was not a mandatory build dependency on Unix,
but sed was not guaranteed to be available on Windows.

(The Meson build system used the sed version even on Windows, which
was probably incorrect and probably would have had to be fixed before
elevating that build system from experimental status.)

As of 721856f, Perl is a required build dependency, so this split
is no longer necessary.  We can just use the Perl script in all build
environments and remove a whole bunch of infrastructure to keep the
two variants in sync.

The new Gen_dummy_probes.pl is not the version generated by s2p but a
new implementation written by hand by adapting the sed version to Perl
syntax.

Reviewed-by: Michael Paquier <michael@paquier.xyz>
Discussion: https://www.postgresql.org/message-id/3fd0f1bc-4483-4ba9-8aa0-64765b052039@eisentraut.org

Author: petere

.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

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;

src/backend/utils/Gen_dummy_probes.pl.prolog

@@ -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'