Add testcase for #807

5 files changed, 262 insertions, 0 deletions

diff --git a/testsuite/gna/issue807/repro.vhdl b/testsuite/gna/issue807/repro.vhdl
new file mode 100644
index 000000000..1e57d8bf2
--- /dev/null
+++ b/testsuite/gna/issue807/repro.vhdl
@@ -0,0 +1,20 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+use work.test_pkg.all;
+
+entity test is
+end entity;
+
+architecture a of test is
+begin
+
+  process
+    variable rec : record_t(data(7 downto 0));
+  begin
+    test_procedure(rec);
+    report to_string(rec.data);
+    wait;
+  end process;
+
+end architecture;
diff --git a/testsuite/gna/issue807/reproct.vhdl b/testsuite/gna/issue807/reproct.vhdl
new file mode 100644
index 000000000..d8a82eec2
--- /dev/null
+++ b/testsuite/gna/issue807/reproct.vhdl
@@ -0,0 +1,43 @@
+entity reproct is
+   generic ( lowb : integer := 1 ;
+             highb : integer := 10 ;
+             lowb_i2 : integer := 0 ;
+             highb_i2 : integer := 1000 );
+   
+   constant c_boolean_1 : boolean := false ;
+   constant c_boolean_2 : boolean := true ;
+   constant c_integer_1 : integer := lowb ;
+   constant c_integer_2 : integer := highb ;
+   constant c_time_1 : time := 1 ns ;
+   constant c_time_2 : time := 2 ns ;
+   constant c_real_1 : real := 0.0 ;
+   constant c_real_2 : real := 1.0 ;
+
+   type     t_rec1 is record
+              f1 : integer range lowb_i2 to highb_i2 ;
+              f2 : time ;
+              f3 : boolean ;
+              f4 : real ;
+           end record ;
+  constant c_t_rec1_1 : t_rec1 :=
+                          (c_integer_1, c_time_1, c_boolean_1, c_real_1) ;
+  constant c_t_rec1_2 : t_rec1 :=
+                          (c_integer_2, c_time_2, c_boolean_2, c_real_2) ;
+  subtype  st_rec1 is t_rec1 ;
+  constant c_st_rec1_1 : st_rec1 := c_t_rec1_1 ;
+  constant c_st_rec1_2 : st_rec1 := c_t_rec1_2 ;
+
+end;
+
+architecture ARCH of reproct is
+   signal i_t_rec1_1, i_t_rec1_2 : st_rec1
+       := c_st_rec1_1 ;
+begin
+   L1:
+   block
+   port (i_t_rec1_1 : inout t_rec1 := c_st_rec1_1 ) ;
+   port map (i_t_rec1_1) ;
+   begin
+         i_t_rec1_1 <= c_st_rec1_2 ;
+   end block L1 ;
+end ARCH ;
diff --git a/testsuite/gna/issue807/repropoc.vhdl b/testsuite/gna/issue807/repropoc.vhdl
new file mode 100644
index 000000000..814f44409
--- /dev/null
+++ b/testsuite/gna/issue807/repropoc.vhdl
@@ -0,0 +1,136 @@
+entity repropoc is
+end ;
+
+library	IEEE;
+use			IEEE.std_logic_1164.all;
+
+package config_private is
+  -- TODO: 
+  -- ===========================================================================
+  subtype T_BOARD_STRING is STRING(1 to 16);
+  subtype T_BOARD_CONFIG_STRING is STRING(1 to 64);
+  subtype T_DEVICE_STRING is STRING(1 to 32);
+
+  -- Data structures to describe UART / RS232
+  type T_BOARD_UART_DESC is record
+    IsDTE : BOOLEAN; -- Data terminal Equipment (e.g. PC, Printer)
+    FlowControl : T_BOARD_CONFIG_STRING; -- (NONE, SW, HW_CTS_RTS, HW_RTR_RTS)
+    BaudRate : T_BOARD_CONFIG_STRING;		-- e.g. "115.2 kBd"
+    BaudRate_Max : T_BOARD_CONFIG_STRING;
+  end record;
+	
+  -- Data structures to describe Ethernet
+  type T_BOARD_ETHERNET_DESC is record
+    IPStyle : T_BOARD_CONFIG_STRING;
+    RS_DataInterface : T_BOARD_CONFIG_STRING;
+    PHY_Device : T_BOARD_CONFIG_STRING;
+    PHY_DeviceAddress : STD_LOGIC_VECTOR(7 downto 0);
+    PHY_DataInterface : T_BOARD_CONFIG_STRING;
+    PHY_ManagementInterface : T_BOARD_CONFIG_STRING;
+  end record;
+
+  subtype T_BOARD_ETHERNET_DESC_INDEX is NATURAL range 0 to 7;
+  type T_BOARD_ETHERNET_DESC_VECTOR is array(NATURAL range <>) of T_BOARD_ETHERNET_DESC;
+
+  -- Data structures to describe a board layout
+  type T_BOARD_INFO is record
+    BoardName : T_BOARD_CONFIG_STRING;
+    FPGADevice : T_BOARD_CONFIG_STRING;
+    UART : T_BOARD_UART_DESC;
+    Ethernet : T_BOARD_ETHERNET_DESC_VECTOR(T_BOARD_ETHERNET_DESC_INDEX);
+    EthernetCount : T_BOARD_ETHERNET_DESC_INDEX;
+  end record;
+
+  type T_BOARD_INFO_VECTOR is array (natural range <>) of T_BOARD_INFO;
+
+  constant C_POC_NUL : CHARACTER;
+  constant C_BOARD_STRING_EMPTY : T_BOARD_STRING;
+  constant C_BOARD_CONFIG_STRING_EMPTY	: T_BOARD_CONFIG_STRING;
+  constant C_DEVICE_STRING_EMPTY : T_DEVICE_STRING;
+  CONSTANT C_BOARD_INFO_LIST : T_BOARD_INFO_VECTOR;
+end package;
+
+
+package body config_private is
+  constant C_POC_NUL : CHARACTER := '~';
+  constant C_BOARD_STRING_EMPTY : T_BOARD_STRING := (others => C_POC_NUL);
+  constant C_BOARD_CONFIG_STRING_EMPTY	: T_BOARD_CONFIG_STRING		:= (others => C_POC_NUL);
+  constant C_DEVICE_STRING_EMPTY : T_DEVICE_STRING := (others => C_POC_NUL);
+
+  function conf(str : string) return T_BOARD_CONFIG_STRING is
+    constant ConstNUL : STRING(1 to 1) := (others => C_POC_NUL);
+    variable Result : STRING(1 to T_BOARD_CONFIG_STRING'length);
+  begin
+    Result := (others => C_POC_NUL);
+    if (str'length > 0) then
+      Result(1 to str'length) := str;
+    end if;
+    return Result;
+  end function;
+	
+  constant C_BOARD_ETHERNET_DESC_EMPTY	: T_BOARD_ETHERNET_DESC		:= (
+    IPStyle => C_BOARD_CONFIG_STRING_EMPTY,
+    RS_DataInterface => C_BOARD_CONFIG_STRING_EMPTY,
+    PHY_Device => C_BOARD_CONFIG_STRING_EMPTY,
+    PHY_DeviceAddress => x"00",
+    PHY_DataInterface => C_BOARD_CONFIG_STRING_EMPTY,
+    PHY_ManagementInterface => C_BOARD_CONFIG_STRING_EMPTY
+    );      
+	
+  -- predefined UART descriptions
+  function brd_CreateUART(IsDTE : BOOLEAN; FlowControl : STRING; BaudRate : STRING; BaudRate_Max : STRING := "") return T_BOARD_UART_DESC is
+    variable Result			: T_BOARD_UART_DESC;
+  begin
+    Result.IsDTE				:= IsDTE;
+    Result.FlowControl	:= conf(FlowControl);
+    Result.BaudRate			:= conf(BaudRate);
+    Result.BaudRate_Max	:= conf(BaudRate);
+    return Result;
+  end function;
+	
+  constant C_BOARD_UART_EMPTY : T_BOARD_UART_DESC :=
+    brd_CreateUART(TRUE, "NONE", "0 Bd");
+
+  function brd_CreateEthernet(IPStyle : STRING; RS_DataInt : STRING;
+                              PHY_Device : STRING;
+                              PHY_DevAddress : STD_LOGIC_VECTOR(7 downto 0);
+                              PHY_DataInt : STRING;
+                              PHY_MgntInt : STRING)
+    return T_BOARD_ETHERNET_DESC is
+    variable Result		: T_BOARD_ETHERNET_DESC;
+  begin
+    Result.IPStyle := conf(IPStyle);
+    Result.RS_DataInterface := conf(RS_DataInt);
+    Result.PHY_Device := conf(PHY_Device);
+    Result.PHY_DeviceAddress := PHY_DevAddress;
+    Result.PHY_DataInterface := conf(PHY_DataInt);
+    Result.PHY_ManagementInterface	:= conf(PHY_MgntInt);
+    return Result;
+  end function;
+
+  constant C_BOARD_ETH_EMPTY : T_BOARD_ETHERNET_DESC :=
+    brd_CreateEthernet("", "", "", x"00", "", "");
+	
+  constant C_BOARD_ETH_NONE : T_BOARD_ETHERNET_DESC_VECTOR(T_BOARD_ETHERNET_DESC_INDEX)	:= (others => C_BOARD_ETH_EMPTY);
+
+
+  -- Board Descriptions
+  -- =========================================================================
+  CONSTANT C_BOARD_INFO_LIST : T_BOARD_INFO_VECTOR := (
+    -- Custom Board (MUST BE LAST ONE)
+    -- ======================================================================
+    1 => (
+      BoardName => conf("Custom"),
+      FPGADevice => conf("Device is unknown for a custom board"),
+      UART => C_BOARD_UART_EMPTY,
+      Ethernet => C_BOARD_ETH_NONE,
+      EthernetCount =>	0
+      )
+    );
+end package body;
+
+
+use work.config_private.all;
+architecture behav of repropoc is
+begin
+end behav;
diff --git a/testsuite/gna/issue807/test.vhdl b/testsuite/gna/issue807/test.vhdl
new file mode 100644
index 000000000..6061d1c8e
--- /dev/null
+++ b/testsuite/gna/issue807/test.vhdl
@@ -0,0 +1,44 @@
+library ieee;
+use ieee.std_logic_1164.all;
+
+package test_pkg is
+
+  type record_t is record
+    data : std_ulogic_vector;
+  end record;
+
+  procedure test_procedure(
+    variable rec : out record_t);
+
+  function test_function
+    return record_t;
+
+  function get_data
+    return std_ulogic_vector;
+
+end package;
+
+package body test_pkg is
+
+  procedure test_procedure(
+    variable rec : out record_t)
+  is
+  begin
+    rec := test_function;
+  end procedure;
+
+  function test_function
+    return record_t
+  is
+  begin
+    return (data => get_data);
+  end function;
+
+  function get_data
+    return std_ulogic_vector
+  is
+  begin
+    return x"0F";
+  end function;
+
+end package body;
diff --git a/testsuite/gna/issue807/testsuite.sh b/testsuite/gna/issue807/testsuite.sh
new file mode 100755
index 000000000..e4f645694
--- /dev/null
+++ b/testsuite/gna/issue807/testsuite.sh
@@ -0,0 +1,19 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze repropoc.vhdl
+elab_simulate repropoc
+
+analyze reproct.vhdl
+elab_simulate reproct
+
+clean
+
+export GHDL_STD_FLAGS=--std=08
+analyze test.vhdl repro.vhdl
+elab_simulate test
+
+clean
+
+echo "Test successful"