From 73e33fe4526f01088c1b836f4057688423af65f6 Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Sun, 6 Aug 2023 22:02:14 +0100
Subject: [PATCH] Missing array bounds check for composite 'VALUE result

---
 src/jit/jit-exits.c            |  1 +
 src/lower.c                    |  6 +++++-
 test/regress/bounds40.vhd      | 19 +++++++++++++++++++
 test/regress/gold/bounds40.txt |  1 +
 test/regress/testlist.txt      |  1 +
 5 files changed, 27 insertions(+), 1 deletion(-)
 create mode 100644 test/regress/bounds40.vhd
 create mode 100644 test/regress/gold/bounds40.txt

diff --git a/src/jit/jit-exits.c b/src/jit/jit-exits.c
index 41397ffb8..1ceadce93 100644
--- a/src/jit/jit-exits.c
+++ b/src/jit/jit-exits.c
@@ -212,6 +212,7 @@ void x_length_fail(int64_t left, int64_t right, int32_t dim, tree_t where)
       tb_cat(tb, "expected");
       break;
    case T_TYPE_CONV:
+   case T_ATTR_REF:
       tb_printf(tb, "subtype %s", type_pp(tree_type(where)));
       break;
    default:
diff --git a/src/lower.c b/src/lower.c
index 3aa5e61a1..7dd915cd5 100644
--- a/src/lower.c
+++ b/src/lower.c
@@ -4696,7 +4696,11 @@ static vcode_reg_t lower_attr_ref(lower_unit_t *lu, tree_t expr)
 
          if (type_is_scalar(name_type))
             lower_check_scalar_bounds(lu, reg, name_type, expr, NULL);
-         // TODO: need array bounds check here
+         else if (type_is_array(name_type) && lower_const_bounds(name_type)) {
+            vcode_reg_t locus = lower_debug_locus(expr);
+            lower_check_array_sizes(lu, name_type, base, VCODE_INVALID_REG,
+                                    reg, locus);
+         }
 
          return reg;
       }
diff --git a/test/regress/bounds40.vhd b/test/regress/bounds40.vhd
new file mode 100644
index 000000000..f3636ab12
--- /dev/null
+++ b/test/regress/bounds40.vhd
@@ -0,0 +1,19 @@
+entity bounds40 is
+end entity;
+
+architecture test of bounds40 is
+    type t_pair is record
+        x, y : integer;
+    end record;
+
+    type t_pair_pair is array (1 to 2) of t_pair;
+begin
+
+    process is
+    begin
+        assert t_pair_pair'value("((1,2), (3,  4), (5, 6))")
+            = ((1,2), (3,4));           -- Error
+        wait;
+    end process;
+
+end architecture;
diff --git a/test/regress/gold/bounds40.txt b/test/regress/gold/bounds40.txt
new file mode 100644
index 000000000..21cb0bc0f
--- /dev/null
+++ b/test/regress/gold/bounds40.txt
@@ -0,0 +1 @@
+0ms+0: value length 3 does not match subtype T_PAIR_PAIR length 2
diff --git a/test/regress/testlist.txt b/test/regress/testlist.txt
index 4c3d5cf4c..14c1bf934 100644
--- a/test/regress/testlist.txt
+++ b/test/regress/testlist.txt
@@ -842,3 +842,4 @@ assert11        normal,2019
 assert12        normal
 image2          normal,2019
 value2          normal,2019
+bounds40        fail,2019,gold