From c47c0bad5d2beaa55e1fb52e445f7b95174121f7 Mon Sep 17 00:00:00 2001
From: Tristan Gingold <tgingold@free.fr>
Date: Sun, 15 Jan 2023 09:43:26 +0100
Subject: testsuite/gna: fix issue#2098 due to elaboration errors.
---
testsuite/gna/issue2098/test-orig.vhdl | 156 +++++++++++++++++++++++++++++++
testsuite/gna/issue2098/test.vhdl | 21 +++--
testsuite/gna/issue2098/test2.vhdl | 164 +++++++++++++++++++++++++++++++++
testsuite/gna/issue2098/testsuite.sh | 11 +++
4 files changed, 342 insertions(+), 10 deletions(-)
create mode 100644 testsuite/gna/issue2098/test-orig.vhdl
create mode 100644 testsuite/gna/issue2098/test2.vhdl
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
--
cgit v1.2.3