[flang] Fix CONTIGUOUS attribute checking

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. Differential Revision: https://reviews.llvm.org/D146588
llvm · Mar 28, 2023 · 86ce609 · 86ce609
1 parent 83c90e6
commit 86ce609
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 12 deletions.
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
@@ -260,10 +260,25 @@ void CheckHelper::Check(const Symbol &symbol) {
       !symbol.implicitAttrs().test(Attr::SAVE)) {
     CheckExplicitSave(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(
@@ -330,7 +345,7 @@ void CheckHelper::Check(const Symbol &symbol) {
                     ProcedureDefinitionClass::Dummy)) ||
         symbol.test(Symbol::Flag::ParentComp)};
     if (!IsStmtFunctionDummy(symbol)) { // C726
-      if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+      if (object) {
         canHaveAssumedParameter |= object->isDummy() ||
             (isChar && object->isFuncResult()) ||
             IsStmtFunctionResult(symbol); // Avoids multiple messages
@@ -393,10 +408,6 @@ void CheckHelper::Check(const Symbol &symbol) {
   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(
@@ -409,12 +420,6 @@ void CheckHelper::Check(const Symbol &symbol) {
     }
     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"

diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
@@ -19,11 +19,13 @@ subroutine s04(p)
   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
     !WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous
     call s01(a02)