[PATCH 4/4] std.pk: Implement pk_vercmp

[Arsen Arsenović]

* doc/poke.texi (Other Functions): New node and section.
Documents miscellaneous functions.
(pk_vercmp): New node.  Documents pk_vercmp and the version string
format.
* libpoke/std.pk (pk_vercmp): New function.  Compares a pair of
GNU poke version strings.
(_pk_ver_strip): New function.  Strips incomparable bits of GNU
poke version strings.
* testsuite/poke.std/std-test.pk: Add pk_vercmp tests.
* autoconf/poke.m4 (PK_PROG_POKE): Update to use pk_vercmp.
---
 ChangeLog                      |  14 +++
 autoconf/poke.m4               |   2 +-
 doc/poke.texi                  |  79 ++++++++++++++++
 libpoke/std.pk                 | 159 +++++++++++++++++++++++++++++++++
 testsuite/poke.std/std-test.pk |  59 ++++++++++++
 5 files changed, 312 insertions(+), 1 deletion(-)

diff --git a/ChangeLog b/ChangeLog
index e0df6736..bc37f7c6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,17 @@
+2023-01-29  Arsen Arsenović  <arsen@aarsen.me>
+
+       std.pk: Implement pk_vercmp
+       * doc/poke.texi (Other Functions): New node and section.
+       Documents miscellaneous functions.
+       (pk_vercmp): New node.  Documents pk_vercmp and the version string
+       format.
+       * libpoke/std.pk (pk_vercmp): New function.  Compares a pair of
+       GNU poke version strings.
+       (_pk_ver_strip): New function.  Strips incomparable bits of GNU
+       poke version strings.
+       * testsuite/poke.std/std-test.pk: Add pk_vercmp tests.
+       * autoconf/poke.m4 (PK_PROG_POKE): Update to use pk_vercmp.
+
 2023-01-29  Arsen Arsenović  <arsen@aarsen.me>
 
        std.pk: Implement strtok
diff --git a/autoconf/poke.m4 b/autoconf/poke.m4
index 459efe78..da0f6a0e 100644
--- a/autoconf/poke.m4
+++ b/autoconf/poke.m4
@@ -34,7 +34,7 @@ _ACEOF
     fi
     if test "x$ac_poke_has_pk_version" = "xyes"; then
       cat >conftest.pk <<_ACEOF
-exit (pk_version >= "$2" ? 0 : 1);
+exit ((pk_vercmp (pk_version, "$2") >= 0) ? 0 : 1);
 _ACEOF
       ac_prog_version=`$$1 --version 2>&1 | sed -n 's/^.*GNU poke.* 
\(.*$\)/\1/p'`
       if $$1 -L conftest.pk 2>&1 >/dev/null; then
diff --git a/doc/poke.texi b/doc/poke.texi
index ff498220..40f55712 100644
--- a/doc/poke.texi
+++ b/doc/poke.texi
@@ -259,6 +259,7 @@ The Standard Library
 * CRC Functions::               Cyclic Redundancy Checksums.
 * Dates and Times::             Processing and displaying dates and times.
 * Offset Functions::            Useful functions that operate on offsets.
+* Other Functions::             Miscellany.
 
 @c Hacking poke
 @c * Writing Commands::                Extending poke with new commands.
@@ -15416,6 +15417,7 @@ facilities provided by the library.
 * CRC Functions::               Cyclic Redundancy Checksums.
 * Dates and Times::             Processing and displaying dates and times.
 * Offset Functions::            Useful functions that operate on offsets.
+* Other Functions::             Miscellany.
 @end menu
 
 @node Standard Integral Types
@@ -16178,6 +16180,83 @@ fun alignto = (uoff64 offset, uoff64 to) uoff64:
 It returns an offset that is the result of aligning the given
 @var{offset} to the given alignment @var{to}.
 
+@node Other Functions
+@section Other Standard Library Functions
+
+The Poke standard library also provides the following functions that
+do not fit into the previous few categories:
+
+@menu
+* pk_vercmp::                   GNU poke version string comparison.
+@end menu
+
+@node pk_vercmp
+@subsection @code{pk_vercmp}
+@cindex version comparison
+Compares a pair of GNU poke strings.  Note that this function is
+@emph{not} generic to any version string, as it assumes and verifies
+the version strings generated by the GNU poke build system.
+
+This function implements partial ordering, as it's not possible to
+distinguish some version numbers as greater or lower than each other,
+as some could be seen as ``lateral'' to eachother.  For instance,
+consider the strings @samp{3.0-a-11-gabcdef} and
+@samp{3.0-b-11-gabcdef}.  They are both 11 commits ahead of the 3.0
+release, but they aren't on the same lineage, and so, they can't be
+considered as greater or lower than eachother.  In cases like these,
+@code{pk_vercmp} will attempt to compare commit numbers as a crude
+measure.
+
+@deftypefun int<32> pk_vercmp (string @var{a}, string @var{b})
+Returns a number greater than, equal to, or lower than zero if @var{a}
+compares greater than, equal to or lower than @var{b}, respectively.
+@end deftypefun
+
+@cindex version format
+The GNU poke version string that this function accepts fit the
+following template:
+@samp{@var{X}.@var{Y}[.@var{Z}][-@var{BRANCH}-@var{NN}][-g@var{XDIGITS}][-dirty]}.
+Individually, these components are:
+
+@table @samp
+@item @var{X}
+The major component of this GNU poke version.  Mandatory.
+@item @var{Y}
+The minor component of this GNU poke version.  Mandatory.
+@item @var{Z}
+The patch component of this GNU poke version.  Optional.
+@item @var{BRANCH}
+A free-form string signifying the current branch a given GNU poke
+build comes from.  Optional.  It has two special values:
+
+@table @samp
+@item maint
+For maintenance branches.
+@item dev
+For the @code{master} development branch.
+@end table
+
+All values other than @samp{dev} are considered equal and lower than
+@samp{dev}.
+
+@item @var{NN}
+The number commits on @samp{@var{BRANCH}} since the
+@samp{@var{X}.@var{Y}[.@var{Z}]} tag.  Present if and only if
+@samp{@var{BRANCH}} is present.
+
+@item @var{XDIGITS}
+The hash this build was generated on.  For the purposes of version
+comparison, it is optional, however, in practice, it can only appear
+when @samp{@var{BRANCH}} is also present.  Due to the @samp{-g}
+prefix, this component also makes a poke version string appropriate
+for Git operations, for example: @code{git show 3.0-dev-22-g2e092}.
+
+@item -dirty
+This suffix is added if the Git tree this GNU poke version was built
+from is dirty.
+@end table
+
+
 @c @node Hacking Poke
 @c @chapter Hacking Poke
 
diff --git a/libpoke/std.pk b/libpoke/std.pk
index 02776052..28d8c05c 100644
--- a/libpoke/std.pk
+++ b/libpoke/std.pk
@@ -650,3 +650,162 @@ fun strtok = (string a) Tokenizer:
 {
   return Tokenizer { str = a, i = 0 };
 }
+
+fun _pk_ver_strip = (string x) string:
+{
+  var dirty = "-dirty";
+  if (x'length >= dirty'length)
+    {
+      /* Strip the -dirty suffix, if any.  */
+      var i = x'length - dirty'length;
+      if (x[i:] == dirty)
+        x = x[:i];
+    }
+
+  /* With -dirty removed, we can be left with -g[[:xdigit:]]*.  This hash is an
+     opaque value, and so, can be ignored.  */
+  var dashi = strrchr (x, '-');
+  if (dashi == -1)
+    return x;
+  if (x[dashi + 1] != 'g')
+    return x;
+
+  for (var i = dashi + 2;
+       i < x'length;
+       i++)
+    {
+      if (!isxdigit (x[i]))
+        return x;
+    }
+
+  /* We're sure at this point that the suffix looks like a commit suffix.  */
+  return x[:dashi];
+}
+
+/* Compare a pair GNU poke version strings.  */
+
+fun pk_vercmp = (string a, string b) int<32>:
+{
+  a = _pk_ver_strip (a);
+  b = _pk_ver_strip (b);
+
+  var i = strtok (a);
+  var j = strtok (b);
+
+  /* Helper that pops an equal character from both tokenizers, and checks that
+     they're the desired character.  */
+  fun popassert = (uint<8> x) void:
+  {
+    try
+      {
+        if (i.peek () != j.peek () || j.peek () != x)
+          raise E_inval;
+        i.i++;
+        j.i++;
+      }
+    catch if E_out_of_bounds
+      {
+        raise E_inval;
+      }
+  };
+
+  /* Integer comparison helper.  */
+  fun cmp = (uint<64> a, uint<64> b) int<32>:
+  {
+    if (a > b)
+      return 1;
+    if (a < b)
+      return -1;
+    return 0;
+  }
+
+  /* Integer comparison helper, except it compounds difference.  This permits
+     us to continue validating the version string.  */
+  var cmpres = 0;
+  fun end = (uint<64> a, uint<64> b) int<32>:
+  {
+    if (cmpres == 0)
+      cmpres = cmp (a, b);
+    return cmpres;
+  }
+
+  try
+    {
+      /* Parsing over x.y[.z][-STR-n].  We expect a number, period, and number,
+         possibly followed by two one more component, a branch identifier and 
the
+         number of commits on said branch.  */
+      var x = i.pop_number ();
+      var y = j.pop_number ();
+
+      end (x, y);
+
+      /* Mandatory period.  */
+      popassert ('.');
+
+      /* Another numeric component.  */
+      x = i.pop_number ();
+      y = j.pop_number ();
+
+      end (x, y);
+    }
+  catch if E_out_of_bounds
+    {
+      /* If any of these two are missing, it's an invalid.  */
+      raise E_inval;
+    }
+  /* Following the two mandatory components, we might run into either a dot or
+     a dash.  Let's try parsing a third component out of both, defaulting to
+     zero.  */
+  var x = 0;
+  var y = 0;
+  if (i.more && i.peek () == '.')
+    {
+      i.pop ();
+      x = i.pop_number ();
+    }
+  if (j.more && j.peek () == '.')
+    {
+      j.pop ();
+      y = j.pop_number ();
+    }
+
+  end (x, y);
+
+  /* Here we break out into two variables, one for isdev and one for commit.
+     The component here is all or nothing - either branch and commit number,
+     or EOF.  */
+  var b1d = 0;
+  var b2d = 0;
+  x = 0;
+  y = 0;
+
+  try
+    {
+      if (i.more && i.pop () == '-')
+        {
+          b1d = i.poprdelim ("-") == "dev";
+          /* ``-'' is popped too, there should be a number.  */
+          x = i.pop_number ();
+        };
+      if (j.more && j.pop () == '-')
+        {
+          b2d = j.poprdelim ("-") == "dev";
+          /* ``-'' is popped too, there should be a number.  */
+          y = j.pop_number ();
+        };
+    }
+  catch if E_out_of_bounds
+    {
+      /* The pop_number operation failed.  */
+      raise E_inval;
+    }
+
+  end (b1d, b2d);
+
+  /* We shouldn't have trailing data at this point, beyond the -gXDIGIT string,
+     or the -dirty string, but both should be stripped already.  */
+  if (i.more || j.more)
+    raise E_inval;
+
+  return end (x, y);
+}
diff --git a/testsuite/poke.std/std-test.pk b/testsuite/poke.std/std-test.pk
index 5b8de358..3985d18f 100644
--- a/testsuite/poke.std/std-test.pk
+++ b/testsuite/poke.std/std-test.pk
@@ -424,6 +424,65 @@ var tests = [
           }
       },
   },
+  PkTest {
+    name = "pk_vercmp",
+    func = lambda (string name) void:
+      {
+        /* Normalizes a number to the [-1,1] integer range.  */
+        fun sign = (int<32> x) int<32>:
+        {
+          if (x == 0)
+            return x;
+
+          var y = x;
+          if (y < 0)
+            y = -y;
+          return x / y;
+        };
+        /* Helper to run a comparison in both directions.  */
+        fun cmptst = (string a, string b, int<32> expected) void:
+        {
+          var forward = sign (pk_vercmp (a, b));
+          var backward = sign (pk_vercmp (b, a));
+          assert (forward == expected, a + " <=> " + b + " was wrong");
+          assert (forward == -backward,
+                  a + " <=> " + b + " isn't antisymmetric");
+        };
+
+        cmptst ("3.0", "3.0", 0);
+        cmptst ("3.21", "3.3", 1);
+        cmptst ("3.21.0", "3.3.0", 1);
+
+        /* Ensure that -dirty / -gXDIGIT make no difference.  */
+        cmptst ("3.0", "3.0-dirty", 0);
+        cmptst ("3.0-g12345", "3.0-dirty", 0);
+        cmptst ("3.0-g12345-dirty", "3.0", 0);
+        cmptst ("3.0", "2.0-dirty", 1);
+        cmptst ("3.0-g12345", "2.0-dirty", 1);
+        cmptst ("3.0-g12345-dirty", "2.0", 1);
+
+        /* Ensure "dev" handling works.  */
+        cmptst ("3.0-dev-12", "3.0-nondev-12", 1);
+        cmptst ("3.0-dev-12", "3.0-dev-13", -1);
+        cmptst ("3.0-dev-12", "3.0-dev-22-g2e092-dirty", -1);
+        cmptst ("3.0-dev-12", "3.0-arsen/do-gettext-stuff-13", 1);
+        cmptst ("3.0-a/-b/c-12", "3.0-a/-b/c-13", -1);
+
+        /* Ensure invalid versions are discarded.  */
+        for (inv in ["", "abc", "2", "2.0.0.0", "3.0-dev", "-dirty", "3.0foo"])
+          {
+            try
+              {
+                pk_vercmp (inv, inv);
+                assert (0, inv + " should not be valid!");
+              }
+            catch if E_inval
+              {
+                assert (1, "expects exception");
+              }
+          }
+      },
+  },
 ];
 
 exit (pktest_run (tests) ? 0 : 1);
-- 
2.39.1