[flang] More precise CONTIGUOUS checking

[klausler]

Summary

A recent fix to avoid bogus errors with the CONTIGUOUS attribute caused
declaration checking to miss errors with applications of CONTIGUOUS to
names that are not variables. Restore those error messages, and
add tests to ensure that the original problem remains fixed while
the recent regressions have been resolved.

[PeteSteinfeld]

All builds and tests correctly and looks good.

Thanks for the fast action on this!

flang/lib/Semantics/check-declarations.cpp

public:
   const Procedure *Characterize(const Symbol &);
 
 private:
   template <typename A> void CheckSpecExpr(const A &x) {
     evaluate::CheckSpecificationExpr(x, DEREF(scope_), foldingContext_);
   }
   void CheckValue(const Symbol &, const DerivedTypeSpec *);
   void CheckVolatile(const Symbol &, const DerivedTypeSpec *);
+  void CheckContiguous(const Symbol &);
   void CheckPointer(const Symbol &);
   void CheckPassArg(
       const Symbol &proc, const Symbol *interface, const WithPassArg &);
   void CheckProcBinding(const Symbol &, const ProcBindingDetails &);
   void CheckObjectEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckPointerInitialization(const Symbol &);
   void CheckArraySpec(const Symbol &, const ArraySpec &);
   void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
void CheckHelper::Check(const Symbol &symbol) {
   }
   if (symbol.attrs().test(Attr::BIND_C)) {
     CheckBindC(symbol);
   }
   if (symbol.attrs().test(Attr::SAVE) &&
       !symbol.implicitAttrs().test(Attr::SAVE)) {
     CheckExplicitSave(symbol);
   }
-  const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
+  if (symbol.attrs().test(Attr::CONTIGUOUS)) {
+    CheckContiguous(symbol);
+  }
   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(
if (symbol.attrs().test(Attr::VOLATILE) &&
       messages_.Say(
           "A pure subprogram may not have a variable with the VOLATILE attribute"_err_en_US);
     }
     if (IsProcedure(symbol) && !IsPureProcedure(symbol) && IsDummy(symbol)) {
       messages_.Say(
           "A dummy procedure of a pure subprogram must be pure"_err_en_US);
     }
   }
+  const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
   if (type) { // Section 7.2, paragraph 7; C795
     bool isChar{type->category() == DeclTypeSpec::Character};
     bool canHaveAssumedParameter{(isChar && IsNamedConstant(symbol)) ||
         (IsAssumedLengthCharacter(symbol) && // C722
             (IsExternal(symbol) ||
                 ClassifyProcedure(symbol) ==
                     ProcedureDefinitionClass::Dummy)) ||
         symbol.test(Symbol::Flag::ParentComp)};
if (auto whyNot{
       }
     }
   }
   if (symbol.attrs().test(Attr::EXTERNAL)) {
     SayWithDeclaration(symbol,
         "'%s' is a data object and may not be EXTERNAL"_err_en_US,
         symbol.name());
   }
-  if (symbol.attrs().test(Attr::CONTIGUOUS)) {
-    if ((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
-        evaluate::IsAssumedRank(symbol)) {
-    } else 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);
-    }
-  }
 }
 
 void CheckHelper::CheckPointerInitialization(const Symbol &symbol) {
   if (IsPointer(symbol) && !context_.HasError(symbol) &&
       !scopeIsUninstantiatedPDT_) {
     if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
       if (object->init()) { // C764, C765; C808
         if (auto designator{evaluate::AsGenericExpr(symbol)}) {
if (derived) {
       if (FindCoarrayUltimateComponent(*derived)) {
         messages_.Say(
             "VOLATILE attribute may not apply to a type with a coarray ultimate component accessed by USE or host association"_err_en_US);
       }
     }
   }
 }
 
+void CheckHelper::CheckContiguous(const Symbol &symbol) {
+  if (evaluate::IsVariable(symbol) &&
+      ((IsPointer(symbol) && symbol.Rank() > 0) || IsAssumedShape(symbol) ||
+          evaluate::IsAssumedRank(symbol))) {
+  } else if (symbol.owner().IsDerivedType()) { // C752
+    messages_.Say(
+        "CONTIGUOUS component '%s' must be an array with the POINTER attribute"_err_en_US,
+        symbol.name());
+  } else {
+    messages_.Say(
+        "CONTIGUOUS entity '%s' must be an array pointer, assumed-shape, or assumed-rank"_err_en_US,
+        symbol.name());
+  }
+}
+
 void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
   CheckConflicting(symbol, Attr::POINTER, Attr::TARGET);
   CheckConflicting(symbol, Attr::POINTER, Attr::ALLOCATABLE); // C751
   CheckConflicting(symbol, Attr::POINTER, Attr::INTRINSIC);
   // Prohibit constant pointers.  The standard does not explicitly prohibit
   // them, but the PARAMETER attribute requires a entity-decl to have an
   // initialization that is a constant-expr, and the only form of
   // initialization that allows a constant-expr is the one that's not a "=>"

flang/test/Semantics/call07.f90

contains
   subroutine s03(p)
     real, pointer, intent(in) :: p(:)
   end subroutine
   subroutine s04(p)
     real, pointer :: p
   end subroutine
 
   subroutine test
-    !ERROR: CONTIGUOUS entity must be an array pointer, assumed-shape, or assumed-rank
+    !ERROR: CONTIGUOUS entity 'a01' 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
+    !ERROR: CONTIGUOUS entity 'scalar' 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)
     !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target
     call s01(a03(::2))
     call s02(a02) ! ok
     call s03(a03) ! ok

flang/test/Semantics/contiguous01.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m0
+  real, pointer, contiguous :: p1(:) ! ok
+  real, pointer :: p2(:)
+end
+module m
+  use m0
+  !ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p1'
+  contiguous p1
+  !ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p2'
+  contiguous p2
+  !ERROR: CONTIGUOUS entity 'x' must be an array pointer, assumed-shape, or assumed-rank
+  real, contiguous :: x
+  !ERROR: CONTIGUOUS entity 'scalar' must be an array pointer, assumed-shape, or assumed-rank
+  real, contiguous, pointer :: scalar
+  !ERROR: CONTIGUOUS entity 'allocatable' must be an array pointer, assumed-shape, or assumed-rank
+  real, contiguous, allocatable :: allocatable
+ contains
+  !ERROR: CONTIGUOUS entity 'func' must be an array pointer, assumed-shape, or assumed-rank
+  function func(ashape,arank) result(r)
+    real, contiguous :: ashape(:) ! ok
+    real, contiguous :: arank(..) ! ok
+    !ERROR: CONTIGUOUS entity 'r' must be an array pointer, assumed-shape, or assumed-rank
+    real :: r(10)
+    !ERROR: CONTIGUOUS entity 'r2' must be an array pointer, assumed-shape, or assumed-rank
+    real :: r2(10)
+    contiguous func
+    contiguous r
+    contiguous e
+    contiguous r2
+    !ERROR: CONTIGUOUS entity 'e' must be an array pointer, assumed-shape, or assumed-rank
+    entry e() result(r2)
+  end
+  function fp()
+    real, pointer, contiguous :: fp(:) ! ok
+  end
+end

flang/test/Semantics/resolve90.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Testing for pointer constant, along with :
 ! C751 A component shall not have both the ALLOCATABLE and POINTER attributes.
 ! C752 If the CONTIGUOUS attribute is specified, the component shall be an 
 !   array with the POINTER attribute.
 ! C753 The * char-length option is permitted only if the component is of type 
 !   character.
 subroutine s()
   !ERROR: 'nullint' may not have both the POINTER and PARAMETER attributes
   integer, pointer, parameter :: nullint => null()
   type derivedType
     !ERROR: 'pointerallocatablefield' may not have both the POINTER and ALLOCATABLE attributes
     real, pointer, allocatable :: pointerAllocatableField
     real, dimension(:), contiguous, pointer :: goodContigField
-    !ERROR: A CONTIGUOUS component must be an array with the POINTER attribute
+    !ERROR: CONTIGUOUS component 'badcontigfield' must be an array with the POINTER attribute
     real, dimension(:), contiguous, allocatable :: badContigField
     character :: charField * 3
     !ERROR: A length specifier cannot be used to declare the non-character entity 'realfield'
     real :: realField * 3
   end type derivedType
 end subroutine s