[flang-commits] [flang] 463f58a - [flang] Further work on relaxing BIND(C) enforcement (#92029)

[via flang-commits]

Author: Peter Klausler
Date: 2024-05-15T16:18:47-07:00
New Revision: 463f58a564a8d136b3e5d56d23bb86b99ab75245

URL: https://github.com/llvm/llvm-project/commit/463f58a564a8d136b3e5d56d23bb86b99ab75245
DIFF: https://github.com/llvm/llvm-project/commit/463f58a564a8d136b3e5d56d23bb86b99ab75245.diff

LOG: [flang] Further work on relaxing BIND(C) enforcement (#92029)

When a BIND(C) interface or subprogram has a dummy argument whose
derived type is not BIND(C) but meets the constraints and requirements
of a BIND(C) type, accept it with a warning.

Added: 
    flang/test/Semantics/bind-c15.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 8d17989ac2793..527a1a9539aa6 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2891,7 +2891,8 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
       } else {
         bool interoperableParent{true};
         if (parent->symbol()) {
-          auto bad{WhyNotInteroperableDerivedType(*parent->symbol(), false)};
+          auto bad{WhyNotInteroperableDerivedType(
+              *parent->symbol(), /*isError=*/false)};
           if (bad.AnyFatalError()) {
             auto &msg{msgs.Say(symbol.name(),
                 "The parent of an interoperable type is not interoperable"_err_en_US)};
@@ -2981,6 +2982,9 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
       }
     }
   }
+  if (msgs.AnyFatalError()) {
+    examinedByWhyNotInteroperableDerivedType_.erase(symbol);
+  }
   return msgs;
 }
 
@@ -3068,8 +3072,8 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
           }
           context_.SetError(symbol);
         } else if (auto bad{WhyNotInteroperableDerivedType(
-                       derived->typeSymbol(), false)};
-                   !bad.empty()) {
+                       derived->typeSymbol(), /*isError=*/false)};
+                   bad.AnyFatalError()) {
           if (auto *msg{messages_.Say(symbol.name(),
                   "The derived type of an interoperable object must be interoperable, but is not"_err_en_US)}) {
             msg->Attach(
@@ -3077,7 +3081,9 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
             bad.AttachTo(*msg, parser::Severity::None);
           }
           context_.SetError(symbol);
-        } else {
+        } else if (context_.ShouldWarn(
+                       common::LanguageFeature::NonBindCInteroperability) &&
+            !InModuleFile()) {
           if (auto *msg{messages_.Say(symbol.name(),
                   "The derived type of an interoperable object should be BIND(C)"_warn_en_US)}) {
             msg->Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
@@ -3151,7 +3157,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
       }
     }
   } else if (symbol.has<DerivedTypeDetails>()) {
-    if (auto msgs{WhyNotInteroperableDerivedType(symbol, false)};
+    if (auto msgs{WhyNotInteroperableDerivedType(symbol, /*isError=*/false)};
         !msgs.empty()) {
       bool anyFatal{msgs.AnyFatalError()};
       if (msgs.AnyFatalError() ||

diff  --git a/flang/test/Semantics/bind-c15.f90 b/flang/test/Semantics/bind-c15.f90
new file mode 100644
index 0000000000000..9aaad52cc0e0a
--- /dev/null
+++ b/flang/test/Semantics/bind-c15.f90
@@ -0,0 +1,45 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+
+module m
+  type, bind(c) :: explicit_bind_c
+    real a
+  end type
+  type :: interoperable1
+    type(explicit_bind_c) a
+  end type
+  type, extends(interoperable1) :: interoperable2
+    real b
+  end type
+  type :: non_interoperable1
+    real, allocatable :: a
+  end type
+  type :: non_interoperable2
+    type(non_interoperable1) b
+  end type
+  interface
+    subroutine sub_bind_c_1(x_bind_c) bind(c)
+      import explicit_bind_c
+      type(explicit_bind_c), intent(in) :: x_bind_c
+    end
+    subroutine sub_bind_c_2(x_interop1) bind(c)
+      import interoperable1
+      !WARNING: The derived type of an interoperable object should be BIND(C)
+      type(interoperable1), intent(in) :: x_interop1
+    end
+    subroutine sub_bind_c_3(x_interop2) bind(c)
+      import interoperable2
+      !WARNING: The derived type of an interoperable object should be BIND(C)
+      type(interoperable2), intent(in) :: x_interop2
+    end
+    subroutine sub_bind_c_4(x_non_interop1) bind(c)
+      import non_interoperable1
+      !ERROR: The derived type of an interoperable object must be interoperable, but is not
+      type(non_interoperable1), intent(in) :: x_non_interop1
+    end
+    subroutine sub_bind_c_5(x_non_interop2) bind(c)
+      import non_interoperable2
+      !ERROR: The derived type of an interoperable object must be interoperable, but is not
+      type(non_interoperable2), intent(in) :: x_non_interop2
+    end
+  end interface
+end