mirror of
https://git.postgresql.org/git/postgresql.git
synced 2025-03-19 20:00:51 +08:00
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 721856ff24, 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
This commit is contained in:
Peter Eisentraut
parent
1e3f461e82
commit
3849fe7c2b
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
||||
@ -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;
|
||||
use warnings;
|
||||
|
||||
# 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);
|
||||
}
|
||||
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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)/
|
||||
@ -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'
|
||||
|
||||
@ -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.
|
||||
@ -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',
|
||||
)
|
||||
|
||||
@ -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'
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user