From dc22544c2412cf8810a4956f537a2f50e0711a05 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 20 Dec 2022 21:17:08 +0100
Subject: [PATCH] Fortran: a C interoperable function cannot have the CLASS
 attribute [PR95375]

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                          | 12 ++++++++----
 gcc/testsuite/gfortran.dg/bind_c_procs_4.f90 | 17 +++++++++++++++++
 2 files changed, 25 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/bind_c_procs_4.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 1562dc22bc6..e593518a77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -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
index 00000000000..407d8bb9afc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_procs_4.f90
@@ -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" }
--
2.35.3