From 56cd8a50b3e37cbb3cd3dc49909bdd14939cfdee Mon Sep 17 00:00:00 2001
From: Peter Klausler <35819229+klausler@users.noreply.github.com>
Date: Tue, 11 Jun 2024 16:38:51 -0700
Subject: [PATCH] [flang] Relax BIND(C) derived type component check (#94392)

Allow an explicit BIND(C) derived type to have a non-BIND(C) component
so long as the component's type is interoperable and it satisfies all
other constraints.
---
 flang/lib/Semantics/check-declarations.cpp | 27 +++++++---------------
 flang/test/Semantics/bind-c15.f90          |  7 ++++++
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index bfb38fa1340e..a55b360cee7c 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -138,7 +138,7 @@ private:
   void CheckGlobalName(const Symbol &);
   void CheckProcedureAssemblyName(const Symbol &symbol);
   void CheckExplicitSave(const Symbol &);
-  parser::Messages WhyNotInteroperableDerivedType(const Symbol &, bool isError);
+  parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
   parser::Messages WhyNotInteroperableObject(const Symbol &, bool isError);
   parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
   parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
@@ -2892,13 +2892,12 @@ void CheckHelper::CheckProcedureAssemblyName(const Symbol &symbol) {
 }
 
 parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
-    const Symbol &symbol, bool isError) {
+    const Symbol &symbol) {
   parser::Messages msgs;
   if (examinedByWhyNotInteroperable_.find(symbol) !=
       examinedByWhyNotInteroperable_.end()) {
     return msgs;
   }
-  isError |= symbol.attrs().test(Attr::BIND_C);
   examinedByWhyNotInteroperable_.insert(symbol);
   if (const auto *derived{symbol.detailsIf<DerivedTypeDetails>()}) {
     if (derived->sequence()) { // C1801
@@ -2909,14 +2908,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
           "An interoperable derived type cannot have a type parameter"_err_en_US);
     } else if (const auto *parent{
                    symbol.scope()->GetDerivedTypeParent()}) { // C1803
-      if (isError) {
+      if (symbol.attrs().test(Attr::BIND_C)) {
         msgs.Say(symbol.name(),
             "A derived type with the BIND attribute cannot be an extended derived type"_err_en_US);
       } else {
         bool interoperableParent{true};
         if (parent->symbol()) {
-          auto bad{WhyNotInteroperableDerivedType(
-              *parent->symbol(), /*isError=*/false)};
+          auto bad{WhyNotInteroperableDerivedType(*parent->symbol())};
           if (bad.AnyFatalError()) {
             auto &msg{msgs.Say(symbol.name(),
                 "The parent of an interoperable type is not interoperable"_err_en_US)};
@@ -2946,8 +2944,7 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
             "An interoperable derived type cannot have a pointer or allocatable component"_err_en_US);
       } else if (const auto *type{component.GetType()}) {
         if (const auto *derived{type->AsDerived()}) {
-          auto bad{
-              WhyNotInteroperableDerivedType(derived->typeSymbol(), isError)};
+          auto bad{WhyNotInteroperableDerivedType(derived->typeSymbol())};
           if (bad.AnyFatalError()) {
             auto &msg{msgs.Say(component.name(),
                 "Component '%s' of an interoperable derived type must have an interoperable type but does not"_err_en_US,
@@ -2999,13 +2996,6 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
       }
     }
   }
-  if (isError) {
-    for (auto &m : msgs.messages()) {
-      if (!m.IsFatal()) {
-        m.set_severity(parser::Severity::Error);
-      }
-    }
-  }
   if (msgs.AnyFatalError()) {
     examinedByWhyNotInteroperable_.erase(symbol);
   }
@@ -3055,8 +3045,8 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
         msgs.Say(symbol.name(),
                 "The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)
             .Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
-      } else if (auto bad{WhyNotInteroperableDerivedType(
-                     derived->typeSymbol(), /*isError=*/false)};
+      } else if (auto bad{
+                     WhyNotInteroperableDerivedType(derived->typeSymbol())};
                  bad.AnyFatalError()) {
         bad.AttachTo(
             msgs.Say(symbol.name(),
@@ -3261,8 +3251,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
       symbol.has<SubprogramDetails>()) {
     whyNot = WhyNotInteroperableProcedure(symbol, /*isError=*/isExplicitBindC);
   } else if (symbol.has<DerivedTypeDetails>()) {
-    whyNot =
-        WhyNotInteroperableDerivedType(symbol, /*isError=*/isExplicitBindC);
+    whyNot = WhyNotInteroperableDerivedType(symbol);
   }
   if (!whyNot.empty()) {
     bool anyFatal{whyNot.AnyFatalError()};
diff --git a/flang/test/Semantics/bind-c15.f90 b/flang/test/Semantics/bind-c15.f90
index 9aaad52cc0e0..82a3cbef791e 100644
--- a/flang/test/Semantics/bind-c15.f90
+++ b/flang/test/Semantics/bind-c15.f90
@@ -16,6 +16,13 @@ module m
   type :: non_interoperable2
     type(non_interoperable1) b
   end type
+  type :: no_bind_c
+    real a
+  end type
+  type, bind(c) :: has_bind_c
+    !WARNING: Derived type of component 'a' of an interoperable derived type should have the BIND attribute
+    type(no_bind_c) :: a
+  end type
   interface
     subroutine sub_bind_c_1(x_bind_c) bind(c)
       import explicit_bind_c