From 610c323eac56e86767f1e5e16f5b96a449393d38 Mon Sep 17 00:00:00 2001
From: Craig Ringer <craig@2ndquadrant.com>
Date: Mon, 14 Nov 2016 12:19:35 +0800
Subject: [PATCH 05/21] Create new pg_lsn class to deal with awkward LSNs in
 tests

---
 src/test/perl/Makefile        |   3 +
 src/test/perl/pg_lsn.pm       | 144 ++++++++++++++++++++++++++++++++++++++++++
 src/test/perl/t/001_load.pl   |   9 +++
 src/test/perl/t/002_pg_lsn.pl |  68 ++++++++++++++++++++
 4 files changed, 224 insertions(+)
 create mode 100644 src/test/perl/pg_lsn.pm
 create mode 100644 src/test/perl/t/001_load.pl
 create mode 100644 src/test/perl/t/002_pg_lsn.pl

diff --git a/src/test/perl/Makefile b/src/test/perl/Makefile
index 8ab60fc..cdc38f4 100644
--- a/src/test/perl/Makefile
+++ b/src/test/perl/Makefile
@@ -15,6 +15,9 @@ include $(top_builddir)/src/Makefile.global
 
 ifeq ($(enable_tap_tests),yes)
 
+check:
+	$(prove_check)
+
 installdirs:
 	$(MKDIR_P) '$(DESTDIR)$(pgxsdir)/$(subdir)'
 
diff --git a/src/test/perl/pg_lsn.pm b/src/test/perl/pg_lsn.pm
new file mode 100644
index 0000000..777b3df
--- /dev/null
+++ b/src/test/perl/pg_lsn.pm
@@ -0,0 +1,144 @@
+package pg_lsn;
+
+use strict;
+use warnings;
+
+our (@ISA, @EXPORT_OK);
+BEGIN {
+	require Exporter;
+	@ISA = qw(Exporter);
+	@EXPORT_OK = qw(parse_lsn);
+}
+
+use Scalar::Util qw(blessed looks_like_number);
+use Carp;
+
+use overload
+	'""' => \&Str,
+	'<=>' => \&NumCmp,
+	'bool' => \&Bool,
+	'-' => \&Negate,
+	fallback => 1;
+
+=pod package pg_lsn
+
+A class to encapsulate a PostgreSQL log-sequence number (LSN) and handle conversion
+of its hex representation.
+
+Provides equality and inequality operators.
+
+Calling 'new' on undef or empty string argument returns undef, not an instance.
+
+=cut
+
+sub new_num
+{
+	my ($class, $high, $low) = @_;
+	my $self = bless { '_low' => $low, '_high' => $high } => $class;
+	$self->_constraint;
+	return $self;
+}
+
+sub new
+{
+	my ($class, $lsn_str) = @_;
+	return undef if !defined($lsn_str) || $lsn_str eq '';
+	my ($high, $low) = split('/', $lsn_str, 2);
+	die "malformed LSN" if ($high eq '' || $low eq '');
+	return $class->new_num(hex($high), hex($low));
+}
+
+sub NumCmp
+{
+	my ($self, $other, $swap) = @_;
+	$self->_constraint;
+	die "comparison with undef" unless defined($other);
+	if (!blessed($other))
+	{
+		# coerce from string if needed. Try to coerce any non-object.
+		$other = pg_lsn->new($other) if !blessed($other);
+	}
+	$other->_constraint;
+	# and compare
+	my $ret;
+	if ($self->{'_high'} < $other->{'_high'})
+	{
+		$ret = -1;
+	}
+	elsif ($self->{'_high'} == $other->{'_high'})
+	{
+		if ($self->{'_low'} < $other->{'_low'})
+		{
+			$ret = -1;
+		}
+		elsif ($self->{'_low'} == $other->{'_low'})
+		{
+			$ret = 0;
+		}
+		else
+		{
+			$ret = 1;
+		}
+	}
+	else
+	{
+		$ret = 1;
+	}
+	$ret = -$ret if $swap;
+	return $ret;
+}
+
+sub _constraint
+{
+	my $self = shift;
+	die "high word must be defined" unless (defined($self->{'_high'}));
+	die "high word must be numeric" unless (looks_like_number($self->{'_high'}));
+	die "high word must be in uint32 range" unless ($self->{'_high'} >= 0 && $self->{'_high'} <= 0xFFFFFFFF);
+	die "low word must be defined" unless (defined($self->{'_low'}));
+	die "low word must be numeric" unless (looks_like_number($self->{'_low'}));
+	die "low word must be in uint32 range" unless ($self->{'_low'} >= 0 && $self->{'_low'} <= 0xFFFFFFFF);
+}
+
+sub Bool
+{
+	my $self = shift;
+	$self->_constraint;
+	return $self->{'_high'} || $self->{'_low'};
+}
+
+sub Negate
+{
+	die "cannot negate pg_lsn";
+}
+
+sub Str
+{
+	my $self = shift;
+	return sprintf("%X/%X", $self->high, $self->low);
+}
+
+sub high
+{
+	my $self = shift;
+	return $self->{'_high'};
+}
+
+sub low
+{
+	my $self = shift;
+	return $self->{'_low'};
+}
+
+# Todo: addition/subtraction. Needs to handle wraparound and carrying.
+
+=pod parse_lsn(lsn)
+
+Returns a 2-array of the high and low words of the passed LSN as numbers,
+or undef if argument is the empty string or undef.
+
+=cut 
+
+sub parse_lsn
+{
+	return pg_lsn->new($_[0]);
+}
diff --git a/src/test/perl/t/001_load.pl b/src/test/perl/t/001_load.pl
new file mode 100644
index 0000000..53a39af
--- /dev/null
+++ b/src/test/perl/t/001_load.pl
@@ -0,0 +1,9 @@
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+require_ok 'RecursiveCopy';
+require_ok 'SimpleTee';
+require_ok 'TestLib';
+require_ok 'PostgresNode';
+require_ok 'pg_lsn';
diff --git a/src/test/perl/t/002_pg_lsn.pl b/src/test/perl/t/002_pg_lsn.pl
new file mode 100644
index 0000000..73e3d65
--- /dev/null
+++ b/src/test/perl/t/002_pg_lsn.pl
@@ -0,0 +1,68 @@
+use strict;
+use warnings;
+use Test::More tests => 42;
+use Scalar::Util qw(blessed);
+
+use pg_lsn qw(parse_lsn);
+
+ok(!defined(parse_lsn('')), 'parse_lsn of empty string is undef');
+ok(!defined(parse_lsn(undef)), 'parse_lsn of undef is undef');
+
+my $zero_lsn = parse_lsn('0/0');
+ok(blessed($zero_lsn), 'zero lsn blessed');
+ok($zero_lsn->isa("pg_lsn"), 'zero lsn isa pg_lsn');
+is($zero_lsn->{'_high'}, 0, 'zero lsn high word zero');
+is($zero_lsn->{'_low'}, 0, 'zero lsn low word zero');
+cmp_ok($zero_lsn, "==", pg_lsn->new_num(0, 0), 'parse_lsn of 0/0');
+
+cmp_ok(parse_lsn('0/FFFFFFFF'), "==", pg_lsn->new_num(0, 0xFFFFFFFF), 'parse_lsn of 0/FFFFFFFF');
+cmp_ok(parse_lsn('FFFFFFFF/0'), "==", pg_lsn->new_num(0xFFFFFFFF, 0), 'parse_lsn of FFFFFFFF/0');
+cmp_ok(parse_lsn('FFFFFFFF/FFFFFFFF'), "==", pg_lsn->new_num(0xFFFFFFFF, 0xFFFFFFFF), 'parse_lsn of 0xFFFFFFFF/0xFFFFFFFF');
+
+is(parse_lsn('2/2') <=> parse_lsn('2/3'), -1);
+is(parse_lsn('2/2') <=> parse_lsn('2/2'), 0);
+is(parse_lsn('2/2') <=> parse_lsn('2/1'), 1);
+is(parse_lsn('2/2') <=> parse_lsn('3/2'), -1);
+is(parse_lsn('2/2') <=> parse_lsn('1/2'), 1);
+
+cmp_ok(parse_lsn('0/1'), "==", parse_lsn('0/1'));
+ok(!(parse_lsn('0/1') == parse_lsn('0/2')), "! 0/1 == 0/2");
+ok(!(parse_lsn('0/1') == parse_lsn('0/0')), "! 0/1 == 0/0");
+cmp_ok(parse_lsn('1/0'), "==", parse_lsn('1/0'));
+cmp_ok(parse_lsn('1/0'), "!=", parse_lsn('1/1'));
+cmp_ok(parse_lsn('1/0'), "!=", parse_lsn('2/0'));
+cmp_ok(parse_lsn('1/0'), "!=", parse_lsn('0/0'));
+cmp_ok(parse_lsn('1/0'), "!=", parse_lsn('0/1'));
+
+cmp_ok(parse_lsn('0/1'), ">=", parse_lsn('0/1'));
+cmp_ok(parse_lsn('0/1'), "<=", parse_lsn('0/1'));
+cmp_ok(parse_lsn('0/1'), "<=", parse_lsn('0/2'));
+cmp_ok(parse_lsn('0/1'), ">=", parse_lsn('0/0'));
+cmp_ok(parse_lsn('1/0'), ">=", parse_lsn('1/0'));
+cmp_ok(parse_lsn('1/0'), "<=", parse_lsn('1/0'));
+cmp_ok(parse_lsn('1/0'), "<=", parse_lsn('2/0'));
+cmp_ok(parse_lsn('1/0'), ">=", parse_lsn('0/0'));
+cmp_ok(parse_lsn('1/1'), ">=", parse_lsn('1/1'));
+cmp_ok(parse_lsn('1/1'), "<=", parse_lsn('1/1'));
+cmp_ok(parse_lsn('1/1'), "<=", parse_lsn('1/2'));
+cmp_ok(parse_lsn('1/2'), ">=", parse_lsn('1/1'));
+
+ok(parse_lsn('1/1'), 'bool conversion');
+ok(! $zero_lsn, 'bool negation');
+
+# implicit string conversions
+cmp_ok(parse_lsn('0/0'), "==", "0/0");
+cmp_ok(parse_lsn('FFFFFFFF/FFFFFFFF'), "==", "FFFFFFFF/FFFFFFFF");
+# swapped string conversions
+cmp_ok("0/0", "==", parse_lsn('0/0'));
+cmp_ok("FFFFFFFF/FFFFFFFF", "==", parse_lsn('FFFFFFFF/FFFFFFFF'));
+
+# negation makes no sense for a uint64
+eval {
+	- parse_lsn('0/1');
+};
+if ($@) {
+	ok('negation raises error');
+} else {
+	fail('negation did not raise error');
+}
-- 
2.5.5