https://gcc.gnu.org/bugzilla/show_bug.cgi?id=107266

--- Comment #7 from kargl at gcc dot gnu.org ---
Here's the updated patch.  It will accept the code as before if -std= is absent
or -std=GNU.  For other -std= flags such as -std=f2018, one will get

%  gfcx -c -std=f2018 a.f90
a.f90:1:31:

    1 | function f(x) bind(C) result(a)
      |                               1
    2 |    character(kind=4) a
      |                    2           
Error: GNU Extension: Function result variable 'a' at (1) with type
CHARACTER(KIND=4) at (2) cannot have the BIND(C) attribute
a.f90:7:28:

    7 | character(kind=4) function g(x) bind(C)
      |                            1
Error: GNU Extension: Symbol 'g' at (1) with type CHARACTER(KIND=4) cannot have
the BIND(C) attribute


diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d133bc2d034..db28cd05365 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -15509,6 +15509,29 @@ resolve_symbol (gfc_symbol *sym)
       return;
     }

+  /* A Function result with character(kind=4) cannot have the bind(c)
+     attribute, because c_char is assumed to match default character kind.  */
+  if (sym->attr.function && sym->attr.is_bind_c)
+    {
+      if (sym->ts.type == BT_CHARACTER
+         && sym->result->ts.kind != gfc_default_character_kind
+         && !gfc_notify_std (GFC_STD_GNU, "Symbol %qs at %L with type "
+                             "CHARACTER(KIND=4) cannot have the BIND(C) "
+                             "attribute", sym->name, &sym->declared_at))
+       return;
+
+      if (sym->ts.type == BT_UNKNOWN
+         && sym->result
+         && sym->result->ts.type == BT_CHARACTER
+         && sym->result->ts.kind != gfc_default_character_kind
+         && !gfc_notify_std (GFC_STD_GNU, "Function result variable %qs at "
+                             "%L with type CHARACTER(KIND=4) at %L cannot "
+                             "have the BIND(C) attribute", sym->result->name,
+                             &sym->result->declared_at,
+                             &sym->result->ts.u.cl->length->where))
+       return;
+    }
+
   if (sym->attr.artificial)
     return;

Reply via email to