From 8f450ece191df4b45c0e299b1d80693d7437b028 Mon Sep 17 00:00:00 2001
From: Nick Gasson <nick@nickg.me.uk>
Date: Thu, 18 Jan 2024 16:31:30 +0000
Subject: [PATCH] Avoid crash with 'SUBTYPE attribute. Fixes #837

---
 src/parse.c             | 12 +++++++-----
 test/parse/issue837.vhd |  9 +++++++++
 test/test_parse.c       | 30 ++++++++++++++++++++++++++++++
 3 files changed, 46 insertions(+), 5 deletions(-)
 create mode 100644 test/parse/issue837.vhd

diff --git a/src/parse.c b/src/parse.c
index e13c4e41..8bee3c00 100644
--- a/src/parse.c
+++ b/src/parse.c
@@ -1894,10 +1894,10 @@ static void _spec_list_cleanup(spec_list_t **list)
 static type_t get_subtype_for(tree_t expr)
 {
    type_t type = tree_type(expr);
-   assert(type_is_unconstrained(type));
+   assert(type_is_composite(type));
 
    type_t sub = type_new(T_SUBTYPE);
-   type_set_base(sub, type);
+   type_set_base(sub, type_base_recur(type));
 
    const loc_t *loc = tree_loc(expr);
 
@@ -1982,6 +1982,8 @@ static type_t get_subtype_for(tree_t expr)
 
          type_set_elem(sub, get_subtype_for(aref));
       }
+      else
+         type_set_elem(sub, elem);
    }
 
    return sub;
@@ -1999,12 +2001,12 @@ static type_t apply_subtype_attribute(tree_t aref)
                   "have a type");
       return type_new(T_NONE);
    }
-   else if (type_is_unconstrained(type)) {
+   else if (type_const_bounds(type))
+      return type;
+   else {
       // Construct a new subtype using the constraints from the prefix
       return get_subtype_for(name);
    }
-   else
-      return type;
 }
 
 static type_t apply_element_attribute(tree_t aref)
diff --git a/test/parse/issue837.vhd b/test/parse/issue837.vhd
new file mode 100644
index 00000000..a7c3a9eb
--- /dev/null
+++ b/test/parse/issue837.vhd
@@ -0,0 +1,9 @@
+entity issue837 is
+    generic ( g : integer );
+    port ( p : in bit_vector(1 to g - 1) );
+end entity;
+
+architecture test of issue837 is
+    signal s : p'subtype;               -- OK
+begin
+end architecture;
diff --git a/test/test_parse.c b/test/test_parse.c
index 7a3afbb5..8cc9f972 100644
--- a/test/test_parse.c
+++ b/test/test_parse.c
@@ -6085,6 +6085,35 @@ START_TEST(test_visibility11)
 }
 END_TEST
 
+START_TEST(test_issue837)
+{
+   set_standard(STD_08);
+
+   input_from_file(TESTDIR "/parse/issue837.vhd");
+
+   tree_t e = parse();
+   fail_if(e == NULL);
+   fail_unless(tree_kind(e) == T_ENTITY);
+   lib_put(lib_work(), e);
+
+   tree_t a = parse();
+   fail_if(a == NULL);
+   fail_unless(tree_kind(a) == T_ARCH);
+
+   tree_t s = tree_decl(a, 0);
+   fail_unless(tree_kind(s) == T_SIGNAL_DECL);
+
+   type_t t = tree_type(s);
+   fail_unless(type_kind(t) == T_SUBTYPE);
+
+   tree_t r = range_of(t, 0);
+   fail_unless(tree_subkind(r) == RANGE_EXPR);
+   fail_unless(tree_kind(tree_value(r)) == T_ATTR_REF);
+
+   fail_if_errors();
+}
+END_TEST
+
 Suite *get_parse_tests(void)
 {
    Suite *s = suite_create("parse");
@@ -6219,6 +6248,7 @@ Suite *get_parse_tests(void)
    tcase_add_test(tc_core, test_issue802);
    tcase_add_test(tc_core, test_issue805);
    tcase_add_test(tc_core, test_visibility11);
+   tcase_add_test(tc_core, test_issue837);
    suite_add_tcase(s, tc_core);
 
    return s;
-- 
2.39.2