Check function specification and body return types exactly match

Fixes #980

src/sem.c

@@ -1993,6 +1993,27 @@ static bool sem_check_conforming(tree_t decl, tree_t body)
          ok &= sem_compare_interfaces(decl, body, i, tree_generic, "generic");
    }
 
+   type_t dtype = tree_type(decl);
+   type_t btype = tree_type(body);
+
+   if (type_has_result(dtype) && type_has_result(btype)) {
+      type_t dresult = type_result(dtype);
+      type_t bresult = type_result(btype);
+
+      if (!type_strict_eq(dresult, bresult)) {
+         diag_t *d = diag_new(DIAG_ERROR, tree_loc(body));
+         diag_printf(d, "return type of function body %s does not match type "
+                     "%s in specification", istr(tree_ident(body)),
+                     type_pp(dresult));
+         diag_hint(d, tree_loc(decl), "specification has return type %s",
+                   type_pp(dresult));
+         diag_hint(d, tree_loc(body), "body has return type %s ",
+                   type_pp(bresult));
+         diag_emit(d);
+         ok = false;
+      }
+   }
+
    return ok;
 }
 

test/sem/issue980.vhd

@@ -0,0 +1,17 @@
+package issue980 is
+    type t_enum is (a, b, c);
+    subtype t_sub is t_enum range a to b;
+
+    function foo return t_sub;
+    procedure bar (x : t_sub);
+end package;
+
+package body issue980 is
+    function foo return t_enum is       -- Error
+    begin
+    end function;
+
+    procedure bar (x : t_enum) is       -- Error
+    begin
+    end procedure;
+end package body;

test/test_sem.c

@@ -3750,6 +3750,26 @@ START_TEST(test_lcs2016_49)
 }
 END_TEST
 
+START_TEST(test_issue980)
+{
+   input_from_file(TESTDIR "/sem/issue980.vhd");
+
+   const error_t expect[] = {
+      { 10, "return type of function body FOO does not match type T_SUB in "
+        "specification" },
+      {  0, "body has return type T_ENUM" },
+      {  0, "specification has return type T_SUB" },
+      { 14, "subtype of parameter X does not match type T_SUB" },
+      { -1, NULL }
+   };
+   expect_errors(expect);
+
+   parse_and_check(T_PACKAGE, T_PACK_BODY);
+
+   check_expected_errors();
+}
+END_TEST
+
 Suite *get_sem_tests(void)
 {
    Suite *s = suite_create("sem");
@@ -3922,6 +3942,7 @@ Suite *get_sem_tests(void)
    tcase_add_test(tc_core, test_issue958);
    tcase_add_test(tc_core, test_issue965);
    tcase_add_test(tc_core, test_lcs2016_49);
+   tcase_add_test(tc_core, test_issue980);
    suite_add_tcase(s, tc_core);
 
    return s;