poke-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] pkl: re-work re-declaration


From: Mohammad-Reza Nabipoor
Subject: [PATCH] pkl: re-work re-declaration
Date: Sun, 25 Jun 2023 23:00:15 +0200

2023-06-25  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>

        * bootstrap.conf (libpoke_modules): Add `xvasprintf-posix'.
        * libpoke/pkl-ast.h (PKL_AST_DECL_PREV_DECL): New macro.
        (PKL_AST_DECL_REDECL_CHAIN): Likewise.
        (struct pkl_ast_decl): New fields.
        * libpoke/pkl-ast.c (pkl_type_append_to): Don't report re-declared
        names directly (because they contain the a dollar character and
        a generation number which are implementation details). Use user-defined
        name.
        (pkl_ast_node_free_1): Handle `prev_decl' field.
        (pkl_ast_print_1): Likewise.
        * libpoke/pkl-env.h (pkl_env_commit_renames): New function and comments.
        * libpoke/pkl-env.c (xvasprintf): Add new include.
        (struct pkl_env): Add new field `redecls' to keep track of 
re-declarations.
        (decl_rollback): New static function.
        (env_redecls_free): Likewise.
        (register_decl): Add new param `env'.  Change the logic of re-naming
        for re-declarations.
        (pkl_env_free): Handle `redecls'.
        (pkl_env_register): Pass `env' to `register_decl'.
        (is_prev_decl_p): New static function.
        (pkl_env_iter_begin): Updated to skip re-defined declarations.
        (pkl_env_iter_next): Likewise.
        (pkl_env_commit_renames): New function to commit new re-declarations
        in the environment.
        (pkl_env_rollback_renames): Rewrite to call `env_redecls_free'.
        * libpoke/pkl.c (pkl_execute_buffer): Add
        `pkl_env_{commit,rollback}_reanmes'.
        (pkl_execute_statement): Likewise.
        (pkl_compile_expression): Likewise.
        (pkl_execute_expression): Likewise.
        (pkl_execute_file): Likewise.
        * testsuite/poke.pkl/redef-4.pk: New test.
        * testsuite/poke.pkl/redef-5.pk: Likewise.
        * testsuite/poke.pkl/redef-6.pk: Likewise.
        * testsuite/poke.pkl/redef-7.pk: Likewise.
        * testsuite/poke.pkl/redef-diag-4.pk: Likewise.
        * testsuite/poke.pkl/redef-diag-5.pk: Likewise.
        * testsuite/poke.pkl/redef-diag-6.pk: Likewise.
        * testsuite/Makefile.am (EXTRA_DIST): Update.
---

Hi Jose.

The only missing test is rollback of declarations when there's a compile-time
error.  Like this one:

```poke
(poke) type Foo = struct { };
(poke) type Foo = struct { int<64> i64; }, Bar = ""
<stdin>:1:43: error: syntax error: unexpected string
(poke) Foo {}
Foo {
}
```


Regards,
Mohammad-Reza


 ChangeLog                          |  42 +++++++++
 bootstrap.conf                     |   1 +
 libpoke/pkl-ast.c                  |  18 +++-
 libpoke/pkl-ast.h                  |  17 ++--
 libpoke/pkl-env.c                  | 139 +++++++++++++++++++++--------
 libpoke/pkl-env.h                  |   7 +-
 libpoke/pkl.c                      |  18 ++--
 testsuite/Makefile.am              |   7 ++
 testsuite/poke.pkl/redef-4.pk      |   9 ++
 testsuite/poke.pkl/redef-5.pk      |  13 +++
 testsuite/poke.pkl/redef-6.pk      |  11 +++
 testsuite/poke.pkl/redef-7.pk      |  10 +++
 testsuite/poke.pkl/redef-diag-4.pk |  10 +++
 testsuite/poke.pkl/redef-diag-5.pk |  15 ++++
 testsuite/poke.pkl/redef-diag-6.pk |  20 +++++
 15 files changed, 282 insertions(+), 55 deletions(-)
 create mode 100644 testsuite/poke.pkl/redef-4.pk
 create mode 100644 testsuite/poke.pkl/redef-5.pk
 create mode 100644 testsuite/poke.pkl/redef-6.pk
 create mode 100644 testsuite/poke.pkl/redef-7.pk
 create mode 100644 testsuite/poke.pkl/redef-diag-4.pk
 create mode 100644 testsuite/poke.pkl/redef-diag-5.pk
 create mode 100644 testsuite/poke.pkl/redef-diag-6.pk

diff --git a/ChangeLog b/ChangeLog
index d6870084..a756036c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,45 @@
+2023-06-25  Mohammad-Reza Nabipoor  <mnabipoor@gnu.org>
+
+       * bootstrap.conf (libpoke_modules): Add `xvasprintf-posix'.
+       * libpoke/pkl-ast.h (PKL_AST_DECL_PREV_DECL): New macro.
+       (PKL_AST_DECL_REDECL_CHAIN): Likewise.
+       (struct pkl_ast_decl): New fields.
+       * libpoke/pkl-ast.c (pkl_type_append_to): Don't report re-declared
+       names directly (because they contain the a dollar character and
+       a generation number which are implementation details). Use user-defined
+       name.
+       (pkl_ast_node_free_1): Handle `prev_decl' field.
+       (pkl_ast_print_1): Likewise.
+       * libpoke/pkl-env.h (pkl_env_commit_renames): New function and comments.
+       * libpoke/pkl-env.c (xvasprintf): Add new include.
+       (struct pkl_env): Add new field `redecls' to keep track of 
re-declarations.
+       (decl_rollback): New static function.
+       (env_redecls_free): Likewise.
+       (register_decl): Add new param `env'.  Change the logic of re-naming
+       for re-declarations.
+       (pkl_env_free): Handle `redecls'.
+       (pkl_env_register): Pass `env' to `register_decl'.
+       (is_prev_decl_p): New static function.
+       (pkl_env_iter_begin): Updated to skip re-defined declarations.
+       (pkl_env_iter_next): Likewise.
+       (pkl_env_commit_renames): New function to commit new re-declarations
+       in the environment.
+       (pkl_env_rollback_renames): Rewrite to call `env_redecls_free'.
+       * libpoke/pkl.c (pkl_execute_buffer): Add
+       `pkl_env_{commit,rollback}_reanmes'.
+       (pkl_execute_statement): Likewise.
+       (pkl_compile_expression): Likewise.
+       (pkl_execute_expression): Likewise.
+       (pkl_execute_file): Likewise.
+       * testsuite/poke.pkl/redef-4.pk: New test.
+       * testsuite/poke.pkl/redef-5.pk: Likewise.
+       * testsuite/poke.pkl/redef-6.pk: Likewise.
+       * testsuite/poke.pkl/redef-7.pk: Likewise.
+       * testsuite/poke.pkl/redef-diag-4.pk: Likewise.
+       * testsuite/poke.pkl/redef-diag-5.pk: Likewise.
+       * testsuite/poke.pkl/redef-diag-6.pk: Likewise.
+       * testsuite/Makefile.am (EXTRA_DIST): Update.
+
 2023-06-23  Jose E. Marchesi  <jemarch@gnu.org>
 
        * libpoke/pkl-gen.pks (struct_constructor): Re-raise an E_conv
diff --git a/bootstrap.conf b/bootstrap.conf
index c5cf0452..7a8e0cec 100644
--- a/bootstrap.conf
+++ b/bootstrap.conf
@@ -106,6 +106,7 @@ libpoke_modules="
   tmpdir
   vasprintf-posix
   vsnprintf-posix
+  xvasprintf-posix
   xalloc
   strstr
   lib-symbol-visibility
diff --git a/libpoke/pkl-ast.c b/libpoke/pkl-ast.c
index 7c2dc7ab..ef170706 100644
--- a/libpoke/pkl-ast.c
+++ b/libpoke/pkl-ast.c
@@ -1500,7 +1500,18 @@ pkl_type_append_to (pkl_ast_node type, int 
use_given_name,
   if (use_given_name
       && PKL_AST_TYPE_NAME (type))
     {
-      sb_append (buffer, PKL_AST_IDENTIFIER_POINTER (PKL_AST_TYPE_NAME 
(type)));
+      char *name = PKL_AST_IDENTIFIER_POINTER (PKL_AST_TYPE_NAME (type));
+      char *dollar = strchr (name, '$');
+
+      if (dollar)
+        {
+          sb_append (buffer, "a previous declaration of ");
+          *dollar = '\0';
+          sb_append (buffer, name);
+          *dollar = '$';
+        }
+      else
+        sb_append (buffer, name);
       return;
     }
 
@@ -2608,7 +2619,7 @@ pkl_ast_node_free_1 (gl_set_t visitations, pkl_ast_node 
ast)
       VISIT_AND_FREE (PKL_AST_DECL_SOURCE (ast));
       PKL_AST_NODE_FREE (PKL_AST_DECL_NAME (ast));
       PKL_AST_NODE_FREE (PKL_AST_DECL_INITIAL (ast));
-      free (PKL_AST_DECL_PREV_NAME (ast));
+      PKL_AST_NODE_FREE (PKL_AST_DECL_PREV_DECL (ast));
       break;
 
     case PKL_AST_OFFSET:
@@ -3488,9 +3499,8 @@ pkl_ast_print_1 (FILE *fp, pkl_ast_node ast, int indent)
       if (PKL_AST_DECL_SOURCE (ast))
         PRINT_AST_IMM (source, DECL_SOURCE, "'%s'");
       PRINT_AST_SUBAST (name, DECL_NAME);
-      if (PKL_AST_DECL_PREV_NAME (ast))
-        PRINT_AST_IMM (prev_name, DECL_PREV_NAME, "'%s'");
       PRINT_AST_SUBAST (initial, DECL_INITIAL);
+      PRINT_AST_SUBAST (prev_decl, DECL_PREV_DECL);
       break;
 
     case PKL_AST_OFFSET:
diff --git a/libpoke/pkl-ast.h b/libpoke/pkl-ast.h
index c276e1dc..716d2771 100644
--- a/libpoke/pkl-ast.h
+++ b/libpoke/pkl-ast.h
@@ -1139,10 +1139,6 @@ pkl_ast_node pkl_ast_type_incr_step (pkl_ast ast, 
pkl_ast_node type);
    NAME is PKL_AST_IDENTIFIER node containing the name in the
    association.
 
-   PREV_NAME is used in order to cache the name in the declaration
-   when the later is set to "" in re-definition of non-immutable
-   global objects.  See pkl-env.c to see how this field is used.
-
    INITIAL is the initial value of the entity.  The kind of node
    depends on what is being declared:
    - An expression node for a variable.
@@ -1150,6 +1146,13 @@ pkl_ast_node pkl_ast_type_incr_step (pkl_ast ast, 
pkl_ast_node type);
    - A PKL_AST_FUNC for a function.
    - A constant expression node for an unit.
 
+   PREV_DECL is used to keep track of previous declaration with the
+   same name.  See pkl-env.c to see how this field is used.
+
+   REDECL_CHAIN is used to form a transient sibling relationships among
+   re-declared non-immutable global entities in a compilation session.
+   See pkl-env to see how this field is used.
+
    ORDER is the order of the declaration in its containing
    compile-time environment.  It is filled up when the declaration is
    registered in an environment.
@@ -1169,13 +1172,14 @@ pkl_ast_node pkl_ast_type_incr_step (pkl_ast ast, 
pkl_ast_node type);
 
 #define PKL_AST_DECL_KIND(AST) ((AST)->decl.kind)
 #define PKL_AST_DECL_NAME(AST) ((AST)->decl.name)
-#define PKL_AST_DECL_PREV_NAME(AST) ((AST)->decl.prev_name)
 #define PKL_AST_DECL_INITIAL(AST) ((AST)->decl.initial)
+#define PKL_AST_DECL_PREV_DECL(AST) ((AST)->decl.prev_decl)
 #define PKL_AST_DECL_ORDER(AST) ((AST)->decl.order)
 #define PKL_AST_DECL_SOURCE(AST) ((AST)->decl.source)
 #define PKL_AST_DECL_STRUCT_FIELD_P(AST) ((AST)->decl.struct_field_p)
 #define PKL_AST_DECL_IN_STRUCT_P(AST) ((AST)->decl.in_struct_p)
 #define PKL_AST_DECL_IMMUTABLE_P(AST) ((AST)->decl.immutable_p)
+#define PKL_AST_DECL_REDECL_CHAIN(AST) ((AST)->decl.redecl_chain)
 
 #define PKL_AST_DECL_KIND_ANY 0
 #define PKL_AST_DECL_KIND_VAR 1
@@ -1192,9 +1196,10 @@ struct pkl_ast_decl
   int in_struct_p;
   int immutable_p;
   char *source;
-  char *prev_name;
   union pkl_ast_node *name;
   union pkl_ast_node *initial;
+  union pkl_ast_node *prev_decl;
+  union pkl_ast_node *redecl_chain;
   int order;
 };
 
diff --git a/libpoke/pkl-env.c b/libpoke/pkl-env.c
index e45a20cf..fa40f908 100644
--- a/libpoke/pkl-env.c
+++ b/libpoke/pkl-env.c
@@ -20,6 +20,7 @@
 
 #include <stdlib.h>
 #include <xalloc.h>
+#include <xvasprintf.h>
 #include <string.h>
 #include <assert.h>
 
@@ -40,16 +41,21 @@
    - A separated namespace for offset units.  UNITS_HASH_TABLE is used
      to store declarations for these.
 
+   REDECLS is used to keep track of re-defined declarations in order to
+   be able to rollback them.  See env_redecls_free function.
+
    UP is a link to the immediately enclosing frame.  This is NULL for
    the top-level frame.  */
 
 #define HASH_TABLE_SIZE 1008
 typedef pkl_ast_node pkl_hash[HASH_TABLE_SIZE];
 
+
 struct pkl_env
 {
   pkl_hash hash_table;
   pkl_hash units_hash_table;
+  pkl_ast_node redecls;
 
   int num_types;
   int num_vars;
@@ -120,20 +126,66 @@ get_registered (pkl_hash hash_table, const char *name)
   return NULL;
 }
 
+static void
+decl_rollback (pkl_ast_node decl)
+{
+  pkl_ast_node prev_decl, prev_decl_name;
+  char *name;
+
+  assert (decl != NULL);
+  prev_decl = PKL_AST_DECL_PREV_DECL (decl);
+  assert (prev_decl != NULL);
+  prev_decl_name = PKL_AST_DECL_NAME (prev_decl);
+
+  name = PKL_AST_IDENTIFIER_POINTER (prev_decl_name);
+  name = strchr (name, '$');
+  assert (name != NULL);
+  *name = '\0';
+
+  prev_decl = ASTDEREF (prev_decl);
+  PKL_AST_DECL_PREV_DECL (decl) = NULL;
+}
+
+static void
+env_redecls_free (pkl_env env, int rollback_p)
+{
+  pkl_ast_node t, n = env->redecls;
+
+  while (n)
+    {
+      if (rollback_p)
+        decl_rollback (n);
+
+      t = PKL_AST_DECL_REDECL_CHAIN (n);
+      PKL_AST_DECL_REDECL_CHAIN (n) = NULL;
+      n = t;
+    }
+  env->redecls = NULL;
+}
+
 static int
-register_decl (int top_level_p,
+register_decl (pkl_env env,
                pkl_hash hash_table,
                const char *name,
                pkl_ast_node decl)
 {
   int hash;
   pkl_ast_node found_decl;
+  int top_level_p = env->up == NULL;
 
   /* Check if DECL is already registered in the given hash table.
 
-     If we are in the global environment then we allow "redefining" by
-     changing the name of the previous declaration to "", provided
-     that previous declaration is _not_ declared as immutable.
+     If we are in the top-level environment, then "redefining" is
+     allowd for non-immutable declarations.
+     The trick is to rename the previous declaration to something
+     that is not accessible through the language; so the old
+     entities continue to work, and it's impossible for the Poke
+     user to combine unrelated entities together (despite the fact
+     that they were defined with the same name).
+
+     We rename the previous declaration to <name>$<generation>.
+     Because of '$' character, Poke user cannot refer to this
+     declaration anymore. The <generation> is a number in base 10.
 
      Otherwise we don't register DECL, as it is already defined.  */
 
@@ -142,11 +194,32 @@ register_decl (int top_level_p,
     {
       if (top_level_p && !PKL_AST_DECL_IMMUTABLE_P (found_decl))
         {
-          pkl_ast_node decl_name = PKL_AST_DECL_NAME (found_decl);
+          int generation = 0;
+          char *new_name;
+
+          /* Calculate the generation number for found_decl.  */
+          if (PKL_AST_DECL_PREV_DECL (found_decl))
+            {
+              pkl_ast_node prev_decl = PKL_AST_DECL_PREV_DECL (found_decl);
+              pkl_ast_node prev_decl_name = PKL_AST_DECL_NAME (prev_decl);
+              char *name = PKL_AST_IDENTIFIER_POINTER (prev_decl_name);
+              char *generation_str = strchr (name, '$');
+
+              assert (generation_str != NULL);
+              generation = atoi (generation_str + 1);
+              assert (generation != 0);
+            }
+
+          new_name = xasprintf ("%s$%d", name, generation + 1);
+          assert (new_name != NULL);
+          free (PKL_AST_IDENTIFIER_POINTER (PKL_AST_DECL_NAME (found_decl)));
+          PKL_AST_IDENTIFIER_POINTER (PKL_AST_DECL_NAME (found_decl)) = 
new_name;
 
-          PKL_AST_DECL_PREV_NAME (found_decl)
-            = PKL_AST_IDENTIFIER_POINTER (decl_name);
-          PKL_AST_IDENTIFIER_POINTER (decl_name) = strdup ("");
+          PKL_AST_DECL_PREV_DECL (decl) = ASTREF (found_decl);
+
+          /* Register DECL in re-defined declarations list.  */
+          PKL_AST_DECL_REDECL_CHAIN (decl) = env->redecls;
+          env->redecls = decl;
         }
       else
         return 0;
@@ -194,6 +267,7 @@ pkl_env_free (pkl_env env)
   if (env)
     {
       pkl_env_free (env->up);
+      env_redecls_free (env, /*rollback_p*/ 1);
       free_hash_table (env->hash_table);
       free_hash_table (env->units_hash_table);
       free (env);
@@ -230,7 +304,7 @@ pkl_env_register (pkl_env env,
 {
   pkl_hash *table = get_ns_table (env, namespace);
 
-  if (register_decl (env->up == NULL, *table, name, decl))
+  if (register_decl (env, *table, name, decl))
     {
       switch (PKL_AST_DECL_KIND (decl))
         {
@@ -320,14 +394,24 @@ pkl_env_toplevel_p (pkl_env env)
   return env->up == NULL;
 }
 
+/* Return non-zero value if DECL has already been re-defined, otherwise return
+   zero.  */
+
+static int
+is_prev_decl_p (pkl_ast_node decl)
+{
+  pkl_ast_node name = PKL_AST_DECL_NAME (decl);
+
+  return strchr (PKL_AST_IDENTIFIER_POINTER (name), '$') != NULL;
+}
+
 void
 pkl_env_iter_begin (pkl_env env, struct pkl_ast_node_iter *iter)
 {
   iter->bucket = 0;
   iter->node = env->hash_table[iter->bucket];
   /* Note that we skip re-defined declarations.  */
-  while (iter->node == NULL
-         || *PKL_AST_IDENTIFIER_POINTER (PKL_AST_DECL_NAME (iter->node)) == 
'\0')
+  while (iter->node == NULL || is_prev_decl_p (iter->node))
     {
       iter->bucket++;
       if (iter->bucket >= HASH_TABLE_SIZE)
@@ -343,8 +427,7 @@ pkl_env_iter_next (pkl_env env, struct pkl_ast_node_iter 
*iter)
 
   iter->node = PKL_AST_CHAIN2 (iter->node);
   /* Note that we skip re-defined declarations.  */
-  while (iter->node == NULL
-         || *PKL_AST_IDENTIFIER_POINTER (PKL_AST_DECL_NAME (iter->node)) == 
'\0')
+  while (iter->node == NULL || is_prev_decl_p (iter->node))
     {
       iter->bucket++;
       if (iter->bucket >= HASH_TABLE_SIZE)
@@ -438,36 +521,14 @@ pkl_env_get_next_matching_decl (pkl_env env, struct 
pkl_ast_node_iter *iter,
   return NULL;
 }
 
-static void
-pkl_env_rollback_renames_1 (pkl_hash hash_table)
+void
+pkl_env_commit_renames (pkl_env env)
 {
-  int i;
-  for (i = 0; i < HASH_TABLE_SIZE; ++i)
-    {
-      pkl_ast_node t;
-      pkl_ast_node decl = hash_table[i];
-
-      for (t = decl; t; t = PKL_AST_CHAIN2 (t))
-        {
-          pkl_ast_node decl_name = PKL_AST_DECL_NAME (t);
-
-          if (PKL_AST_DECL_PREV_NAME (t))
-            {
-              assert (decl_name
-                      && STREQ (PKL_AST_IDENTIFIER_POINTER (decl_name), ""));
-
-              free (PKL_AST_IDENTIFIER_POINTER (decl_name));
-              PKL_AST_IDENTIFIER_POINTER (decl_name)
-                = PKL_AST_DECL_PREV_NAME (t);
-              PKL_AST_DECL_PREV_NAME (t) = NULL;
-            }
-        }
-    }
+  env_redecls_free (env, /*rollback_p*/ 0);
 }
 
 void
 pkl_env_rollback_renames (pkl_env env)
 {
-  pkl_env_rollback_renames_1 (env->hash_table);
-  pkl_env_rollback_renames_1 (env->units_hash_table);
+  env_redecls_free (env, /*rollback_p*/ 1);
 }
diff --git a/libpoke/pkl-env.h b/libpoke/pkl-env.h
index 1bc4f9dd..41a3bd4d 100644
--- a/libpoke/pkl-env.h
+++ b/libpoke/pkl-env.h
@@ -162,7 +162,12 @@ void pkl_env_map_decls (pkl_env env,
                         pkl_map_decl_fn cb,
                         void *data);
 
-/* Function to rollback/undo redefinitions/renames of global objects
+/* Function to commit the redefinitions/renames of global objects
+   in the given environment.  */
+
+void pkl_env_commit_renames (pkl_env env);
+
+/* Function to rollback/undo the redefinitions/renames of global objects
    in the given environment.  */
 
 void pkl_env_rollback_renames (pkl_env env);
diff --git a/libpoke/pkl.c b/libpoke/pkl.c
index 9da052ed..8367d536 100644
--- a/libpoke/pkl.c
+++ b/libpoke/pkl.c
@@ -348,11 +348,13 @@ pkl_execute_buffer (pkl_compiler compiler,
     {
       pkl_env_free (compiler->env);
       compiler->env = env;
+      pkl_env_commit_renames (compiler->env);
     }
+  else
+    pkl_env_rollback_renames (env);
   return 1;
 
  error:
-  pkl_env_rollback_renames (compiler->env);
   pkl_env_free (env);
   return 0;
 }
@@ -403,11 +405,13 @@ pkl_execute_statement (pkl_compiler compiler,
     {
       pkl_env_free (compiler->env);
       compiler->env = env;
+      pkl_env_commit_renames (compiler->env);
     }
+  else
+    pkl_env_rollback_renames (env);
   return 1;
 
  error:
-  pkl_env_rollback_renames (compiler->env);
   pkl_env_free (env);
   return 0;
 }
@@ -445,12 +449,12 @@ pkl_compile_expression (pkl_compiler compiler,
 
    pkl_env_free (compiler->env);
    compiler->env = env;
+   pkl_env_commit_renames (compiler->env);
    pvm_program_make_executable (program);
 
    return program;
 
  error:
-   pkl_env_rollback_renames (compiler->env);
    pkl_env_free (env);
    return NULL;
 }
@@ -501,11 +505,13 @@ pkl_execute_expression (pkl_compiler compiler,
     {
       pkl_env_free (compiler->env);
       compiler->env = env;
+      pkl_env_commit_renames (compiler->env);
     }
+  else
+    pkl_env_rollback_renames (env);
   return 1;
 
  error:
-  pkl_env_rollback_renames (compiler->env);
   pkl_env_free (env);
   return 0;
 }
@@ -554,12 +560,14 @@ pkl_execute_file (pkl_compiler compiler, const char 
*fname,
     {
       pkl_env_free (compiler->env);
       compiler->env = env;
+      pkl_env_commit_renames (compiler->env);
     }
+  else
+    pkl_env_rollback_renames (env);
   return 1;
 
  error:
   fclose (fp);
-  pkl_env_rollback_renames (compiler->env);
   pkl_env_free (env);
   return 0;
 }
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index acb0220b..0ea3536e 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -2256,9 +2256,16 @@ EXTRA_DIST = \
   poke.pkl/redef-diag-1.pk \
   poke.pkl/redef-diag-2.pk \
   poke.pkl/redef-diag-3.pk \
+  poke.pkl/redef-diag-4.pk \
+  poke.pkl/redef-diag-5.pk \
+  poke.pkl/redef-diag-6.pk \
   poke.pkl/redef-1.pk \
   poke.pkl/redef-2.pk \
   poke.pkl/redef-3.pk \
+  poke.pkl/redef-4.pk \
+  poke.pkl/redef-5.pk \
+  poke.pkl/redef-6.pk \
+  poke.pkl/redef-7.pk \
   poke.pkl/reduce-array-1.pk \
   poke.pkl/reduce-array-2.pk \
   poke.pkl/return-1.pk \
diff --git a/testsuite/poke.pkl/redef-4.pk b/testsuite/poke.pkl/redef-4.pk
new file mode 100644
index 00000000..0765e41a
--- /dev/null
+++ b/testsuite/poke.pkl/redef-4.pk
@@ -0,0 +1,9 @@
+/* { dg-do run } */
+
+type Foo = struct { };
+fun foo = (Foo a) void: { print "foo\n"; }
+var f = Foo {};
+type Foo = struct { };
+
+/* { dg-command {foo (f)} } */
+/* { dg-output "foo\n" } */
diff --git a/testsuite/poke.pkl/redef-5.pk b/testsuite/poke.pkl/redef-5.pk
new file mode 100644
index 00000000..a8930f97
--- /dev/null
+++ b/testsuite/poke.pkl/redef-5.pk
@@ -0,0 +1,13 @@
+/* { dg-do run } */
+
+type Foo = struct { int<32> i32; };
+
+/* { dg-command { .set obase 10 } } */
+/* { dg-command { .set omode flat } } */
+/* { dg-command { 2#Foo } } */
+/* { dg-output "2#32" } */
+/* { dg-command {unit Foo = 33} } */
+/* { dg-command {3#Foo} } */
+/* { dg-output "\n3#33" } */
+/* { dg-command {Foo {}} } */
+/* { dg-output "\nFoo {i32=0}" } */
diff --git a/testsuite/poke.pkl/redef-6.pk b/testsuite/poke.pkl/redef-6.pk
new file mode 100644
index 00000000..696320f4
--- /dev/null
+++ b/testsuite/poke.pkl/redef-6.pk
@@ -0,0 +1,11 @@
+/* { dg-do run } */
+
+type Foo = struct { int<32> i32; };
+
+/* { dg-command {.set obase 10} } */
+/* { dg-command {.set omode flat} } */
+/* { dg-command {Foo {}} } */
+/* { dg-output "Foo {i32=0}" } */
+/* { dg-command {type Foo = struct { int<64> i64; }} } */
+/* { dg-command {Foo {}} } */
+/* { dg-output "\nFoo {i64=0L}" } */
diff --git a/testsuite/poke.pkl/redef-7.pk b/testsuite/poke.pkl/redef-7.pk
new file mode 100644
index 00000000..6f9fa344
--- /dev/null
+++ b/testsuite/poke.pkl/redef-7.pk
@@ -0,0 +1,10 @@
+/* { dg-do run } */
+
+var x = "Hello";
+
+/* { dg-command {x} } */
+/* { dg-output {"Hello"} } */
+/* { dg-command {var x = 1, y = lambda string: {printf "x:%i32d\n", x; raise 
E_elem; return "";} ()} } */
+/* { dg-output {\nx:1\nunhandled .*} } */
+/* { dg-command {x} } */
+/* { dg-output {\n"Hello"} } */
diff --git a/testsuite/poke.pkl/redef-diag-4.pk 
b/testsuite/poke.pkl/redef-diag-4.pk
new file mode 100644
index 00000000..4288df2a
--- /dev/null
+++ b/testsuite/poke.pkl/redef-diag-4.pk
@@ -0,0 +1,10 @@
+/* { dg-do compile } */
+
+type Foo = struct { };
+fun foo = (Foo a) void: { print "foo\n"; }
+var f1 = Foo {};
+type Foo = struct { };
+var f2 = Foo {};
+
+foo (f1);
+foo (f2); /* { dg-error "invalid value for function argument.*\n.*expected a 
previous declaration of Foo, got Foo" } */
diff --git a/testsuite/poke.pkl/redef-diag-5.pk 
b/testsuite/poke.pkl/redef-diag-5.pk
new file mode 100644
index 00000000..b8f1cbb2
--- /dev/null
+++ b/testsuite/poke.pkl/redef-diag-5.pk
@@ -0,0 +1,15 @@
+/* { dg-do compile } */
+
+type Foo = struct { };
+fun foo = (Foo a) void: { print "foo1\n"; }
+var f1 = Foo {};
+
+foo (f1);
+
+type Foo = struct { };
+var f2 = Foo {};
+
+fun foo = (Foo a) void: { print "foo2\n"; }
+
+foo (f2);
+foo (f1); /* { dg-error "invalid value for function argument.*\n.*expected 
Foo, got a previous declaration of Foo" } */
diff --git a/testsuite/poke.pkl/redef-diag-6.pk 
b/testsuite/poke.pkl/redef-diag-6.pk
new file mode 100644
index 00000000..2461937b
--- /dev/null
+++ b/testsuite/poke.pkl/redef-diag-6.pk
@@ -0,0 +1,20 @@
+/* { dg-do compile } */
+
+type Foo = struct { };
+fun foo = (Foo a) void: { print "foo1\n"; }
+var f1 = Foo {};
+
+foo (f1);
+
+type Foo = struct { };
+var f2 = Foo {};
+
+fun foo = (Foo a) void: { print "foo2\n"; }
+
+type Foo = struct { };
+var f3 = Foo {};
+
+fun foo = (Foo a) void: { print "foo3\n"; }
+
+foo (f3);
+foo (f2); /* { dg-error "invalid value for function argument.*\n.*expected 
Foo, got a previous declaration of Foo" } */
-- 
2.41.0




reply via email to

[Prev in Thread] Current Thread [Next in Thread]