Hi,
I found a comparaison bug when using the PostgreSQL::Version module. See:
$ perl -I. -MPostgreSQL::Version -le '
my $v = PostgreSQL::Version->new("9.6");
print "not 9.6 > 9.0" unless $v > 9.0;
print "not 9.6 < 9.0" unless $v < 9.0;
print "9.6 <= 9.0" if $v <= 9.0;
print "9.6 >= 9.0" if $v >= 9.0;'
not 9.6 > 9.0
not 9.6 < 9.0
9.6 <= 9.0
9.6 >= 9.0
When using < or >, 9.6 is neither greater or lesser than 9.0.
When using <= or >=, 9.6 is equally greater and lesser than 9.0.
The bug does not show up if you compare with "9.0" instead of 9.0.
This bug is triggered with devel versions, eg. 14beta1 <=> 14.
The bug appears when both objects have a different number of digit in the
internal array representation:
$ perl -I. -MPostgreSQL::Version -MData::Dumper -le '
print Dumper(PostgreSQL::Version->new("9.0")->{num});
print Dumper(PostgreSQL::Version->new(9.0)->{num});
print Dumper(PostgreSQL::Version->new(14)->{num});
print Dumper(PostgreSQL::Version->new("14beta1")->{num});'
$VAR1 = [ '9', '0' ];
$VAR1 = [ '9' ];
$VAR1 = [ '14' ];
$VAR1 = [ '14', -1 ];
Because of this, The following loop in "_version_cmp" is wrong because we are
comparing two versions with different size of 'num' array:
for (my $idx = 0;; $idx++)
{
return 0 unless (defined $an->[$idx] && defined $bn->[$idx]);
return $an->[$idx] <=> $bn->[$idx]
if ($an->[$idx] <=> $bn->[$idx]);
}
If we want to keep this internal array representation, the only fix I can think
of would be to always use a 4 element array defaulted to 0. Previous examples
would be:
$VAR1 = [ 9, 0, 0, 0 ];
$VAR1 = [ 9, 0, 0, 0 ];
$VAR1 = [ 14, 0, 0, 0 ];
$VAR1 = [ 14, 0, 0, -1 ];
A better fix would be to store the version internally as version_num that are
trivial to compute and compare. Please, find in attachment an implementation of
this.
The patch is a bit bigger because it improved the devel version to support
rc/beta/alpha comparison like 14rc2 > 14rc1.
Moreover, it adds a bunch of TAP tests to check various use cases.
Regards,
>From d6b28440ad8eb61fd83be6a0df8f40108296bc4e Mon Sep 17 00:00:00 2001
From: Jehan-Guillaume de Rorthais <j...@dalibo.com>
Date: Tue, 28 Jun 2022 22:17:48 +0200
Subject: [PATCH] Fix and improve PostgreSQL::Version
The internal array representation of a version was failing some
comparaisons because the loop comparing each digit expected both array
to have the same number of digit.
Comparaison like 9.6 <=> 9.0 or 14beta1 <=> 14 were failing.
This patch compute and use the numeric version internaly to compare
objects.
Moreover, it improve the comparaison on development versions paying
attention to the iteration number for rc, beta and alpha.
---
src/test/perl/PostgreSQL/Version.pm | 112 ++++++++++++------
src/test/perl/t/01-PostgreSQL::Version.t | 141 +++++++++++++++++++++++
2 files changed, 216 insertions(+), 37 deletions(-)
create mode 100644 src/test/perl/t/01-PostgreSQL::Version.t
diff --git a/src/test/perl/PostgreSQL/Version.pm b/src/test/perl/PostgreSQL/Version.pm
index 8f70491189..e42003d0d1 100644
--- a/src/test/perl/PostgreSQL/Version.pm
+++ b/src/test/perl/PostgreSQL/Version.pm
@@ -46,6 +46,7 @@ package PostgreSQL::Version;
use strict;
use warnings;
+use Carp;
use Scalar::Util qw(blessed);
@@ -73,35 +74,73 @@ of a Postgres command like `psql --version` or `pg_config --version`;
sub new
{
- my $class = shift;
- my $arg = shift;
-
- chomp $arg;
-
- # Accept standard formats, in case caller has handed us the output of a
- # postgres command line tool
- my $devel;
- ($arg, $devel) = ($1, $2)
- if (
- $arg =~ m!^ # beginning of line
- (?:\(?PostgreSQL\)?\s)? # ignore PostgreSQL marker
- (\d+(?:\.\d+)*) # version number, dotted notation
- (devel|(?:alpha|beta|rc)\d+)? # dev marker - see version_stamp.pl
- !x);
-
- # Split into an array
- my @numbers = split(/\./, $arg);
-
- # Treat development versions as having a minor/micro version one less than
- # the first released version of that branch.
- push @numbers, -1 if ($devel);
+ my $class = shift;
+ my $arg = shift;
+ my $ver = '';
+ my $devel = '';
+ my $vernum = 0;
+ my $devnum = 0;
+
+ $arg =~ m!^(?:[^\s]+\s)? # beginning of line + optionnal command
+ (?:\(?PostgreSQL\)?\s)? # ignore PostgreSQL marker
+ (\d+)(?:\.(\d+))?(?:\.(\d+))? # version number, dotted notation
+ ([^\s]+)? # dev marker - see version_stamp.pl
+ !x;
+
+ croak "could not parse version: $arg" unless defined $1;
+
+ $ver = "$1";
+ $vernum += 10000 * $1;
+ $ver .= ".$2" if defined $2;
+
+ if ($vernum >= 100000)
+ {
+ croak "versions 10 and after can not have a third digit"
+ if defined $3;
+ $vernum += $2 if defined $2;
+ }
+ else
+ {
+ my $minor;
+
+ if ( defined $2 )
+ {
+ $vernum += 100 * $2;
+ }
+ else
+ {
+ # version build from numbers might not have a real part. Eg. 9.0
+ # becomes 9. In this case $2 is then undefined and we must
+ # explicitly add the .0 part to the string version
+ $ver .= ".0"
+ }
+
+ $minor = defined $3 ? $3 : 0;
+ $vernum += $minor;
+ $ver .= ".$minor" if $minor;
+ }
- $devel ||= "";
+ # negative weights for devel versions
+ if ( defined $4 )
+ {
+ $devel = $4;
+ # parse dev marker: see version_stamp.pl
+ if ($devel =~ /^rc(\d+)$/) { $devnum = -100+$1 }
+ elsif ($devel =~ /^beta(\d+)$/) { $devnum = -1000+$1 }
+ elsif ($devel =~ /^alpha(\d+)$/) { $devnum = -10000+$1 }
+ elsif ($devel =~ /^devel$/) { $devnum = -10001 }
+ else { croak "could not parse version: $arg" }
+ }
- return bless { str => "$arg$devel", num => \@numbers }, $class;
+ return bless
+ {
+ str => "$ver$devel",
+ num => $vernum,
+ dev => $devnum
+ }, $class;
}
-# Routine which compares the _pg_version_array obtained for the two
+# Routine which compares the versions obtained from the two
# arguments and returns -1, 0, or 1, allowing comparison between two
# PostgreSQL::Version objects or a PostgreSQL::Version and a version string or number.
#
@@ -114,19 +153,18 @@ sub new
sub _version_cmp
{
my ($a, $b, $swapped) = @_;
+ my $res;
- $b = __PACKAGE__->new($b) unless blessed($b);
+ $b = __PACKAGE__->new($b) unless ref($b) eq 'PostgreSQL::Version';
- ($a, $b) = ($b, $a) if $swapped;
+ $res = $a->{'num'} <=> $b->{'num'};
- my ($an, $bn) = ($a->{num}, $b->{num});
+ # compare devel versions if versions are equal
+ $res = ( $a->{'dev'} <=> $b->{'dev'} ) unless $res;
- for (my $idx = 0;; $idx++)
- {
- return 0 unless (defined $an->[$idx] && defined $bn->[$idx]);
- return $an->[$idx] <=> $bn->[$idx]
- if ($an->[$idx] <=> $bn->[$idx]);
- }
+ $res *= -1 if $swapped;
+
+ return $res;
}
# Render the version number using the saved string.
@@ -152,11 +190,11 @@ a dot unless the separator argument is given.
sub major
{
my ($self, %params) = @_;
- my $result = $self->{num}->[0];
- if ($result + 0 < 10)
+ my $result = int($self->{num} / 10000);
+ if ($result < 10)
{
my $sep = $params{separator} || '.';
- $result .= "$sep$self->{num}->[1]";
+ $result .= $sep . int($self->{num}/100)%100;
}
return $result;
}
diff --git a/src/test/perl/t/01-PostgreSQL::Version.t b/src/test/perl/t/01-PostgreSQL::Version.t
new file mode 100644
index 0000000000..9468865ddc
--- /dev/null
+++ b/src/test/perl/t/01-PostgreSQL::Version.t
@@ -0,0 +1,141 @@
+use strict;
+use warnings;
+use Carp;
+use lib '.';
+
+use PostgreSQL::Version;
+use Test::More;
+
+# testing version num computation from 9.0 string
+is(
+ PostgreSQL::Version->new("9.0")->{num},
+ 90000,
+ "string 9.0 vernum = 90000"
+);
+
+# testing version num computation from numeric 9.0
+is(
+ PostgreSQL::Version->new(9)->{num},
+ 90000,
+ "numeric 9.0 vernum = 90000"
+);
+
+# testing version num from a pre-10 3-digit version
+is(
+ PostgreSQL::Version->new("9.1.26")->{num},
+ 90126,
+ "vernum 9.0 -> 90126"
+);
+
+# testing version num from a post-10 2-digit version
+is(
+ PostgreSQL::Version->new("11.4")->{num},
+ 110004,
+ "vernum 11.4 -> 110004"
+);
+
+# testing version num computation from numeric with real part
+is(
+ PostgreSQL::Version->new(11.1)->{num},
+ 110001,
+ "numeric 11.1 vernum = 110001"
+);
+
+# version from pg_config --version
+is(
+ PostgreSQL::Version->new("PostgreSQL 14.4"),
+ "14.4",
+ 'Parsing "PostgreSQL 14.4"'
+);
+
+# version from psql --version
+is(
+ PostgreSQL::Version->new("psql (PostgreSQL) 9.6.24"),
+ "9.6.24",
+ 'Parsing "psql (PostgreSQL) 9.6.24"'
+);
+
+# version from initdb --version
+is(
+ PostgreSQL::Version->new("initdb (PostgreSQL) 7.4.30"),
+ "7.4.30",
+ 'Parsing "initdb (PostgreSQL) 7.4.30"'
+);
+
+# Comparing various versions.
+# First element of each array must be greater than the second.
+# Third element is the major version of the first element.
+for my $t (
+ # all args are strings
+ [ "9.6", "9.0", "9.6" ],
+ [ "9.1", "9.1devel", "9.1" ],
+ [ "9.1", "9.1rc1", "9.1" ],
+ [ "9.1rc2", "9.1rc1", "9.1" ],
+ [ "9.1rc1", "9.1beta2", "9.1" ],
+ [ "9.1beta2", "9.1beta1", "9.1" ],
+ [ "9.1beta1", "9.1alpha2", "9.1" ],
+ [ "9.1alpha2", "9.1alpha1", "9.1" ],
+ [ "9.1alpha1", "9.1devel", "9.1" ],
+ [ "9.1.26", "9.1", "9.1" ],
+ [ "9.1.26", "9.1.3", "9.1" ],
+ [ "9.2devel", "9.1.3", "9.2" ],
+ [ "9.2", "9.1.3", "9.2" ],
+ [ "9.3.1", "9.1.3", "9.3" ],
+ [ "9.4.1", "9.1", "9.4" ],
+ [ "11alpha1", "9.6", "11" ],
+ [ "11devel", "10", "11" ],
+ [ "10", "9.6", "10" ],
+ [ "11.1", "9.6", "11" ],
+ [ "12", "9.6.26", "12" ],
+ [ "10.1", "9.6.26", "10" ],
+ [ "13", "10", "13" ],
+ [ "14", "14rc1", "14" ],
+ [ "14.1", "14", "14" ],
+
+ # with at least one numerical arg
+ [ 9.6, 9.0, 9.6 ],
+ [ 9.1, "9.1devel", 9.1 ],
+ [ 9.1, "9.1rc1", 9.1 ],
+ [ "9.1.26", 9.1, 9.1 ],
+ [ 9.2, "9.1.3", 9.2 ],
+ [ "9.4.1", 9.1, 9.4 ],
+ [ "11alpha1", 9.6, 11 ],
+ [ "11devel", 10, 11 ],
+ [ 10, 9.6, 10 ],
+ [ 11.1, 9.6, 11 ],
+ [ 12, "9.6.26", 12 ],
+ [ 10.1, "9.6.26", 10 ],
+ [ 13, 10, 13 ],
+ [ 14, "14rc1", 14 ],
+ [ 14.1, 14, 14 ],
+) {
+ my ($a, $b, $m) = @$t;
+ my $va = PostgreSQL::Version->new($a);
+ my $vb = PostgreSQL::Version->new($b);
+
+ # va <=> vb
+ ok( $va > $vb, "$a > $b" );
+ ok( $va >= $vb, "$a >= $b" );
+ ok( not ($va == $vb), "not $a == $b" );
+ ok( not ($va <= $vb), "not $a <= $b" );
+ ok( not ($va < $vb), "not $a < $b" );
+
+ # vb <=> va
+ ok( $vb < $va, "$b < $a" );
+ ok( $vb <= $va, "$b <= $a" );
+ ok( not ($vb == $va), "not $b == $a" );
+ ok( not ($vb >= $va), "not $b >= $a" );
+ ok( not ($vb > $va), "not $b > $a" );
+
+ # va == va
+ ok( $va == $va, "$a == $a" );
+
+ # string va == a
+ ok( "$va" eq $a, "$va eq $a" );
+
+ # check major version of va
+ is( $va->major, $m, "major version ok" );
+}
+
+done_testing();
+
--
2.35.3
