From d6a8f93b543ede48005000d90612060ef05cfd8c Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sat, 10 Apr 2021 21:07:58 +0200
Subject: testsuite/gna: add a test for #1717

---
 testsuite/gna/issue1717/package.vhdl | 50 ++++++++++++++++++++++++++++++++++++
 testsuite/gna/issue1717/testsuite.sh | 10 ++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 testsuite/gna/issue1717/package.vhdl
 create mode 100755 testsuite/gna/issue1717/testsuite.sh

(limited to 'testsuite')

diff --git a/testsuite/gna/issue1717/package.vhdl b/testsuite/gna/issue1717/package.vhdl
new file mode 100644
index 000000000..89f54a9f3
--- /dev/null
+++ b/testsuite/gna/issue1717/package.vhdl
@@ -0,0 +1,50 @@
+package generic_list_mwe_pkg is
+  generic (
+    type g_element_t);
+
+  type elementp_t is access g_element_t;
+
+  type g_list is protected
+
+    impure function pull return g_element_t;
+
+  end protected;
+
+end package generic_list_mwe_pkg;
+
+package body generic_list_mwe_pkg is
+
+  type g_list is protected body
+    type list_obj_t;
+    type listp_t is access list_obj_t;
+
+    type list_obj_t is record
+      element : elementp_t;             -- pointer to element                                                                                                                                               
+      nxt     : listp_t;                -- pointer to next list_obj                                                                                                                                         
+    end record;
+
+    variable list : listp_t;
+
+    impure function pull
+      return g_element_t is
+      variable v_list : listp_t;
+      variable v_elementp : elementp_t;
+      impure function delete_and_return
+        return g_element_t is
+        variable ret : v_elementp.all'subtype;
+      begin  -- function delete_and_return                                                                                                                                                                  
+        ret := v_elementp.all;    -- Create a constrained copy of last element in list                                                                                                                      
+        list := list.nxt;
+        deallocate(v_list.element);
+        deallocate(v_list);
+        return ret;
+      end function delete_and_return;
+    begin
+      assert list/=null report "Tried to pull element from empty list" severity error;
+      v_list     := list;
+      v_elementp := list.element;
+      return delete_and_return;
+    end function;
+  end protected body;
+      
+end generic_list_mwe_pkg;
diff --git a/testsuite/gna/issue1717/testsuite.sh b/testsuite/gna/issue1717/testsuite.sh
new file mode 100755
index 000000000..03e9b6b52
--- /dev/null
+++ b/testsuite/gna/issue1717/testsuite.sh
@@ -0,0 +1,10 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+export GHDL_STD_FLAGS=--std=08
+analyze package.vhdl
+
+clean
+
+echo "Test successful"
-- 
cgit v1.2.3