[COMMITTED] pkl: disallow constructing non-empty arrays of `any' values without initial value

[Jose E. Marchesi]

2023-01-22  Jose E. Marchesi  <jemarch@gnu.org>

        * libpoke/pkl-anal.c (pkl_anal1_ps_cons): Constructing non-empty
        arrays of `any' without initial values is not supported.
        * testsuite/poke.pkl/acons-diag-9.pk: New test.
        * testsuite/poke.pkl/acons-diag-10.pk: Likewise.
        * testsuite/poke.pkl/acons-13.pk: Likewise.
        * testsuite/poke.pkl/acons-14.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
---
 ChangeLog                           | 10 +++++++
 libpoke/pkl-anal.c                  | 46 +++++++++++++++++++++++------
 testsuite/Makefile.am               |  4 +++
 testsuite/poke.pkl/acons-13.pk      |  4 +++
 testsuite/poke.pkl/acons-14.pk      |  4 +++
 testsuite/poke.pkl/acons-diag-10.pk |  3 ++
 testsuite/poke.pkl/acons-diag-9.pk  |  3 ++
 7 files changed, 65 insertions(+), 9 deletions(-)
 create mode 100644 testsuite/poke.pkl/acons-13.pk
 create mode 100644 testsuite/poke.pkl/acons-14.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-10.pk
 create mode 100644 testsuite/poke.pkl/acons-diag-9.pk

diff --git a/ChangeLog b/ChangeLog
index d57c8fb3..37d50f56 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2023-01-22  Jose E. Marchesi  <jemarch@gnu.org>
+
+       * libpoke/pkl-anal.c (pkl_anal1_ps_cons): Constructing non-empty
+       arrays of `any' without initial values is not supported.
+       * testsuite/poke.pkl/acons-diag-9.pk: New test.
+       * testsuite/poke.pkl/acons-diag-10.pk: Likewise.
+       * testsuite/poke.pkl/acons-13.pk: Likewise.
+       * testsuite/poke.pkl/acons-14.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Add new tests.
+
 2023-01-21  Jose E. Marchesi  <jemarch@gnu.org>
 
        * configure.ac: Change version to 2.90.0.
diff --git a/libpoke/pkl-anal.c b/libpoke/pkl-anal.c
index 5bd99b97..80f0eebe 100644
--- a/libpoke/pkl-anal.c
+++ b/libpoke/pkl-anal.c
@@ -656,15 +656,43 @@ PKL_PHASE_BEGIN_HANDLER (pkl_anal1_ps_cons)
         }
       break;
     case PKL_TYPE_ARRAY:
-      /* Array constructors accept zero or one arguments.  */
-      if (pkl_ast_chain_length (cons_value) > 1)
-        {
-          PKL_ERROR (PKL_AST_LOC (cons),
-                     "struct constructor requires exactly one argument");
-          PKL_ANAL_PAYLOAD->errors++;
-          PKL_PASS_ERROR;
-        }
-      break;
+      {
+        /* It is not allowed to construct arrays of values of type
+           `any' unless the constructed array has no elements or an
+           initial value is specified.  */
+
+        pkl_ast_node cons_type_etype;
+        pkl_ast_node cons_type_bound;
+
+        assert (PKL_AST_TYPE_CODE (cons_type) == PKL_TYPE_ARRAY);
+        cons_type_etype = PKL_AST_TYPE_A_ETYPE (cons_type);
+        cons_type_bound = PKL_AST_TYPE_A_BOUND (cons_type);
+
+        if (PKL_AST_TYPE_CODE (cons_type_etype) == PKL_TYPE_ANY
+            && pkl_ast_chain_length (cons_value) == 0
+            && cons_type_bound != NULL
+            && ((PKL_AST_CODE (cons_type_bound) == PKL_AST_INTEGER
+                 && PKL_AST_INTEGER_VALUE (cons_type_bound) > 0)
+                || (PKL_AST_CODE (cons_type_bound) == PKL_AST_OFFSET
+                    && PKL_AST_INTEGER_VALUE (PKL_AST_OFFSET_MAGNITUDE 
(cons_type_bound)) > 0)))
+          {
+            PKL_ERROR (PKL_AST_LOC (cons),
+                       "constructing non-empty arrays of `any' without an 
initializer\n"
+                       "is not supported");
+            PKL_ANAL_PAYLOAD->errors++;
+            PKL_PASS_ERROR;
+          }
+
+        /* Array constructors accept zero or one arguments.  */
+        if (pkl_ast_chain_length (cons_value) > 1)
+          {
+            PKL_ERROR (PKL_AST_LOC (cons),
+                       "struct constructor requires exactly one argument");
+            PKL_ANAL_PAYLOAD->errors++;
+            PKL_PASS_ERROR;
+          }
+        break;
+      }
     default:
       assert (0);
     }
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index cfe3f8cb..8b7f038a 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -643,6 +643,8 @@ EXTRA_DIST = \
   poke.pkl/acons-diag-6.pk \
   poke.pkl/acons-diag-7.pk \
   poke.pkl/acons-diag-8.pk \
+  poke.pkl/acons-diag-9.pk \
+  poke.pkl/acons-diag-10.pk \
   poke.pkl/acons-fun-1.pk \
   poke.pkl/acons-fun-2.pk \
   poke.pkl/acons-1.pk \
@@ -656,6 +658,8 @@ EXTRA_DIST = \
   poke.pkl/acons-9.pk \
   poke.pkl/acons-11.pk \
   poke.pkl/acons-12.pk \
+  poke.pkl/acons-13.pk \
+  poke.pkl/acons-14.pk \
   poke.pkl/add-arrays-1.pk \
   poke.pkl/add-arrays-2.pk \
   poke.pkl/add-arrays-3.pk \
diff --git a/testsuite/poke.pkl/acons-13.pk b/testsuite/poke.pkl/acons-13.pk
new file mode 100644
index 00000000..8a88a4be
--- /dev/null
+++ b/testsuite/poke.pkl/acons-13.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { any[]() } } */
+/* { dg-output {\[\]} } */
diff --git a/testsuite/poke.pkl/acons-14.pk b/testsuite/poke.pkl/acons-14.pk
new file mode 100644
index 00000000..4d8ac0c9
--- /dev/null
+++ b/testsuite/poke.pkl/acons-14.pk
@@ -0,0 +1,4 @@
+/* { dg-do run } */
+
+/* { dg-command { any[3](666) } } */
+/* { dg-output {\[666,666,666\]} } */
diff --git a/testsuite/poke.pkl/acons-diag-10.pk 
b/testsuite/poke.pkl/acons-diag-10.pk
new file mode 100644
index 00000000..185e9168
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-10.pk
@@ -0,0 +1,3 @@
+/* { dg-do compile } */
+
+any[3#B] (); /* { dg-error ".*\n.*not supported" } */
diff --git a/testsuite/poke.pkl/acons-diag-9.pk 
b/testsuite/poke.pkl/acons-diag-9.pk
new file mode 100644
index 00000000..21e7c2a6
--- /dev/null
+++ b/testsuite/poke.pkl/acons-diag-9.pk
@@ -0,0 +1,3 @@
+/* { dg-do compile } */
+
+any[3] (); /* { dg-error ".*\n.*not supported" } */
-- 
2.30.2