From 3e0a352ff5ea20c6cf59be4cb09b223f218f02c3 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Mon, 15 Apr 2019 20:36:07 +0200
Subject: Add reproducer for #797

---
 testsuite/gna/issue797/main.c       | 25 +++++++++++++
 testsuite/gna/issue797/pkg_c.vhdl   | 71 +++++++++++++++++++++++++++++++++++++
 testsuite/gna/issue797/repro.vhdl   | 21 +++++++++++
 testsuite/gna/issue797/tb.vhdl      | 19 ++++++++++
 testsuite/gna/issue797/testsuite.sh | 12 +++++++
 5 files changed, 148 insertions(+)
 create mode 100644 testsuite/gna/issue797/main.c
 create mode 100644 testsuite/gna/issue797/pkg_c.vhdl
 create mode 100644 testsuite/gna/issue797/repro.vhdl
 create mode 100644 testsuite/gna/issue797/tb.vhdl
 create mode 100755 testsuite/gna/issue797/testsuite.sh

(limited to 'testsuite')

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"
-- 
cgit v1.2.3