diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 04f2ebcbcaee2..a08a1e803a1c0 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -268,6 +268,43 @@ bool OmpStructureChecker::CheckAllowedClause(llvmOmpClause clause) { return CheckAllowed(clause); } +void OmpStructureChecker::AnalyzeObject( + const parser::OmpObject &object, bool allowAssumedSizeArrays) { + if (std::holds_alternative(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() || symbol->has()) { + // 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(allowAssumedSizeArrays)}; + common::visit([&](auto &&s) { ea.Analyze(s); }, object.u); +} + +void OmpStructureChecker::AnalyzeObjects( + const parser::OmpObjectList &objects, bool allowAssumedSizeArrays) { + for (const parser::OmpObject &object : objects.v) { + AnalyzeObject(object, allowAssumedSizeArrays); + } +} + bool OmpStructureChecker::IsCloselyNestedRegion(const OmpDirectiveSet &set) { // Definition of close nesting: // @@ -2705,8 +2742,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: @@ -2720,7 +2758,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; @@ -2729,7 +2767,20 @@ void OmpStructureChecker::Enter(const parser::OmpClause &x) { break; } + auto allowsAssumedSizeArrays{[](llvm::omp::Clause c) { + // These clauses allow assumed-size-arrays as list items. + switch (c) { + case llvm::omp::Clause::OMPC_map: + case llvm::omp::Clause::OMPC_shared: + case llvm::omp::Clause::OMPC_use_device_addr: + return true; + default: + return false; + } + }}; + if (const parser::OmpObjectList *objList{GetOmpObjectList(x)}) { + AnalyzeObjects(*objList, allowsAssumedSizeArrays(id)); SymbolSourceMap symbols; GetSymbolsInObjectList(*objList, symbols); for (const auto &[symbol, source] : symbols) { diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 8ac905242162f..177a5f4bd3a27 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -167,6 +167,10 @@ class OmpStructureChecker void CheckVariableListItem(const SymbolSourceMap &symbols); void CheckDirectiveSpelling( parser::CharBlock spelling, llvm::omp::Directive id); + void AnalyzeObject( + const parser::OmpObject &object, bool allowAssumedSizeArrays = false); + void AnalyzeObjects(const parser::OmpObjectList &objects, + bool allowAssumedSizeArrays = false); void CheckMultipleOccurrence(semantics::UnorderedSymbolSet &listVars, const std::list &nameList, const parser::CharBlock &item, const std::string &clauseName); diff --git a/flang/test/Lower/OpenMP/Todo/omp-do-simd-linear.f90 b/flang/test/Lower/OpenMP/Todo/omp-do-simd-linear.f90 index 4caf12a0169c4..db8f5c293b40e 100644 --- a/flang/test/Lower/OpenMP/Todo/omp-do-simd-linear.f90 +++ b/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 diff --git a/flang/test/Semantics/OpenMP/cray-pointer-usage.f90 b/flang/test/Semantics/OpenMP/cray-pointer-usage.f90 index 6c74462dd2789..bc45c2e38d057 100644 --- a/flang/test/Semantics/OpenMP/cray-pointer-usage.f90 +++ b/flang/test/Semantics/OpenMP/cray-pointer-usage.f90 @@ -4,6 +4,9 @@ subroutine test_cray_pointer_usage integer :: i real(8) :: var(*), pointee(2) pointer(ivar, var) + real(8) :: var2(10) + pointer(ivar2, var2) + ! ERROR: Whole assumed-size array 'var' may not appear here without subscripts ! ERROR: Cray Pointee 'var' may not appear in LINEAR clause ! ERROR: The list item 'var' specified without the REF 'linear-modifier' must be of INTEGER type ! ERROR: The list item `var` must be a dummy argument @@ -17,9 +20,9 @@ subroutine test_cray_pointer_usage print *, var(1) !$omp end parallel - ! ERROR: Cray Pointee 'var' may not appear in PRIVATE clause, use Cray Pointer 'ivar' instead - !$omp parallel num_threads(2) default(none) private(var) - print *, var(1) + ! ERROR: Cray Pointee 'var2' may not appear in PRIVATE clause, use Cray Pointer 'ivar2' instead + !$omp parallel num_threads(2) default(none) private(var2) + print *, var2(1) !$omp end parallel ! ERROR: Cray Pointee 'var' may not appear in SHARED clause, use Cray Pointer 'ivar' instead diff --git a/flang/test/Semantics/OpenMP/declare-mapper02.f90 b/flang/test/Semantics/OpenMP/declare-mapper02.f90 index a62a7f8d0a392..2ad87c914bc7d 100644 --- a/flang/test/Semantics/OpenMP/declare-mapper02.f90 +++ b/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 diff --git a/flang/test/Semantics/OpenMP/depend01.f90 b/flang/test/Semantics/OpenMP/depend01.f90 index 19fcfbf64bebd..6c6cc16bcc5f9 100644 --- a/flang/test/Semantics/OpenMP/depend01.f90 +++ b/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 diff --git a/flang/test/Semantics/OpenMP/depend07.f90 b/flang/test/Semantics/OpenMP/depend07.f90 new file mode 100644 index 0000000000000..53c98b079f34b --- /dev/null +++ b/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 +