Add gna tests

9 files changed, 397 insertions, 0 deletions

diff --git a/testsuite/gna/bug15368/15368.vhd b/testsuite/gna/bug15638/15368.vhd
index 0c8a50827..0c8a50827 100644
--- a/testsuite/gna/bug15368/15368.vhd
+++ b/testsuite/gna/bug15638/15368.vhd
diff --git a/testsuite/gna/bug15368/testsuite.sh b/testsuite/gna/bug15638/testsuite.sh
index 9de7543d3..9de7543d3 100755
--- a/testsuite/gna/bug15368/testsuite.sh
+++ b/testsuite/gna/bug15638/testsuite.sh
diff --git a/testsuite/gna/bug21332/testsuite.sh b/testsuite/gna/bug21332/testsuite.sh
new file mode 100755
index 000000000..d1c254969
--- /dev/null
+++ b/testsuite/gna/bug21332/testsuite.sh
@@ -0,0 +1,10 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze twoscomplement.vhdl
+elab_simulate_failure test
+
+clean
+
+echo "Test successful"
diff --git a/testsuite/gna/bug21332/twoscomplement.vhdl b/testsuite/gna/bug21332/twoscomplement.vhdl
new file mode 100644
index 000000000..639f04981
--- /dev/null
+++ b/testsuite/gna/bug21332/twoscomplement.vhdl
@@ -0,0 +1,48 @@
+library ieee;
+use ieee.std_logic_1164.all; 
+use ieee.numeric_std.all;
+entity twoscompliment is
+      generic
+      (
+              Nbits : positive := 8 
+       );
+ port 
+( 
+           --Inputs
+           A : in std_logic_vector (Nbits-1 downto 0);
+           --Outputs
+           Y : out std_logic_vector (Nbits downto 0)
+);
+end twoscompliment;
+
+architecture twoscompliment_v1 of twoscompliment is
+    constant ONE:   UNSIGNED(Y'RANGE) := (0 => '1', others => '0');
+begin
+     Y <= std_logic_vector(unsigned (not A) + ONE);
+end twoscompliment_v1;
+
+architecture twoscompliment_v2 of twoscompliment is
+signal temp : std_logic_vector(Nbits-1 downto 0);
+begin
+  temp <= not A;
+  Y    <= std_logic_vector(unsigned(temp) + 1);
+end twoscompliment_v2;
+
+library ieee;
+use ieee.std_logic_1164.all;
+
+entity test is
+end entity;
+
+architecture foo of test is
+    -- counts on default value for Nbits in DUT = 8)
+    signal A:   std_logic_vector (7 downto 0) := (0=>'1', others => '0');  -- ONE
+    signal Y:   std_logic_vector ( 8 downto 0);
+begin
+    DUT: entity work.twoscompliment(twoscompliment_v2)
+    port map (
+        A => A,
+        Y => Y
+    );
+        
+end architecture;
\ No newline at end of file
diff --git a/testsuite/gna/sr2903/boundcheck.vhdl b/testsuite/gna/sr2903/boundcheck.vhdl
new file mode 100644
index 000000000..ee5b3a66d
--- /dev/null
+++ b/testsuite/gna/sr2903/boundcheck.vhdl
@@ -0,0 +1,36 @@
+library IEEE;
+use IEEE.numeric_std.all;
+
+entity tb is
+end tb;
+
+architecture behavioral of tb is
+
+   subtype int31 is integer range -2**(31-1) to 2**(31-1)-1; 
+   type array_7_int31 is array(0 to 6) of int31;   
+  
+  function ASR(v : integer;  n : natural ; nv : natural; nres : natural) return integer is
+    variable tmp : signed(nv downto 0);
+    variable res : signed(nv downto 0);
+    begin
+      tmp := resize(to_signed(v,nv),nv+1);
+      res := shift_right(tmp,n);              
+      return to_integer(res(nres-1 downto 0));
+    end;
+
+begin
+
+  software_emulation : process
+  variable test : int31;
+  variable tmp : int31;
+
+  begin
+    report "Start" severity note;
+	tmp := 5965232;
+    -- test := test + ASR(((tmp * 119304647) + 268435456),29,57,31);
+    -- test := test + ASR(((tmp * 178956971) + 268435456),29,57,31);
+    test := test + ASR(((tmp * 59652324) + 268435456),29,57,31);
+ end process;
+
+ end behavioral;
+
diff --git a/testsuite/gna/sr2903/testsuite.sh b/testsuite/gna/sr2903/testsuite.sh
new file mode 100755
index 000000000..347593b6c
--- /dev/null
+++ b/testsuite/gna/sr2903/testsuite.sh
@@ -0,0 +1,10 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze boundcheck.vhdl
+elab_simulate_failure tb
+
+clean
+
+echo "Test successful"
diff --git a/testsuite/gna/sr2940/GCD.vhd b/testsuite/gna/sr2940/GCD.vhd
new file mode 100644
index 000000000..509b72162
--- /dev/null
+++ b/testsuite/gna/sr2940/GCD.vhd
@@ -0,0 +1,203 @@
+-- module GCD where
+-- 
+-- 
+-- $wmygcd::*Int# -> *Int# -> *Int#
+-- $wmygcd ww ww1 =
+--   let wild::GHC.Types.Bool = (GHC.Prim.==# ww ww1) in
+--   case wild of :: *Int#
+--     GHC.Types.False ->
+--       let wild1::GHC.Types.Bool = (GHC.Prim.<# ww ww1) in
+--       case wild1 of :: *Int#
+--         GHC.Types.False -> ($wmygcd (GHC.Prim.-# ww ww1) ww1)
+--         GHC.Types.True -> ($wmygcd ww (GHC.Prim.-# ww1 ww))
+--     GHC.Types.True -> ww
+-- 
+-- mygcd::GHC.Types.Int -> GHC.Types.Int -> GHC.Types.Int
+-- mygcd w w1 =
+--   let w2::GHC.Types.Int = w in
+--   case w2 of :: GHC.Types.Int
+--     GHC.Types.I# ww::*Int# ->
+--       let w3::GHC.Types.Int = w1 in
+--       case w3 of :: GHC.Types.Int
+--         GHC.Types.I# ww1::*Int# ->
+--           let ww2::*Int# = ($wmygcd ww ww1) in
+--           case ww2 of :: GHC.Types.Int DEFAULT -> (GHC.Types.I# ww2)
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+
+package \GCD\ is
+end \GCD\;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+use work.\GCD\.all;
+
+entity \$wmygcd\ is
+  port (clk : in std_logic;
+        s1_call : in std_logic;
+        s1_ret : out std_logic;
+        s1_ww : in \Int#\;
+        s1_ww1 : in \Int#\;
+        res : out \Int#\);
+end entity;
+
+architecture rtl of \$wmygcd\ is
+  signal tail_call : std_logic;
+  signal tail_ww : \Int#\;
+  signal tail_ww1 : \Int#\;
+  signal core_call : std_logic;
+  signal core_ret : std_logic;
+  signal core_ww : \Int#\;
+  signal core_ww1 : \Int#\;
+  signal s1_act : std_logic;
+  signal s1_wait : std_logic;
+  signal s1_saved_ww : \Int#\;
+  signal s1_saved_ww1 : \Int#\;
+begin
+  process (core_call, core_ww, core_ww1)
+  variable wild : \GHC.Types.Bool\;
+  variable wild1 : \GHC.Types.Bool\;
+  variable ww : \Int#\;
+  variable ww1 : \Int#\;
+  begin
+    ww := core_ww;
+    ww1 := core_ww1;
+    wild := \GHC.Prim.==#\(ww, ww1);
+    if \is_GHC.Types.False\(wild) then
+      wild1 := \GHC.Prim.<#\(ww, ww1);
+      if \is_GHC.Types.False\(wild1) then
+        res <= \$wmygcd\(\GHC.Prim.-#\(ww, ww1), ww1);
+      elsif \is_GHC.Types.True\(wild1) then
+        res <= \$wmygcd\(ww, \GHC.Prim.-#\(ww1, ww));
+      end if;
+    elsif \is_GHC.Types.True\(wild) then res <= ww;
+    end if;
+  end process;
+  
+  process (clk)
+  begin
+    if rising_edge(clk) then
+      core_call <= '0';
+      if s1_call = '1' then
+        s1_wait <= '1';
+        s1_saved_ww <= s1_ww;
+        s1_saved_ww1 <= s1_ww1;
+      end if;
+      if tail_call = '1' then
+        core_call <= '1';
+        core_ww <= tail_ww;
+        core_ww1 <= tail_ww1;
+      elsif core_ret = '1' or s1_act = '1' then
+        s1_act <= '0';
+        if s1_wait = '1' then
+          core_call <= '1';
+          s1_act <= '1';
+          s1_wait <= '0';
+          core_ww <= s1_saved_ww;
+          core_ww1 <= s1_saved_ww1;
+        elsif s1_call = '1' then
+          core_call <= '1';
+          s1_act <= '1';
+          s1_wait <= '0';
+          core_ww <= s1_ww;
+          core_ww1 <= s1_ww1;
+        end if;
+      end if;
+    end if;
+  end process;
+  
+  s1_ret <= core_ret and s1_act;
+  
+end architecture;
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+use work.\Prim\.all;
+use work.\GCD\.all;
+
+entity mygcd is
+  port (clk : in std_logic;
+        s1_call : in std_logic;
+        s1_ret : out std_logic;
+        s1_w : in \GHC.Types.Int\;
+        s1_w1 : in \GHC.Types.Int\;
+        res : out \GHC.Types.Int\);
+end entity;
+
+architecture rtl of mygcd is
+  signal tail_call : std_logic;
+  signal tail_w : \GHC.Types.Int\;
+  signal tail_w1 : \GHC.Types.Int\;
+  signal core_call : std_logic;
+  signal core_ret : std_logic;
+  signal core_w : \GHC.Types.Int\;
+  signal core_w1 : \GHC.Types.Int\;
+  signal s1_act : std_logic;
+  signal s1_wait : std_logic;
+  signal s1_saved_w : \GHC.Types.Int\;
+  signal s1_saved_w1 : \GHC.Types.Int\;
+begin
+  process (core_call, core_w, core_w1)
+  variable w2 : \GHC.Types.Int\;
+  variable ww : \Int#\;
+  variable w3 : \GHC.Types.Int\;
+  variable ww1 : \Int#\;
+  variable ww2 : \Int#\;
+  variable w : \GHC.Types.Int\;
+  variable w1 : \GHC.Types.Int\;
+  begin
+    w := core_w;
+    w1 := core_w1;
+    w2 := w;
+    if \is_GHC.Types.I#\(w2) then
+      \expand_GHC.Types.I#\(w2, ww);
+      w3 := w1;
+      if \is_GHC.Types.I#\(w3) then
+        \expand_GHC.Types.I#\(w3, ww1);
+        ww2 := \$wmygcd\(ww, ww1);
+        res <= \GHC.Types.I#\(ww2);
+      end if;
+    end if;
+  end process;
+  
+  process (clk)
+  begin
+    if rising_edge(clk) then
+      core_call <= '0';
+      if s1_call = '1' then
+        s1_wait <= '1';
+        s1_saved_w <= s1_w;
+        s1_saved_w1 <= s1_w1;
+      end if;
+      if tail_call = '1' then
+        core_call <= '1';
+        core_w <= tail_w;
+        core_w1 <= tail_w1;
+      elsif core_ret = '1' or s1_act = '1' then
+        s1_act <= '0';
+        if s1_wait = '1' then
+          core_call <= '1';
+          s1_act <= '1';
+          s1_wait <= '0';
+          core_w <= s1_saved_w;
+          core_w1 <= s1_saved_w1;
+        elsif s1_call = '1' then
+          core_call <= '1';
+          s1_act <= '1';
+          s1_wait <= '0';
+          core_w <= s1_w;
+          core_w1 <= s1_w1;
+        end if;
+      end if;
+    end if;
+  end process;
+  
+  s1_ret <= core_ret and s1_act;
+  
+end architecture;
+
diff --git a/testsuite/gna/sr2940/Prim.vhd b/testsuite/gna/sr2940/Prim.vhd
new file mode 100644
index 000000000..5bef42fcf
--- /dev/null
+++ b/testsuite/gna/sr2940/Prim.vhd
@@ -0,0 +1,80 @@
+-- Types and functions for Haskell Primitives
+
+library ieee;
+use ieee.std_logic_1164.all;
+use ieee.numeric_std.all;
+
+package \Prim\ is
+
+  subtype \Int#\ is signed(31 downto 0);
+  subtype \GHC.Types.Int\ is signed(31 downto 0);
+  subtype \GHC.Types.Bool\ is std_logic;
+
+  -- Primitive arithmetic operations
+  function \GHC.Prim.==#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\;
+  function \GHC.Prim.<#\  ( a, b : \Int#\ ) return \GHC.Types.Bool\;
+  function \GHC.Prim.-#\  ( a, b : \Int#\ ) return \Int#\;
+
+  -- Data Constructor predicates: each takes a object and returns
+  -- a boolean (i.e., tested with VHDL's if) that indicates whether the
+  -- object was constructed with the given constructor
+  function \is_GHC.Types.False\ (a : \GHC.Types.Bool\) return boolean;
+  function \is_GHC.Types.True\ (a : \GHC.Types.Bool\) return boolean;
+  function \is_GHC.Types.I#\ (a : \GHC.Types.Int\) return boolean;
+
+  -- Data "deconstructor" procedures: split apart an algebraic data type
+  -- into fields
+
+  procedure \expand_GHC.Types.I#\ ( input : in  \GHC.Types.Int\;
+                                    field1 : out \Int#\);
+
+end \Prim\;
+
+package body \Prim\ is
+
+  function \GHC.Prim.==#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\ is
+  begin
+    if a = b then
+      return '1';
+    else
+      return '0';
+    end if;
+  end \GHC.Prim.==#\;
+
+  function \GHC.Prim.<#\ ( a, b : \Int#\ ) return \GHC.Types.Bool\ is
+  begin
+    if a < b then
+      return '1';
+    else
+      return '0';
+    end if;
+  end \GHC.Prim.<#\;
+
+  function \GHC.Prim.-#\ ( a, b : \Int#\ ) return \Int#\ is
+  begin
+    return a - b;
+  end \GHC.Prim.-#\;
+
+  function \is_GHC.Types.False\ (a : \GHC.Types.Bool\) return boolean is
+  begin
+    return a = '0';
+  end \is_GHC.Types.False\;
+
+  function \is_GHC.Types.True\ (a : \GHC.Types.Bool\) return boolean is
+  begin
+    return a = '1';
+  end \is_GHC.Types.True\;
+
+  function \is_GHC.Types.I#\ (a : \GHC.Types.Int\) return boolean is
+  begin
+    return true;          -- Trivial: there's only one constructor
+  end \is_GHC.Types.I#\;
+  
+  procedure \expand_GHC.Types.I#\ (
+    input  : in  \GHC.Types.Int\;
+    field1 : out \Int#\) is
+  begin
+    field1 := input;
+  end \expand_GHC.Types.I#\;
+  
+end \Prim\;
diff --git a/testsuite/gna/sr2940/testsuite.sh b/testsuite/gna/sr2940/testsuite.sh
new file mode 100755
index 000000000..5e25d4b2a
--- /dev/null
+++ b/testsuite/gna/sr2940/testsuite.sh
@@ -0,0 +1,10 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+analyze Prim.vhd
+analyze_failure GCD.vhd
+
+clean
+
+echo "Test successful"