Adding upstream version 15.4.upstream/15.4upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 63 insertions, 0 deletions

diff --git a/src/test/perl/PostgreSQL/Test/SimpleTee.pm b/src/test/perl/PostgreSQL/Test/SimpleTee.pm
new file mode 100644
index 0000000..ec13714
--- /dev/null
+++ b/src/test/perl/PostgreSQL/Test/SimpleTee.pm
@@ -0,0 +1,63 @@
+
+# Copyright (c) 2021-2022, PostgreSQL Global Development Group
+
+# A simple 'tee' implementation, using perl tie.
+#
+# Whenever you print to the handle, it gets forwarded to a list of
+# handles. The list of output filehandles is passed to the constructor.
+#
+# This is similar to IO::Tee, but only used for output. Only the PRINT
+# method is currently implemented; that's all we need. We don't want to
+# depend on IO::Tee just for this.
+
+# The package is enhanced to add timestamp and elapsed time decorations to
+# the log file traces sent through this interface from Test::More functions
+# (ok, is, note, diag etc.). Elapsed time is shown as the time since the last
+# log trace.
+
+package PostgreSQL::Test::SimpleTee;
+use strict;
+use warnings;
+
+use Time::HiRes qw(time);
+
+my $last_time;
+
+BEGIN { $last_time = time; }
+
+sub _time_str
+{
+	my $tm   = time;
+	my $diff = $tm - $last_time;
+	$last_time = $tm;
+	my ($sec, $min, $hour) = localtime($tm);
+	my $msec = int(1000 * ($tm - int($tm)));
+	return sprintf("[%.2d:%.2d:%.2d.%.3d](%.3fs) ",
+		$hour, $min, $sec, $msec, $diff);
+}
+
+sub TIEHANDLE
+{
+	my $self = shift;
+	return bless \@_, $self;
+}
+
+sub PRINT
+{
+	my $self = shift;
+	my $ok   = 1;
+	# The first file argument passed to tiehandle in PostgreSQL::Test::Utils is
+	# the original stdout, which is what PROVE sees. Additional decorations
+	# confuse it, so only put out the time string on files after the first.
+	my $skip = 1;
+	my $ts   = _time_str;
+	for my $fh (@$self)
+	{
+		print $fh ($skip ? "" : $ts), @_ or $ok = 0;
+		$fh->flush or $ok = 0;
+		$skip = 0;
+	}
+	return $ok;
+}
+
+1;