[flang-commits] [PATCH] D157342: [flang] Foil attempts to require interoperable objects be CONTIGUOUS

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

BIND(C) interoperable descriptors may not be required to be CONTIGUOUS.

(Also fixed erroneous true result from IsDescriptor() predicate for
assumed-size arrays that was exposed by testing.)

Fixes llvm-test-suite/Fortran/gfortran/regression/bind_c_contiguous.f90.


https://reviews.llvm.org/D157342

Files:
  flang/lib/Evaluate/type.cpp
  flang/lib/Semantics/check-declarations.cpp
  flang/test/Semantics/bind-c13.f90


Index: flang/test/Semantics/bind-c13.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/bind-c13.f90
@@ -0,0 +1,14 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Interoperable objects that require descriptors cannot be CONTIGUOUS
+subroutine interop(ptr,ashape,arank,eshape,asize) bind(c)
+  !ERROR: An interoperable object must not be CONTIGUOUS
+  real, pointer, contiguous :: ptr(:)
+  !ERROR: An interoperable object must not be CONTIGUOUS
+  real, contiguous :: ashape(:)
+  !ERROR: An interoperable object must not be CONTIGUOUS
+  real, contiguous :: arank(..)
+  !ERROR: CONTIGUOUS entity 'eshape' must be an array pointer, assumed-shape, or assumed-rank
+  real, contiguous :: eshape(10)
+  !ERROR: CONTIGUOUS entity 'asize' must be an array pointer, assumed-shape, or assumed-rank
+  real, contiguous :: asize(*)
+end
Index: flang/lib/Semantics/check-declarations.cpp
===================================================================
--- flang/lib/Semantics/check-declarations.cpp
+++ flang/lib/Semantics/check-declarations.cpp
@@ -2707,6 +2707,10 @@
       WarnIfNotInModuleFile(symbol.name(),
           "An interoperable procedure with an OPTIONAL dummy argument might not be portable"_port_en_US);
     }
+    if (IsDescriptor(symbol) && symbol.attrs().test(Attr::CONTIGUOUS)) {
+      messages_.Say(symbol.name(),
+          "An interoperable object must not be CONTIGUOUS"_err_en_US);
+    }
   } else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) {
     if (!proc->procInterface() ||
         !proc->procInterface()->attrs().test(Attr::BIND_C)) {
Index: flang/lib/Evaluate/type.cpp
===================================================================
--- flang/lib/Evaluate/type.cpp
+++ flang/lib/Evaluate/type.cpp
@@ -34,13 +34,23 @@
 }
 
 static bool IsDescriptor(const ObjectEntityDetails &details) {
-  if (IsDescriptor(details.type())) {
+  if (IsDescriptor(details.type()) || details.IsAssumedRank()) {
     return true;
   }
+  std::size_t j{0};
   for (const ShapeSpec &shapeSpec : details.shape()) {
-    const auto &lb{shapeSpec.lbound().GetExplicit()};
-    const auto &ub{shapeSpec.ubound().GetExplicit()};
-    if (!lb || !ub || !IsConstantExpr(*lb) || !IsConstantExpr(*ub)) {
+    ++j;
+    if (const auto &lb{shapeSpec.lbound().GetExplicit()};
+        !lb || !IsConstantExpr(*lb)) {
+      return true;
+    }
+    if (const auto &ub{shapeSpec.ubound().GetExplicit()}) {
+      if (!IsConstantExpr(*ub)) {
+        return true;
+      }
+    } else if (j == details.shape().size() && details.isDummy()) {
+      // assumed size array
+    } else {
       return true;
     }
   }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D157342.547973.patch
Type: text/x-patch
Size: 2696 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230807/25e16a24/attachment-0001.bin>