diff --git a/flang/docs/OpenMP-semantics.md b/flang/docs/OpenMP-semantics.md --- a/flang/docs/OpenMP-semantics.md +++ b/flang/docs/OpenMP-semantics.md @@ -626,6 +626,32 @@ all the data-sharing or data-mapping attributes marked for the `Symbols` may be used later in the Semantics Analysis and in the Code Generation. +## Declare Target & Target Region Implicit Function Capture Analysis + +The OpenMP specification states that all functions and subroutines called +from a _declare target_ function/subroutine or _target region_ are to +be treated as if they are marked as _declare target_ with a _to_ clause. + +The OpenMP specifications current wording (emphasis on current) gives +wiggle room for this to be done later in the compilation pipeline (e.g. +the MLIR -> LLVM IR phase). However, this means filtering out functions +from modules they do not belong in requires significant extra work on the +compilers behalf and less strict semantic rules can be applied to these +implicit target functions. So, in this case we have opted to perform this +implicit capture as a semantic analysis pass (_ImplicitDeclareTargetCapture_), +which marks all functions and subroutines (and their callees) that are called +within _target_ and _declare target_ functions as _declare _target_ +themselves by materializing the function or subroutines name in the original +declare target's clause list. + +This pass occurs after name and scope resolution, primarily so that all name +and symbol information is available for access and use and all functions are +now resolved as functions (i.e. no misinterpretation as an array). + +The semantic analysis pass has yet to be extended to support implicit +capture for target regions, however, this is an intended extension for +the future. + ## Module File Extensions for OpenMP After the successful compilation of modules and submodules diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -28,6 +28,7 @@ data-to-inits.cpp definable.cpp expression.cpp + finalize-omp.cpp mod-file.cpp pointer-assignment.cpp program-tree.cpp diff --git a/flang/lib/Semantics/finalize-omp.h b/flang/lib/Semantics/finalize-omp.h new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/finalize-omp.h @@ -0,0 +1,21 @@ +//===-- lib/Semantics/finalize-omp.h ------------------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_SEMANTICS_FINALIZE_OMP_H_ +#define FORTRAN_SEMANTICS_FINALIZE_OMP_H_ + +namespace Fortran::parser { +struct Program; +} // namespace Fortran::parser + +namespace Fortran::semantics { +class SemanticsContext; +bool FinalizeOMP(SemanticsContext &context, parser::Program &program); +} // namespace Fortran::semantics + +#endif // FORTRAN_SEMANTICS_FINALIZE_OMP_H_ diff --git a/flang/lib/Semantics/finalize-omp.cpp b/flang/lib/Semantics/finalize-omp.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Semantics/finalize-omp.cpp @@ -0,0 +1,181 @@ +#include "finalize-omp.h" +#include "flang/Parser/parse-tree-visitor.h" +#include "flang/Semantics/tools.h" + +#include +#include +#include + +namespace Fortran::semantics { + +using namespace parser::literals; + +class GatherCallRefs { +public: + GatherCallRefs() {} + + // Default action for a parse tree node is to visit children. + template bool Pre(T &) { return true; } + template void Post(T &) {} + + void Post(parser::Call &call) { + if (std::holds_alternative(std::get<0>(call.t).u)) + callNames.push_back(std::get(std::get<0>(call.t).u)); + } + + std::list callNames; +}; + +// This pass works by passing over the modules PFT and collecting all of the +// subroutines and functions as it passes through these nodes. +// When it meets a declare target node, it reads through the extended-list of +// the declare target directive's clause finding functions (the current function +// should be referred to in this declare target if a list is specified), if no +// list is specified the function the declare target is in, is considered the +// only function in the declare target list. These functions are then processed, +// with the algorithm looking for calls in these functions that are not included +// in the declare target but are implicitly declare target as they are invoked +// by a declare target region. These functions/subroutines are searched for in +// the map of subporograms (check if it exists, and allows access to go through +// it's own callees, to further find implicit functions) before being added to +// the original declare target extended-list (either by extended it to add a +// list, or just appending to the original list), now becoming directly declare +// target and can be further lowered as declare target. Care is taken not to add +// duplicate members to these lists, this also helps avoid infinite recursion +// when encountering a recursive function. +class ImplicitDeclareTargetCapture { + using Subprograms = std::variant; + Subprograms currentSubprogram_; + std::map subPrograms_; + + parser::Messages &messages_; + +public: + template bool Pre(T &) { return true; } + template void Post(T &) {} + ImplicitDeclareTargetCapture(SemanticsContext &context) + : messages_{context.messages()} {} + + // Related to rewriting declare target specifiers to + // contain functions nested within the primary declare + // target function. + void Post(parser::OpenMPDeclareTargetConstruct &x) { + auto &spec{std::get(x.t)}; + if (parser::OmpObjectList * + objectList{parser::Unwrap(spec.u)}) { + markDeclTarForEachProgramInList(subPrograms_, *objectList); + } else if (auto *clauseList{ + parser::Unwrap(spec.u)}) { + for (auto &clause : clauseList->v) { + if (auto *toClause{std::get_if(&clause.u)}) { + markDeclTarForEachProgramInList(subPrograms_, toClause->v); + } else if (auto *linkClause{ + std::get_if(&clause.u)}) { + markDeclTarForEachProgramInList(subPrograms_, linkClause->v); + } + } + + // The default "declare target" inside of a function case, we must + // create and generate an to extended-list, containing at minimum the + // current function + if (clauseList->v.empty()) { + if (auto *name = getNameFromVariant(currentSubprogram_)) { + std::list list; + list.push_back(parser::OmpObject{ + parser::Designator{parser::DataRef{std::move(*name)}}}); + auto objList = parser::OmpObjectList{std::move(list)}; + markDeclTarForEachProgramInList(subPrograms_, objList); + clauseList->v.push_back(parser::OmpClause::To{std::move(objList)}); + } + } + } + } + + bool Pre(parser::FunctionSubprogram &x) { + parser::FunctionStmt &Stmt = std::get<0>(x.t).statement; + auto name = std::get(Stmt.t); + subPrograms_[name.ToString()] = &x; + currentSubprogram_ = &x; + return true; + } + + bool Pre(parser::SubroutineSubprogram &x) { + parser::SubroutineStmt &Stmt = std::get<0>(x.t).statement; + auto name = std::get(Stmt.t); + subPrograms_[name.ToString()] = &x; + currentSubprogram_ = &x; + return true; + } + + parser::Name *getNameFromVariant(Subprograms &x) { + if (std::holds_alternative(x)) { + parser::FunctionStmt &Stmt = + std::get<0>(std::get(x)->t).statement; + return &std::get(Stmt.t); + } + + if (std::holds_alternative(x)) { + parser::SubroutineStmt &Stmt = + std::get<0>(std::get(x)->t).statement; + return &std::get(Stmt.t); + } + + return nullptr; + } + + void markDeclTarForEachProgramInList( + std::map &subPrograms, + parser::OmpObjectList &objList) { + auto existsInList = [](parser::OmpObjectList &objList, parser::Name name) { + for (auto &ompObject : objList.v) + if (auto *objName{parser::Unwrap(ompObject)}) + if (objName->ToString() == name.ToString()) + return true; + return false; + }; + + GatherCallRefs gatherer{}; + for (auto &ompObject : objList.v) { + if (auto *name{parser::Unwrap(ompObject)}) { + auto subProgram = subPrograms.find(name->ToString()); + // something other than a subroutine or function, skip it + if (subProgram == subPrograms.end()) + continue; + + if (std::holds_alternative( + subProgram->second)) + parser::Walk( + *std::get(subProgram->second), + gatherer); + else + parser::Walk( + *std::get(subProgram->second), + gatherer); + + // Currently using the Function Name rather than the CallRef name, + // unsure if these are interchangeable. However, ideally functions + // and subroutines should probably be parser::PorcedureDesignator's + // rather than parser::Designator's, but regular designators seem + // to be all that is utilised in the PFT definition for OmpObjects. + for (auto v : gatherer.callNames) { + if (!existsInList(objList, v)) { + objList.v.push_back(parser::OmpObject{parser::Designator{ + parser::DataRef{std::move(*getNameFromVariant( + subPrograms.find(v.ToString())->second))}}}); + } + } + + gatherer.callNames.clear(); + } + } + } +}; + +bool FinalizeOMP(SemanticsContext &context, parser::Program &program) { + ImplicitDeclareTargetCapture impCap{context}; + Walk(program, impCap); + return !context.AnyFatalError(); +} + +} // namespace Fortran::semantics diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -31,6 +31,7 @@ #include "check-select-type.h" #include "check-stop.h" #include "compute-offsets.h" +#include "finalize-omp.h" #include "mod-file.h" #include "resolve-labels.h" #include "resolve-names.h" @@ -170,6 +171,7 @@ ResolveNames(context, program, context.globalScope()); RewriteParseTree(context, program); ComputeOffsets(context, context.globalScope()); + FinalizeOMP(context, program); CheckDeclarations(context); StatementSemanticsPass1{context}.Walk(program); StatementSemanticsPass2 pass2{context}; diff --git a/flang/test/Examples/omp-declarative-directive.f90 b/flang/test/Examples/omp-declarative-directive.f90 --- a/flang/test/Examples/omp-declarative-directive.f90 +++ b/flang/test/Examples/omp-declarative-directive.f90 @@ -37,5 +37,7 @@ ! CHECK-NEXT:- file: '{{[^"]*}}omp-declarative-directive.f90' ! CHECK-NEXT: line: 21 ! CHECK-NEXT: construct: declare target -! CHECK-NEXT: clauses: [] -! CHECK-NEXT:... +! CHECK-NEXT: clauses: +! CHECK-NEXT: - clause: '' +! CHECK-NEXT: details: '' +! CHECK-NEXT:... \ No newline at end of file diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite01.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite01.f90 @@ -0,0 +1,229 @@ +! RUN: %flang_fc1 -fopenmp -fdebug-dump-parse-tree %s 2>&1 | FileCheck %s +! +! Ensure that functions and subroutines referenced within +! declare target functions are themselves made declare target +! as specified by more recent iterations of the OpenMP +! specification. This is done through a semantic pass which +! appends the implicitly captured functions to the original +! declare target declaration rather than generating and +! inserting new ones within the captured functions. +! +! For example a declare target inside of a function named 'ORIGINAL', +! would initially be empty, after the pass, the declare target +! would be expanded to declare target to(ORIGINAL). If +! there is a function named 'CAPTURED' called within 'ORIGINAL' +! the declare target inside of 'ORIGINAL' would be further +! expanded to declare target to(ORIGINAL, CAPTURED) + +FUNCTION IMPLICITLY_CAPTURED_NEST_TWICE() RESULT(I) + INTEGER :: I + I = 10 +END FUNCTION IMPLICITLY_CAPTURED_NEST_TWICE + +FUNCTION IMPLICITLY_CAPTURED_ONE_TWICE() RESULT(K) + K = IMPLICITLY_CAPTURED_NEST_TWICE() +END FUNCTION IMPLICITLY_CAPTURED_ONE_TWICE + +FUNCTION IMPLICITLY_CAPTURED_TWO_TWICE() RESULT(Y) + INTEGER :: Y + Y = 5 +END FUNCTION IMPLICITLY_CAPTURED_TWO_TWICE + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test_device' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one_twice' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two_twice' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest_twice' +! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost +FUNCTION TARGET_FUNCTION_TEST_DEVICE() RESULT(J) +!$omp declare target to(TARGET_FUNCTION_TEST_DEVICE) device_type(nohost) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE_TWICE() + J = IMPLICITLY_CAPTURED_TWO_TWICE() + I +END FUNCTION TARGET_FUNCTION_TEST_DEVICE + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test_host' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one_twice' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two_twice' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest_twice' +! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Host +FUNCTION TARGET_FUNCTION_TEST_HOST() RESULT(J) +!$omp declare target to(TARGET_FUNCTION_TEST_HOST) device_type(host) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE_TWICE() + J = IMPLICITLY_CAPTURED_TWO_TWICE() + I +END FUNCTION TARGET_FUNCTION_TEST_HOST + +!! ----- + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'func_t_device' +! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost +FUNCTION FUNC_T_DEVICE() RESULT(I) +!$omp declare target to(FUNC_T_DEVICE) device_type(nohost) + INTEGER :: I + I = 1 +END FUNCTION FUNC_T_DEVICE + +!! ----- + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_t_any' +! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Any +SUBROUTINE SUBR_T_ANY() +!$omp declare target to(SUBR_T_ANY) device_type(any) +END + +!! ----- + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithList -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_default_extendedlist' +SUBROUTINE SUBR_DEFAULT_EXTENDEDLIST() +!$omp declare target(SUBR_DEFAULT_EXTENDEDLIST) +END + +!! ----- + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_unspecified' +SUBROUTINE SUBR_UNSPECIFIED() +!$omp declare target +END + +!! ----- + +FUNCTION UNSPECIFIED_CAPTURE() RESULT(K) + REAL :: K + K = 1 +END FUNCTION UNSPECIFIED_CAPTURE + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_unspecified_capture' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'unspecified_capture' +SUBROUTINE SUBR_UNSPECIFIED_CAPTURE() +!$omp declare target + REAL :: I + I = UNSPECIFIED_CAPTURE() +END + +!! ----- + +FUNCTION IMPLICITLY_CAPTURED_NEST() RESULT(K) + INTEGER :: I + I = 10 + K = I +END FUNCTION IMPLICITLY_CAPTURED_NEST + +FUNCTION IMPLICITLY_CAPTURED_ONE() RESULT(K) + K = IMPLICITLY_CAPTURED_NEST() +END FUNCTION IMPLICITLY_CAPTURED_ONE + +FUNCTION IMPLICITLY_CAPTURED_TWO() RESULT(K) + INTEGER :: I + I = 10 + K = I +END FUNCTION IMPLICITLY_CAPTURED_TWO + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest' +! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost +FUNCTION TARGET_FUNCTION_TEST() RESULT(J) +!$omp declare target to(TARGET_FUNCTION_TEST) device_type(nohost) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE() + J = IMPLICITLY_CAPTURED_TWO() + I +END FUNCTION TARGET_FUNCTION_TEST + +!! ----- + +FUNCTION NO_DECLARE_TARGET() RESULT(K) + implicit none + REAL :: I, K + I = 10.0 + K = I +END FUNCTION NO_DECLARE_TARGET + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'declare_target_two' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'no_declare_target' +FUNCTION DECLARE_TARGET_TWO() RESULT(J) +!$omp declare target to(DECLARE_TARGET_TWO) + implicit none + REAL :: I, J + I = NO_DECLARE_TARGET() + J = I +END FUNCTION DECLARE_TARGET_TWO + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'declare_target_one' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'declare_target_two' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'no_declare_target' +FUNCTION DECLARE_TARGET_ONE() RESULT(I) +!$omp declare target to(DECLARE_TARGET_ONE) + implicit none + REAL :: K, I + I = DECLARE_TARGET_TWO() + K = I +END FUNCTION DECLARE_TARGET_ONE + +!! ----- + +RECURSIVE FUNCTION IMPLICITLY_CAPTURED_RECURSIVE(INCREMENT) RESULT(K) + INTEGER :: INCREMENT, K + IF (INCREMENT == 10) THEN + K = INCREMENT + ELSE + K = IMPLICITLY_CAPTURED_RECURSIVE(INCREMENT + 1) + END IF +END FUNCTION IMPLICITLY_CAPTURED_RECURSIVE + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithList -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_recurse' +! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_recursive' +FUNCTION TARGET_FUNCTION_RECURSE() RESULT(I) +!$omp declare target(TARGET_FUNCTION_RECURSE) + INTEGER :: I + I = IMPLICITLY_CAPTURED_RECURSIVE(0) +END FUNCTION TARGET_FUNCTION_RECURSE + +!! ----- + +! CHECK: SpecificationPart +! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct +! CHECK: Verbatim +! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'recursive_declare_target' +RECURSIVE FUNCTION RECURSIVE_DECLARE_TARGET(INCREMENT) RESULT(K) +!$omp declare target to(RECURSIVE_DECLARE_TARGET) device_type(nohost) + INTEGER :: INCREMENT, K + IF (INCREMENT == 10) THEN + K = INCREMENT + ELSE + K = RECURSIVE_DECLARE_TARGET(INCREMENT + 1) + END IF +END FUNCTION RECURSIVE_DECLARE_TARGET diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite02.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/OpenMP/declare-target-implicit-capture-rewrite02.f90 @@ -0,0 +1,236 @@ +! RUN: %flang_fc1 -fopenmp -fdebug-dump-parse-tree %s 2>&1 | FileCheck %s +! +! Ensure that functions and subroutines referenced within +! declare target functions are themselves made declare target +! when inside of an interface as specified by more recent +! iterations of the OpenMP specification. This is done through +! a semantic pass which appends the implicitly captured functions +! to the original declare target declaration rather than +! generating and inserting new ones within the captured functions. +! +! For example a declare target inside of a function named 'ORIGINAL', +! would initially be empty, after the pass, the declare target +! would be expanded to declare target to(ORIGINAL). If +! there is a function named 'CAPTURED' called within 'ORIGINAL' +! the declare target inside of 'ORIGINAL' would be further +! expanded to declare target to(ORIGINAL, CAPTURED) +! +! This test case is declare-target-implicit-capture-rewrite01.f90 +! except placed into a module, to verify the pass works and continues +! to work in conjunction with modules. + +module test_module + contains + FUNCTION IMPLICITLY_CAPTURED_NEST_TWICE() RESULT(I) + INTEGER :: I + I = 10 + END FUNCTION IMPLICITLY_CAPTURED_NEST_TWICE + + FUNCTION IMPLICITLY_CAPTURED_ONE_TWICE() RESULT(K) + K = IMPLICITLY_CAPTURED_NEST_TWICE() + END FUNCTION IMPLICITLY_CAPTURED_ONE_TWICE + + FUNCTION IMPLICITLY_CAPTURED_TWO_TWICE() RESULT(Y) + INTEGER :: Y + Y = 5 + END FUNCTION IMPLICITLY_CAPTURED_TWO_TWICE + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test_device' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one_twice' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two_twice' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest_twice' + ! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost + FUNCTION TARGET_FUNCTION_TEST_DEVICE() RESULT(J) + !$omp declare target to(TARGET_FUNCTION_TEST_DEVICE) device_type(nohost) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE_TWICE() + J = IMPLICITLY_CAPTURED_TWO_TWICE() + I + END FUNCTION TARGET_FUNCTION_TEST_DEVICE + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test_host' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one_twice' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two_twice' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest_twice' + ! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Host + FUNCTION TARGET_FUNCTION_TEST_HOST() RESULT(J) + !$omp declare target to(TARGET_FUNCTION_TEST_HOST) device_type(host) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE_TWICE() + J = IMPLICITLY_CAPTURED_TWO_TWICE() + I + END FUNCTION TARGET_FUNCTION_TEST_HOST + + !! ----- + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'func_t_device' + ! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost + FUNCTION FUNC_T_DEVICE() RESULT(I) + !$omp declare target to(FUNC_T_DEVICE) device_type(nohost) + INTEGER :: I + I = 1 + END FUNCTION FUNC_T_DEVICE + + !! ----- + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_t_any' + ! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Any + SUBROUTINE SUBR_T_ANY() + !$omp declare target to(SUBR_T_ANY) device_type(any) + END + + !! ----- + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithList -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_default_extendedlist' + SUBROUTINE SUBR_DEFAULT_EXTENDEDLIST() + !$omp declare target(SUBR_DEFAULT_EXTENDEDLIST) + END + + !! ----- + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_unspecified' + SUBROUTINE SUBR_UNSPECIFIED() + !$omp declare target + END + + !! ----- + + FUNCTION UNSPECIFIED_CAPTURE() RESULT(K) + REAL :: K + K = 1 + END FUNCTION UNSPECIFIED_CAPTURE + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'subr_unspecified_capture' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'unspecified_capture' + SUBROUTINE SUBR_UNSPECIFIED_CAPTURE() + !$omp declare target + REAL :: I + I = UNSPECIFIED_CAPTURE() + END + + !! ----- + + FUNCTION IMPLICITLY_CAPTURED_NEST() RESULT(K) + INTEGER :: I + I = 10 + K = I + END FUNCTION IMPLICITLY_CAPTURED_NEST + + FUNCTION IMPLICITLY_CAPTURED_ONE() RESULT(K) + K = IMPLICITLY_CAPTURED_NEST() + END FUNCTION IMPLICITLY_CAPTURED_ONE + + FUNCTION IMPLICITLY_CAPTURED_TWO() RESULT(K) + INTEGER :: I + I = 10 + K = I + END FUNCTION IMPLICITLY_CAPTURED_TWO + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_test' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_one' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_two' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_nest' + ! CHECK: OmpClause -> DeviceType -> OmpDeviceTypeClause -> Type = Nohost + FUNCTION TARGET_FUNCTION_TEST() RESULT(J) + !$omp declare target to(TARGET_FUNCTION_TEST) device_type(nohost) + INTEGER :: I, J + I = IMPLICITLY_CAPTURED_ONE() + J = IMPLICITLY_CAPTURED_TWO() + I + END FUNCTION TARGET_FUNCTION_TEST + + !! ----- + + FUNCTION NO_DECLARE_TARGET() RESULT(K) + implicit none + REAL :: I, K + I = 10.0 + K = I + END FUNCTION NO_DECLARE_TARGET + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'declare_target_two' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'no_declare_target' + FUNCTION DECLARE_TARGET_TWO() RESULT(J) + !$omp declare target to(DECLARE_TARGET_TWO) + implicit none + REAL :: I, J + I = NO_DECLARE_TARGET() + J = I + END FUNCTION DECLARE_TARGET_TWO + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'declare_target_one' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'declare_target_two' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'no_declare_target' + FUNCTION DECLARE_TARGET_ONE() RESULT(I) + !$omp declare target to(DECLARE_TARGET_ONE) + implicit none + REAL :: K, I + I = DECLARE_TARGET_TWO() + K = I + END FUNCTION DECLARE_TARGET_ONE + + !! ----- + + RECURSIVE FUNCTION IMPLICITLY_CAPTURED_RECURSIVE(INCREMENT) RESULT(K) + INTEGER :: INCREMENT, K + IF (INCREMENT == 10) THEN + K = INCREMENT + ELSE + K = IMPLICITLY_CAPTURED_RECURSIVE(INCREMENT + 1) + END IF + END FUNCTION IMPLICITLY_CAPTURED_RECURSIVE + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithList -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'target_function_recurse' + ! CHECK: OmpObject -> Designator -> DataRef -> Name = 'implicitly_captured_recursive' + FUNCTION TARGET_FUNCTION_RECURSE() RESULT(I) + !$omp declare target(TARGET_FUNCTION_RECURSE) + INTEGER :: I + I = IMPLICITLY_CAPTURED_RECURSIVE(0) + END FUNCTION TARGET_FUNCTION_RECURSE + + !! ----- + + ! CHECK: SpecificationPart + ! CHECK: OpenMPDeclarativeConstruct -> OpenMPDeclareTargetConstruct + ! CHECK: Verbatim + ! CHECK: OmpDeclareTargetSpecifier -> OmpDeclareTargetWithClause -> OmpClauseList -> OmpClause -> To -> OmpObjectList -> OmpObject -> Designator -> DataRef -> Name = 'recursive_declare_target' + RECURSIVE FUNCTION RECURSIVE_DECLARE_TARGET(INCREMENT) RESULT(K) + !$omp declare target to(RECURSIVE_DECLARE_TARGET) device_type(nohost) + INTEGER :: INCREMENT, K + IF (INCREMENT == 10) THEN + K = INCREMENT + ELSE + K = RECURSIVE_DECLARE_TARGET(INCREMENT + 1) + END IF + END FUNCTION RECURSIVE_DECLARE_TARGET +end module test_module