[flang-commits] [flang] [flang] Support BIND(C, NAME="...", CDEFINED) extension (PR #94402)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Jun 4 14:27:50 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/94402
This CDEFINED keyword extension to a language-binding-spec signifies that static storage for an interoperable variable will be allocated outside of Fortran, probably by a C/C++ external object definition.
>From 873386f6a293129825b7bdc2b12eaaebce487ea7 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 4 Jun 2024 14:25:27 -0700
Subject: [PATCH] [flang] Support BIND(C, NAME="...", CDEFINED) extension
This CDEFINED keyword extension to a language-binding-spec signifies
that static storage for an interoperable variable will be allocated
outside of Fortran, probably by a C/C++ external object definition.
---
flang/docs/Extensions.md | 3 +++
flang/include/flang/Parser/parse-tree.h | 9 ++++++---
flang/include/flang/Semantics/symbol.h | 4 ++++
flang/lib/Parser/Fortran-parsers.cpp | 3 ++-
flang/lib/Parser/unparse.cpp | 8 +++++++-
flang/lib/Semantics/resolve-names.cpp | 23 ++++++++++++++++++-----
flang/lib/Semantics/symbol.cpp | 13 +++++++++++++
flang/test/Semantics/bind-c16.f90 | 5 +++++
8 files changed, 58 insertions(+), 10 deletions(-)
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 14410f17ab8ac..82f9a021c14ee 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -374,6 +374,9 @@ end
required, with warnings, even if it lacks the BIND(C) attribute.
* A "mult-operand" in an expression can be preceded by a unary
`+` or `-` operator.
+* `BIND(C, NAME="...", CDEFINED)` signifies that the storage for an
+ interoperable variable will be allocated outside of Fortran,
+ probably by a C or C++ external definition.
### Extensions supported when enabled by options
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 12e35075d2a69..f0b9b682030c6 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1296,10 +1296,13 @@ struct AcImpliedDo {
};
// R808 language-binding-spec ->
-// BIND ( C [, NAME = scalar-default-char-constant-expr] )
+// BIND ( C [, NAME = scalar-default-char-constant-expr ]
+// [, CDEFINED ] )
// R1528 proc-language-binding-spec -> language-binding-spec
-WRAPPER_CLASS(
- LanguageBindingSpec, std::optional<ScalarDefaultCharConstantExpr>);
+struct LanguageBindingSpec {
+ TUPLE_CLASS_BOILERPLATE(LanguageBindingSpec);
+ std::tuple<std::optional<ScalarDefaultCharConstantExpr>, bool> t;
+};
// R852 named-constant-def -> named-constant = constant-expr
struct NamedConstantDef {
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 357a4c76d997b..cdbe3e39386bb 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -115,10 +115,13 @@ class WithBindName {
bool isExplicitBindName() const { return isExplicitBindName_; }
void set_bindName(std::string &&name) { bindName_ = std::move(name); }
void set_isExplicitBindName(bool yes) { isExplicitBindName_ = yes; }
+ bool isCDefined() const { return isCDefined_; }
+ void set_isCDefined(bool yes) { isCDefined_ = yes; }
private:
std::optional<std::string> bindName_;
bool isExplicitBindName_{false};
+ bool isCDefined_{false};
};
// Device type specific OpenACC routine information
@@ -814,6 +817,7 @@ class Symbol {
void SetBindName(std::string &&);
bool GetIsExplicitBindName() const;
void SetIsExplicitBindName(bool);
+ void SetIsCDefined(bool);
bool IsFuncResult() const;
bool IsObjectArray() const;
const ArraySpec *GetShape() const;
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index ff01974b549a1..13f15c84e579e 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -735,7 +735,8 @@ TYPE_PARSER(construct<AccessSpec>("PUBLIC" >> pure(AccessSpec::Kind::Public)) ||
// BIND ( C [, NAME = scalar-default-char-constant-expr] )
// R1528 proc-language-binding-spec -> language-binding-spec
TYPE_PARSER(construct<LanguageBindingSpec>(
- "BIND ( C" >> maybe(", NAME =" >> scalarDefaultCharConstantExpr) / ")"))
+ "BIND ( C" >> maybe(", NAME =" >> scalarDefaultCharConstantExpr),
+ (", CDEFINED" >> pure(true) || pure(false)) / ")"))
// R809 coarray-spec -> deferred-coshape-spec-list | explicit-coshape-spec
// N.B. Bracketed here rather than around references, for consistency with
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index b98aae8e8f7a2..13ca2309ad502 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -524,7 +524,13 @@ class UnparseVisitor {
Word("NULL()");
}
void Unparse(const LanguageBindingSpec &x) { // R808 & R1528
- Word("BIND(C"), Walk(", NAME=", x.v), Put(')');
+ Word("BIND(C");
+ Walk(
+ ", NAME=", std::get<std::optional<ScalarDefaultCharConstantExpr>>(x.t));
+ if (std::get<bool>(x.t)) {
+ Word(", CDEFINED");
+ }
+ Put(')');
}
void Unparse(const CoarraySpec &x) { // R809
common::visit(common::visitors{
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7397c3a51b61e..17ff12568b06d 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -315,6 +315,7 @@ class AttrsVisitor : public virtual BaseVisitor {
bool IsConflictingAttr(Attr);
MaybeExpr bindName_; // from BIND(C, NAME="...")
+ bool isCDefined_{false}; // BIND(C, NAME="...", CDEFINED) extension
std::optional<SourceName> passName_; // from PASS(...)
};
@@ -1762,6 +1763,7 @@ Attrs AttrsVisitor::EndAttrs() {
cudaDataAttr_.reset();
passName_ = std::nullopt;
bindName_.reset();
+ isCDefined_ = false;
return result;
}
@@ -1783,6 +1785,7 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
!symbol.attrs().test(Attr::BIND_C)) {
return;
}
+ symbol.SetIsCDefined(isCDefined_);
std::optional<std::string> label{
evaluate::GetScalarConstantValue<evaluate::Ascii>(bindName_)};
// 18.9.2(2): discard leading and trailing blanks
@@ -1820,9 +1823,12 @@ void AttrsVisitor::SetBindNameOn(Symbol &symbol) {
void AttrsVisitor::Post(const parser::LanguageBindingSpec &x) {
if (CheckAndSet(Attr::BIND_C)) {
- if (x.v) {
- bindName_ = EvaluateExpr(*x.v);
+ if (const auto &name{
+ std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
+ x.t)}) {
+ bindName_ = EvaluateExpr(*name);
}
+ isCDefined_ = std::get<bool>(x.t);
}
}
bool AttrsVisitor::Pre(const parser::IntentSpec &x) {
@@ -4056,7 +4062,9 @@ void SubprogramVisitor::CreateEntry(
Attrs attrs;
const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
bool hasGlobalBindingName{outer.IsGlobal() && suffix && suffix->binding &&
- suffix->binding->v.has_value()};
+ std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
+ suffix->binding->t)
+ .has_value()};
if (!hasGlobalBindingName) {
if (Symbol * extant{FindSymbol(outer, entryName)}) {
if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
@@ -4440,7 +4448,10 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
bool hasModulePrefix) {
Symbol *symbol{GetSpecificFromGeneric(name)};
if (!symbol) {
- if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
+ if (bindingSpec && currScope().IsGlobal() &&
+ std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
+ bindingSpec->t)
+ .has_value()) {
// Create this new top-level subprogram with a binding label
// in a new global scope, so that its symbol's name won't clash
// with another symbol that has a distinct binding label.
@@ -5670,7 +5681,9 @@ bool DeclarationVisitor::Pre(const parser::ProcedureDeclarationStmt &x) {
const auto &procAttrSpec{std::get<std::list<parser::ProcAttrSpec>>(x.t)};
for (const parser::ProcAttrSpec &procAttr : procAttrSpec) {
if (auto *bindC{std::get_if<parser::LanguageBindingSpec>(&procAttr.u)}) {
- if (bindC->v.has_value()) {
+ if (std::get<std::optional<parser::ScalarDefaultCharConstantExpr>>(
+ bindC->t)
+ .has_value()) {
if (std::get<std::list<parser::ProcDecl>>(x.t).size() > 1) {
Say(context().location().value(),
"A procedure declaration statement with a binding name may not declare multiple procedures"_err_en_US);
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 3eb120fd962fa..023ab7b64e4fc 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/lib/Semantics/symbol.cpp
@@ -375,6 +375,18 @@ void Symbol::SetIsExplicitBindName(bool yes) {
details_);
}
+void Symbol::SetIsCDefined(bool yes) {
+ common::visit(
+ [&](auto &x) {
+ if constexpr (HasBindName<decltype(&x)>) {
+ x.set_isCDefined(yes);
+ } else {
+ DIE("CDEFINED not allowed on this kind of symbol");
+ }
+ },
+ details_);
+}
+
bool Symbol::IsFuncResult() const {
return common::visit(
common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); },
@@ -422,6 +434,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) {
os << " type: " << *x.type();
}
DumpOptional(os, "bindName", x.bindName());
+ DumpBool(os, "CDEFINED", x.isCDefined());
return os;
}
diff --git a/flang/test/Semantics/bind-c16.f90 b/flang/test/Semantics/bind-c16.f90
index b9dfb03e35eec..77c1a91608894 100644
--- a/flang/test/Semantics/bind-c16.f90
+++ b/flang/test/Semantics/bind-c16.f90
@@ -84,3 +84,8 @@ subroutine s3() bind(c,name='foo')
end
end interface
end
+
+!CHECK: cdef01, BIND(C), PUBLIC size=4 offset=0: ObjectEntity type: REAL(4) bindName:cDef01 CDEFINED
+module m4
+ real, bind(c, name='cDef01', cdefined) :: cdef01
+end
More information about the flang-commits
mailing list