[flang][OpenMP] Analyze objects in OmpObjectList on clauses (#155424) (#155667)

This is intended to diagnose errors such as incorrect uses of
assumed-size arrays, for example.

Fixes llvm/llvm-project#151990

Reinstate 6308531 (PR 155424) with a change that treats whole
assumed- size-arrays as variables (as defined by the Fortran standard).
This treats them, by default, as valid variable list items.

Author: kparzysz

flang/lib/Semantics/check-omp-structure.cpp

@@ -268,6 +268,41 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) {
   return CheckAllowed(clause);
 }
 
+void OmpStructureChecker::AnalyzeObject(const parser::OmpObject &object) {
+  if (std::holds_alternative<parser::Name>(object.u)) {
+    // Do not analyze common block names. The analyzer will flag an error
+    // on those.
+    return;
+  }
+  if (auto *symbol{GetObjectSymbol(object)}) {
+    // Eliminate certain kinds of symbols before running the analyzer to
+    // avoid confusing error messages. The analyzer assumes that the context
+    // of the object use is an expression, and some diagnostics are tailored
+    // to that.
+    if (symbol->has<DerivedTypeDetails>() || symbol->has<MiscDetails>()) {
+      // Type names, construct names, etc.
+      return;
+    }
+    if (auto *typeSpec{symbol->GetType()}) {
+      if (typeSpec->category() == DeclTypeSpec::Category::Character) {
+        // Don't pass character objects to the analyzer, it can emit somewhat
+        // cryptic errors (e.g. "'obj' is not an array"). Substrings are
+        // checked elsewhere in OmpStructureChecker.
+        return;
+      }
+    }
+  }
+  evaluate::ExpressionAnalyzer ea{context_};
+  auto restore{ea.AllowWholeAssumedSizeArray(true)};
+  common::visit([&](auto &&s) { ea.Analyze(s); }, object.u);
+}
+
+void OmpStructureChecker::AnalyzeObjects(const parser::OmpObjectList &objects) {
+  for (const parser::OmpObject &object : objects.v) {
+    AnalyzeObject(object);
+  }
+}
+
 bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) {
   // Definition of close nesting:
   //
@@ -2697,8 +2732,9 @@ void OmpStructureChecker::Leave(const parser::OmpClauseList &) {
 void OmpStructureChecker::Enter(const parser::OmpClause &x) {
   SetContextClause(x);
 
+  llvm::omp::Clause id{x.Id()};
   // The visitors for these clauses do their own checks.
-  switch (x.Id()) {
+  switch (id) {
   case llvm::omp::Clause::OMPC_copyprivate:
   case llvm::omp::Clause::OMPC_enter:
   case llvm::omp::Clause::OMPC_lastprivate:
@@ -2712,7 +2748,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause &x) {
   // Named constants are OK to be used within 'shared' and 'firstprivate'
   // clauses.  The check for this happens a few lines below.
   bool SharedOrFirstprivate = false;
-  switch (x.Id()) {
+  switch (id) {
   case llvm::omp::Clause::OMPC_shared:
   case llvm::omp::Clause::OMPC_firstprivate:
     SharedOrFirstprivate = true;
@@ -2722,6 +2758,7 @@ void OmpStructureChecker::Enter(const parser::OmpClause &x) {
   }
 
   if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) {
+    AnalyzeObjects(*objList);
     SymbolSourceMap symbols;
     GetSymbolsInObjectList(*objList, symbols);
     for (const auto &[symbol, source] : symbols) {

flang/lib/Semantics/check-omp-structure.h

@@ -167,6 +167,8 @@ class OmpStructureChecker
   void CheckVariableListItem(const SymbolSourceMap &symbols);
   void CheckDirectiveSpelling(
       parser::CharBlock spelling, llvm::omp::Directive id);
+  void AnalyzeObject(const parser::OmpObject &object);
+  void AnalyzeObjects(const parser::OmpObjectList &objects);
   void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars,
       const std::list<parser::Name> &nameList, const parser::CharBlock &item,
       const std::string &clauseName);

flang/test/Lower/OpenMP/Todo/omp-do-simd-linear.f90

@@ -3,7 +3,7 @@
 ! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 ! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 subroutine testDoSimdLinear(int_array)
-        integer :: int_array(*)
+        integer :: int_array(:)
 !CHECK: not yet implemented: Unhandled clause LINEAR in SIMD construct
 !$omp do simd linear(int_array)
         do index_ = 1, 10

flang/test/Semantics/OpenMP/declare-mapper02.f90

@@ -6,5 +6,6 @@
 end type t1
 
 !ERROR: ABSTRACT derived type may not be used here
+!ERROR: Reference to object with abstract derived type 't1' must be polymorphic
 !$omp declare mapper(mm : t1::x) map(x, x%y)
 end

flang/test/Semantics/OpenMP/depend01.f90

@@ -20,7 +20,7 @@ program omp_depend
   !ERROR: 'a' in DEPEND clause must have a positive stride
   !ERROR: 'b' in DEPEND clause must have a positive stride
   !ERROR: 'b' in DEPEND clause is a zero size array section
-  !$omp task shared(x) depend(in: a(10:5:-1)) depend(in: b(5:10:-1))
+  !$omp task shared(x) depend(in: a(10:5:-1)) depend(in: b(5:10:-1, 2))
   print *, a(5:10), b
   !$omp end task
 

flang/test/Semantics/OpenMP/depend07.f90

@@ -0,0 +1,11 @@
+!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=45
+
+subroutine foo(x)
+  integer :: x(3, *)
+  !$omp task depend(in:x(:,5))
+  !$omp end task
+  !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
+  !$omp task depend(in:x(5,:))
+  !$omp end task
+end
+