[PATCH] Poke: make `in' error on different element types

[Arsen Arsenović]

---
As discussed on IRC.

 ChangeLog                           | 16 ++++++++++++
 libpoke/pkl-rt.pk                   | 16 ++++++------
 libpoke/pkl-typify.c                |  4 +--
 pickles/btf.pk                      | 38 ++++++++++++++---------------
 testsuite/poke.pkl/field-init-10.pk |  2 +-
 testsuite/poke.pkl/field-init-11.pk |  4 +--
 testsuite/poke.pkl/field-init-12.pk |  2 +-
 testsuite/poke.pkl/field-init-9.pk  |  4 +--
 testsuite/poke.pkl/in-1.pk          |  2 +-
 testsuite/poke.pkl/in-2.pk          |  2 +-
 testsuite/poke.pkl/in-3.pk          |  2 +-
 11 files changed, 53 insertions(+), 39 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index ff50592a..a3946900 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2022-10-21  Arsen Arsenović  <arsen@aarsen.me>
+
+        * libpoke/pkl-typify.c (pkl_typify1_ps_op_in): Don't allow
+        different types between LHS and element of RHS.
+        * libpoke/pkl-rt.pk: More strictly specify PK_TYPE_... constants,
+        to adhere to new `in' promotion rules.
+        * testsuite/poke.pkl/in-3.pk: Refactor test to work with new `in'
+        promotion rules.
+        * testsuite/poke.pkl/in-3.pk: Likewise.
+        * testsuite/poke.pkl/in-2.pk: Likewise.
+        * testsuite/poke.pkl/in-1.pk: Likewise.
+        * testsuite/poke.pkl/field-init-9.pk: Likewise.
+        * testsuite/poke.pkl/field-init-12.pk: Likewise.
+        * testsuite/poke.pkl/field-init-11.pk: Likewise.
+        * testsuite/poke.pkl/field-init-10.pk: Likewise.
+
 2022-10-21  Jose E. Marchesi  <jemarch@gnu.org>
 
        * libpoke/pkl-gen.c (pkl_gen_pr_cast): In casts from any, make
diff --git a/libpoke/pkl-rt.pk b/libpoke/pkl-rt.pk
index ece7d8c5..50ebc8bc 100644
--- a/libpoke/pkl-rt.pk
+++ b/libpoke/pkl-rt.pk
@@ -561,14 +561,14 @@ immutable fun _pkl_assert = (uint<64> cond, string msg, 
string filename,
       is ok.
 */
 
-immutable var PK_TYPE_UNKNOWN =  0;
-immutable var PK_TYPE_INTEGRAL = 1;
-immutable var PK_TYPE_OFFSET   = 2;
-immutable var PK_TYPE_STRING   = 3;
-immutable var PK_TYPE_ARRAY    = 4;
-immutable var PK_TYPE_STRUCT   = 5;
-immutable var PK_TYPE_FUNCTION = 6;
-immutable var PK_TYPE_ANY      = 7;
+immutable var PK_TYPE_UNKNOWN  = 0U;
+immutable var PK_TYPE_INTEGRAL = 1U;
+immutable var PK_TYPE_OFFSET   = 2U;
+immutable var PK_TYPE_STRING   = 3U;
+immutable var PK_TYPE_ARRAY    = 4U;
+immutable var PK_TYPE_STRUCT   = 5U;
+immutable var PK_TYPE_FUNCTION = 6U;
+immutable var PK_TYPE_ANY      = 7U;
 
 immutable type Pk_Type =
   struct
diff --git a/libpoke/pkl-typify.c b/libpoke/pkl-typify.c
index 72527885..e17a0ad0 100644
--- a/libpoke/pkl-typify.c
+++ b/libpoke/pkl-typify.c
@@ -894,9 +894,7 @@ PKL_PHASE_BEGIN_HANDLER (pkl_typify1_ps_op_in)
   if (PKL_AST_TYPE_CODE (op2_type) != PKL_TYPE_ARRAY)
     INVALID_OPERAND (op2, "expected array");
 
-  if (!pkl_ast_type_promoteable_p (op1_type,
-                                   PKL_AST_TYPE_A_ETYPE (op2_type),
-                                   0 /* promote_array_of_any */))
+  if (!pkl_ast_type_equal_p (op1_type, PKL_AST_TYPE_A_ETYPE (op2_type)))
     {
       char *t1_str = pkl_type_str (op1_type, 1);
       char *t2_str = pkl_type_str (PKL_AST_TYPE_A_ETYPE (op2_type), 1);
diff --git a/pickles/btf.pk b/pickles/btf.pk
index e40be31d..c84bfbd1 100644
--- a/pickles/btf.pk
+++ b/pickles/btf.pk
@@ -20,25 +20,25 @@
    documented in https://www.kernel.org/doc/html/latest/bpf/btf.html
    (fetched 2019-10-25) */
 
-var BTF_KIND_UNKNOWN = 0,
-    BTF_KIND_INT = 1,
-    BTF_KIND_PTR = 2,
-    BTF_KIND_ARRAY = 3,
-    BTF_KIND_STRUCT = 4,
-    BTF_KIND_UNION = 5,
-    BTF_KIND_ENUM = 6,
-    BTF_KIND_FWD = 7,
-    BTF_KIND_TYPEDEF = 8,
-    BTF_KIND_VOLATILE = 9,
-    BTF_KIND_CONST = 10,
-    BTF_KIND_RESTRICT = 11,
-    BTF_KIND_FUNC = 12,
-    BTF_KIND_FUNC_PROTO = 13,
-    BTF_KIND_VAR = 14,
-    BTF_KIND_DATASEC = 15,
-    BTF_KIND_FLOAT = 16,
-    BTF_KIND_DECL_TAG = 17,
-    BTF_KIND_TYPE_TAG = 18;
+var BTF_KIND_UNKNOWN = 0 as uint<5>,
+    BTF_KIND_INT = 1 as uint<5>,
+    BTF_KIND_PTR = 2 as uint<5>,
+    BTF_KIND_ARRAY = 3 as uint<5>,
+    BTF_KIND_STRUCT = 4 as uint<5>,
+    BTF_KIND_UNION = 5 as uint<5>,
+    BTF_KIND_ENUM = 6 as uint<5>,
+    BTF_KIND_FWD = 7 as uint<5>,
+    BTF_KIND_TYPEDEF = 8 as uint<5>,
+    BTF_KIND_VOLATILE = 9 as uint<5>,
+    BTF_KIND_CONST = 10 as uint<5>,
+    BTF_KIND_RESTRICT = 11 as uint<5>,
+    BTF_KIND_FUNC = 12 as uint<5>,
+    BTF_KIND_FUNC_PROTO = 13 as uint<5>,
+    BTF_KIND_VAR = 14 as uint<5>,
+    BTF_KIND_DATASEC = 15 as uint<5>,
+    BTF_KIND_FLOAT = 16 as uint<5>,
+    BTF_KIND_DECL_TAG = 17 as uint<5>,
+    BTF_KIND_TYPE_TAG = 18 as uint<5>;
 
 var btf_kind_names =
   ["unkn", "int", "ptr", "array", "struct", "union", "enum",
diff --git a/testsuite/poke.pkl/field-init-10.pk 
b/testsuite/poke.pkl/field-init-10.pk
index 7cc5a7d2..24084312 100644
--- a/testsuite/poke.pkl/field-init-10.pk
+++ b/testsuite/poke.pkl/field-init-10.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-type Foo = struct { byte a = 10 : a in [10, 20, 30]; };
+type Foo = struct { int<32> a = 10 : a in [10, 20, 30]; };
 
 /* { dg-command {try Foo { a = 40 }; catch if E_constraint { print "caught\n"; 
} } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/field-init-11.pk 
b/testsuite/poke.pkl/field-init-11.pk
index b44bea72..5e474301 100644
--- a/testsuite/poke.pkl/field-init-11.pk
+++ b/testsuite/poke.pkl/field-init-11.pk
@@ -1,7 +1,7 @@
 /* { dg-do run } */
 
-type Foo = struct { byte a : a in [10, 20, 30] = 10; };
+type Foo = struct { int<32> a : a in [10, 20, 30] = 10; };
 
 /* { dg-command {var f = Foo {} } } */
 /* { dg-command {f} } */
-/* { dg-output "Foo \{a=10UB\}" } */
+/* { dg-output "Foo \{a=10\}" } */
diff --git a/testsuite/poke.pkl/field-init-12.pk 
b/testsuite/poke.pkl/field-init-12.pk
index 2950e061..7168a934 100644
--- a/testsuite/poke.pkl/field-init-12.pk
+++ b/testsuite/poke.pkl/field-init-12.pk
@@ -1,6 +1,6 @@
 /* { dg-do run } */
 
-type Foo = struct { byte a : a in [10, 20, 30] = 50; };
+type Foo = struct { int<32> a : a in [10, 20, 30] = 50; };
 
 /* { dg-command {try Foo {}; catch if E_constraint { print "caught\n"; } } } */
 /* { dg-output "caught" } */
diff --git a/testsuite/poke.pkl/field-init-9.pk 
b/testsuite/poke.pkl/field-init-9.pk
index 0f8657e7..60811d47 100644
--- a/testsuite/poke.pkl/field-init-9.pk
+++ b/testsuite/poke.pkl/field-init-9.pk
@@ -1,7 +1,7 @@
 /* { dg-do run } */
 
-type Foo = struct { byte a = 10 : a in [10, 20, 30]; };
+type Foo = struct { int<32> a = 10 : a in [10, 20, 30]; };
 
 /* { dg-command {var f = Foo {} } } */
 /* { dg-command {f} } */
-/* { dg-output "Foo \{a=10UB\}" } */
+/* { dg-output "Foo \{a=10\}" } */
diff --git a/testsuite/poke.pkl/in-1.pk b/testsuite/poke.pkl/in-1.pk
index a9e60041..87a61bcf 100644
--- a/testsuite/poke.pkl/in-1.pk
+++ b/testsuite/poke.pkl/in-1.pk
@@ -1,4 +1,4 @@
-/* { dg-do run } */
+/* { dg-do run { xfail *-*-* } } */
 
 /* { dg-command {10#B in [2#b,10*8#b,3#b]} } */
 /* { dg-output "1" } */
diff --git a/testsuite/poke.pkl/in-2.pk b/testsuite/poke.pkl/in-2.pk
index a50b7a82..ab8676f1 100644
--- a/testsuite/poke.pkl/in-2.pk
+++ b/testsuite/poke.pkl/in-2.pk
@@ -1,4 +1,4 @@
-/* { dg-do run } */
+/* { dg-do run { xfail *-*-* } } */
 
 var x = 10UB;
 
diff --git a/testsuite/poke.pkl/in-3.pk b/testsuite/poke.pkl/in-3.pk
index 4b93d264..afdda1ef 100644
--- a/testsuite/poke.pkl/in-3.pk
+++ b/testsuite/poke.pkl/in-3.pk
@@ -1,4 +1,4 @@
-/* { dg-do run } */
+/* { dg-do run { xfail *-*-* } } */
 
 var x = 10UB;
 
-- 
2.38.1