testsuite/gna: add reproducers for #2510

testsuite/gna/issue2510/repro1.vhdl

@@ -0,0 +1,49 @@
+package repro1_pkg1 is
+  function get_const return natural;
+end;
+
+package body repro1_pkg1 is
+  function get_const return natural is
+  begin
+    return 3;
+  end;
+end;
+
+
+use work.repro1_pkg1.all;
+
+package repro1_pkg2 is
+  type prot_t is protected
+    impure function get return natural;
+    procedure set (v : natural);
+  end protected;
+
+  shared variable sh : prot_t;
+
+  constant c : natural := get_const;
+end repro1_pkg2;
+
+package body repro1_pkg2 is
+  type prot_t is protected body
+    variable val : natural := c;
+    impure function get return natural is
+    begin
+      return val;
+    end;
+
+    procedure set (v : natural) is
+    begin
+      val := v;
+    end;
+  end protected body;
+end repro1_pkg2;
+
+use work.repro1_pkg2.all;
+
+entity repro1 is
+end;
+
+architecture arch of repro1 is
+begin
+  assert sh.get = 3 severity failure;
+end;

testsuite/gna/issue2510/repro2.vhdl

@@ -0,0 +1,50 @@
+package repro2_pkg1 is
+  generic (type t;
+           init : t);
+  type prot_t is protected
+    impure function get return t;
+    procedure set (v : t);
+  end protected;
+end;
+
+package body repro2_pkg1 is
+  type prot_t is protected body
+    variable val : t := init;
+    impure function get return t is
+    begin
+      return val;
+    end;
+
+    procedure set (v : t) is
+    begin
+      val := v;
+    end;
+  end protected body;
+end;
+
+
+package repro2_pkg2 is
+
+  function my_func return natural;
+
+  package my_pkg1 is new work.repro2_pkg1
+    generic map (t => natural, init => 6);
+  shared variable sh : my_pkg1.prot_t;
+end repro2_pkg2;
+
+package body repro2_pkg2 is
+  function my_func return natural is
+  begin
+    return 7;
+  end;
+end repro2_pkg2;
+
+use work.repro2_pkg2.all;
+
+entity repro2 is
+end;
+
+architecture arch of repro2 is
+begin
+  assert sh.get = 6 severity failure;
+end;

testsuite/gna/issue2510/repro3.vhdl

@@ -0,0 +1,54 @@
+package repro3_pkg1 is
+  generic (type t;
+           init : t);
+  type prot_t is protected
+    impure function get return t;
+    procedure set (v : t);
+  end protected;
+end;
+
+package body repro3_pkg1 is
+  type my_Rec is record
+    val : t;
+  end record;
+
+  type prot_t is protected body
+    variable val : my_rec := (val => init);
+    impure function get return t is
+    begin
+      return val.val;
+    end;
+
+    procedure set (v : t) is
+    begin
+      val.val := v;
+    end;
+  end protected body;
+end;
+
+
+package repro3_pkg2 is
+
+  function my_func return natural;
+
+  package my_pkg1 is new work.repro3_pkg1
+    generic map (t => natural, init => 6);
+  shared variable sh : my_pkg1.prot_t;
+end repro3_pkg2;
+
+package body repro3_pkg2 is
+  function my_func return natural is
+  begin
+    return 7;
+  end;
+end repro3_pkg2;
+
+use work.repro3_pkg2.all;
+
+entity repro3 is
+end;
+
+architecture arch of repro3 is
+begin
+  assert sh.get = 6 severity failure;
+end;

testsuite/gna/issue2510/testsuite.sh

@@ -0,0 +1,21 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+GHDL_STD_FLAGS=--std=08
+
+analyze repro1.vhdl
+elab_simulate_failure repro1
+
+analyze repro2.vhdl
+
+analyze repro3.vhdl
+
+if ghdl_is_preelaboration; then
+    elab_simulate_failure repro3
+fi
+
+
+clean
+
+echo "Test successful"