[flang-commits] [flang] [flang] Allow interoperable object to have interoperable derived type… (PR #94768)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/94768

>From fd95cabfa081801a960ff8d160a31cabde1fc22c Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 7 Jun 2024 08:54:09 -0700
Subject: [PATCH] [flang] Allow interoperable object to have interoperable
 derived type that's not BIND(C)

An interoperable BIND(C) object with a derived type should have
a BIND(C) derived type, but will now work with a derived type that
satisfies all of the requirements of a BIND(C) derived type.
---
 flang/lib/Semantics/check-declarations.cpp | 18 ++++++++----------
 flang/test/Semantics/declarations02.f90    |  6 +++---
 2 files changed, 11 insertions(+), 13 deletions(-)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index ff43223f3e054..4bb625bfbc2ca 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -143,7 +143,7 @@ class CheckHelper {
   void CheckProcedureAssemblyName(const Symbol &symbol);
   void CheckExplicitSave(const Symbol &);
   parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
-  parser::Messages WhyNotInteroperableObject(const Symbol &, bool isError);
+  parser::Messages WhyNotInteroperableObject(const Symbol &);
   parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
   parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
   void CheckBindC(const Symbol &);
@@ -3012,15 +3012,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
   return msgs;
 }
 
-parser::Messages CheckHelper::WhyNotInteroperableObject(
-    const Symbol &symbol, bool isError) {
+parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
   parser::Messages msgs;
   if (examinedByWhyNotInteroperable_.find(symbol) !=
       examinedByWhyNotInteroperable_.end()) {
     return msgs;
   }
   bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
-  isError |= isExplicitBindC;
   examinedByWhyNotInteroperable_.insert(symbol);
   CHECK(symbol.has<ObjectEntityDetails>());
   if (isExplicitBindC && !symbol.owner().IsModule()) {
@@ -3049,11 +3047,11 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
   }
   if (const auto *type{symbol.GetType()}) {
     const auto *derived{type->AsDerived()};
-    if (derived) {
-      if (derived->typeSymbol().attrs().test(Attr::BIND_C)) {
-      } else if (isError) {
+    if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
+      if (!context_.IsEnabled(
+              common::LanguageFeature::NonBindCInteroperability)) {
         msgs.Say(symbol.name(),
-                "The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)
+                "The derived type of an interoperable object must be BIND(C)"_err_en_US)
             .Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
       } else if (auto bad{
                      WhyNotInteroperableDerivedType(derived->typeSymbol())};
@@ -3186,7 +3184,7 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
                 "A dummy procedure of an interoperable procedure should be BIND(C)"_warn_en_US);
           }
         } else if (dummy->has<ObjectEntityDetails>()) {
-          dummyMsgs = WhyNotInteroperableObject(*dummy, /*isError=*/false);
+          dummyMsgs = WhyNotInteroperableObject(*dummy);
         } else {
           CheckBindC(*dummy);
         }
@@ -3256,7 +3254,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
     }
   }
   if (symbol.has<ObjectEntityDetails>()) {
-    whyNot = WhyNotInteroperableObject(symbol, /*isError=*/isExplicitBindC);
+    whyNot = WhyNotInteroperableObject(symbol);
   } else if (symbol.has<ProcEntityDetails>() ||
       symbol.has<SubprogramDetails>()) {
     whyNot = WhyNotInteroperableProcedure(symbol, /*isError=*/isExplicitBindC);
diff --git a/flang/test/Semantics/declarations02.f90 b/flang/test/Semantics/declarations02.f90
index f39c233c1c3a4..32c3517d13cd1 100644
--- a/flang/test/Semantics/declarations02.f90
+++ b/flang/test/Semantics/declarations02.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 
 module m
   !ERROR: 'x1' may not have both the BIND(C) and PARAMETER attributes
@@ -32,14 +32,14 @@ module m
   end type
 
   !ERROR: 't1' may not have both the BIND(C) and PARAMETER attributes
-  !ERROR: The derived type of a BIND(C) object must also be BIND(C)
+  !WARNING: The derived type of an interoperable object should be BIND(C)
   type(my_type1), bind(c), parameter :: t1 = my_type1(1)
   !ERROR: 't2' may not have both the BIND(C) and PARAMETER attributes
   type(my_type2), bind(c), parameter :: t2 = my_type2(1)
 
   type(my_type2), parameter :: t3 = my_type2(1) ! no error
   !ERROR: 't4' may not have both the BIND(C) and PARAMETER attributes
-  !ERROR: The derived type of a BIND(C) object must also be BIND(C)
+  !WARNING: The derived type of an interoperable object should be BIND(C)
   type(my_type1), parameter :: t4 = my_type1(1)
   !ERROR: 't5' may not have both the BIND(C) and PARAMETER attributes
   type(my_type2), parameter :: t5 = my_type2(1)