Cleanup some code related to pgbench log checks in TAP tests
authorMichael Paquier
Fri, 25 Jun 2021 11:15:31 +0000 (20:15 +0900)
committerMichael Paquier
Fri, 25 Jun 2021 11:15:31 +0000 (20:15 +0900)
This fixes a couple of problems within the so-said code of this commit
subject:
- Replace the use of open() with slurp_file(), fixing an issue reported
by buildfarm member fairywren whose perl installation keep around CRLF
characters, causing the matching patterns for the logs to fail.
- Remove the eval block, which is not really necessary.

This set of issues has come into light after fixing a different issue
with c13585fe, and this is wrong since this code has been introduced.

Reported-by: Andrew Dunstan, and buildfarm member fairywren
Author: Michael Paquier
Reviewed-by: Andrew Dunstan
Discussion: https://postgr.es/m/0f49303e-7784-b3ee-200b-cbf67be2eb9e@dunslane.net
Backpatch-through: 11

src/bin/pgbench/t/001_pgbench_with_server.pl

index 6e0d6b87cda939a3b469e516850f3774744c1e6a..248da5b1e7a2462df54b3780b5383c94f93eba7d 100644 (file)
@@ -1063,18 +1063,27 @@ sub check_pgbench_logs
    my $log_number = 0;
    for my $log (sort @logs)
    {
-       eval {
-           open my $fh, '<', $log or die "$@";
-           my @contents = <$fh>;
-           my $clen     = @contents;
-           ok( $min <= $clen && $clen <= $max,
-               "transaction count for $log ($clen)");
-           ok( grep(/$re/, @contents) == $clen,
-               "transaction format for $prefix");
-           close $fh or die "$@";
-       };
+       # Check the contents of each log file.
+       my $contents_raw = slurp_file($log);
+
+       my @contents = split(/\n/, $contents_raw);
+       my $clen     = @contents;
+       ok( $min <= $clen && $clen <= $max,
+           "transaction count for $log ($clen)");
+       my $clen_match = grep(/$re/, @contents);
+       ok($clen_match == $clen, "transaction format for $prefix");
+
+       # Show more information if some logs don't match
+       # to help with debugging.
+       if ($clen_match != $clen)
+       {
+           foreach my $log (@contents)
+           {
+               print "# Log entry not matching: $log\n"
+                 unless $log =~ /$re/;
+           }
+       }
    }
-   ok(unlink(@logs), "remove log files");
    return;
 }