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 <pe...@eisentraut.org>
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
