testsuite/gna: add testcase for #1597

5 files changed, 551 insertions, 0 deletions

diff --git a/testsuite/gna/issue1597/proc_pkg.vhdl b/testsuite/gna/issue1597/proc_pkg.vhdl
new file mode 100644
index 000000000..7a12aafda
--- /dev/null
+++ b/testsuite/gna/issue1597/proc_pkg.vhdl
@@ -0,0 +1,212 @@
+------------------------------------------------
+--!  Test intent : declaration of procedure in package
+--!  Test scope  : function with active checking
+--!  Keywords    : [function, attribute, active]
+--!  References  : [VH2000 1.1:]
+--!                [Rlink REQ00:2.1.1.2.1]
+--!                [Rlink REQ00:14.1.38]
+--
+-------------------------------------------------
+--  declare a procedures and functions to demonstrate
+--  attributes.
+--    with partially driven bus we should see ativity as expected.
+--   
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.std_logic_arith.all;
+use ieee.std_logic_unsigned.all;
+use work.subs_pkg.all;
+
+package proc_pkg is
+
+  type ctl_if_t is record
+    d1 : std_logic_vector(31 downto 0);
+    d2 : std_logic_vector(31 downto 0);
+    a1 : std_logic_vector(15 downto 0);
+    wr  : std_logic;
+    di  : std_logic_vector(63 downto 0);
+    dv  : std_logic;
+  end record;
+
+  type rsp_if_t is record
+    do1 : std_logic_vector(31 downto 0);
+    do2 : std_logic_vector(31 downto 0);
+    sel : std_logic_vector(3 downto 0);
+    addr : std_logic_vector(11 downto 0);
+    do  : std_logic_vector(63 downto 0);
+  end record;
+
+  type marr_t is array(15 downto 0) of std_logic_vector(63 downto 0);
+  type arr_marr_t is array(3 downto 0) of marr_t;
+
+  procedure mem_access(signal ctl : in ctl_if_t;
+                       signal rsp : out rsp_if_t;
+                       signal mem : inout arr_marr_t;
+                       signal ack : out std_logic);
+
+  procedure mem_obj(signal mem : in marr_t;
+                    signal addr : in std_logic_vector(11 downto 0);
+                    signal wr : in std_logic;
+                    signal w_in : in std_logic_vector(63 downto 0);
+                    signal mem_out : out marr_t;
+                    signal dout : out std_logic_vector(63 downto 0)
+                    );
+
+  procedure proc_mix(signal val1 : in std_logic_vector;
+                     signal val2 : in std_logic_vector);
+
+  function kslv2int(vec : std_logic_vector) return integer;
+  
+  function active_bit(signal vec : std_logic_vector;
+                      idx : integer) return boolean;
+
+  function active_bits(signal vec : std_logic_vector) return std_logic_vector;
+
+  procedure act_mon(signal ctl : in ctl_if_t;
+                    signal rsp : in rsp_if_t;
+                    signal act : out boolean
+                    );
+
+end package proc_pkg;
+
+package body proc_pkg is
+
+  --  activity  functions.
+  function active_bit(signal vec : std_logic_vector;
+                      idx : integer) return boolean is
+  begin
+    return vec(idx)'active;
+  end function;
+  
+
+  function active_bits(signal vec : std_logic_vector) return std_logic_vector is
+    variable rtnv : std_logic_vector(vec'range);
+  begin
+    for i in vec'range loop
+      if active_bit(vec, i) then
+        rtnv(i) := '1';
+      else
+        rtnv(i) := '0';
+      end if;
+    end loop;
+    return rtnv;
+  end function;
+
+
+  -- convert std_logic_vector to integer.
+  function kslv2int(vec : std_logic_vector) return integer is
+    variable rtn : integer := 0;
+    variable len : integer := (vec'length) - 1;
+  begin
+    --report "Vector in: " & slv2str(vec);
+    for i in vec'range loop
+      if vec(i) = '1' then
+        rtn := rtn + (2**i);
+      end if;
+    end loop;
+    --report "Integer out: " & integer'image(rtn);
+    return rtn;
+  end function;
+
+  procedure act_mon(signal ctl : in ctl_if_t;
+                    signal rsp : in rsp_if_t;
+                    signal act : out boolean
+                    ) is
+  variable delta : integer := 0;
+  variable ltime : time;
+  begin
+    while true loop
+      act <= false;
+      if ctl'active then
+        report "ctl is active ...";
+      end if;
+      
+      if rsp'active then
+        report "rsp is active ...";
+      end if;
+      
+      if ctl'active or rsp'active then
+        if ltime = now then
+          delta := delta + 1;
+        else
+          delta := 0;
+        end if;
+        report "delta now at: " & integer'image(delta);
+        act <= true;
+      end if;
+      ltime := now;
+      --wait for 0 ps;
+      wait on ctl, rsp;
+    end loop;
+  end procedure;
+  
+
+
+  -- access the memory passed.
+  procedure mem_obj(signal mem : in marr_t;
+                    signal addr : in std_logic_vector(11 downto 0);
+                    signal wr : in std_logic;
+                    signal w_in : in std_logic_vector(63 downto 0);
+                    signal mem_out : out marr_t;
+                    signal dout : out std_logic_vector(63 downto 0)
+                    ) is
+    variable idx : integer := 0;
+  begin
+    idx := kslv2int(addr);
+    --report integer'image(idx);
+    dout(63 downto 16) <= mem(kslv2int(addr(3 downto 0)))(63 downto 16);
+    mem_out <= mem;
+    if wr = '1' then
+      --report "Writing mem ...";
+      mem_out(kslv2int(addr(3 downto 0))) <= w_in;
+    end if;
+    wait for 0 ps;
+  end procedure;
+
+  -- do a request for memory access.
+  procedure mem_access(signal ctl : in ctl_if_t;
+                       signal rsp : out rsp_if_t;
+                       signal mem : inout arr_marr_t;
+                       signal ack : out std_logic) is
+    --variable rsp_v : std_logic;
+    variable idx : integer;
+  begin
+    ack <= '0';
+    case ctl.a1(7 downto 4) is
+      when "0000" =>
+        mem_obj(mem(0), ctl.a1(11 downto 0), ctl.wr, ctl.di, mem(0), rsp.do);
+      when "0001" =>
+        mem_obj(mem(1), ctl.a1(11 downto 0), ctl.wr, ctl.di, mem(1), rsp.do);
+      when "0010" =>
+        mem_obj(mem(2), ctl.a1(11 downto 0), ctl.wr, ctl.di, mem(2), rsp.do);
+      when "0011" =>
+        mem_obj(mem(3), ctl.a1(11 downto 0), ctl.wr, ctl.di, mem(3), rsp.do);
+      when others =>
+        mem_obj(mem(0), ctl.a1(11 downto 0), ctl.wr, ctl.di, mem(0), rsp.do);
+    end case;
+  
+    ack <= '1';
+    --wait until  = '1';
+  end procedure;
+    
+    --  the test procedure implemenation
+    procedure proc_mix(signal val1 : in std_logic_vector;
+                       signal val2 : in std_logic_vector) is
+      variable tmp : bit_vector(val1'high downto val1'low);
+      variable tmp2 : bit_vector(val2'high downto val2'low);
+    begin
+      report "-----  start of call  ----";
+      wait for 0.5 ns;   --<<  get us off the rising edge event let data settle
+      tmp := to_bitvector(val1);
+      report "val1 got: " & bv2str(tmp);
+      tmp2 := to_bitvector(val2);
+      report "val2 got: " & bv2str(tmp2);
+      wait for 2 ns;   --<<  get us off the rising edge after next data change.
+      report "-----   then  ----";
+      tmp := to_bitvector(val1);
+      report "val1 got: " & bv2str(tmp);
+      tmp2 := to_bitvector(val2);
+      report "val2 got: " & bv2str(tmp2);
+    end procedure;
+    
+end proc_pkg;
diff --git a/testsuite/gna/issue1597/repro.vhdl b/testsuite/gna/issue1597/repro.vhdl
new file mode 100644
index 000000000..2789bf61f
--- /dev/null
+++ b/testsuite/gna/issue1597/repro.vhdl
@@ -0,0 +1,16 @@
+entity repro is
+  port (b : bit_vector (7 downto 0));
+end;
+
+architecture behav of repro is
+begin
+  process
+  begin
+    for i in b'range loop
+      if b(i)'active then
+        report "active";
+      end if;
+    end loop;
+    wait for 1 ns;
+  end process;
+end behav;
diff --git a/testsuite/gna/issue1597/std_subs_pkg.vhdl b/testsuite/gna/issue1597/std_subs_pkg.vhdl
new file mode 100644
index 000000000..045230631
--- /dev/null
+++ b/testsuite/gna/issue1597/std_subs_pkg.vhdl
@@ -0,0 +1,160 @@
+------------------------------------------------
+--  Test intent : collection of useful functions and procs
+--  Test scope  : Basic File write of type character
+--  Keywords    : [function, procedure]
+--!  References    [VH1993 3.4: ]
+--!                [VH2019 5.5: ]
+-------------------------------------------------
+--  
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+package subs_pkg is
+
+  --  procedures
+  procedure msg(str : in string);  -- output a system message string.
+
+  --  functions
+  function bv2str(bv: bit_vector) return string; -- convert bit_vector to string
+  function slv2str(slv: std_logic_vector) return string; -- convert std_logic_vector to string
+  function sulv2str(sulv: std_ulogic_vector) return string; -- convert std_ulogic_vector to string
+  function klsfr(bv: bit_vector) return bit_vector;  -- do LSFR on bit_vector 8, 16 32
+  function klsfr(bv: std_logic_vector) return std_logic_vector;  -- do LSFR on bit_vector 8, 16 32
+  
+end;
+
+package body subs_pkg is
+
+  -- simple message output.
+  procedure msg(str : in string) is
+  begin 
+    report "System Message: " & str;
+  end procedure;
+
+
+  --  take in bit_vector return string.
+  function bv2str(bv: bit_vector) return string is
+    variable st_out : string(1 to bv'length);
+    alias v : bit_vector(1 to bv'length) is bv;
+  begin
+    for i in v'range loop
+      if(v(i) = '0') then
+        st_out(i) := '0';
+      else
+        st_out(i) := '1';
+      end if;
+    end loop;
+    return st_out;
+  end function;
+    
+  --  take in std_logic_vector return string.
+  function slv2str(slv: std_logic_vector) return string is
+    variable st_out  : string(1 to slv'length);
+    alias v : std_logic_vector(1 to slv'length) is slv; 
+  begin 
+    for i in v'range loop 
+      case v(i) is 
+        when 'U' => 
+          st_out(i) := 'U'; 
+        when 'X' => 
+          st_out(i) := 'X'; 
+        when '0' => 
+          st_out(i) := '0'; 
+        when '1' => 
+          st_out(i) := '1'; 
+        when 'Z' => 
+          st_out(i) := 'Z'; 
+        when 'W' => 
+          st_out(i) := 'W'; 
+        when 'L' => 
+          st_out(i) := 'L'; 
+        when 'H' => 
+          st_out(i) := 'H'; 
+        when '-' => 
+          st_out(i) := '-'; 
+        when others => 
+          assert false report "STD_LOGIC_VALUE not in value set." severity failure; 
+      end case; 
+    end loop; 
+    return st_out; 
+  end function; 
+  
+  -- to 
+  function sulv2str(sulv: std_ulogic_vector) return string is
+    variable st_out  : string(1 to sulv'length);
+    alias v : std_ulogic_vector(1 to sulv'length) is sulv; 
+  begin
+    for i in v'range loop 
+      case v(i) is 
+        when 'U' => 
+          st_out(i) := 'U'; 
+        when 'X' => 
+          st_out(i) := 'X'; 
+        when '0' => 
+          st_out(i) := '0'; 
+        when '1' => 
+          st_out(i) := '1'; 
+        when 'Z' => 
+          st_out(i) := 'Z'; 
+        when 'W' => 
+          st_out(i) := 'W'; 
+        when 'L' => 
+          st_out(i) := 'L'; 
+        when 'H' => 
+          st_out(i) := 'H'; 
+        when '-' => 
+          st_out(i) := '-'; 
+        when others => 
+          assert false report "STD_ULOGIC_VALUE not in value set." severity failure; 
+      end case; 
+    end loop; 
+    return st_out; 
+      --return slv2str(std_logic_vector(to_unsigned(sulv)));
+  end function;
+    
+  -- bitvector lsfr
+  function klsfr(bv: bit_vector) return bit_vector is
+    alias v : bit_vector(bv'high downto 0) is bv;
+    variable rtn : bit_vector(bv'high downto 0);
+    variable len : integer := bv'length;
+  begin
+    case len is
+      when 8 =>
+        rtn := v(6 downto 0) & ((v(7) xor v(4)) xor (v(1) xor v(2)));
+      when 16 =>
+        rtn := v(14 downto 0) & ((v(15) xor v(14)) xor (v(12) xor v(3)));
+      when 32 =>
+        rtn := v(30 downto 0) & ((v(31) xor v(6)) xor (v(5) xor v(1)));
+      when others =>
+        report "ERROR: LSFR size not implemented ..." severity failure;
+    end case;
+    return rtn;
+  end function;
+    
+  function klsfr(bv: std_logic_vector) return std_logic_vector is
+    alias v : std_logic_vector(bv'high downto 0) is bv;
+    variable rtn : std_logic_vector(bv'high downto 0);
+    variable len : integer := bv'length;
+  begin
+    for i in bv'range loop
+      if (bv(i) /= '1' and
+         bv(i) /= '0') then
+        report "klsfr got a none logic value passed ..." severity failure;
+      end if;
+    end loop;
+  
+    case len is
+      when 8 =>
+        rtn := v(6 downto 0) & ((v(7) xor v(4)) xor (v(1) xor v(2)));
+      when 16 =>
+        rtn := v(14 downto 0) & ((v(15) xor v(14)) xor (v(12) xor v(3)));
+      when 32 =>
+        rtn := v(30 downto 0) & ((v(31) xor v(6)) xor (v(5) xor v(1)));
+      when others =>
+        report "ERROR: LSFR size not implemented ..." severity failure;
+    end case;
+    return rtn;
+  end function;
+    
+end package body;
diff --git a/testsuite/gna/issue1597/test.vhdl b/testsuite/gna/issue1597/test.vhdl
new file mode 100644
index 000000000..7c71069bb
--- /dev/null
+++ b/testsuite/gna/issue1597/test.vhdl
@@ -0,0 +1,152 @@
+------------------------------------------------
+--!  Test intent : Procedure calls with signals parameters.
+--!  Test scope  : Checking activity with  'active
+--!  Keywords    : [procedure, parameters, signal]
+--!  References  : [VH2000 1.1:]
+--!                [Rlink REQ00:2.1.1.2.1]
+--!                [Rlink REQ00:2.1.1.2.4]
+--
+-------------------------------------------------
+--  'active 
+-- 
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.std_logic_unsigned.all;
+use work.subs_pkg.all;
+use work.proc_pkg.all;
+use work.all;
+
+entity pf7 is
+end entity;
+
+architecture tb of pf7 is
+
+  signal tclk : std_logic := '0';
+  signal trst : std_logic := '0';
+  signal tper : integer := 1;
+  
+  signal u1_in:  std_logic_vector(7 downto 0);
+  signal u1_out: std_logic_vector(7 downto 0);
+  signal u2_in:  std_logic_vector(7 downto 0);
+  signal u2_out: std_logic_vector(7 downto 0);
+  
+  signal gen_out : std_logic_vector(15 downto 0);
+  
+  signal mems : arr_marr_t;
+  
+  signal mem_if_in : ctl_if_t;
+  signal mem_if_out : rsp_if_t;
+  signal mon_if_in : ctl_if_t;
+  signal mon_if_out : rsp_if_t;
+  signal ackm : std_logic;
+  
+  signal sig_act : boolean;
+
+begin
+
+  act_mon(mem_if_in, mem_if_out, sig_act);
+
+  process(mem_if_in)
+  begin
+    for i in mem_if_in.d1'range loop
+      if mem_if_in.d1(i)'active then
+        report "Bit : " & integer'image(i) & " is active";
+      end if;
+    end loop;
+  end process;
+
+  -- clock
+  clock: process
+  begin
+    tclk <= '0';
+    wait for 1 ns;
+    tclk <= '1';
+    wait for 1 ns;
+  end process;
+  
+  sim_ctl: process
+    variable v_cnt : integer := 0;
+  begin
+    while v_cnt < 5 loop
+      v_cnt := v_cnt + 1;
+      --report "Tick ...";
+      wait until tclk'event and tclk = '1';
+    end loop;
+    report "Passed, END SIM ..." severity failure;
+  end process;
+
+  -- generate some data
+  dgen: process(tclk)
+    variable vec : bit_vector(15 downto 0) := (others => '1');
+  begin
+    if tclk'event and tclk = '1' then
+      vec := klsfr(vec);
+      --report bv2str(vec);
+      gen_out <= to_stdlogicvector(vec);
+      u1_in  <= to_stdlogicvector(vec(7 downto 0));
+      u2_in  <= to_stdlogicvector(vec(15 downto 8));
+    end if;
+  end process;
+
+  --  memory access process
+  mem_acc: process
+    variable addr : std_logic_vector(15 downto 0) := (others => '0');
+    variable idx : integer;
+    variable  init : integer := 0;
+    variable v_tmp_dat : std_logic_vector(63 downto 0);
+  begin
+    if init = 0 then
+      for i in 3 downto 0 loop
+        for j in marr_t'range loop
+          mems(i)(j) <= (others => '0');
+          wait for 0 ps;
+        end loop;
+      end loop;
+      report "Done.";
+      wait for 0 ps;
+      for i in 3 downto 0 loop
+        for j in marr_t'range loop
+          assert kslv2int(mems(i)(j)) = 0 
+            report "ERROR: Ram not initialized"
+            severity failure;
+        end loop;
+      end loop;
+      mem_if_in.d1 <= (others => '0');
+      init := 1;
+      
+    elsif tclk'event and tclk = '1' then
+      mem_access(mem_if_in, mem_if_out, mems, ackm);
+      mem_if_in.wr <= '0';
+      mem_access(mem_if_in, mem_if_out, mems, ackm);
+      --report "Active Drive state: " & slv2str(active_bits(mem_if_out.do));
+      --report "Inactive outputs Drive state: " & slv2str(active_bits(mem_if_out.do1));
+      wait for 0 ps;
+      --report "Inactive Drive state: " & slv2str(active_bits(mem_if_out.do));
+      --report "Data: " & slv2str(mem_if_out.do);
+      if now > 2 ns then
+        assert v_tmp_dat(63 downto 16) = mem_if_out.do(63 downto 16)
+          report "Error:  data missmatch on read ..."
+          severity failure;
+      end if;
+    elsif tclk'event and tclk = '0' then
+      mem_if_in.a1 <= addr;
+      mem_if_in.wr <= '1';
+      addr := addr + 16#0001#;
+      --report "Address: " & slv2str(addr);
+      mem_if_in.di <= gen_out & gen_out(7 downto 0) & gen_out(15 downto 8) & gen_out & gen_out;
+      v_tmp_dat := gen_out & gen_out(7 downto 0) & gen_out(15 downto 8) & gen_out & gen_out;
+      
+      -- generate events on ctl.d1
+      wait for 2 ps;
+      if now > 2 ns then
+        for i in mem_if_in.d1'range loop
+          mem_if_in.d1(i) <= not mem_if_in.d1(i);
+          wait for 0 ps;
+        end loop;
+        report slv2str(mem_if_in.d1);
+      end if;
+    end if;
+    wait on tclk;
+  end process;
+
+end tb;
diff --git a/testsuite/gna/issue1597/testsuite.sh b/testsuite/gna/issue1597/testsuite.sh
new file mode 100755
index 000000000..5640261a6
--- /dev/null
+++ b/testsuite/gna/issue1597/testsuite.sh
@@ -0,0 +1,11 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+GHDL_STD_FLAGS=-fsynopsys
+analyze std_subs_pkg.vhdl
+analyze_failure proc_pkg.vhdl
+
+clean
+
+echo "Test successful"