testsuite/gna: add a test for #2091

3 files changed, 117 insertions, 0 deletions

diff --git a/testsuite/gna/issue2091/log.vhdl b/testsuite/gna/issue2091/log.vhdl
new file mode 100644
index 000000000..265ce412b
--- /dev/null
+++ b/testsuite/gna/issue2091/log.vhdl
@@ -0,0 +1,79 @@
+library std;
+   use std.textio.all;
+
+package log is
+
+   type t_level is (TRACE, DEBUG, INFO, WARN, ERROR);
+
+   type t_logger is protected
+      procedure set_level(lvl : t_level);
+
+      procedure trace(msg : string);
+      procedure debug(msg : string);
+      procedure info(msg : string);
+      procedure warn(msg : string);
+      procedure error(msg : string);
+   end protected;
+
+   shared variable logger : t_logger;
+
+   procedure trace(msg : string);
+   procedure debug(msg : string);
+   procedure info(msg : string);
+   procedure warn(msg : string);
+   procedure error(msg : string);
+
+end package;
+
+package body log is
+
+   procedure trace(msg : string) is begin logger.trace(msg); end procedure;
+   procedure debug(msg : string) is begin logger.debug(msg); end procedure;
+   procedure info(msg : string) is begin logger.info(msg); end procedure;
+   procedure warn(msg : string) is begin logger.warn(msg); end procedure;
+   procedure error(msg : string) is begin logger.error(msg); end procedure;
+
+   type t_logger is protected body
+      variable level      : t_level := INFO;
+      variable show_level : boolean := true;
+
+      variable time_unit     : time    := ns;
+      variable show_sim_time : boolean := true;
+
+      procedure set_level(lvl : t_level) is
+      begin
+         level := lvl;
+      end procedure;
+
+      procedure log(lvl : t_level; msg : string) is
+         constant MAX_TIME_LEN : positive := 32;
+         variable time : string(1 to MAX_TIME_LEN);
+         variable time_line : line;
+
+         procedure trim_time(t : inout string) is
+         begin
+            for i in t'reverse_range loop
+               if t(i) = ' ' then time(i) := nul; else return; end if;
+            end loop;
+         end procedure;
+      begin
+         if lvl < level then return; end if;
+
+         if show_sim_time then
+            write(time_line, now, left, MAX_TIME_LEN, time_unit);
+            time := time_line.all;
+            trim_time(time);
+         end if;
+
+         write(output, t_level'image(lvl) & ": " & time & ": " &  msg & LF);
+      end procedure;
+
+      procedure trace(msg : string) is begin log(TRACE, msg); end procedure;
+      procedure debug(msg : string) is begin log(DEBUG, msg); end procedure;
+      procedure info(msg : string) is begin log(INFO, msg); end procedure;
+      procedure warn(msg : string) is begin log(WARN, msg); end procedure;
+      procedure error(msg : string) is begin log(ERROR, msg); end procedure;
+
+   end protected body;
+
+end package body;
diff --git a/testsuite/gna/issue2091/test.vhdl b/testsuite/gna/issue2091/test.vhdl
new file mode 100644
index 000000000..99c13af52
--- /dev/null
+++ b/testsuite/gna/issue2091/test.vhdl
@@ -0,0 +1,27 @@
+library ieee;
+   use ieee.std_logic_1164.all;
+   use ieee.numeric_std.all;
+
+library work;
+   use work.log;
+
+entity test is
+end entity;
+
+architecture tb of test is
+begin
+   main : process is
+   begin
+      wait for 7.5 ns;
+
+      log.logger.set_level(log.TRACE);
+
+      log.trace("TRACE");
+      log.debug("DEBUG");
+      log.info("INFO");
+      log.warn("WARN");
+      log.error("ERROR");
+
+      std.env.finish;
+   end process;
+end architecture;
diff --git a/testsuite/gna/issue2091/testsuite.sh b/testsuite/gna/issue2091/testsuite.sh
new file mode 100755
index 000000000..17151b5d2
--- /dev/null
+++ b/testsuite/gna/issue2091/testsuite.sh
@@ -0,0 +1,11 @@
+#! /bin/sh
+
+. ../../testenv.sh
+
+export GHDL_STD_FLAGS=--std=08
+analyze log.vhdl test.vhdl
+elab_simulate test
+
+clean
+
+echo "Test successful"