[flang-commits] [PATCH] D146588: [flang] Fix CONTIGUOUS attribute checking

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

A CONTIGUOUS entity must be an array pointer, assumed-shape dummy array,
or assumed-rank dummy argument (C752, C830).  As currently implemented,
f18 only implements the array requirement if the entity is a pointer.
Combine these checks and start issuing citations to scalars.


https://reviews.llvm.org/D146588

Files:
  flang/lib/Semantics/check-declarations.cpp
  flang/test/Semantics/call07.f90


Index: flang/test/Semantics/call07.f90
===================================================================
--- flang/test/Semantics/call07.f90
+++ flang/test/Semantics/call07.f90
@@ -19,11 +19,13 @@
   end subroutine
 
   subroutine test
-    !ERROR: CONTIGUOUS POINTER must be an array
+    !ERROR: CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank
     real, pointer, contiguous :: a01 ! C830
     real, pointer :: a02(:)
     real, target :: a03(10)
     real :: a04(10) ! not TARGET
+    !ERROR: CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank
+    real, contiguous :: scalar
     call s01(a03) ! ok
     !ERROR: Actual argument associated with CONTIGUOUS POINTER dummy argument 'p=' must be simply contiguous
     call s01(a02)
Index: flang/lib/Semantics/check-declarations.cpp
===================================================================
--- flang/lib/Semantics/check-declarations.cpp
+++ flang/lib/Semantics/check-declarations.cpp
@@ -257,10 +257,25 @@
   if (symbol.attrs().test(Attr::BIND_C)) {
     CheckBindC(symbol);
   }
+  const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
+  if (symbol.attrs().test(Attr::CONTIGUOUS)) {
+    if ((!object && !symbol.has<UseDetails>()) ||
+        !((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
+            evaluate::IsAssumedRank(symbol))) {
+      if (symbol.owner().IsDerivedType()) { // C752
+        messages_.Say(
+            "A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
+      } else { // C830
+        messages_.Say(
+            "CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank"_err_en_US);
+      }
+    }
+  }
   CheckGlobalName(symbol);
   if (isDone) {
     return; // following checks do not apply
   }
+
   if (symbol.attrs().test(Attr::PROTECTED)) {
     if (symbol.owner().kind() != Scope::Kind::Module) { // C854
       messages_.Say(
@@ -326,7 +341,7 @@
                     ProcedureDefinitionClass::Dummy)) ||
         symbol.test(Symbol::Flag::ParentComp)};
     if (!IsStmtFunctionDummy(symbol)) { // C726
-      if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+      if (object) {
         canHaveAssumedParameter |= object->isDummy() ||
             (object->isFuncResult() &&
                 type->category() == DeclTypeSpec::Character) ||
@@ -390,10 +405,6 @@
   if (symbol.attrs().test(Attr::VALUE)) {
     CheckValue(symbol, derived);
   }
-  if (symbol.attrs().test(Attr::CONTIGUOUS) && IsPointer(symbol) &&
-      symbol.Rank() == 0) { // C830
-    messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
-  }
   if (IsDummy(symbol)) {
     if (IsNamedConstant(symbol)) {
       messages_.Say(
@@ -416,12 +427,6 @@
     }
     CheckBindCFunctionResult(symbol);
   }
-  if (symbol.owner().IsDerivedType() &&
-      (symbol.attrs().test(Attr::CONTIGUOUS) &&
-          !(IsPointer(symbol) && symbol.Rank() > 0))) { // C752
-    messages_.Say(
-        "A CONTIGUOUS component must be an array with the POINTER attribute"_err_en_US);
-  }
   if (symbol.owner().IsModule() && IsAutomatic(symbol)) {
     messages_.Say(
         "Automatic data object '%s' may not appear in the specification part"


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D146588.507157.patch
Type: text/x-patch
Size: 3260 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230321/1c970e6e/attachment.bin>