[COMMITTED] pkl-rt: fix any comparator for struct types

[Jose E. Marchesi]

2023-02-03  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-rt.pk (_pkl_eq_any): Fix comparation for structs.
        * testsuite/poke.pkl/eq-any-union-1.pk: New test.
        * testsuite/poke.pkl/neq-any-union-1.pk: Likewise.
        * testsuite/poke.pkl/eq-any-struct-5.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
 ChangeLog                             |  8 +++++
 libpoke/pkl-rt.pk                     | 45 ++++++++++++++++++++++++---
 testsuite/Makefile.am                 |  3 ++
 testsuite/poke.pkl/eq-any-struct-5.pk | 16 ++++++++++
 testsuite/poke.pkl/eq-any-union-1.pk  | 19 +++++++++++
 testsuite/poke.pkl/neq-any-union-1.pk | 19 +++++++++++
 6 files changed, 106 insertions(+), 4 deletions(-)
 create mode 100644 testsuite/poke.pkl/eq-any-struct-5.pk
 create mode 100644 testsuite/poke.pkl/eq-any-union-1.pk
 create mode 100644 testsuite/poke.pkl/neq-any-union-1.pk

diff --git a/ChangeLog b/ChangeLog
index 0e63c46c..a6cccf3a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2023-02-03  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-rt.pk (_pkl_eq_any): Fix comparation for structs.
+       * testsuite/poke.pkl/eq-any-union-1.pk: New test.
+       * testsuite/poke.pkl/neq-any-union-1.pk: Likewise.
+       * testsuite/poke.pkl/eq-any-struct-5.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
 2023-02-03  Jose E. Marchesi  <jemarch@gnu.org>
 
        * libpoke/pkl-rt.pk (_pkl_eq_any): Fix typo in assembly template.
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index b9caa39c..9e0b72df 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -1188,12 +1188,12 @@ immutable fun _pkl_eq_string = (any v1, any v2) int<32>:
 
 immutable fun _pkl_eq_any = (any v1, any v2) int<32>:
 {
-  fun handle_composite = int<32>:
+  fun handle_array = int<32>:
   {
-    /* First check the lenght.  */
     var v1_len = asm uint<64>: ("sel; nip" : v1);
     var v2_len = asm uint<64>: ("sel; nip" : v2);
 
+    /* First check the lenght.  */
     if (v1_len != v2_len)
       return 0;
 
@@ -1205,6 +1205,43 @@ immutable fun _pkl_eq_any = (any v1, any v2) int<32>:
     return 1;
   }
 
+  fun handle_struct = int<32>:
+  {
+    fun struct_type_name = (any val) string:
+    {
+      return asm string: ("typof
+                      tysctgetn
+                      nip2
+                      bn .namenull
+                      nip
+                      ba .done
+                    .namenull:
+                      drop
+                    .done:" : "", val);
+    }
+
+    var v1_len = asm uint<64>: ("sel; nip" : v1);
+    var v2_len = asm uint<64>: ("sel; nip" : v2);
+
+    /* First make sure both struct types have the
+       same name.  */
+    if (struct_type_name (v1) != struct_type_name (v2))
+      return 0;
+
+    /* Now check the lenght.  This accommodates optional
+       fields and the like.  */
+    if (v1_len != v2_len)
+      return 0;
+
+    /* Check the elements.  */
+    for (var i = 0UL; i < v1_len; ++i)
+      if (v1'ename (i) != v2'ename (i)
+          || !_pkl_eq_any (v1'elem (i), v2'elem (i)))
+        return 0;
+
+    return 1;
+  }
+
   if (_pkl_any_integral_p (v1) && _pkl_any_integral_p (v2))
     /* Integrals.  */
     return _pkl_eq_integral (v1, v2);
@@ -1219,11 +1256,11 @@ immutable fun _pkl_eq_any = (any v1, any v2) int<32>:
   else if (asm int<32>: ("typof; nip; tyisa; nip" : v1)
            && asm int<32>: ("typof; nip; tyisa; nip" : v2))
     /* Arrays.  */
-    return handle_composite;
+    return handle_array;
   else if (asm int<32>: ("typof; nip; tyissct; nip" : v1)
            && asm int<32>: ("typof; nip; tyissct; nip" : v2))
     /* Structs.  */
-    return handle_composite;
+    return handle_struct;
   else
     return 0;
 }
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index bd5f6325..2309dcc7 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -1271,11 +1271,13 @@ EXTRA_DIST = \
   poke.pkl/eq-any-offset-5.pk \
   poke.pkl/eq-any-offset-6.pk \
   poke.pkl/eq-any-offset-7.pk \
+  poke.pkl/eq-any-union-1.pk \
   poke.pkl/eq-any-string-1.pk \
   poke.pkl/eq-any-struct-1.pk \
   poke.pkl/eq-any-struct-2.pk \
   poke.pkl/eq-any-struct-3.pk \
   poke.pkl/eq-any-struct-4.pk \
+  poke.pkl/eq-any-struct-5.pk \
   poke.pkl/eq-arrays-1.pk \
   poke.pkl/eq-arrays-2.pk \
   poke.pkl/eq-arrays-3.pk \
@@ -1879,6 +1881,7 @@ EXTRA_DIST = \
   poke.pkl/neq-any-string-1.pk \
   poke.pkl/neq-any-struct-1.pk \
   poke.pkl/neq-any-struct-2.pk \
+  poke.pkl/neq-any-union-1.pk \
   poke.pkl/neq-integers-1.pk \
   poke.pkl/neq-integers-2.pk \
   poke.pkl/neq-offsets-1.pk \
diff --git a/testsuite/poke.pkl/eq-any-struct-5.pk 
b/testsuite/poke.pkl/eq-any-struct-5.pk
new file mode 100644
index 00000000..0a134733
--- /dev/null
+++ b/testsuite/poke.pkl/eq-any-struct-5.pk
@@ -0,0 +1,16 @@
+/* { dg-do run } */
+
+fun eq_any = (any a, any b) int<32>: { return a == b; }
+
+type Foo =
+  struct
+  {
+  };
+
+type Bar =
+  struct
+  {
+  };
+
+/* { dg-command { eq_any (Foo {}, Bar {}) } } */
+/* { dg-output "0" } */
diff --git a/testsuite/poke.pkl/eq-any-union-1.pk 
b/testsuite/poke.pkl/eq-any-union-1.pk
new file mode 100644
index 00000000..2a760c8e
--- /dev/null
+++ b/testsuite/poke.pkl/eq-any-union-1.pk
@@ -0,0 +1,19 @@
+/* { dg-do run } */
+
+fun eq_any = (any a, any b) int<32>: { return a == b; }
+
+var x = 2;
+
+type Foo =
+  union
+  {
+    int i : x > 0;
+    long l;
+  };
+
+/* { dg-command {var u1 = Foo {}} } */
+/* { dg-command {eq_any (u1, Foo {})} } */
+/* { dg-output "1" } */
+/* { dg-command {x = 0} } */
+/* { dg-command {eq_any (u1, Foo {})} } */
+/* { dg-output "\n0" } */
diff --git a/testsuite/poke.pkl/neq-any-union-1.pk 
b/testsuite/poke.pkl/neq-any-union-1.pk
new file mode 100644
index 00000000..40f4ad16
--- /dev/null
+++ b/testsuite/poke.pkl/neq-any-union-1.pk
@@ -0,0 +1,19 @@
+/* { dg-do run } */
+
+fun neq_any = (any a, any b) int<32>: { return a != b; }
+
+var x = 2;
+
+type Foo =
+  union
+  {
+    int i : x > 0;
+    long l;
+  };
+
+/* { dg-command {var u1 = Foo {}} } */
+/* { dg-command {neq_any (u1, Foo {})} } */
+/* { dg-output "0" } */
+/* { dg-command {x = 0} } */
+/* { dg-command {neq_any (u1, Foo {})} } */
+/* { dg-output "\n1" } */
-- 
2.30.2