Change qr/foo$/m to qr/foo\n/m, for Perl 5.8.8.

In each case, absence of a trailing newline would itself constitute a
PostgreSQL bug.  Therefore, this slightly enhances the changed tests.
This works around a bug that last appeared in Perl 5.8.8, fixing
src/test/modules/test_pg_dump when run against that version.  Commit
e7293e3271 worked around the bug, but the
subsequent addition of test_pg_dump introduced affected code.  As that
commit had shown, slight increases in pattern complexity can suppress
the bug.  This commit edits qr/foo$/m patterns too complex to encounter
the bug today, for style consistency and robustness against unrelated
pattern changes.  Back-patch to 9.6, where test_pg_dump was introduced.

As of this writing, a fresh MSYS installation includes an affected Perl
5.8.8.  The Perl 5.8.8 in Red Hat Enterprise Linux 5.11 carries a patch
that renders it unaffected, but the Perl 5.8.5 of Red Hat Enterprise
Linux 4.4 is affected.
This commit is contained in:
Noah Misch 2016-11-07 20:27:30 -05:00
parent e3e66d8a98
commit 650b967076
4 changed files with 32 additions and 30 deletions

View File

@ -215,16 +215,14 @@ $node->command_ok([ 'pg_basebackup', '-D', "$tempdir/backupR", '-R' ],
ok(-f "$tempdir/backupR/recovery.conf", 'recovery.conf was created');
my $recovery_conf = slurp_file "$tempdir/backupR/recovery.conf";
# using a character class for the final "'" here works around an apparent
# bug in several version of the Msys DTK perl
my $port = $node->port;
like(
$recovery_conf,
qr/^standby_mode = 'on[']$/m,
qr/^standby_mode = 'on'\n/m,
'recovery.conf sets standby_mode');
like(
$recovery_conf,
qr/^primary_conninfo = '.*port=$port.*'$/m,
qr/^primary_conninfo = '.*port=$port.*'\n/m,
'recovery.conf sets primary_conninfo');
$node->command_ok(
@ -273,5 +271,5 @@ $node->command_ok(
'pg_basebackup with replication slot and -R runs');
like(
slurp_file("$tempdir/backupxs_sl_R/recovery.conf"),
qr/^primary_slot_name = 'slot1'$/m,
qr/^primary_slot_name = 'slot1'\n/m,
'recovery.conf sets primary_slot_name');

View File

@ -193,7 +193,7 @@ my %tests = (
create_sql => 'CREATE EXTENSION test_pg_dump;',
regexp => qr/^
\QCREATE EXTENSION IF NOT EXISTS test_pg_dump WITH SCHEMA public;\E
$/xm,
\n/xm,
like => {
clean => 1,
clean_if_exists => 1,
@ -210,7 +210,7 @@ my %tests = (
'CREATE ROLE regress_dump_test_role' => {
create_order => 1,
create_sql => 'CREATE ROLE regress_dump_test_role;',
regexp => qr/^CREATE ROLE regress_dump_test_role;$/m,
regexp => qr/^CREATE ROLE regress_dump_test_role;\n/m,
like => { pg_dumpall_globals => 1, },
unlike => {
binary_upgrade => 1,
@ -231,7 +231,7 @@ my %tests = (
\n\s+\QNO MINVALUE\E
\n\s+\QNO MAXVALUE\E
\n\s+\QCACHE 1;\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -252,7 +252,7 @@ my %tests = (
\n\s+\QNO MINVALUE\E
\n\s+\QNO MAXVALUE\E
\n\s+\QCACHE 1;\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -270,7 +270,7 @@ my %tests = (
\QCREATE TABLE regress_pg_dump_table (\E
\n\s+\Qcol1 integer NOT NULL,\E
\n\s+\Qcol2 integer\E
\n\);$/xm,
\n\);\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -286,7 +286,7 @@ my %tests = (
'CREATE ACCESS METHOD regress_test_am' => {
regexp => qr/^
\QCREATE ACCESS METHOD regress_test_am TYPE INDEX HANDLER bthandler;\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -303,7 +303,7 @@ my %tests = (
regexp => qr/^
\QCOMMENT ON EXTENSION test_pg_dump \E
\QIS 'Test pg_dump with an extension';\E
$/xm,
\n/xm,
like => {
binary_upgrade => 1,
clean => 1,
@ -322,7 +322,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT SELECT ON TABLE regress_pg_dump_table TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -340,7 +340,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT SELECT(col1) ON TABLE regress_pg_dump_table TO PUBLIC;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -359,7 +359,7 @@ my %tests = (
TO regress_dump_test_role;',
regexp => qr/^
\QGRANT SELECT(col2) ON TABLE regress_pg_dump_table TO regress_dump_test_role;\E
$/xm,
\n/xm,
like => {
binary_upgrade => 1,
clean => 1,
@ -380,7 +380,7 @@ my %tests = (
TO regress_dump_test_role;',
regexp => qr/^
\QGRANT USAGE ON SEQUENCE regress_pg_dump_table_col1_seq TO regress_dump_test_role;\E
$/xm,
\n/xm,
like => {
binary_upgrade => 1,
clean => 1,
@ -397,7 +397,7 @@ my %tests = (
'GRANT USAGE ON regress_pg_dump_seq TO regress_dump_test_role' => {
regexp => qr/^
\QGRANT USAGE ON SEQUENCE regress_pg_dump_seq TO regress_dump_test_role;\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -416,7 +416,7 @@ my %tests = (
FROM PUBLIC;',
regexp => qr/^
\QREVOKE SELECT(col1) ON TABLE regress_pg_dump_table FROM PUBLIC;\E
$/xm,
\n/xm,
like => {
binary_upgrade => 1,
clean => 1,
@ -436,7 +436,7 @@ my %tests = (
\QCREATE TABLE test_table (\E
\n\s+\Qcol1 integer,\E
\n\s+\Qcol2 integer\E
\n\);$/xm,
\n\);\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -454,7 +454,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT SELECT ON TABLE test_table TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -475,7 +475,7 @@ my %tests = (
\n\s+\QNO MINVALUE\E
\n\s+\QNO MAXVALUE\E
\n\s+\QCACHE 1;\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -493,7 +493,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT USAGE ON SEQUENCE test_seq TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -510,7 +510,7 @@ my %tests = (
regexp => qr/^
\QCREATE TYPE test_type AS (\E
\n\s+\Qcol1 integer\E
\n\);$/xm,
\n\);\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -528,7 +528,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT ALL ON TYPE test_type TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -545,7 +545,7 @@ my %tests = (
regexp => qr/^
\QCREATE FUNCTION test_func() RETURNS integer\E
\n\s+\QLANGUAGE sql\E
$/xm,
\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -563,7 +563,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT ALL ON FUNCTION test_func() TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -581,7 +581,7 @@ my %tests = (
\QCREATE AGGREGATE test_agg(smallint) (\E
\n\s+\QSFUNC = int2_sum,\E
\n\s+\QSTYPE = bigint\E
\n\);$/xm,
\n\);\n/xm,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -599,7 +599,7 @@ my %tests = (
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(true);\E\n
\QGRANT ALL ON FUNCTION test_agg(smallint) TO regress_dump_test_role;\E\n
\QSELECT pg_catalog.binary_upgrade_set_record_init_privs(false);\E
$/xms,
\n/xms,
like => { binary_upgrade => 1, },
unlike => {
clean => 1,
@ -620,7 +620,7 @@ my %tests = (
regexp => qr/^
\QCREATE TABLE external_tab (\E
\n\s+\Qcol1 integer\E
\n\);$/xm,
\n\);\n/xm,
like => {
binary_upgrade => 1,
clean => 1,

View File

@ -46,6 +46,10 @@ against them and evaluate the results. For example:
$node->stop('fast');
Test::More::like entails use of the qr// operator. Avoid Perl 5.8.8 bug
#39185 by not using the "$" regular expression metacharacter in qr// when also
using the "/m" modifier. Instead of "$", use "\n" or "(?=\n|\z)".
Read the Test::More documentation for more on how to write tests:
perldoc Test::More

View File

@ -256,7 +256,7 @@ sub AddDir
# Match rules that pull in source files from different directories, eg
# pgstrcasecmp.c rint.c snprintf.c: % : $(top_srcdir)/src/port/%
my $replace_re =
qr{^([^:\n\$]+\.c)\s*:\s*(?:%\s*: )?\$(\([^\)]+\))\/(.*)\/[^\/]+$}m;
qr{^([^:\n\$]+\.c)\s*:\s*(?:%\s*: )?\$(\([^\)]+\))\/(.*)\/[^\/]+\n}m;
while ($mf =~ m{$replace_re}m)
{
my $match = $1;