[flang-commits] [flang] [Flang][OpenMP] Implement OMP 5.2 implicit DECLARE TARGET procedure handling (PR #196826)
via flang-commits
flang-commits at lists.llvm.org
Thu Jun 4 02:23:14 PDT 2026
https://github.com/blazie2004 updated https://github.com/llvm/llvm-project/pull/196826
>From b2915ff63ff8e75e4b464c6757c2b78488b5687a Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Sun, 10 May 2026 13:04:32 -0500
Subject: [PATCH 1/6] Implement OMP 5.2 implicit DECLARE TARGET procedure
handling
---
flang/lib/Semantics/check-omp-structure.cpp | 6 +-
flang/lib/Semantics/openmp-utils.cpp | 4 +-
flang/lib/Semantics/resolve-directives.cpp | 14 +++
flang/lib/Semantics/resolve-names.cpp | 112 ++++++++++--------
.../OpenMP/declare-target-implicit-proc.f90 | 22 ++++
5 files changed, 108 insertions(+), 50 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 33ea727343cf4..4792aa6b36bbf 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1297,11 +1297,13 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
llvm::omp::Directive directive{GetContext().directive};
if (name->symbol->GetUltimate().IsSubprogram()) {
- if (directive == llvm::omp::Directive::OMPD_threadprivate)
+ if (directive == llvm::omp::Directive::OMPD_threadprivate) {
context_.Say(name->source,
"The procedure name cannot be in a %s directive"_err_en_US,
ContextDirectiveAsFortran());
- // TODO: Check for procedure name in declare target directive.
+ }
+ // OMP 5.2 7.8.2 p10: a procedure name in DECLARE TARGET is valid
+ // (treated as external subroutine if not otherwise specified).
} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
if (directive == llvm::omp::Directive::OMPD_threadprivate)
context_.Say(name->source,
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index 58aefe2e1fc52..167d4dc936d7e 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -190,7 +190,9 @@ bool IsVariableListItem(const Symbol &sym) {
}
bool IsExtendedListItem(const Symbol &sym) {
- return IsVariableListItem(sym) || sym.IsSubprogram();
+ // Extended-list item: variable, procedure, or procedure pointer
+ return IsVariableListItem(sym) || sym.IsSubprogram() ||
+ sym.has<ProcEntityDetails>();
}
bool IsTypeParamInquiry(const Symbol &sym) {
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index b97f7ce58a1c0..c96b66f4d5907 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2972,6 +2972,20 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
name->symbol = func;
}
}
+ // OMP 5.2 §7.8.2 ¶10: If a name appears in a declare target directive
+ // and has not been explicitly typed as a variable or procedure, and
+ // no other declaration gives it a procedure property, treat it as an
+ // external subroutine.
+ if (symbol->has<EntityDetails>() &&
+ !symbol->attrs().test(Attr::EXTERNAL) &&
+ !symbol->test(Symbol::Flag::Function) &&
+ !symbol->test(Symbol::Flag::Subroutine)) {
+ // Symbol is still unspecialized EntityDetails - promote to external
+ // proc
+ symbol->attrs().set(Attr::EXTERNAL);
+ symbol->set_details(ProcEntityDetails{});
+ symbol->set(Symbol::Flag::Subroutine);
+ }
}
if (directive == llvm::omp::Directive::OMPD_target_data) {
checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr, symbol,
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4f824ef1321e9..2c9b5a4bd7b18 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2441,7 +2441,7 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
}
symbol.SetBindName(std::move(*label));
if (!oldBindName.empty()) {
- if (const std::string * newBindName{symbol.GetBindName()}) {
+ if (const std::string *newBindName{symbol.GetBindName()}) {
if (oldBindName != *newBindName) {
Say(symbol.name(),
"The entity '%s' has multiple BIND names ('%s' and '%s')"_err_en_US,
@@ -2567,7 +2567,7 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
// expression semantics if the DeclTypeSpec is a valid TypeSpec.
// The grammar ensures that it's an intrinsic or derived type spec,
// not TYPE(*) or CLASS(*) or CLASS(T).
- if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
+ if (const DeclTypeSpec *spec{state_.declTypeSpec}) {
switch (spec->category()) {
case DeclTypeSpec::Numeric:
case DeclTypeSpec::Logical:
@@ -2575,7 +2575,7 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
typeSpec.declTypeSpec = spec;
break;
case DeclTypeSpec::TypeDerived:
- if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
+ if (const DerivedTypeSpec *derived{spec->AsDerived()}) {
CheckForAbstractType(derived->typeSymbol()); // C703
typeSpec.declTypeSpec = spec;
}
@@ -3187,8 +3187,8 @@ Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
Symbol &ScopeHandler::MakeHostAssocSymbol(
const parser::Name &name, const Symbol &hostSymbol) {
Symbol &symbol{*NonDerivedTypeScope()
- .try_emplace(name.source, HostAssocDetails{hostSymbol})
- .first->second};
+ .try_emplace(name.source, HostAssocDetails{hostSymbol})
+ .first->second};
name.symbol = &symbol;
symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
// These attributes can be redundantly reapplied without error
@@ -3276,7 +3276,7 @@ void ScopeHandler::ApplyImplicitRules(
if (context().HasError(symbol) || !NeedsType(symbol)) {
return;
}
- if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
+ if (const DeclTypeSpec *type{GetImplicitType(symbol)}) {
if (!skipImplicitTyping_) {
symbol.set(Symbol::Flag::Implicit);
symbol.SetType(*type);
@@ -3376,7 +3376,7 @@ const DeclTypeSpec *ScopeHandler::GetImplicitType(
const auto *type{implicitRulesMap_->at(scope).GetType(
symbol.name(), respectImplicitNoneType)};
if (type) {
- if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ if (const DerivedTypeSpec *derived{type->AsDerived()}) {
// Resolve any forward-referenced derived type; a quick no-op else.
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(currScope());
@@ -4397,7 +4397,7 @@ Scope *ModuleVisitor::FindModule(const parser::Name &name,
if (scope) {
if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
std::optional<SourceName> submoduleName;
- if (const Scope * container{FindModuleOrSubmoduleContaining(currScope())};
+ if (const Scope *container{FindModuleOrSubmoduleContaining(currScope())};
container && container->IsSubmodule()) {
submoduleName = container->GetName();
}
@@ -4502,7 +4502,7 @@ bool InterfaceVisitor::isAbstract() const {
void InterfaceVisitor::AddSpecificProcs(
const std::list<parser::Name> &names, ProcedureKind kind) {
- if (Symbol * symbol{GetGenericInfo().symbol};
+ if (Symbol *symbol{GetGenericInfo().symbol};
symbol && symbol->has<GenericDetails>()) {
for (const auto &name : names) {
specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));
@@ -4602,7 +4602,7 @@ void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {
}
void InterfaceVisitor::ResolveNewSpecifics() {
- if (Symbol * generic{genericInfo_.top().symbol};
+ if (Symbol *generic{genericInfo_.top().symbol};
generic && generic->has<GenericDetails>()) {
ResolveSpecificsInGeneric(*generic, false);
}
@@ -4692,7 +4692,7 @@ bool SubprogramVisitor::HandleStmtFunction(const parser::StmtFunctionStmt &x) {
// re-resolves to the new local SubprogramDetails.
name.symbol = nullptr;
} else if (auto *entity{ultimate.detailsIf<EntityDetails>()};
- entity && !ultimate.has<ProcEntityDetails>()) {
+ entity && !ultimate.has<ProcEntityDetails>()) {
resultType = entity->type();
ultimate.details() = UnknownDetails{}; // will be replaced below
} else {
@@ -5291,7 +5291,7 @@ Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
symbol = generic->specific();
}
}
- if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
+ if (const Symbol *defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
// Error recovery in case of multiple definitions
symbol = const_cast<Symbol *>(defnIface);
}
@@ -5431,8 +5431,8 @@ bool SubprogramVisitor::HandlePreviousCalls(
return generic->specific() &&
HandlePreviousCalls(name, *generic->specific(), subpFlag);
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
- !proc->isDummy() &&
- !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
+ !proc->isDummy() &&
+ !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
// There's a symbol created for previous calls to this subprogram or
// ENTRY's name. We have to replace that symbol in situ to avoid the
// obligation to rewrite symbol pointers in the parse tree.
@@ -5474,7 +5474,7 @@ const Symbol *SubprogramVisitor::CheckExtantProc(
if (prev) {
if (IsDummy(*prev)) {
} else if (auto *entity{prev->detailsIf<EntityDetails>()};
- IsPointer(*prev) && entity && !entity->type()) {
+ IsPointer(*prev) && entity && !entity->type()) {
// POINTER attribute set before interface
} else if (inInterfaceBlock() && currScope() != prev->owner()) {
// Procedures in an INTERFACE block do not resolve to symbols
@@ -5546,7 +5546,7 @@ Symbol *SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
}
set_inheritFromParent(false); // interfaces don't inherit, even if MODULE
}
- if (Symbol * found{FindSymbol(name)};
+ if (Symbol *found{FindSymbol(name)};
found && found->has<HostAssocDetails>()) {
found->set(subpFlag); // PushScope() created symbol
}
@@ -6402,9 +6402,9 @@ void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) {
vectorDerivedType.CookParameters(GetFoldingContext());
}
- if (const DeclTypeSpec *
- extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType(
- vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
+ if (const DeclTypeSpec *extant{
+ ppcBuiltinTypesScope->FindInstantiatedDerivedType(
+ vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) {
// This derived type and parameter expressions (if any) are already present
// in the __ppc_intrinsics scope.
SetDeclTypeSpec(*extant);
@@ -6426,7 +6426,7 @@ bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
const parser::Name &derivedName{std::get<parser::Name>(type.v.t)};
- if (const Symbol * derivedSymbol{derivedName.symbol}) {
+ if (const Symbol *derivedSymbol{derivedName.symbol}) {
CheckForAbstractType(*derivedSymbol); // C706
}
}
@@ -6495,8 +6495,8 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
if (!spec->MightBeParameterized()) {
spec->EvaluateParameters(context());
}
- if (const DeclTypeSpec *
- extant{currScope().FindInstantiatedDerivedType(*spec, category)}) {
+ if (const DeclTypeSpec *extant{
+ currScope().FindInstantiatedDerivedType(*spec, category)}) {
// This derived type and parameter expressions (if any) are already present
// in this scope.
SetDeclTypeSpec(*extant);
@@ -6527,8 +6527,7 @@ void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Record &rec) {
if (auto spec{ResolveDerivedType(typeName)}) {
spec->CookParameters(GetFoldingContext());
spec->EvaluateParameters(context());
- if (const DeclTypeSpec *
- extant{currScope().FindInstantiatedDerivedType(
+ if (const DeclTypeSpec *extant{currScope().FindInstantiatedDerivedType(
*spec, DeclTypeSpec::TypeDerived)}) {
SetDeclTypeSpec(*extant);
} else {
@@ -7553,7 +7552,7 @@ bool DeclarationVisitor::PassesLocalityChecks(
"Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);
return false;
}
- if (const DeclTypeSpec * type{symbol.GetType()}) {
+ if (const DeclTypeSpec *type{symbol.GetType()}) {
if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
!isReduce) { // F'2023 C1130
SayWithDecl(name, symbol,
@@ -7787,7 +7786,7 @@ Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
}
void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
- if (const Symbol * symbol{name.symbol}) {
+ if (const Symbol *symbol{name.symbol}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
!BypassGeneric(ultimate).HasExplicitInterface()) {
@@ -8107,7 +8106,7 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
if (const auto *name{std::get_if<parser::Name>(&elem->Base().u)}) {
- if (const Symbol * symbol{FindSymbol(*name)};
+ if (const Symbol *symbol{FindSymbol(*name)};
symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {
mutableData.u = elem->ConvertToStructureConstructor(
DerivedTypeSpec{name->source, *symbol});
@@ -8253,15 +8252,15 @@ void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
}
}
} else {
- if (const Symbol *
- whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
+ if (const Symbol *whole{
+ UnwrapWholeSymbolDataRef(association.selector.expr)}) {
ConvertToObjectEntity(const_cast<Symbol &>(*whole));
if (!IsVariableName(*whole)) {
Say(association.selector.source, // C901
"Selector is not a variable"_err_en_US);
association = {};
}
- if (const DeclTypeSpec * type{whole->GetType()}) {
+ if (const DeclTypeSpec *type{whole->GetType()}) {
if (!type->IsPolymorphic()) { // C1159
Say(association.selector.source,
"Selector '%s' in SELECT TYPE statement must be "
@@ -8401,8 +8400,8 @@ Symbol *ConstructVisitor::MakeAssocEntity() {
"The associate name '%s' is already used in this associate statement"_err_en_US);
return nullptr;
}
- } else if (const Symbol *
- whole{UnwrapWholeSymbolDataRef(association.selector.expr)}) {
+ } else if (const Symbol *whole{
+ UnwrapWholeSymbolDataRef(association.selector.expr)}) {
symbol = &MakeSymbol(whole->name());
} else {
return nullptr;
@@ -9025,7 +9024,7 @@ bool DeclarationVisitor::CheckForHostAssociatedImplicit(
if (name.symbol) {
ApplyImplicitRules(*name.symbol, true);
}
- if (Scope * host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
+ if (Scope *host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
Symbol *hostSymbol{nullptr};
if (!name.symbol) {
if (currScope().CanImport(name.source)) {
@@ -9096,7 +9095,7 @@ const parser::Name *DeclarationVisitor::FindComponent(
if (!type) {
return nullptr; // should have already reported error
}
- if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
+ if (const IntrinsicTypeSpec *intrinsic{type->AsIntrinsic()}) {
auto category{intrinsic->category()};
MiscDetails::Kind miscKind{MiscDetails::Kind::None};
if (component.source == "kind") {
@@ -9118,7 +9117,7 @@ const parser::Name *DeclarationVisitor::FindComponent(
}
} else if (DerivedTypeSpec * derived{type->AsDerived()}) {
derived->Instantiate(currScope()); // in case of forward referenced type
- if (const Scope * scope{derived->scope()}) {
+ if (const Scope *scope{derived->scope()}) {
if (Resolve(component, scope->FindComponent(component.source))) {
if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {
context().Say(component.source, *msg);
@@ -9165,18 +9164,37 @@ bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
return true;
}
// if we find a symbol that is not a function or subroutine, we
- // currently escape without doing anything.
- break;
+ // currently escape without doing anything. Do NOT fall through
+ // to create an implicit external procedure.
+ return false;
}
// This is our loop exit condition, as parent() has an inbuilt assert
// if you call it on a top level scope, rather than returning a null
// value.
if (scope->IsTopLevel()) {
- return false;
+ break;
}
}
}
+
+ // OpenMP 5.2, 7.8.2 p10: a procedure name in DECLARE TARGET with no
+ // explicit data/procedure properties is treated as an external
+ // subroutine. Only apply this at program/module scope level, not inside
+ // subprograms where local variables could be forward-declared.
+ if (!isImplicitNoneType() &&
+ currScope().kind() != Scope::Kind::Subprogram &&
+ currScope().kind() != Scope::Kind::BlockConstruct) {
+ auto [it, inserted]{
+ currScope().try_emplace(name.source, Attrs{}, ProcEntityDetails{})};
+ Symbol &symbol{*it->second};
+ if (inserted || symbol.has<ProcEntityDetails>()) {
+ name.symbol = &symbol;
+ symbol.set(Symbol::Flag::Subroutine);
+ SetImplicitAttr(symbol, Attr::EXTERNAL);
+ return true;
+ }
+ }
}
}
return false;
@@ -9275,8 +9293,8 @@ void DeclarationVisitor::PointerInitialization(
if (evaluate::IsNullProcedurePointer(&*expr)) {
CHECK(!details->init());
details->set_init(nullptr);
- } else if (const Symbol *
- targetSymbol{evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
+ } else if (const Symbol *targetSymbol{
+ evaluate::UnwrapWholeSymbolDataRef(*expr)}) {
CHECK(!details->init());
details->set_init(*targetSymbol);
} else {
@@ -9885,7 +9903,7 @@ void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
for (const auto &ent : entities) {
const auto &objName{std::get<parser::ObjectName>(ent.t)};
Resolve(objName, FindInScope(currScope(), objName));
- if (Symbol * symbol{objName.symbol};
+ if (Symbol *symbol{objName.symbol};
symbol && IsDummy(*symbol) && NeedsType(*symbol)) {
if (!type) {
type = ProcessTypeSpec(declTypeSpec);
@@ -10027,7 +10045,7 @@ void ResolveNamesVisitor::FinishSpecificationPart(
if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
!proc->isDummy() && !IsPointer(symbol) &&
!symbol.attrs().test(Attr::BIND_C)) {
- if (const Symbol * iface{proc->procInterface()};
+ if (const Symbol *iface{proc->procInterface()};
iface && IsBindCProcedure(*iface)) {
SetImplicitAttr(symbol, Attr::BIND_C);
SetBindNameOn(symbol);
@@ -10167,7 +10185,7 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
Walk(bounds);
// Resolve unrestricted specific intrinsic procedures as in "p => cos".
- if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
+ if (const parser::Name *name{parser::Unwrap<parser::Name>(expr)}) {
if (NameIsKnownOrIntrinsic(*name)) {
if (Symbol * symbol{name->symbol}) {
if (IsProcedurePointer(ptrSymbol) &&
@@ -10630,8 +10648,8 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
// implied SAVE so that evaluate::IsSaved() will return true.
if (node.scope()->kind() == Scope::Kind::MainProgram) {
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
- if (const DeclTypeSpec * type{object->type()}) {
- if (const DerivedTypeSpec * derived{type->AsDerived()}) {
+ if (const DeclTypeSpec *type{object->type()}) {
+ if (const DerivedTypeSpec *derived{type->AsDerived()}) {
if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {
SetImplicitAttr(symbol, Attr::SAVE);
}
@@ -10891,7 +10909,7 @@ void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
spec->Instantiate(currScope());
const Symbol &origTypeSymbol{spec->typeSymbol()};
- if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
+ if (const Scope *origTypeScope{origTypeSymbol.scope()}) {
CHECK(origTypeScope->IsDerivedType() &&
origTypeScope->symbol() == &origTypeSymbol);
auto &foldingContext{GetFoldingContext()};
@@ -10902,7 +10920,7 @@ void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
if (IsPointer(comp)) {
if (auto *details{comp.detailsIf<ObjectEntityDetails>()}) {
auto origDetails{origComp.get<ObjectEntityDetails>()};
- if (const MaybeExpr & init{origDetails.init()}) {
+ if (const MaybeExpr &init{origDetails.init()}) {
SomeExpr newInit{*init};
MaybeExpr folded{FoldExpr(std::move(newInit))};
details->set_init(std::move(folded));
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
new file mode 100644
index 0000000000000..203a94419594b
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
@@ -0,0 +1,22 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
+
+! Test OpenMP 5.2 §7.8.2 ¶10: implicit external procedure in DECLARE TARGET
+! A name in DECLARE TARGET with no explicit type is treated as external subroutine
+
+program test_implicit_declare_target
+ integer :: n = 10
+ ! ext_sub should be implicitly treated as an external subroutine
+ !$omp declare target(ext_sub)
+
+ !$omp target
+ call ext_sub(n)
+ !$omp end target
+end program
+
+subroutine ext_sub(x)
+ !$omp declare target
+ integer, intent(in) :: x
+ print *, "Called with:", x
+end subroutine
+
+! CHECK-NOT: error:
\ No newline at end of file
>From a29b7a82bb5a8b2244393179db215bba0631d946 Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Thu, 14 May 2026 06:22:30 -0500
Subject: [PATCH 2/6] Fix review comments: isImplicitNoneExternal, remove
Subroutine flag
---
flang/lib/Semantics/resolve-directives.cpp | 4 +--
flang/lib/Semantics/resolve-names.cpp | 7 +++--
.../OpenMP/declare-target-implicit-func.f90 | 26 +++++++++++++++++++
.../declare-target-implicit-none-external.f90 | 18 +++++++++++++
.../declare-target-implicit-subroutine.f90 | 18 +++++++++++++
.../Semantics/OpenMP/declare-target06.f90 | 7 ++---
6 files changed, 73 insertions(+), 7 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
create mode 100644 flang/test/Semantics/OpenMP/declare-target-implicit-subroutine.f90
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 2ce924e7ce2d3..93ee521243e35 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2913,10 +2913,10 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
!symbol->test(Symbol::Flag::Function) &&
!symbol->test(Symbol::Flag::Subroutine)) {
// Symbol is still unspecialized EntityDetails - promote to external
- // proc
+ // proc. Don't set Subroutine flag - let the actual definition
+ // determine whether it's a subroutine or function.
symbol->attrs().set(Attr::EXTERNAL);
symbol->set_details(ProcEntityDetails{});
- symbol->set(Symbol::Flag::Subroutine);
}
}
if (directive == llvm::omp::Directive::OMPD_target_data) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 169f86a29ae24..eda88b292fb4d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9334,7 +9334,9 @@ bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
// subroutine. Only apply this at program/module scope level, not inside
// subprograms where local variables could be forward-declared.
// Also skip if a common block with the same name exists.
- if (!isImplicitNoneType() &&
+ // Use isImplicitNoneExternal() since this creates an implicit external,
+ // not an implicit type.
+ if (!isImplicitNoneExternal() &&
currScope().kind() != Scope::Kind::Subprogram &&
currScope().kind() != Scope::Kind::BlockConstruct &&
!currScope().FindCommonBlock(name.source)) {
@@ -9343,7 +9345,8 @@ bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
Symbol &symbol{*it->second};
if (inserted || symbol.has<ProcEntityDetails>()) {
name.symbol = &symbol;
- symbol.set(Symbol::Flag::Subroutine);
+ // Don't set Subroutine flag - let the actual definition determine
+ // whether it's a subroutine or function
SetImplicitAttr(symbol, Attr::EXTERNAL);
return true;
}
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
new file mode 100644
index 0000000000000..5a90bcd973d16
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
@@ -0,0 +1,26 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
+
+! Test OpenMP 5.2 §7.8.2 ¶10: implicit external procedure in DECLARE TARGET
+! When the name is later defined as a function, it should work correctly
+
+program test_implicit_declare_target_func
+ integer :: n = 10
+ integer :: result
+ ! ext_func should be implicitly treated as an external procedure
+ ! Note: OMP 5.2 says "subroutine" but we test function here
+ !$omp declare target(ext_func)
+
+ !$omp target map(from: result)
+ result = ext_func(n)
+ !$omp end target
+ print *, result
+end program
+
+function ext_func(x) result(y)
+ !$omp declare target
+ integer, intent(in) :: x
+ integer :: y
+ y = x * 2
+end function
+
+! CHECK-NOT: error:
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
new file mode 100644
index 0000000000000..b10a1827e2173
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
@@ -0,0 +1,18 @@
+! RUN: not %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
+
+! Test that IMPLICIT NONE(EXTERNAL) blocks implicit procedure creation
+! per OpenMP 5.2 §7.8.2 ¶10
+
+program test_implicit_none_external
+ implicit none(external)
+ integer :: n = 10
+ ! With IMPLICIT NONE(EXTERNAL), ext_sub should NOT be implicitly
+ ! created as an external procedure - should get an error
+ !$omp declare target(ext_sub)
+
+ !$omp target
+ call ext_sub(n)
+ !$omp end target
+end program
+
+! CHECK: error:
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-subroutine.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-subroutine.f90
new file mode 100644
index 0000000000000..16dde13e7493f
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-subroutine.f90
@@ -0,0 +1,18 @@
+! REQUIRES: openmp_runtime
+
+! RUN: %python %S/../test_errors.py %s %flang_fc1 %openmp_flags -fopenmp-version=52
+! OpenMP Version 5.2
+
+program my_fib
+ integer :: n = 8
+ !$omp declare target(fib)
+ !$omp target
+ call fib(n)
+ !$omp end target
+end program my_fib
+
+subroutine fib(n)
+ integer :: n
+ !$omp declare target
+ print *, "hello from fib"
+end subroutine fib
diff --git a/flang/test/Semantics/OpenMP/declare-target06.f90 b/flang/test/Semantics/OpenMP/declare-target06.f90
index 5ad2377d3fcfd..1fbcb8db26116 100644
--- a/flang/test/Semantics/OpenMP/declare-target06.f90
+++ b/flang/test/Semantics/OpenMP/declare-target06.f90
@@ -1,19 +1,20 @@
! RUN: %python %S/../test_errors.py %s %flang_fc1 -fopenmp -fopenmp-version=52
-! OpenMP Version 5.1
+! OpenMP Version 5.2
! Check OpenMP construct validity for the following directives:
! 2.14.7 Declare Target Directive
! When used in an implicit none context.
+! Per OMP 5.2 §7.8.2 ¶10, unknown names in DECLARE TARGET are treated as
+! external procedures, so no "No explicit type" error is expected for
+! names in ENTER/TO clauses (or bare list). LINK clause is different.
module test_0
implicit none
-!ERROR: No explicit type declared for 'no_implicit_materialization_1'
!$omp declare target(no_implicit_materialization_1)
!ERROR: No explicit type declared for 'no_implicit_materialization_2'
!$omp declare target link(no_implicit_materialization_2)
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
-!ERROR: No explicit type declared for 'no_implicit_materialization_3'
!$omp declare target to(no_implicit_materialization_3)
!$omp declare target enter(no_implicit_materialization_3)
>From 01059f897470887330cc2fc7b936513dc36e109b Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Tue, 19 May 2026 07:50:30 -0500
Subject: [PATCH 3/6] Fix DECLARE TARGET declaration ordering in specification
parts
---
flang/lib/Semantics/resolve-directives.cpp | 10 ++--
flang/lib/Semantics/resolve-names.cpp | 24 ++++++++--
.../declare-target-variable-ordering.f90 | 48 +++++++++++++++++++
.../Semantics/OpenMP/declare-target02.f90 | 2 +
.../Semantics/OpenMP/declare-target06.f90 | 1 +
5 files changed, 76 insertions(+), 9 deletions(-)
create mode 100644 flang/test/Semantics/OpenMP/declare-target-variable-ordering.f90
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 93ee521243e35..5fb5d58ce774c 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2909,13 +2909,13 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
// no other declaration gives it a procedure property, treat it as an
// external subroutine.
if (symbol->has<EntityDetails>() && !symbol->GetType() &&
- !symbol->attrs().test(Attr::EXTERNAL) &&
!symbol->test(Symbol::Flag::Function) &&
!symbol->test(Symbol::Flag::Subroutine)) {
- // Symbol is still unspecialized EntityDetails - promote to external
- // proc. Don't set Subroutine flag - let the actual definition
- // determine whether it's a subroutine or function.
- symbol->attrs().set(Attr::EXTERNAL);
+ // Promote to external proc. Don't set Subroutine flag - let the
+ // actual definition determine whether it's a subroutine or function.
+ if (!symbol->attrs().test(Attr::EXTERNAL)) {
+ symbol->attrs().set(Attr::EXTERNAL);
+ }
symbol->set_details(ProcEntityDetails{});
}
}
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index eda88b292fb4d..b50c0773a5ddf 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1171,6 +1171,14 @@ class DeclarationVisitor : public ArraySpecVisitor,
symbol.set_details(T{});
return symbol;
} else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
+ // Variable declaration overrides tentative DECLARE TARGET external.
+ if (std::is_same_v<ObjectEntityDetails, T> &&
+ symbol.implicitAttrs().test(Attr::EXTERNAL) &&
+ symbol.test(Symbol::Flag::OmpDeclareTarget)) {
+ symbol.attrs().reset(Attr::EXTERNAL);
+ symbol.implicitAttrs().reset(Attr::EXTERNAL);
+ symbol.set(Symbol::Flag::OmpDeclareTarget, false);
+ }
symbol.set_details(T{std::move(*details)});
return symbol;
} else if (std::is_same_v<EntityDetails, T> &&
@@ -3457,6 +3465,12 @@ void ScopeHandler::ApplyImplicitRules(
// or object, it'll be caught later.
return;
}
+ // Tentative DECLARE TARGET external; type will resolve later.
+ if (symbol.test(Symbol::Flag::OmpDeclareTarget) &&
+ symbol.implicitAttrs().test(Attr::EXTERNAL) &&
+ symbol.has<EntityDetails>()) {
+ return;
+ }
if (deferImplicitTyping_) {
return;
}
@@ -9335,19 +9349,21 @@ bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
// subprograms where local variables could be forward-declared.
// Also skip if a common block with the same name exists.
// Use isImplicitNoneExternal() since this creates an implicit external,
- // not an implicit type.
+ // not an implicit type. Use EntityDetails so a later variable
+ // declaration in the same spec part can override it.
if (!isImplicitNoneExternal() &&
currScope().kind() != Scope::Kind::Subprogram &&
currScope().kind() != Scope::Kind::BlockConstruct &&
!currScope().FindCommonBlock(name.source)) {
auto [it, inserted]{
- currScope().try_emplace(name.source, Attrs{}, ProcEntityDetails{})};
+ currScope().try_emplace(name.source, Attrs{}, EntityDetails{})};
Symbol &symbol{*it->second};
- if (inserted || symbol.has<ProcEntityDetails>()) {
+ if (inserted || symbol.has<EntityDetails>()) {
name.symbol = &symbol;
// Don't set Subroutine flag - let the actual definition determine
- // whether it's a subroutine or function
+ // whether it's a subroutine or function.
SetImplicitAttr(symbol, Attr::EXTERNAL);
+ symbol.set(Symbol::Flag::OmpDeclareTarget);
return true;
}
}
diff --git a/flang/test/Semantics/OpenMP/declare-target-variable-ordering.f90 b/flang/test/Semantics/OpenMP/declare-target-variable-ordering.f90
new file mode 100644
index 0000000000000..9f279ebf070fc
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/declare-target-variable-ordering.f90
@@ -0,0 +1,48 @@
+! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
+
+! Test that DECLARE TARGET can appear before variable declarations in the
+! specification part without causing spurious errors. This tests the fix for
+! declaration ordering: within a specification part, the order of statements
+! is flexible in Fortran, so !$omp declare target(x) can legally appear before
+! the declaration of x as a variable.
+
+module device_data
+ implicit none
+ ! DECLARE TARGET appears BEFORE the variable declaration - this is valid
+ !$omp declare target(shared_buf)
+ integer :: shared_buf(1000)
+
+ ! Also test multiple names and mixed ordering
+ !$omp declare target(var_a, var_b)
+ real :: var_a
+ integer :: var_b(10)
+
+ ! Test that actual external procedures still work
+ ! Need explicit EXTERNAL since module has implicit none
+ external :: ext_proc
+ !$omp declare target(ext_proc)
+end module
+
+program test_ordering
+ use device_data
+ implicit none
+
+ ! Test at program scope too
+ !$omp declare target(local_array)
+ integer :: local_array(100)
+
+ !$omp target map(tofrom: shared_buf, local_array)
+ shared_buf(1) = 42
+ local_array(1) = 24
+ !$omp end target
+
+ print *, shared_buf(1), local_array(1)
+end program
+
+subroutine ext_proc()
+ !$omp declare target
+ print *, "External procedure"
+end subroutine
+
+! CHECK-NOT: error:
+! CHECK-NOT: already declared as a procedure
diff --git a/flang/test/Semantics/OpenMP/declare-target02.f90 b/flang/test/Semantics/OpenMP/declare-target02.f90
index 1dddb62231d82..cd481c84c5bcd 100644
--- a/flang/test/Semantics/OpenMP/declare-target02.f90
+++ b/flang/test/Semantics/OpenMP/declare-target02.f90
@@ -24,6 +24,7 @@ program declare_target02
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
!$omp declare target to (blk1_to)
+ !ERROR: 'blk1_to' must be a variable or a procedure
!$omp declare target enter (blk1_to)
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
@@ -144,6 +145,7 @@ module mod4
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
!$omp declare target to (blk4_to)
+ !ERROR: 'blk4_to' must be a variable or a procedure
!$omp declare target enter (blk4_to)
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
diff --git a/flang/test/Semantics/OpenMP/declare-target06.f90 b/flang/test/Semantics/OpenMP/declare-target06.f90
index 1fbcb8db26116..c3cd484f02d0d 100644
--- a/flang/test/Semantics/OpenMP/declare-target06.f90
+++ b/flang/test/Semantics/OpenMP/declare-target06.f90
@@ -17,6 +17,7 @@ module test_0
!WARNING: The usage of TO clause on DECLARE TARGET directive has been deprecated. Use ENTER clause instead. [-Wopenmp-usage]
!$omp declare target to(no_implicit_materialization_3)
+!ERROR: 'no_implicit_materialization_3' must be a variable or a procedure
!$omp declare target enter(no_implicit_materialization_3)
INTEGER :: data_int = 10
>From d44fa007a43d89886108b99ad77466ff22fa41db Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Thu, 21 May 2026 02:15:28 -0500
Subject: [PATCH 4/6] fixed formatting changes
---
flang/lib/Semantics/check-omp-structure.cpp | 5 ++---
flang/lib/Semantics/resolve-directives.cpp | 2 +-
2 files changed, 3 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 7ffb769e94d1c..5ac66df9349d5 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1475,12 +1475,11 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
llvm::omp::Directive directive{GetContext().directive};
if (name->symbol->GetUltimate().IsSubprogram()) {
- if (directive == llvm::omp::Directive::OMPD_threadprivate) {
+ if (directive == llvm::omp::Directive::OMPD_threadprivate)
context_.Say(name->source,
"The procedure name cannot be in a %s directive"_err_en_US,
ContextDirectiveAsFortran());
- }
- // OMP 5.2 7.8.2 p10: a procedure name in DECLARE TARGET is valid
+ // OMP 5.2 7.8.1 p10: a procedure name in DECLARE TARGET is valid
// (treated as external subroutine if not otherwise specified).
} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
if (directive == llvm::omp::Directive::OMPD_threadprivate)
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 5fb5d58ce774c..4cd4f1fbebb5e 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2904,7 +2904,7 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
name->symbol = func;
}
}
- // OMP 5.2 §7.8.2 ¶10: If a name appears in a declare target directive
+ // OMP 5.2 §7.8.1 ¶10: If a name appears in a declare target directive
// and has not been explicitly typed as a variable or procedure, and
// no other declaration gives it a procedure property, treat it as an
// external subroutine.
>From 1890987737ae95f159ee3fea9c4d7ac987e54289 Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Thu, 21 May 2026 02:31:05 -0500
Subject: [PATCH 5/6] Fix formatting-only changes in resolve-names.cpp
---
flang/lib/Semantics/resolve-names.cpp | 56 +++++++++++++--------------
1 file changed, 28 insertions(+), 28 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 3f8619912bec4..7dd91f72e4890 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2591,7 +2591,7 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
}
symbol.SetBindName(std::move(*label));
if (!oldBindName.empty()) {
- if (const std::string *newBindName{symbol.GetBindName()}) {
+ if (const std::string * newBindName{symbol.GetBindName()}) {
if (oldBindName != *newBindName) {
Say(symbol.name(),
"The entity '%s' has multiple BIND names ('%s' and '%s')"_err_en_US,
@@ -2717,7 +2717,7 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
// expression semantics if the DeclTypeSpec is a valid TypeSpec.
// The grammar ensures that it's an intrinsic or derived type spec,
// not TYPE(*) or CLASS(*) or CLASS(T).
- if (const DeclTypeSpec *spec{state_.declTypeSpec}) {
+ if (const DeclTypeSpec * spec{state_.declTypeSpec}) {
switch (spec->category()) {
case DeclTypeSpec::Numeric:
case DeclTypeSpec::Logical:
@@ -2725,7 +2725,7 @@ void DeclTypeSpecVisitor::Post(const parser::TypeSpec &typeSpec) {
typeSpec.declTypeSpec = spec;
break;
case DeclTypeSpec::TypeDerived:
- if (const DerivedTypeSpec *derived{spec->AsDerived()}) {
+ if (const DerivedTypeSpec * derived{spec->AsDerived()}) {
CheckForAbstractType(derived->typeSymbol()); // C703
typeSpec.declTypeSpec = spec;
}
@@ -3346,8 +3346,8 @@ Symbol &ScopeHandler::MakeSymbol(const parser::Name &name, Attrs attrs) {
Symbol &ScopeHandler::MakeHostAssocSymbol(
const parser::Name &name, const Symbol &hostSymbol) {
Symbol &symbol{*NonDerivedTypeScope()
- .try_emplace(name.source, HostAssocDetails{hostSymbol})
- .first->second};
+ .try_emplace(name.source, HostAssocDetails{hostSymbol})
+ .first->second};
name.symbol = &symbol;
symbol.attrs() = hostSymbol.attrs(); // TODO: except PRIVATE, PUBLIC?
// These attributes can be redundantly reapplied without error
@@ -3435,7 +3435,7 @@ void ScopeHandler::ApplyImplicitRules(
if (context().HasError(symbol) || !NeedsType(symbol)) {
return;
}
- if (const DeclTypeSpec *type{GetImplicitType(symbol)}) {
+ if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
if (!skipImplicitTyping_) {
symbol.set(Symbol::Flag::Implicit);
symbol.SetType(*type);
@@ -3541,7 +3541,7 @@ const DeclTypeSpec *ScopeHandler::GetImplicitType(
const auto *type{implicitRulesMap_->at(scope).GetType(
symbol.name(), respectImplicitNoneType)};
if (type) {
- if (const DerivedTypeSpec *derived{type->AsDerived()}) {
+ if (const DerivedTypeSpec * derived{type->AsDerived()}) {
// Resolve any forward-referenced derived type; a quick no-op else.
auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
instantiatable.Instantiate(currScope());
@@ -4562,7 +4562,7 @@ Scope *ModuleVisitor::FindModule(const parser::Name &name,
if (scope) {
if (DoesScopeContain(scope, currScope())) { // 14.2.2(1)
std::optional<SourceName> submoduleName;
- if (const Scope *container{FindModuleOrSubmoduleContaining(currScope())};
+ if (const Scope * container{FindModuleOrSubmoduleContaining(currScope())};
container && container->IsSubmodule()) {
submoduleName = container->GetName();
}
@@ -4667,7 +4667,7 @@ bool InterfaceVisitor::isAbstract() const {
void InterfaceVisitor::AddSpecificProcs(
const std::list<parser::Name> &names, ProcedureKind kind) {
- if (Symbol *symbol{GetGenericInfo().symbol};
+ if (Symbol * symbol{GetGenericInfo().symbol};
symbol && symbol->has<GenericDetails>()) {
for (const auto &name : names) {
specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind));
@@ -4767,7 +4767,7 @@ void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) {
}
void InterfaceVisitor::ResolveNewSpecifics() {
- if (Symbol *generic{genericInfo_.top().symbol};
+ if (Symbol * generic{genericInfo_.top().symbol};
generic && generic->has<GenericDetails>()) {
ResolveSpecificsInGeneric(*generic, false);
}
@@ -5461,7 +5461,7 @@ Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
symbol = generic->specific();
}
}
- if (const Symbol *defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
+ if (const Symbol * defnIface{FindSeparateModuleSubprogramInterface(symbol)}) {
// Error recovery in case of multiple definitions
symbol = const_cast<Symbol *>(defnIface);
}
@@ -5601,8 +5601,8 @@ bool SubprogramVisitor::HandlePreviousCalls(
return generic->specific() &&
HandlePreviousCalls(name, *generic->specific(), subpFlag);
} else if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
- !proc->isDummy() &&
- !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
+ !proc->isDummy() &&
+ !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
// There's a symbol created for previous calls to this subprogram or
// ENTRY's name. We have to replace that symbol in situ to avoid the
// obligation to rewrite symbol pointers in the parse tree.
@@ -5716,7 +5716,7 @@ Symbol *SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
}
set_inheritFromParent(false); // interfaces don't inherit, even if MODULE
}
- if (Symbol *found{FindSymbol(name)};
+ if (Symbol * found{FindSymbol(name)};
found && found->has<HostAssocDetails>()) {
found->set(subpFlag); // PushScope() created symbol
}
@@ -6596,7 +6596,7 @@ bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) {
void DeclarationVisitor::Post(const parser::DeclarationTypeSpec::Type &type) {
const parser::Name &derivedName{std::get<parser::Name>(type.v.t)};
- if (const Symbol *derivedSymbol{derivedName.symbol}) {
+ if (const Symbol * derivedSymbol{derivedName.symbol}) {
CheckForAbstractType(*derivedSymbol); // C706
}
}
@@ -7722,7 +7722,7 @@ bool DeclarationVisitor::PassesLocalityChecks(
"Coarray '%s' not allowed in a %s locality-spec"_err_en_US, specName);
return false;
}
- if (const DeclTypeSpec *type{symbol.GetType()}) {
+ if (const DeclTypeSpec * type{symbol.GetType()}) {
if (type->IsPolymorphic() && IsDummy(symbol) && !IsPointer(symbol) &&
!isReduce) { // F'2023 C1130
SayWithDecl(name, symbol,
@@ -7956,7 +7956,7 @@ Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
}
void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
- if (const Symbol *symbol{name.symbol}) {
+ if (const Symbol * symbol{name.symbol}) {
const Symbol &ultimate{symbol->GetUltimate()};
if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
!BypassGeneric(ultimate).HasExplicitInterface()) {
@@ -8276,7 +8276,7 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
if (const auto *name{std::get_if<parser::Name>(&elem->Base().u)}) {
- if (const Symbol *symbol{FindSymbol(*name)};
+ if (const Symbol * symbol{FindSymbol(*name)};
symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {
mutableData.u = elem->ConvertToStructureConstructor(
DerivedTypeSpec{name->source, *symbol});
@@ -8430,7 +8430,7 @@ void ConstructVisitor::Post(const parser::SelectTypeStmt &x) {
"Selector is not a variable"_err_en_US);
association = {};
}
- if (const DeclTypeSpec *type{whole->GetType()}) {
+ if (const DeclTypeSpec * type{whole->GetType()}) {
if (!type->IsPolymorphic()) { // C1159
Say(association.selector.source,
"Selector '%s' in SELECT TYPE statement must be "
@@ -9194,7 +9194,7 @@ bool DeclarationVisitor::CheckForHostAssociatedImplicit(
if (name.symbol) {
ApplyImplicitRules(*name.symbol, true);
}
- if (Scope *host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
+ if (Scope * host{GetHostProcedure()}; host && !isImplicitNoneType(*host)) {
Symbol *hostSymbol{nullptr};
if (!name.symbol) {
if (currScope().CanImport(name.source)) {
@@ -9265,7 +9265,7 @@ const parser::Name *DeclarationVisitor::FindComponent(
if (!type) {
return nullptr; // should have already reported error
}
- if (const IntrinsicTypeSpec *intrinsic{type->AsIntrinsic()}) {
+ if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
auto category{intrinsic->category()};
MiscDetails::Kind miscKind{MiscDetails::Kind::None};
if (component.source == "kind") {
@@ -9287,7 +9287,7 @@ const parser::Name *DeclarationVisitor::FindComponent(
}
} else if (DerivedTypeSpec * derived{type->AsDerived()}) {
derived->Instantiate(currScope()); // in case of forward referenced type
- if (const Scope *scope{derived->scope()}) {
+ if (const Scope * scope{derived->scope()}) {
if (Resolve(component, scope->FindComponent(component.source))) {
if (auto msg{CheckAccessibleSymbol(currScope(), *component.symbol)}) {
context().Say(component.source, *msg);
@@ -10080,7 +10080,7 @@ void ResolveNamesVisitor::EarlyDummyTypeDeclaration(
for (const auto &ent : entities) {
const auto &objName{std::get<parser::ObjectName>(ent.t)};
Resolve(objName, FindInScope(currScope(), objName));
- if (Symbol *symbol{objName.symbol};
+ if (Symbol * symbol{objName.symbol};
symbol && IsDummy(*symbol) && NeedsType(*symbol)) {
if (!type) {
type = ProcessTypeSpec(declTypeSpec);
@@ -10222,7 +10222,7 @@ void ResolveNamesVisitor::FinishSpecificationPart(
if (auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
!proc->isDummy() && !IsPointer(symbol) &&
!symbol.attrs().test(Attr::BIND_C)) {
- if (const Symbol *iface{proc->procInterface()};
+ if (const Symbol * iface{proc->procInterface()};
iface && IsBindCProcedure(*iface)) {
SetImplicitAttr(symbol, Attr::BIND_C);
SetBindNameOn(symbol);
@@ -10376,7 +10376,7 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
Symbol *ptrSymbol{parser::GetLastName(dataRef).symbol};
Walk(bounds);
// Resolve unrestricted specific intrinsic procedures as in "p => cos".
- if (const parser::Name *name{parser::Unwrap<parser::Name>(expr)}) {
+ if (const parser::Name * name{parser::Unwrap<parser::Name>(expr)}) {
if (NameIsKnownOrIntrinsic(*name)) {
if (Symbol * symbol{name->symbol}) {
if (IsProcedurePointer(ptrSymbol) &&
@@ -10855,8 +10855,8 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
// implied SAVE so that evaluate::IsSaved() will return true.
if (node.scope()->kind() == Scope::Kind::MainProgram) {
if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
- if (const DeclTypeSpec *type{object->type()}) {
- if (const DerivedTypeSpec *derived{type->AsDerived()}) {
+ if (const DeclTypeSpec * type{object->type()}) {
+ if (const DerivedTypeSpec * derived{type->AsDerived()}) {
if (!IsSaved(symbol) && FindCoarrayPotentialComponent(*derived)) {
SetImplicitAttr(symbol, Attr::SAVE);
}
@@ -11116,7 +11116,7 @@ void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
spec->Instantiate(currScope());
const Symbol &origTypeSymbol{spec->typeSymbol()};
- if (const Scope *origTypeScope{origTypeSymbol.scope()}) {
+ if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
CHECK(origTypeScope->IsDerivedType() &&
origTypeScope->symbol() == &origTypeSymbol);
auto &foldingContext{GetFoldingContext()};
>From b5b3136d889b1f6147dcd31c71ca7c0b131a98bb Mon Sep 17 00:00:00 2001
From: Jay Satish Kumar Patel <kumarpat at pe31.hpc.amslabs.hpecorp.net>
Date: Thu, 4 Jun 2026 04:22:48 -0500
Subject: [PATCH 6/6] Update OpenMP spec citations from 7.8.2 to 3.2.1, 7.8,
7.8.1
---
flang/lib/Semantics/check-omp-structure.cpp | 7 ++++---
flang/lib/Semantics/resolve-directives.cpp | 7 +++----
flang/lib/Semantics/resolve-names.cpp | 14 +++++++-------
.../OpenMP/declare-target-implicit-func.f90 | 2 +-
.../declare-target-implicit-none-external.f90 | 2 +-
.../OpenMP/declare-target-implicit-proc.f90 | 2 +-
flang/test/Semantics/OpenMP/declare-target06.f90 | 7 ++++---
7 files changed, 21 insertions(+), 20 deletions(-)
diff --git a/flang/lib/Semantics/check-omp-structure.cpp b/flang/lib/Semantics/check-omp-structure.cpp
index 3184687eda227..2ec4b7ee1439d 100644
--- a/flang/lib/Semantics/check-omp-structure.cpp
+++ b/flang/lib/Semantics/check-omp-structure.cpp
@@ -1468,8 +1468,8 @@ void OmpStructureChecker::CheckThreadprivateOrDeclareTargetVar(
context_.Say(name->source,
"The procedure name cannot be in a %s directive"_err_en_US,
ContextDirectiveAsFortran());
- // OMP 5.2 7.8.1 p10: a procedure name in DECLARE TARGET is valid
- // (treated as external subroutine if not otherwise specified).
+ // OpenMP 5.2 , 3.2.1, 7.8 &7.8.1: a procedure name in DECLARE TARGET
+ // is valid (extended-list items may be procedure names).
} else if (name->symbol->attrs().test(Attr::PARAMETER)) {
if (directive == llvm::omp::Directive::OMPD_threadprivate)
context_.Say(name->source,
@@ -2345,7 +2345,8 @@ void OmpStructureChecker::Enter(const parser::OmpDeclareTargetDirective &x) {
// The bare form (no arguments, no clauses) is only permitted in the
// specification part of a subroutine, function, or interface body
- // (OpenMP 5.2 §7.8.2).
+ // (OpenMP 5.2 &
+ // 7.8.2).
if (x.v.Arguments().v.empty() && x.v.Clauses().v.empty()) {
const Scope &scope{GetScopingUnit(*scopeStack_.back())};
if (scope.kind() != Scope::Kind::Subprogram) {
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index f303031e3b00e..5a425ddc10301 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2942,10 +2942,9 @@ void OmpAttributeVisitor::ResolveOmpDesignator(
name->symbol = func;
}
}
- // OMP 5.2 §7.8.1 ¶10: If a name appears in a declare target directive
- // and has not been explicitly typed as a variable or procedure, and
- // no other declaration gives it a procedure property, treat it as an
- // external subroutine.
+ // OpenMP 5.2 , 3.2.1, 7.8 & 7.8.1: a declare target extended-list
+ // name that was never declared as a variable or given procedure
+ // properties is treated as an external procedure.
if (symbol->has<EntityDetails>() && !symbol->GetType() &&
!symbol->test(Symbol::Flag::Function) &&
!symbol->test(Symbol::Flag::Subroutine)) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7dd91f72e4890..d6a1138cd446e 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9348,14 +9348,14 @@ bool DeclarationVisitor::FindAndMarkDeclareTargetSymbol(
}
}
- // OpenMP 5.2, 7.8.2 p10: a procedure name in DECLARE TARGET with no
- // explicit data/procedure properties is treated as an external
- // subroutine. Only apply this at program/module scope level, not inside
- // subprograms where local variables could be forward-declared.
+ // OpenMP 5.2 3.2.1, 7.8 & 7.8.1: an extended-list item in
+ // DECLARE TARGET may be a procedure name. If the name has no prior
+ // declaration, preserve both possibilities (variable or procedure)
+ // by creating an EntityDetails placeholder. A later variable
+ // declaration in the same spec part can override it; otherwise
+ // resolve-directives promotes it to ProcEntityDetails.
+ // Only apply at program/module scope, not inside subprograms.
// Also skip if a common block with the same name exists.
- // Use isImplicitNoneExternal() since this creates an implicit external,
- // not an implicit type. Use EntityDetails so a later variable
- // declaration in the same spec part can override it.
if (!isImplicitNoneExternal() &&
currScope().kind() != Scope::Kind::Subprogram &&
currScope().kind() != Scope::Kind::BlockConstruct &&
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
index 5a90bcd973d16..358fd9b02eb2d 100644
--- a/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-func.f90
@@ -1,6 +1,6 @@
! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
-! Test OpenMP 5.2 §7.8.2 ¶10: implicit external procedure in DECLARE TARGET
+! Test OpenMP 5.2 , 3.2.1, 7.8 & 7.8.1: implicit external procedure in DECLARE TARGET
! When the name is later defined as a function, it should work correctly
program test_implicit_declare_target_func
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
index b10a1827e2173..0a0a4572c4c11 100644
--- a/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-none-external.f90
@@ -1,7 +1,7 @@
! RUN: not %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
! Test that IMPLICIT NONE(EXTERNAL) blocks implicit procedure creation
-! per OpenMP 5.2 §7.8.2 ¶10
+! per OpenMP 5.2 3.2.1, 7.8 &7.8.1
program test_implicit_none_external
implicit none(external)
diff --git a/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90 b/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
index cbe6568da49ec..10b2e9185a9e9 100644
--- a/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
+++ b/flang/test/Semantics/OpenMP/declare-target-implicit-proc.f90
@@ -1,6 +1,6 @@
! RUN: %flang_fc1 -fopenmp -fopenmp-version=52 -fsyntax-only %s 2>&1 | FileCheck %s
-! Test OpenMP 5.2 §7.8.2 ¶10: implicit external procedure in DECLARE TARGET
+! Test OpenMP 5.2 3.2.1, 7.8 & 7.8.1: implicit external procedure in DECLARE TARGET
! A name in DECLARE TARGET with no explicit type is treated as external subroutine
program test_implicit_declare_target
diff --git a/flang/test/Semantics/OpenMP/declare-target06.f90 b/flang/test/Semantics/OpenMP/declare-target06.f90
index c3cd484f02d0d..db693a1fee137 100644
--- a/flang/test/Semantics/OpenMP/declare-target06.f90
+++ b/flang/test/Semantics/OpenMP/declare-target06.f90
@@ -3,9 +3,10 @@
! Check OpenMP construct validity for the following directives:
! 2.14.7 Declare Target Directive
! When used in an implicit none context.
-! Per OMP 5.2 §7.8.2 ¶10, unknown names in DECLARE TARGET are treated as
-! external procedures, so no "No explicit type" error is expected for
-! names in ENTER/TO clauses (or bare list). LINK clause is different.
+! Per OpenMP 5.2 ,3.2.1, 7.8 & 7.8.1, names in DECLARE TARGET may denote
+! procedures. Unknown names are treated as external procedures, so no
+! "No explicit type" error is expected for names in ENTER/TO clauses
+! (or bare list). LINK clause is different.
module test_0
implicit none
More information about the flang-commits
mailing list