[flang] Foil attempts to require interoperable objects be CONTIGUOUS

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/type.cpp

if (type) {
     if (auto dynamicType{evaluate::DynamicType::From(*type)}) {
       return dynamicType->RequiresDescriptor();
     }
   }
   return false;
 }
 
 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;
     }
   }
   return false;
 }
 
 bool IsDescriptor(const Symbol &symbol) {
   return common::visit(

flang/lib/Semantics/check-declarations.cpp

if (const auto *type{symbol.GetType()}) {
             "A BIND(C) object must have an interoperable type"_err_en_US);
         context_.SetError(symbol);
       }
     }
     if (IsOptional(symbol) && !symbol.attrs().test(Attr::VALUE)) {
       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)) {
       if (proc->isDummy()) {
         messages_.Say(symbol.name(),
             "A dummy procedure to an interoperable procedure must also be interoperable"_err_en_US);
         context_.SetError(symbol);
       } else {

flang/test/Semantics/bind-c13.f90

+! 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