From 7873abb597fb454156f6248c7736bbd3c7ad7d5d Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Sat, 14 Oct 2023 21:27:04 +0100
Subject: [PATCH] Fix crash with unconstrained field in record aggregate

Issue #768
---
 NEWS.md                 |  2 ++
 src/lower.c             | 27 +++++++++++++------------
 test/lower/issue768.vhd | 14 +++++++++++++
 test/test_lower.c       | 44 +++++++++++++++++++++++++++++++++++++++++
 4 files changed, 74 insertions(+), 13 deletions(-)
 create mode 100644 test/lower/issue768.vhd

diff --git a/NEWS.md b/NEWS.md
index b4e7f442..93c9a801 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,6 +4,8 @@
 - Improved overload resolution when subprogram argument is known to have
   character type.
 - Improved bounds checking for port map actuals.
+- Fixed a crash with aggregates for record types that contain an
+  unconstrained field (#768).
 
 ## Version 1.10.3 - 2023-09-17
 - Fixed memory corruption in rare circumstances with functions declared
diff --git a/src/lower.c b/src/lower.c
index b8166f47..653e4ee7 100644
--- a/src/lower.c
+++ b/src/lower.c
@@ -3577,29 +3577,30 @@ static vcode_reg_t lower_record_aggregate(lower_unit_t *lu, tree_t expr,
          type_t ftype = tree_type(f);
          vcode_reg_t ptr_reg = emit_record_ref(mem_reg, i);
          if (type_is_array(ftype)) {
-            if (lower_const_bounds(ftype)) {
-               vcode_reg_t src_reg = lower_array_data(vals[i]);
-               vcode_reg_t length_reg =
-                  lower_array_total_len(lu, ftype, vals[i]);
-               emit_copy(ptr_reg, src_reg, length_reg);
-            }
-            else {
-               vcode_reg_t src_reg = vals[i];
-               if (vcode_reg_kind(src_reg) != VCODE_TYPE_UARRAY)
-                  src_reg = lower_wrap(lu, tree_type(map[i]), src_reg);
+            if (have_uarray_ptr(ptr_reg)) {
+               type_t value_type = tree_type(map[i]);
+               vcode_reg_t wrap_reg =
+                  lower_wrap_with_new_bounds(lu, value_type, ftype,
+                                             vals[i], vals[i]);
 
                if ((cons = type_constraint_for_field(type, f))) {
                   // Element constraint may be OPEN for constants
                   type_t ctype = tree_type(cons);
                   if (!type_is_unconstrained(ctype)) {
                      vcode_reg_t locus = lower_debug_locus(map[i]);
-                     lower_check_array_sizes(lu, ctype, tree_type(map[i]),
+                     lower_check_array_sizes(lu, ctype, value_type,
                                              VCODE_INVALID_REG,
-                                             src_reg, locus);
+                                             wrap_reg, locus);
                   }
                }
 
-               emit_store_indirect(src_reg, ptr_reg);
+               emit_store_indirect(wrap_reg, ptr_reg);
+            }
+            else {
+               vcode_reg_t src_reg = lower_array_data(vals[i]);
+               vcode_reg_t length_reg =
+                  lower_array_total_len(lu, ftype, vals[i]);
+               emit_copy(ptr_reg, src_reg, length_reg);
             }
          }
          else if (type_is_record(ftype))
diff --git a/test/lower/issue768.vhd b/test/lower/issue768.vhd
new file mode 100644
index 00000000..e0988f7d
--- /dev/null
+++ b/test/lower/issue768.vhd
@@ -0,0 +1,14 @@
+package issue768 is
+
+    type t_slv_arr is array (natural range <>) of bit_vector;  --! Array of bit_vector is the primary data type
+
+    type t_code_word is record
+        word : bit_vector;            --! data word
+        code : t_slv_arr;                   --! code word array
+    end record t_code_word;
+
+    type t_codec is array(natural range <>) of t_code_word;  --! Codec (array of data & code words)
+
+    constant C_HDLC_CODEC : t_codec(0 to 0)(word(7 downto 0), code(0 to 0)(7 downto 0)) := (0 => (word => x"7e", code => (0 => x"7d")));
+
+end package;
diff --git a/test/test_lower.c b/test/test_lower.c
index c8e6c668..925d5d0c 100644
--- a/test/test_lower.c
+++ b/test/test_lower.c
@@ -5292,6 +5292,49 @@ START_TEST(test_issue756)
 }
 END_TEST
 
+START_TEST(test_issue768)
+{
+   set_standard(STD_08);
+
+   input_from_file(TESTDIR "/lower/issue768.vhd");
+
+   parse_check_simplify_and_lower(T_PACKAGE);
+
+   unit_registry_t *ur = get_registry();
+   vcode_unit_t vu = unit_registry_get(ur, ident_new("WORK.ISSUE768"));
+   fail_if(vu == NULL);
+
+   vcode_select_unit(vu);
+
+   EXPECT_BB(0) = {
+      { VCODE_OP_PACKAGE_INIT, .name = "STD.STANDARD" },
+      { VCODE_OP_CONST, .value = 1 },
+      { VCODE_OP_ALLOC },
+      { VCODE_OP_CONST, .value = 0 },
+      { VCODE_OP_CONST, .value = 0 },
+      { VCODE_OP_WRAP },
+      { VCODE_OP_STORE, .name = "C_HDLC_CODEC" },
+      { VCODE_OP_CONST, .value = 0 },
+      { VCODE_OP_ARRAY_REF },
+      { VCODE_OP_CONST, .value = 1 },
+      { VCODE_OP_CONST_ARRAY, .length = 8 },
+      { VCODE_OP_ADDRESS_OF },
+      { VCODE_OP_CONST_ARRAY, .length = 8 },
+      { VCODE_OP_ADDRESS_OF },
+      { VCODE_OP_RECORD_REF, .field = 0 },
+      { VCODE_OP_CONST, .value = 7 },
+      { VCODE_OP_WRAP },
+      { VCODE_OP_STORE_INDIRECT },
+      { VCODE_OP_RECORD_REF, .field = 1 },
+      { VCODE_OP_WRAP },
+      { VCODE_OP_STORE_INDIRECT },
+      { VCODE_OP_RETURN },
+   };
+
+   CHECK_BB(0);
+}
+END_TEST
+
 Suite *get_lower_tests(void)
 {
    Suite *s = suite_create("lower");
@@ -5421,6 +5464,7 @@ Suite *get_lower_tests(void)
    tcase_add_test(tc, test_cond2);
    tcase_add_test(tc, test_protpcall);
    tcase_add_test(tc, test_issue756);
+   tcase_add_test(tc, test_issue768);
    suite_add_tcase(s, tc);
 
    return s;
-- 
2.39.2