aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--testsuite/gna/bug15638/15368.vhd (renamed from testsuite/gna/bug15368/15368.vhd)0
-rwxr-xr-xtestsuite/gna/bug15638/testsuite.sh (renamed from testsuite/gna/bug15368/testsuite.sh)0
-rwxr-xr-xtestsuite/gna/bug21332/testsuite.sh10
-rw-r--r--testsuite/gna/bug21332/twoscomplement.vhdl48
-rw-r--r--testsuite/gna/sr2903/boundcheck.vhdl36
-rwxr-xr-xtestsuite/gna/sr2903/testsuite.sh10
-rw-r--r--testsuite/gna/sr2940/GCD.vhd203
-rw-r--r--testsuite/gna/sr2940/Prim.vhd80
-rwxr-xr-xtestsuite/gna/sr2940/testsuite.sh10
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"
generated by cgit v1.2.3 (git 2.25.1) at 2025-11-04 13:01:05 +0000