[flang-commits] [flang] 86ce609 - [flang] Fix CONTIGUOUS attribute checking

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-03-28T04:44:01-07:00
New Revision: 86ce609d3f420e55fc2c282560acf8f71deaddbf

URL: https://github.com/llvm/llvm-project/commit/86ce609d3f420e55fc2c282560acf8f71deaddbf
DIFF: https://github.com/llvm/llvm-project/commit/86ce609d3f420e55fc2c282560acf8f71deaddbf.diff

LOG: [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

Added: 
    

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 0e4ba83cae36f..5bd794f104d37 100644
--- 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
index d1e86201c4d6a..08465a965e6ac 100644
--- 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)