[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

   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 &);

   }
   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 (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) ||

   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_) {

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

flang/test/Semantics/call07.f90

   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

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

   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