diff options
author | Tristan Gingold <tgingold@free.fr> | 2023-01-15 09:43:26 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2023-01-15 11:36:07 +0100 |
commit | c47c0bad5d2beaa55e1fb52e445f7b95174121f7 (patch) | |
tree | 51fbf4df30356aa6abc18b6082420c0fcfbda331 /testsuite/gna/issue2098 | |
parent | aa440f398761c13c720f358198f8a4f93d880f61 (diff) | |
download | ghdl-c47c0bad5d2beaa55e1fb52e445f7b95174121f7.tar.gz ghdl-c47c0bad5d2beaa55e1fb52e445f7b95174121f7.tar.bz2 ghdl-c47c0bad5d2beaa55e1fb52e445f7b95174121f7.zip |
testsuite/gna: fix issue#2098 due to elaboration errors.
Diffstat (limited to 'testsuite/gna/issue2098')
-rw-r--r-- | testsuite/gna/issue2098/test-orig.vhdl | 156 | ||||
-rw-r--r-- | testsuite/gna/issue2098/test.vhdl | 21 | ||||
-rw-r--r-- | testsuite/gna/issue2098/test2.vhdl | 164 | ||||
-rwxr-xr-x | testsuite/gna/issue2098/testsuite.sh | 11 |
4 files changed, 342 insertions, 10 deletions
diff --git a/testsuite/gna/issue2098/test-orig.vhdl b/testsuite/gna/issue2098/test-orig.vhdl new file mode 100644 index 000000000..b2dedd731 --- /dev/null +++ b/testsuite/gna/issue2098/test-orig.vhdl @@ -0,0 +1,156 @@ +library std; + use std.textio.all; + +package log is + + type t_level is (TRACE, DEBUG, INFO, WARN, ERROR); + + type t_config is record + level : t_level; + show_level : boolean; + time_unit : time; + show_sim_time : boolean; + prefix : string(1 to 32); + separator : string(1 to 3); + end record; + + type t_logger is protected + procedure set_config(c : t_config); + + 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 set_config(cfg : t_config); + + procedure trace(msg : string); + procedure debug(msg : string); + procedure info(msg : string); + procedure warn(msg : string); + procedure error(msg : string); + + function config( + level : t_level := INFO; + time_unit : time := ns; + prefix : string(1 to 32) := (others => nul); + separator : string(1 to 3) := ": " & nul; + show_level : boolean := true; + show_sim_time : boolean := true + ) return t_config; + +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 cfg : t_config := config; + + procedure set_config(c : t_config) is begin cfg := c; 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 < cfg.level then return; end if; + + if cfg.show_sim_time then + write(time_line, now, left, MAX_TIME_LEN, cfg.time_unit); + time := time_line.all; + trim_time(time); + end if; + + write(output, t_level'image(lvl) & cfg.separator & time & cfg.separator & 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; + + procedure set_level(l : t_level) is + begin + cfg.level := l; + end procedure; + + end protected body; + + procedure set_config(cfg : t_config) is begin logger.set_config(cfg); end procedure; + + function config( + level : t_level := INFO; + time_unit : time := ns; + prefix : string(1 to 32) := (others => nul); + separator : string(1 to 3) := ": " & nul; + show_level : boolean := true; + show_sim_time : boolean := true + ) return t_config is + variable cfg : t_config; + begin + cfg.level := level; + cfg.show_level := show_level; + cfg.time_unit := time_unit; + cfg.show_sim_time := show_sim_time; + cfg.prefix := prefix; + cfg.separator := separator; + return cfg; + end function; + +end package body; +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 + variable l : log.t_logger; + begin + wait for 7.5 ns; + + log.set_config(log.config(log.TRACE)); + + log.trace("TRACE"); + log.debug("DEBUG"); + log.info("INFO"); + log.warn("WARN"); + log.error("ERROR" & LF); + + l.set_config(log.config(log.TRACE)); + l.trace("TRACE"); + l.debug("DEBUG"); + l.info("INFO"); + l.warn("WARN"); + l.error("ERROR"); + + std.env.finish; + end process; +end architecture; diff --git a/testsuite/gna/issue2098/test.vhdl b/testsuite/gna/issue2098/test.vhdl index b2dedd731..854d30ef2 100644 --- a/testsuite/gna/issue2098/test.vhdl +++ b/testsuite/gna/issue2098/test.vhdl @@ -14,6 +14,8 @@ package log is separator : string(1 to 3); end record; + procedure set_config(cfg : t_config); + type t_logger is protected procedure set_config(c : t_config); @@ -24,10 +26,6 @@ package log is procedure error(msg : string); end protected; - shared variable logger : t_logger; - - procedure set_config(cfg : t_config); - procedure trace(msg : string); procedure debug(msg : string); procedure info(msg : string); @@ -47,12 +45,6 @@ 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 cfg : t_config := config; @@ -96,6 +88,15 @@ package body log is end protected body; + shared variable logger : t_logger; + + 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; + + procedure set_config(cfg : t_config) is begin logger.set_config(cfg); end procedure; function config( diff --git a/testsuite/gna/issue2098/test2.vhdl b/testsuite/gna/issue2098/test2.vhdl new file mode 100644 index 000000000..768d9a74f --- /dev/null +++ b/testsuite/gna/issue2098/test2.vhdl @@ -0,0 +1,164 @@ +library std; + use std.textio.all; + +package log_pkg is + + type t_level is (TRACE, DEBUG, INFO, WARN, ERROR); + + type t_config is record + level : t_level; + show_level : boolean; + time_unit : time; + show_sim_time : boolean; + prefix : string(1 to 32); + separator : string(1 to 3); + end record; + + type t_logger is protected + procedure set_config(c : t_config); + + procedure trace(msg : string); + procedure debug(msg : string); + procedure info(msg : string); + procedure warn(msg : string); + procedure error(msg : string); + end protected; + + function config( + level : t_level := INFO; + time_unit : time := ns; + prefix : string(1 to 32) := (others => nul); + separator : string(1 to 3) := ": " & nul; + show_level : boolean := true; + show_sim_time : boolean := true + ) return t_config; + +end log_pkg; + +use work.log_pkg.all; + +package log is + shared variable logger : t_logger; + + procedure set_config(cfg : t_config); + + 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_pkg is + type t_logger is protected body + + variable cfg : t_config := config; + + procedure set_config(c : t_config) is begin cfg := c; 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 < cfg.level then return; end if; + + if cfg.show_sim_time then + write(time_line, now, left, MAX_TIME_LEN, cfg.time_unit); + time := time_line.all; + trim_time(time); + end if; + + write(output, t_level'image(lvl) & cfg.separator & time & cfg.separator & 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; + + procedure set_level(l : t_level) is + begin + cfg.level := l; + end procedure; + + end protected body; + + function config( + level : t_level := INFO; + time_unit : time := ns; + prefix : string(1 to 32) := (others => nul); + separator : string(1 to 3) := ": " & nul; + show_level : boolean := true; + show_sim_time : boolean := true + ) return t_config is + variable cfg : t_config; + begin + cfg.level := level; + cfg.show_level := show_level; + cfg.time_unit := time_unit; + cfg.show_sim_time := show_sim_time; + cfg.prefix := prefix; + cfg.separator := separator; + return cfg; + end function; +end package body; + +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; + + procedure set_config(cfg : t_config) is begin logger.set_config(cfg); end procedure; +end package body; + +library ieee; + use ieee.std_logic_1164.all; + use ieee.numeric_std.all; + +library work; + use work.log_pkg; + use work.log; + +entity test2 is +end entity; + +architecture tb of test2 is + +begin + main : process is + variable l : log_pkg.t_logger; + begin + wait for 7.5 ns; + + log.set_config(log_pkg.config(log_pkg.TRACE)); + + log.trace("TRACE"); + log.debug("DEBUG"); + log.info("INFO"); + log.warn("WARN"); + log.error("ERROR" & LF); + + l.set_config(log_pkg.config(log_pkg.TRACE)); + l.trace("TRACE"); + l.debug("DEBUG"); + l.info("INFO"); + l.warn("WARN"); + l.error("ERROR"); + + std.env.finish; + end process; +end architecture; diff --git a/testsuite/gna/issue2098/testsuite.sh b/testsuite/gna/issue2098/testsuite.sh index 1d84c0f57..dfd2be71e 100755 --- a/testsuite/gna/issue2098/testsuite.sh +++ b/testsuite/gna/issue2098/testsuite.sh @@ -3,6 +3,17 @@ . ../../testenv.sh export GHDL_STD_FLAGS=--std=08 + +# Original test, incorrect +analyze_failure -Werror=elaboration test-orig.vhdl + +# Modified v1 +analyze -Werror=elaboration test2.vhdl +elab_simulate test2 + +clean + +# Better modification analyze test.vhdl elab_simulate test |