Check for duplicate attribute specification. Fixes xxx

NEWS.md

@@ -49,6 +49,7 @@
   improved support for array type generics.
 - Optimised emission of FST initial signal values which also fixes a
   potential crash (#979).
+- Added checks for duplicate attribute specification (#977).
 - Several other minor bugs were resolved (#961, #962, #971, #975, #985).
 
 ## Version 1.13.3 - 2024-08-24

src/names.c

@@ -836,7 +836,7 @@ static symbol_t *make_visible(scope_t *s, ident_t name, tree_t decl,
 
       if (dd->tree == decl)
          return sym;
-      else if (dd->visibility == HIDDEN || dd->visibility == ATTRIBUTE)
+      else if (dd->visibility == HIDDEN)
          continue;
       else if (dd->kind == T_LIBRARY) {
          if (tkind == T_LIBRARY && tree_ident(decl) == name)
@@ -932,6 +932,20 @@ static symbol_t *make_visible(scope_t *s, ident_t name, tree_t decl,
             return sym;
          }
       }
+      else if (kind == ATTRIBUTE && dd->visibility == ATTRIBUTE
+               && tree_has_ref(dd->tree) && tree_has_ref(decl)) {
+         tree_t of = tree_ref(decl);
+         if (of == tree_ref(dd->tree)) {
+            diag_t *d = diag_new(DIAG_ERROR, tree_loc(decl));
+            diag_printf(d, "duplicate specification for attribute %s of %s %s",
+                        istr(tree_ident(decl)), class_str(tree_class(decl)),
+                        istr(tree_ident(of)));
+            diag_hint(d, tree_loc(dd->tree), "previous specification was here");
+            diag_hint(d, tree_loc(decl), "duplicate specification");
+            diag_suppress(d, s->suppress);
+            diag_emit(d);
+         }
+      }
    }
 
    *add_decl(sym) = (decl_t) {

test/parse/issue977.vhd

@@ -0,0 +1,14 @@
+entity issue977 is
+end entity;
+
+architecture test of issue977 is
+    procedure foo is
+    begin
+    end procedure;
+
+    attribute foreign of foo : procedure is "abc";  -- OK
+    attribute foreign of foo : procedure is "123";  -- Error
+
+begin
+
+end architecture;

test/sem/attr.vhd

@@ -297,18 +297,18 @@ begin
 END c07s04b01x00p08n01i02565arch;
 
 architecture builtins of e is
-    procedure p;
+    procedure p; procedure p2; procedure p3;
     attribute never_waits : boolean;
     attribute never_waits of p : procedure is true;  -- OK
-    attribute never_waits of p : procedure is false;  -- OK
-    attribute never_waits of p : procedure is 1 = 1;  -- Error
-    function f return integer;
+    attribute never_waits of p2 : procedure is false;  -- OK
+    attribute never_waits of p3 : procedure is 1 = 1;  -- Error
+    function f return integer; function f2 return integer;
     attribute never_waits of f : function is true;   -- Error
     procedure q (x : integer);
     procedure q (x : boolean);
     attribute never_waits of q [integer] : procedure is true;  -- OK
     attribute foreign of f [return integer] : function is "bad string";  -- OK
-    attribute foreign of f [return integer] : function is e'path_name;  -- OK
+    attribute foreign of f2 [return integer] : function is e'path_name;  -- OK
 begin
 
     b: block is

test/test_parse.c

@@ -6879,6 +6879,24 @@ START_TEST(test_issue961)
 }
 END_TEST
 
+START_TEST(test_issue977)
+{
+   input_from_file(TESTDIR "/parse/issue977.vhd");
+
+   const error_t expect[] = {
+      { 10, "duplicate specification for attribute FOREIGN of procedure FOO" },
+      { -1, NULL }
+   };
+   expect_errors(expect);
+
+   parse_and_check(T_ENTITY, T_ARCH);
+
+   fail_unless(parse() == NULL);
+
+   check_expected_errors();
+}
+END_TEST
+
 Suite *get_parse_tests(void)
 {
    Suite *s = suite_create("parse");
@@ -7041,6 +7059,7 @@ Suite *get_parse_tests(void)
    tcase_add_test(tc_core, test_visibility12);
    tcase_add_test(tc_core, test_issue956);
    tcase_add_test(tc_core, test_issue961);
+   tcase_add_test(tc_core, test_issue977);
    suite_add_tcase(s, tc_core);
 
    return s;