Fix pgbench TAP test failure with funky file names (redux)

This test fails if the containing directory contains a funny character
such as a space or some perl metacharacter. To avoid that, we check for
files names using readdir and a regex, rather than using a glob pattern.

Discussion: https://postgr.es/m/CAM6_UM6dGdU39PKAC24T+HD9ouy0jLN9vH6163K8QEEzr__iZw@mail.gmail.com

Author: Fabien COELHO
Reviewed-by: Raúl Marín Rodríguez

diff --git a/src/bin/pgbench/t/001_pgbench_with_server.pl b/src/bin/pgbench/t/001_pgbench_with_server.pl
index ad15ba66eaf8e89e121558d930619a7f4beabf30..930ff4ebb9204edb7c66e93162cef7e097b4e7c4 100644 (file)
--- a/src/bin/pgbench/t/001_pgbench_with_server.pl
+++ b/src/bin/pgbench/t/001_pgbench_with_server.pl
@@ -10,12 +10,19 @@ my $node = get_new_node('main');
 $node->init;
 $node->start;
 
-# invoke pgbench
+# invoke pgbench, with parameters:
+#   $opts: options as a string to be split on spaces
+#   $stat: expected exit status
+#   $out: reference to a regexp list that must match stdout
+#   $err: reference to a regexp list that must match stderr
+#   $name: name of test for error messages
+#   $files: reference to filename/contents dictionnary
+#   @args: further raw options or arguments
 sub pgbench
 {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-   my ($opts, $stat, $out, $err, $name, $files) = @_;
+   my ($opts, $stat, $out, $err, $name, $files, @args) = @_;
    my @cmd = ('pgbench', split /\s+/, $opts);
    my @filenames = ();
    if (defined $files)
@@ -40,6 +47,9 @@ sub pgbench
            append_to_file($filename, $$files{$fn});
        }
    }
+
+   push @cmd, @args;
+
    $node->command_checks_all(\@cmd, $stat, $out, $err, $name);
 
    # cleanup?
@@ -868,20 +878,32 @@ pgbench(
        qr{type: .*/001_pgbench_sleep},
        qr{above the 1.0 ms latency limit: [01]/}
    ],
-   [qr{^$}i],
+   [qr{^$}],
    'pgbench late throttling',
    { '001_pgbench_sleep' => q{\sleep 2ms} });
 
+# return a list of files from directory $dir matching regexpr $re
+# this works around glob portability and escaping issues
+sub list_files
+{
+   my ($dir, $re) = @_;
+   opendir my $dh, $dir or die "cannot opendir $dir: $!";
+   my @files = grep /$re/, readdir $dh;
+   closedir $dh or die "cannot closedir $dir: $!";
+   return map { $dir . '/' . $_ } @files;
+}
+
 # check log contents and cleanup
 sub check_pgbench_logs
 {
    local $Test::Builder::Level = $Test::Builder::Level + 1;
 
-   my ($prefix, $nb, $min, $max, $re) = @_;
+   my ($dir, $prefix, $nb, $min, $max, $re) = @_;
 
-   my @logs = glob "$prefix.*";
+   # $prefix is simple enough, thus does not need escaping
+   my @logs = list_files($dir, qr{^$prefix\..*$});
    ok(@logs == $nb, "number of log files");
-   ok(grep(/^$prefix\.\d+(\.\d+)?$/, @logs) == $nb, "file name format");
+   ok(grep(/\/$prefix\.\d+(\.\d+)?$/, @logs) == $nb, "file name format");
 
    my $log_number = 0;
    for my $log (sort @logs)
@@ -905,22 +927,25 @@ my $bdir = $node->basedir;
 
 # with sampling rate
 pgbench(
-   "-n -S -t 50 -c 2 --log --log-prefix=$bdir/001_pgbench_log_2 --sampling-rate=0.5",
+   "-n -S -t 50 -c 2 --log --sampling-rate=0.5",
    0,
    [ qr{select only}, qr{processed: 100/100} ],
-   [qr{^$}],
-   'pgbench logs');
+   [ qr{^$} ],
+   'pgbench logs',
+   undef,
+   "--log-prefix=$bdir/001_pgbench_log_2");
 
-check_pgbench_logs("$bdir/001_pgbench_log_2", 1, 8, 92,
+check_pgbench_logs($bdir, '001_pgbench_log_2', 1, 8, 92,
    qr{^0 \d{1,2} \d+ \d \d+ \d+$});
 
 # check log file in some detail
 pgbench(
-   "-n -b se -t 10 -l --log-prefix=$bdir/001_pgbench_log_3",
-   0, [ qr{select only}, qr{processed: 10/10} ],
-   [qr{^$}], 'pgbench logs contents');
+   "-n -b se -t 10 -l",
+   0, [ qr{select only}, qr{processed: 10/10} ], [ qr{^$} ],
+   'pgbench logs contents', undef,
+   "--log-prefix=$bdir/001_pgbench_log_3");
 
-check_pgbench_logs("$bdir/001_pgbench_log_3", 1, 10, 10,
+check_pgbench_logs($bdir, '001_pgbench_log_3', 1, 10, 10,
    qr{^\d \d{1,2} \d+ \d \d+ \d+$});
 
 # done