From 47731e486d7356462ce610a6a76c21a0b3619823 Mon Sep 17 00:00:00 2001 From: Peter Eisentraut 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 = )) - { - 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 = )) - { - 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