Skip to content

Conversation

@klausler
Copy link
Contributor

@klausler klausler commented Nov 5, 2024

The standard doesn't require that an interoperable procedure's dummy arguments have interoperable derived types in some cases. Although nearly all extant Fortran compilers emit errors, some don't, and things should work; so reduce the current fatal error message to an optional portability warning.

Fixes #115010.

@klausler klausler requested a review from clementval November 5, 2024 23:29
@llvmbot llvmbot added flang Flang issues not falling into any other category flang:semantics labels Nov 5, 2024
@llvmbot
Copy link
Member

llvmbot commented Nov 5, 2024

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

The standard doesn't require that an interoperable procedure's dummy arguments have interoperable derived types in some cases. Although nearly all extant Fortran compilers emit errors, some don't, and things should work; so reduce the current fatal error message to an optional portability warning.

Fixes #115010.


Full diff: https://github.com/llvm/llvm-project/pull/115092.diff

3 Files Affected:

  • (modified) flang/include/flang/Evaluate/tools.h (+1-2)
  • (modified) flang/lib/Semantics/check-declarations.cpp (+19-6)
  • (added) flang/test/Semantics/bind-c17.f90 (+10)
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index f547138f5a116c..a8a6eb922a045d 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1103,8 +1103,7 @@ extern template semantics::UnorderedSymbolSet CollectCudaSymbols(
 bool HasVectorSubscript(const Expr<SomeType> &);
 
 // Utilities for attaching the location of the declaration of a symbol
-// of interest to a message, if both pointers are non-null.  Handles
-// the case of USE association gracefully.
+// of interest to a message.  Handles the case of USE association gracefully.
 parser::Message *AttachDeclaration(parser::Message &, const Symbol &);
 parser::Message *AttachDeclaration(parser::Message *, const Symbol &);
 template <typename MESSAGES, typename... A>
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index f8e873008ceabc..547ff96de0c8fe 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -147,7 +147,8 @@ class CheckHelper {
   void CheckProcedureAssemblyName(const Symbol &symbol);
   void CheckExplicitSave(const Symbol &);
   parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
-  parser::Messages WhyNotInteroperableObject(const Symbol &);
+  parser::Messages WhyNotInteroperableObject(
+      const Symbol &, bool allowNonInteroperableType = false);
   parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
   parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
   void CheckBindC(const Symbol &);
@@ -2999,7 +3000,8 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
   return msgs;
 }
 
-parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
+parser::Messages CheckHelper::WhyNotInteroperableObject(
+    const Symbol &symbol, bool allowNonInteroperableType) {
   parser::Messages msgs;
   if (examinedByWhyNotInteroperable_.find(symbol) !=
       examinedByWhyNotInteroperable_.end()) {
@@ -3035,14 +3037,19 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
   if (const auto *type{symbol.GetType()}) {
     const auto *derived{type->AsDerived()};
     if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
-      if (!context_.IsEnabled(
-              common::LanguageFeature::NonBindCInteroperability)) {
+      if (allowNonInteroperableType) { // portability warning only
+        evaluate::AttachDeclaration(
+            context_.Warn(common::UsageWarning::Portability, symbol.name(),
+                "The derived type of this interoperable object should be BIND(C)"_port_en_US),
+            derived->typeSymbol());
+      } else if (!context_.IsEnabled(
+                     common::LanguageFeature::NonBindCInteroperability)) {
         msgs.Say(symbol.name(),
                 "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())};
-                 bad.AnyFatalError()) {
+          bad.AnyFatalError()) {
         bad.AttachTo(
             msgs.Say(symbol.name(),
                     "The derived type of an interoperable object must be interoperable, but is not"_err_en_US)
@@ -3176,7 +3183,13 @@ 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);
+          // Emit only optional portability warnings for non-interoperable
+          // types when the dummy argument is not VALUE and will be implemented
+          // on the C side by either a cdesc_t * or a void *.  F'2023 18.3.7 (5)
+          bool allowNonInteroperableType{!dummy->attrs().test(Attr::VALUE) &&
+              (IsDescriptor(*dummy) || IsAssumedType(*dummy))};
+          dummyMsgs =
+              WhyNotInteroperableObject(*dummy, allowNonInteroperableType);
         } else {
           CheckBindC(*dummy);
         }
diff --git a/flang/test/Semantics/bind-c17.f90 b/flang/test/Semantics/bind-c17.f90
new file mode 100644
index 00000000000000..8e0ecde67a0a50
--- /dev/null
+++ b/flang/test/Semantics/bind-c17.f90
@@ -0,0 +1,10 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror
+module m
+  type a ! not BIND(C)
+  end type
+ contains
+  subroutine sub(x) bind(c)
+    !PORTABILITY: The derived type of this interoperable object should be BIND(C)
+    type(a), pointer, intent(in) :: x
+  end
+end

@github-actions
Copy link

github-actions bot commented Nov 5, 2024

✅ With the latest revision this PR passed the C/C++ code formatter.

The standard doesn't require that an interoperable procedure's
dummy arguments have interoperable derived types in some cases.
Although nearly all extant Fortran compilers emit errors, some
don't, and things should work; so reduce the current fatal error
message to an optional portability warning.

Fixes llvm#115010.
Copy link
Contributor

@clementval clementval left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

LGTM

@klausler klausler merged commit b3026ba into llvm:main Nov 14, 2024
8 checks passed
@klausler klausler deleted the bug115010 branch November 14, 2024 22:56
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Labels

flang:semantics flang Flang issues not falling into any other category

Projects

None yet

Development

Successfully merging this pull request may close these issues.

[flang] Incorrect Error for bind(c) procedure

3 participants