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

[Peter Klausler via Phabricator via flang-commits]

This revision was automatically updated to reflect the committed changes.
Closed by commit rG6bc14f238e4b: [flang] Foil attempts to require interoperable pointers be CONTIGUOUS (authored by klausler).

Changed prior to commit:
  https://reviews.llvm.org/D157342?vs=547973&id=548303#toc

Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D157342/new/

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,12 @@
+! 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 pointer must not be CONTIGUOUS
+  real, pointer, contiguous :: ptr(:)
+  real, contiguous :: ashape(:) ! ok
+  real, contiguous :: arank(..) ! ok
+  !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
@@ -2720,6 +2720,11 @@
       WarnIfNotInModuleFile(symbol.name(),
           "An interoperable procedure with an OPTIONAL dummy argument might not be portable"_port_en_US);
     }
+    if (IsDescriptor(symbol) && IsPointer(symbol) &&
+        symbol.attrs().test(Attr::CONTIGUOUS)) {
+      messages_.Say(symbol.name(),
+          "An interoperable pointer 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.548303.patch
Type: text/x-patch
Size: 2622 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230808/4573bc4d/attachment-0001.bin>