Fortran: a C interoperable function cannot have the CLASS attribute [PR95375]
authorHarald Anlauf <anlauf@gmx.de>
Tue, 20 Dec 2022 20:17:08 +0000 (21:17 +0100)
committerHarald Anlauf <anlauf@gmx.de>
Tue, 20 Dec 2022 21:24:01 +0000 (22:24 +0100)
gcc/fortran/ChangeLog:

PR fortran/95375
* decl.cc (verify_bind_c_sym): Extend interoperability check to
CLASS variables.

gcc/testsuite/ChangeLog:

PR fortran/95375
* gfortran.dg/bind_c_procs_4.f90: New test.

gcc/fortran/decl.cc
gcc/testsuite/gfortran.dg/bind_c_procs_4.f90 [new file with mode: 0644]

index 1562dc2..e593518 100644 (file)
@@ -5998,10 +5998,14 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
            }
          else
            {
-              if (tmp_sym->ts.type == BT_DERIVED || ts->type == BT_DERIVED)
-                gfc_error ("Type declaration %qs at %L is not C "
-                           "interoperable but it is BIND(C)",
-                           tmp_sym->name, &(tmp_sym->declared_at));
+             if (tmp_sym->ts.type == BT_DERIVED || ts->type == BT_DERIVED
+                 || tmp_sym->ts.type == BT_CLASS || ts->type == BT_CLASS)
+               {
+                 gfc_error ("Type declaration %qs at %L is not C "
+                            "interoperable but it is BIND(C)",
+                            tmp_sym->name, &(tmp_sym->declared_at));
+                 retval = false;
+               }
               else if (warn_c_binding_type)
                 gfc_warning (OPT_Wc_binding_type, "Variable %qs at %L "
                              "may not be a C interoperable "
diff --git a/gcc/testsuite/gfortran.dg/bind_c_procs_4.f90 b/gcc/testsuite/gfortran.dg/bind_c_procs_4.f90
new file mode 100644 (file)
index 0000000..407d8bb
--- /dev/null
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/95375 - ICE in add_use_op
+! Contributed by G.Steinmetz
+
+function f() result(n) bind(c)      ! { dg-error "not C interoperable" }
+  class(*), allocatable :: n
+end
+program p
+  interface
+     function f() result(n) bind(c)
+       integer :: n
+     end
+  end interface
+  if ( f() /= 0 ) stop
+end
+
+! { dg-prune-output "Type mismatch" }