aboutsummaryrefslogtreecommitdiffstats
path: root/testsuite/gna/issue2091
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/gna/issue2091')
-rw-r--r--testsuite/gna/issue2091/log.vhdl79
-rw-r--r--testsuite/gna/issue2091/test.vhdl27
-rwxr-xr-xtestsuite/gna/issue2091/testsuite.sh11
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"