aboutsummaryrefslogtreecommitdiffstats
path: root/testsuite/gna/issue797
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-04-15 20:36:07 +0200
committerTristan Gingold <tgingold@free.fr>2019-04-15 20:36:07 +0200
commit3e0a352ff5ea20c6cf59be4cb09b223f218f02c3 (patch)
tree44778b5541655bc2e0a2ffb94059eaf01563d46d /testsuite/gna/issue797
parent898ef1b4e181e4bf46c045f6e56fb70ef8e5b04d (diff)
downloadghdl-3e0a352ff5ea20c6cf59be4cb09b223f218f02c3.tar.gz
ghdl-3e0a352ff5ea20c6cf59be4cb09b223f218f02c3.tar.bz2
ghdl-3e0a352ff5ea20c6cf59be4cb09b223f218f02c3.zip
Add reproducer for #797
Diffstat (limited to 'testsuite/gna/issue797')
-rw-r--r--testsuite/gna/issue797/main.c25
-rw-r--r--testsuite/gna/issue797/pkg_c.vhdl71
-rw-r--r--testsuite/gna/issue797/repro.vhdl21
-rw-r--r--testsuite/gna/issue797/tb.vhdl19
-rwxr-xr-xtestsuite/gna/issue797/testsuite.sh12
5 files changed, 148 insertions, 0 deletions
diff --git a/testsuite/gna/issue797/main.c b/testsuite/gna/issue797/main.c
new file mode 100644
index 000000000..a6b9cc21c
--- /dev/null
+++ b/testsuite/gna/issue797/main.c
@@ -0,0 +1,25 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+
+extern int ghdl_main (int argc, char **argv);
+
+uint8_t *D[1];
+uintptr_t get_addr(uint8_t id) { return (uintptr_t)D[id]; }
+uintptr_t get_baddr(uint8_t id) { return get_addr(id); }
+
+int main(int argc, char **argv) {
+ const uint32_t length = 3;
+ D[0] = (uint8_t *) malloc(2*length*sizeof(uint8_t));
+ if ( D[0] == NULL ) {
+ perror("execution of malloc() failed!\n");
+ return -1;
+ }
+ int i;
+ for(i=0; i<length; i++) { D[0][i] = (i+1)*10; }
+ for(i=0; i<2*length; i++) { printf("%d: %d\n", i, D[0][i]); }
+ ghdl_main(argc, argv);
+ for(i=0; i<2*length; i++) { printf("%d: %d\n", i, D[0][i]); }
+ free(D[0]);
+ return 0;
+}
diff --git a/testsuite/gna/issue797/pkg_c.vhdl b/testsuite/gna/issue797/pkg_c.vhdl
new file mode 100644
index 000000000..1eb678eee
--- /dev/null
+++ b/testsuite/gna/issue797/pkg_c.vhdl
@@ -0,0 +1,71 @@
+package pkg_c is
+
+ type byte_vector_access_t is access string;
+ type extbuf_access_t is access string(1 to integer'high);
+
+ impure function
+ get_addr(
+ id : integer
+ ) return extbuf_access_t;
+ attribute foreign of get_addr : function is "VHPIDIRECT get_addr";
+
+ impure function
+ get_baddr(
+ id : integer
+ ) return byte_vector_access_t;
+ attribute foreign of get_baddr : function is "VHPIDIRECT get_baddr";
+
+ procedure
+ set(
+ index : natural;
+ value : natural
+ );
+
+ impure function
+ get(
+ index : natural
+ ) return natural;
+end pkg_c;
+
+package body pkg_c is
+ impure function
+ get_addr(
+ id : integer
+ ) return extbuf_access_t is begin
+ assert false report "VHPI get_addr" severity failure;
+ end;
+
+ impure function
+ get_baddr(
+ id : integer
+ ) return byte_vector_access_t is begin
+ assert false report "VHPI get_baddr" severity failure;
+ end;
+
+ procedure
+ set(
+ index : natural;
+ value : natural
+ ) is
+ variable a : extbuf_access_t := get_addr(0);
+ variable b : byte_vector_access_t := get_baddr(0);
+ variable c : byte_vector_access_t(1 to integer'high) := get_baddr(0);
+ begin
+ a(index+1) := character'val(value);
+ --b(index+1) := character'val(value);
+ c(index+1) := character'val(value);
+ end;
+
+ impure function
+ get(
+ index : natural
+ ) return natural is
+ variable a : extbuf_access_t := get_addr(0);
+ variable b : byte_vector_access_t := get_baddr(0);
+ variable c : byte_vector_access_t(1 to integer'high) := get_baddr(0);
+ begin
+ return character'pos(a(index+1));
+ --return character'pos(b(index+1));
+ return character'pos(c(index+1));
+ end;
+end pkg_c;
diff --git a/testsuite/gna/issue797/repro.vhdl b/testsuite/gna/issue797/repro.vhdl
new file mode 100644
index 000000000..f426ac1d0
--- /dev/null
+++ b/testsuite/gna/issue797/repro.vhdl
@@ -0,0 +1,21 @@
+entity repro is
+end;
+
+architecture behav of repro is
+ type byte_vector_access_t is access string;
+
+ procedure set(index : natural; c : character) is
+ variable v : byte_vector_access_t(1 to integer'high);
+ begin
+ v(index+1) := c;
+ end;
+begin
+ process
+ begin
+ if now > 1 ns then
+ set (1, 'a');
+ end if;
+ wait;
+ end process;
+end behav;
+
diff --git a/testsuite/gna/issue797/tb.vhdl b/testsuite/gna/issue797/tb.vhdl
new file mode 100644
index 000000000..2e173fed8
--- /dev/null
+++ b/testsuite/gna/issue797/tb.vhdl
@@ -0,0 +1,19 @@
+use work.pkg_c.all;
+
+entity test is
+end entity;
+
+architecture tb of test is
+ constant block_len : natural := 3;
+begin
+ main: process
+ variable val: integer;
+ begin
+ report "HELLO" severity note;
+ for x in 0 to block_len-1 loop
+ val := get(x);
+ set(block_len+x, val+1);
+ end loop;
+ wait;
+ end process;
+end architecture;
diff --git a/testsuite/gna/issue797/testsuite.sh b/testsuite/gna/issue797/testsuite.sh
new file mode 100755
index 000000000..09cae1076
--- /dev/null
+++ b/testsuite/gna/issue797/testsuite.sh
@@ -0,0 +1,12 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze repro.vhdl
+elab_simulate repro
+
+analyze pkg_c.vhdl
+
+clean
+
+echo "Test successful"