diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp index 512a44ba77da1..d7a0681d1c3d4 100644 --- a/flang/lib/Semantics/check-omp-structure.cpp +++ b/flang/lib/Semantics/check-omp-structure.cpp @@ -1173,6 +1173,37 @@ void OmpStructureChecker::Enter(const parser::OpenMPDeclareTargetConstruct &x) { } } +void OmpStructureChecker::Enter(const parser::OmpDeclareTargetWithList &x) { + SymbolSourceMap symbols; + GetSymbolsInObjectList(x.v, symbols); + for (auto &[symbol, source] : symbols) { + const GenericDetails *genericDetails = symbol->detailsIf(); + if (genericDetails) { + context_.Say(source, + "The procedure '%s' in DECLARE TARGET construct cannot be a generic name."_err_en_US, + symbol->name()); + genericDetails->specific(); + } + if (IsProcedurePointer(*symbol)) { + context_.Say(source, + "The procedure '%s' in DECLARE TARGET construct cannot be a procedure pointer."_err_en_US, + symbol->name()); + } + const SubprogramDetails *entryDetails = + symbol->detailsIf(); + if (entryDetails && entryDetails->entryScope()) { + context_.Say(source, + "The procedure '%s' in DECLARE TARGET construct cannot be an entry name."_err_en_US, + symbol->name()); + } + if (IsStmtFunction(*symbol)) { + context_.Say(source, + "The procedure '%s' in DECLARE TARGET construct cannot be a statement function."_err_en_US, + symbol->name()); + } + } +} + void OmpStructureChecker::CheckSymbolNames( const parser::CharBlock &source, const parser::OmpObjectList &objList) { for (const auto &ompObject : objList.v) { diff --git a/flang/lib/Semantics/check-omp-structure.h b/flang/lib/Semantics/check-omp-structure.h index 0adfa7b5d8387..d35602cca75d5 100644 --- a/flang/lib/Semantics/check-omp-structure.h +++ b/flang/lib/Semantics/check-omp-structure.h @@ -79,6 +79,7 @@ class OmpStructureChecker void Leave(const parser::OpenMPDeclarativeAllocate &); void Enter(const parser::OpenMPDeclareTargetConstruct &); void Leave(const parser::OpenMPDeclareTargetConstruct &); + void Enter(const parser::OmpDeclareTargetWithList &); void Enter(const parser::OpenMPExecutableAllocate &); void Leave(const parser::OpenMPExecutableAllocate &); void Enter(const parser::OpenMPAllocatorsConstruct &); diff --git a/flang/test/Semantics/OpenMP/declare-target07.f90 b/flang/test/Semantics/OpenMP/declare-target07.f90 new file mode 100644 index 0000000000000..22b4a4bd081d7 --- /dev/null +++ b/flang/test/Semantics/OpenMP/declare-target07.f90 @@ -0,0 +1,49 @@ +! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp + +module my_module + interface foo + subroutine foo_int(a) + integer :: a + end subroutine + subroutine foo_real(a) + real :: a + end subroutine + end interface +contains + subroutine bar(N) + integer :: N + entry entry1(N) + end subroutine + subroutine foobar(N) + integer::N + !ERROR: The procedure 'entry1' in DECLARE TARGET construct cannot be an entry name. + !$omp declare target(bar, entry1) + call bar(N) + end subroutine +end module + +module other_mod + abstract interface + integer function foo(a) + integer, intent(in) :: a + end function + end interface + procedure(foo), pointer :: procptr + !ERROR: The procedure 'procptr' in DECLARE TARGET construct cannot be a procedure pointer. + !$omp declare target(procptr) +end module + +subroutine baz(x) + real, intent(inout) :: x + real :: res + stmtfunc(x) = 4.0 * (x**3) + !ERROR: The procedure 'stmtfunc' in DECLARE TARGET construct cannot be a statement function. + !$omp declare target (stmtfunc) + res = stmtfunc(x) +end subroutine + +program main + use my_module + !ERROR: The procedure 'foo' in DECLARE TARGET construct cannot be a generic name. + !$omp declare target(foo) +end