postgres.git / summary / log / commit / refs

commit    a0adf38529d9ad3f4060f788a50ea619be21bcce
Author:   Andrew Dunstan <andrew@dunslane.net>
Date:     Sat Mar 19 22:36:35 2016 +0000

    Remove dependency on psed for MSVC builds.
    
    Modern Perl has removed psed from its core distribution, so it might not
    be readily available on some build platforms. We therefore replace its
    use with a Perl script generated by s2p, which is equivalent to the sed
    script. The latter is retained for non-MSVC builds to avoid creating a
    new hard dependency on Perl for non-Windows tarball builds.
    
    Backpatch to all live branches.
    
    Michael Paquier and me.


src/backend/utils/Gen_dummy_probes.pl | 249 ++++++++++++++++++++++++++++++++++ src/tools/msvc/Solution.pm | 2 +- 2 files changed, 250 insertions(+), 1 deletion(-) diff --git a/src/backend/utils/Gen_dummy_probes.pl b/src/backend/utils/Gen_dummy_probes.pl new file mode 100644 index 00000000000..0499a4cbc97 --- /dev/null +++ b/src/backend/utils/Gen_dummy_probes.pl @@ -0,0 +1,249 @@ +#! /usr/bin/perl -w +#------------------------------------------------------------------------- +# +# Gen_dummy_probes.pl +# Perl script that generates probes.h file when dtrace is not available +# +# Portions Copyright (c) 2008-2016, 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 +# +#------------------------------------------------------------------------- + +$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; + } + + # 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); +} diff --git a/src/tools/msvc/Solution.pm b/src/tools/msvc/Solution.pm index c2244bd4936..5eb084ee343 100644 --- a/src/tools/msvc/Solution.pm +++ b/src/tools/msvc/Solution.pm @@ -304,7 +304,7 @@ s{PG_VERSION_STR "[^"]+"}{__STRINGIFY(x) #x\n#define __STRINGIFY2(z) __STRINGIFY { print "Generating probes.h...\n"; system( -'psed -f src\backend\utils\Gen_dummy_probes.sed src\backend\utils\probes.d > src\include\utils\probes.h' +'perl src/backend/utils/Gen_dummy_probes.pl src/backend/utils/probes.d > src/include/utils/probes.h' ); } [parent: c02aae418527]