From 81fb2aa918b43e22178772e857e404b0ea9b9128 Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Wed, 20 Dec 2023 18:37:25 +0000
Subject: [PATCH] Incorrect length check for non-static port map actual. Fixes
 #817

---
 src/jit/jit-core.c             |  3 +++
 src/lower.c                    | 14 +++++-----
 test/regress/gold/issue817.txt |  1 +
 test/regress/issue817.vhd      | 48 ++++++++++++++++++++++++++++++++++
 test/regress/testlist.txt      |  1 +
 5 files changed, 61 insertions(+), 6 deletions(-)
 create mode 100644 test/regress/gold/issue817.txt
 create mode 100644 test/regress/issue817.vhd

diff --git a/src/jit/jit-core.c b/src/jit/jit-core.c
index 6fb59c2f..f81970fe 100644
--- a/src/jit/jit-core.c
+++ b/src/jit/jit-core.c
@@ -554,6 +554,9 @@ static void jit_emit_trace(diag_t *d, const loc_t *loc, object_t *enclosing,
       case T_PACK_INST:
          diag_trace(d, loc, "Package$$ %s", istr(tree_ident(tree)));
          break;
+      case T_WAVEFORM:
+         diag_trace(d, loc, "Equivalent process");
+         break;
       default:
          diag_trace(d, loc, "$$%s", istr(tree_ident(tree)));
          break;
diff --git a/src/lower.c b/src/lower.c
index 2e631611..52c62f76 100644
--- a/src/lower.c
+++ b/src/lower.c
@@ -11479,8 +11479,8 @@ static void lower_map_signal(lower_unit_t *lu, vcode_reg_t src_reg,
 }
 
 static void lower_non_static_actual(lower_unit_t *parent, tree_t port,
-                                    type_t type, vcode_reg_t port_reg,
-                                    tree_t wave)
+                                    tree_t target, type_t type,
+                                    vcode_reg_t port_reg, tree_t wave)
 {
    // Construct the equivalent process according the procedure in LRM 08
    // section 6.5.6.3
@@ -11533,7 +11533,7 @@ static void lower_non_static_actual(lower_unit_t *parent, tree_t port,
       { .kind = PART_ALL,
         .reg = nets_reg,
         .off = VCODE_INVALID_REG,
-        .target = port },
+        .target = target },
       { .kind = PART_POP,
         .reg = VCODE_INVALID_REG,
         .off = VCODE_INVALID_REG,
@@ -11541,7 +11541,7 @@ static void lower_non_static_actual(lower_unit_t *parent, tree_t port,
    };
 
    target_part_t *ptr = parts;
-   lower_signal_assign_target(lu, &ptr, port, value_reg, type,
+   lower_signal_assign_target(lu, &ptr, target, value_reg, tree_type(expr),
                               zero_time_reg, zero_time_reg);
 
    emit_return(VCODE_INVALID_REG);
@@ -11686,8 +11686,10 @@ static void lower_port_map(lower_unit_t *lu, tree_t block, tree_t map,
       lower_map_signal(lu, src_reg, dst_reg, src_type, dst_type,
                        conv_func, map);
    }
-   else if (tree_kind(value) == T_WAVEFORM)
-      lower_non_static_actual(lu, port, name_type, port_reg, value);
+   else if (tree_kind(value) == T_WAVEFORM) {
+      tree_t name = tree_subkind(map) == P_NAMED ? tree_name(map) : port;
+      lower_non_static_actual(lu, port, name, name_type, port_reg, value);
+   }
    else if (value_reg != VCODE_INVALID_REG) {
       type_t value_type = tree_type(value);
       lower_map_signal(lu, value_reg, port_reg, value_type, name_type,
diff --git a/test/regress/gold/issue817.txt b/test/regress/gold/issue817.txt
new file mode 100644
index 00000000..21e94277
--- /dev/null
+++ b/test/regress/gold/issue817.txt
@@ -0,0 +1 @@
+0ms+0: value length 7 does not match target length 8
diff --git a/test/regress/issue817.vhd b/test/regress/issue817.vhd
new file mode 100644
index 00000000..f83eaf2d
--- /dev/null
+++ b/test/regress/issue817.vhd
@@ -0,0 +1,48 @@
+package test_pkg is
+	type array_of_vectors is array(integer range 0 to 31) of bit_vector(7 downto 0);
+end package;
+
+use work.test_pkg.array_of_vectors ;
+
+entity test is
+  port (
+    in_a    :   in  array_of_vectors ;
+    outs    :   out array_of_vectors
+  ) ;
+end entity ;
+
+architecture arch of test is
+begin
+    process(all)
+    begin
+        outs(0) <= in_a(0);
+    end process ;
+end architecture ;
+
+use work.test_pkg.array_of_vectors ;
+
+entity issue817 is
+end entity ;
+
+architecture arch of issue817 is
+
+    signal a : bit;
+    signal b : bit_vector(7 downto 0);
+
+begin
+
+    U_test_a : entity work.test
+      port map (
+        in_a(0)    =>  "1111111" & a,  	-- OK
+        in_a(1)    =>  "111111" & a,  	-- Error
+        outs(0)    => b
+      ) ;
+
+    tb : process
+    begin
+        wait for 100 ns ;
+        report "Done" ;
+        std.env.stop ;
+    end process ;
+
+end architecture ;
diff --git a/test/regress/testlist.txt b/test/regress/testlist.txt
index a6d1acf3..ad87b260 100644
--- a/test/regress/testlist.txt
+++ b/test/regress/testlist.txt
@@ -912,3 +912,4 @@ elab40          normal,2008
 cmdline9        shell,slow
 genpack16       normal,2008
 issue815        normal,2019
+issue817        fail,gold,2008
-- 
2.39.2