[flang] Save binding labels as strings
Binding labels start as expressions but they have to evaluate to
constant character of default kind, so they can be represented as an
std::string. Leading and trailing blanks have to be removed, so the
folded expression isn't exactly right anyway.
So all BIND(C) symbols now have a string binding label, either the
default or user-supplied one. This is recorded in the .mod file.
Add WithBindName mix-in for details classes that can have a binding
label so that they are all consistent. Add GetBindName() and
SetBindName() member functions to Symbol.
Add tests that verifies that leading and trailing blanks are ignored
in binding labels and that the default label is folded to lower case.
Differential Revision: https://reviews.llvm.org/D99208
GitOrigin-RevId: 5d3249e9af9086a29214312af18651ebb769eb71
diff --git a/include/flang/Semantics/symbol.h b/include/flang/Semantics/symbol.h
index 0078d25..4586ad9 100644
--- a/include/flang/Semantics/symbol.h
+++ b/include/flang/Semantics/symbol.h
@@ -60,7 +60,18 @@
private:
};
-class SubprogramDetails {
+class WithBindName {
+public:
+ const std::string *bindName() const {
+ return bindName_ ? &*bindName_ : nullptr;
+ }
+ void set_bindName(std::string &&name) { bindName_ = std::move(name); }
+
+private:
+ std::optional<std::string> bindName_;
+};
+
+class SubprogramDetails : public WithBindName {
public:
bool isFunction() const { return result_ != nullptr; }
bool isInterface() const { return isInterface_; }
@@ -68,8 +79,6 @@
Scope *entryScope() { return entryScope_; }
const Scope *entryScope() const { return entryScope_; }
void set_entryScope(Scope &scope) { entryScope_ = &scope; }
- MaybeExpr bindName() const { return bindName_; }
- void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
const Symbol &result() const {
CHECK(isFunction());
return *result_;
@@ -86,7 +95,6 @@
private:
bool isInterface_{false}; // true if this represents an interface-body
- MaybeExpr bindName_;
std::vector<Symbol *> dummyArgs_; // nullptr -> alternate return indicator
Symbol *result_{nullptr};
Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
@@ -117,7 +125,7 @@
};
// A name from an entity-decl -- could be object or function.
-class EntityDetails {
+class EntityDetails : public WithBindName {
public:
explicit EntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
const DeclTypeSpec *type() const { return type_; }
@@ -127,14 +135,11 @@
void set_isDummy(bool value = true) { isDummy_ = value; }
bool isFuncResult() const { return isFuncResult_; }
void set_funcResult(bool x) { isFuncResult_ = x; }
- MaybeExpr bindName() const { return bindName_; }
- void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
private:
bool isDummy_{false};
bool isFuncResult_{false};
const DeclTypeSpec *type_{nullptr};
- MaybeExpr bindName_;
friend llvm::raw_ostream &operator<<(
llvm::raw_ostream &, const EntityDetails &);
};
@@ -310,19 +315,16 @@
SymbolVector objects_;
};
-class CommonBlockDetails {
+class CommonBlockDetails : public WithBindName {
public:
MutableSymbolVector &objects() { return objects_; }
const MutableSymbolVector &objects() const { return objects_; }
void add_object(Symbol &object) { objects_.emplace_back(object); }
- MaybeExpr bindName() const { return bindName_; }
- void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
std::size_t alignment() const { return alignment_; }
void set_alignment(std::size_t alignment) { alignment_ = alignment; }
private:
MutableSymbolVector objects_;
- MaybeExpr bindName_;
std::size_t alignment_{0}; // required alignment in bytes
};
@@ -565,8 +567,10 @@
inline DeclTypeSpec *GetType();
inline const DeclTypeSpec *GetType() const;
-
void SetType(const DeclTypeSpec &);
+
+ const std::string *GetBindName() const;
+ void SetBindName(std::string &&);
bool IsFuncResult() const;
bool IsObjectArray() const;
bool IsSubprogram() const;
diff --git a/lib/Semantics/CMakeLists.txt b/lib/Semantics/CMakeLists.txt
index 4bab4b1..9e7c07b 100644
--- a/lib/Semantics/CMakeLists.txt
+++ b/lib/Semantics/CMakeLists.txt
@@ -1,4 +1,3 @@
-
add_flang_library(FortranSemantics
assignment.cpp
attr.cpp
diff --git a/lib/Semantics/check-declarations.cpp b/lib/Semantics/check-declarations.cpp
index 0dad3c6..69607c4 100644
--- a/lib/Semantics/check-declarations.cpp
+++ b/lib/Semantics/check-declarations.cpp
@@ -1687,24 +1687,23 @@
: "Module subprogram '%s' does not have NON_RECURSIVE prefix but "
"the corresponding interface body does"_err_en_US);
}
- MaybeExpr bindName1{details1.bindName()};
- MaybeExpr bindName2{details2.bindName()};
- if (bindName1.has_value() != bindName2.has_value()) {
+ const std::string *bindName1{details1.bindName()};
+ const std::string *bindName2{details2.bindName()};
+ if (!bindName1 && !bindName2) {
+ // OK - neither has a binding label
+ } else if (!bindName1) {
Say(symbol1, symbol2,
- bindName1.has_value()
- ? "Module subprogram '%s' has a binding label but the corresponding"
- " interface body does not"_err_en_US
- : "Module subprogram '%s' does not have a binding label but the"
- " corresponding interface body does"_err_en_US);
- } else if (bindName1) {
- std::string string1{bindName1->AsFortran()};
- std::string string2{bindName2->AsFortran()};
- if (string1 != string2) {
- Say(symbol1, symbol2,
- "Module subprogram '%s' has binding label %s but the corresponding"
- " interface body has %s"_err_en_US,
- string1, string2);
- }
+ "Module subprogram '%s' does not have a binding label but the"
+ " corresponding interface body does"_err_en_US);
+ } else if (!bindName2) {
+ Say(symbol1, symbol2,
+ "Module subprogram '%s' has a binding label but the"
+ " corresponding interface body does not"_err_en_US);
+ } else if (*bindName1 != *bindName2) {
+ Say(symbol1, symbol2,
+ "Module subprogram '%s' has binding label '%s' but the corresponding"
+ " interface body has '%s'"_err_en_US,
+ *details1.bindName(), *details2.bindName());
}
const Procedure *proc1{checkHelper.Characterize(symbol1)};
const Procedure *proc2{checkHelper.Characterize(symbol2)};
diff --git a/lib/Semantics/mod-file.cpp b/lib/Semantics/mod-file.cpp
index 1e2a5c6..a60c8dd 100644
--- a/lib/Semantics/mod-file.cpp
+++ b/lib/Semantics/mod-file.cpp
@@ -54,8 +54,8 @@
static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &);
static void PutInit(llvm::raw_ostream &, const MaybeIntExpr &);
static void PutBound(llvm::raw_ostream &, const Bound &);
-static llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
- const MaybeExpr & = std::nullopt, std::string before = ","s,
+llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
+ const std::string * = nullptr, std::string before = ","s,
std::string after = ""s);
static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
@@ -346,7 +346,7 @@
if (isInterface) {
os << (isAbstract ? "abstract " : "") << "interface\n";
}
- PutAttrs(os, prefixAttrs, std::nullopt, ""s, " "s);
+ PutAttrs(os, prefixAttrs, nullptr, ""s, " "s);
os << (details.isFunction() ? "function " : "subroutine ");
os << symbol.name() << '(';
int n = 0;
@@ -636,26 +636,18 @@
void PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
std::function<void()> writeType, Attrs attrs) {
writeType();
- MaybeExpr bindName;
- std::visit(common::visitors{
- [&](const SubprogramDetails &x) { bindName = x.bindName(); },
- [&](const ObjectEntityDetails &x) { bindName = x.bindName(); },
- [&](const ProcEntityDetails &x) { bindName = x.bindName(); },
- [&](const auto &) {},
- },
- symbol.details());
- PutAttrs(os, attrs, bindName);
+ PutAttrs(os, attrs, symbol.GetBindName());
os << "::" << symbol.name();
}
// Put out each attribute to os, surrounded by `before` and `after` and
// mapped to lower case.
llvm::raw_ostream &PutAttrs(llvm::raw_ostream &os, Attrs attrs,
- const MaybeExpr &bindName, std::string before, std::string after) {
+ const std::string *bindName, std::string before, std::string after) {
attrs.set(Attr::PUBLIC, false); // no need to write PUBLIC
attrs.set(Attr::EXTERNAL, false); // no need to write EXTERNAL
if (bindName) {
- bindName->AsFortran(os << before << "bind(c, name=") << ')' << after;
+ os << before << "bind(c, name=\"" << *bindName << "\")" << after;
attrs.set(Attr::BIND_C, false);
}
for (std::size_t i{0}; i < Attr_enumSize; ++i) {
diff --git a/lib/Semantics/resolve-names.cpp b/lib/Semantics/resolve-names.cpp
index 2d1d513..6818686 100644
--- a/lib/Semantics/resolve-names.cpp
+++ b/lib/Semantics/resolve-names.cpp
@@ -1528,19 +1528,26 @@
}
bool AttrsVisitor::SetBindNameOn(Symbol &symbol) {
- if (!bindName_) {
+ if (!attrs_ || !attrs_->test(Attr::BIND_C)) {
return false;
}
- std::visit(
- common::visitors{
- [&](EntityDetails &x) { x.set_bindName(std::move(bindName_)); },
- [&](ObjectEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
- [&](ProcEntityDetails &x) { x.set_bindName(std::move(bindName_)); },
- [&](SubprogramDetails &x) { x.set_bindName(std::move(bindName_)); },
- [&](CommonBlockDetails &x) { x.set_bindName(std::move(bindName_)); },
- [](auto &) { common::die("unexpected bind name"); },
- },
- symbol.details());
+ std::optional<std::string> label{evaluate::GetScalarConstantValue<
+ evaluate::Type<TypeCategory::Character, 1>>(bindName_)};
+ // 18.9.2(2): discard leading and trailing blanks, ignore if all blank
+ if (label) {
+ auto first{label->find_first_not_of(" ")};
+ auto last{label->find_last_not_of(" ")};
+ if (first == std::string::npos) {
+ Say(currStmtSource().value(), "Blank binding label ignored"_en_US);
+ label.reset();
+ } else {
+ label = label->substr(first, last - first + 1);
+ }
+ }
+ if (!label) {
+ label = parser::ToLowerCaseLetters(symbol.name().ToString());
+ }
+ symbol.SetBindName(std::move(*label));
return true;
}
diff --git a/lib/Semantics/symbol.cpp b/lib/Semantics/symbol.cpp
index edd2c84..7d439df 100644
--- a/lib/Semantics/symbol.cpp
+++ b/lib/Semantics/symbol.cpp
@@ -14,6 +14,7 @@
#include "flang/Semantics/tools.h"
#include "llvm/Support/raw_ostream.h"
#include <string>
+#include <type_traits>
namespace Fortran::semantics {
@@ -84,7 +85,7 @@
llvm::raw_ostream &operator<<(
llvm::raw_ostream &os, const SubprogramDetails &x) {
DumpBool(os, "isInterface", x.isInterface_);
- DumpExpr(os, "bindName", x.bindName_);
+ DumpOptional(os, "bindName", x.bindName());
if (x.result_) {
DumpType(os << " result:", x.result());
os << x.result_->name();
@@ -290,6 +291,33 @@
details_);
}
+template <typename T>
+constexpr bool HasBindName{std::is_convertible_v<T, const WithBindName *>};
+
+const std::string *Symbol::GetBindName() const {
+ return std::visit(
+ [&](auto &x) -> const std::string * {
+ if constexpr (HasBindName<decltype(&x)>) {
+ return x.bindName();
+ } else {
+ return nullptr;
+ }
+ },
+ details_);
+}
+
+void Symbol::SetBindName(std::string &&name) {
+ std::visit(
+ [&](auto &x) {
+ if constexpr (HasBindName<decltype(&x)>) {
+ x.set_bindName(std::move(name));
+ } else {
+ DIE("bind name not allowed on this kind of symbol");
+ }
+ },
+ details_);
+}
+
bool Symbol::IsFuncResult() const {
return std::visit(
common::visitors{[](const EntityDetails &x) { return x.isFuncResult(); },
@@ -331,7 +359,7 @@
if (x.type()) {
os << " type: " << *x.type();
}
- DumpExpr(os, "bindName", x.bindName_);
+ DumpOptional(os, "bindName", x.bindName());
return os;
}
@@ -361,7 +389,7 @@
} else {
DumpType(os, x.interface_.type());
}
- DumpExpr(os, "bindName", x.bindName());
+ DumpOptional(os, "bindName", x.bindName());
DumpOptional(os, "passName", x.passName());
if (x.init()) {
if (const Symbol * target{*x.init()}) {
@@ -448,6 +476,7 @@
DumpSymbolVector(os, x.objects());
},
[&](const CommonBlockDetails &x) {
+ DumpOptional(os, "bindName", x.bindName());
if (x.alignment()) {
os << " alignment=" << x.alignment();
}
diff --git a/test/Semantics/modfile04.f90 b/test/Semantics/modfile04.f90
index bc4d8d4..9312b75 100644
--- a/test/Semantics/modfile04.f90
+++ b/test/Semantics/modfile04.f90
@@ -6,7 +6,7 @@
end type
contains
- pure subroutine s(x, y) bind(c)
+ pure subroutine Ss(x, y) bind(c)
logical x
intent(inout) y
intent(in) x
@@ -53,7 +53,7 @@
!type::t
!end type
!contains
-!pure subroutine s(x,y) bind(c)
+!pure subroutine ss(x,y) bind(c, name="ss")
!logical(4),intent(in)::x
!real(4),intent(inout)::y
!end
diff --git a/test/Semantics/modfile21.f90 b/test/Semantics/modfile21.f90
index e48f633..73cf59f 100644
--- a/test/Semantics/modfile21.f90
+++ b/test/Semantics/modfile21.f90
@@ -29,7 +29,7 @@
! common/cb/x,y,z
! bind(c, name="CB")::/cb/
! common/cb2/a,b,c
-! bind(c)::/cb2/
+! bind(c, name="cb2")::/cb2/
! common/b/cb
! common//t,w,u,v
!end
diff --git a/test/Semantics/separate-mp02.f90 b/test/Semantics/separate-mp02.f90
index 6d620e7..3dd717d 100644
--- a/test/Semantics/separate-mp02.f90
+++ b/test/Semantics/separate-mp02.f90
@@ -136,6 +136,12 @@
end
module subroutine s3() bind(c, name="s3")
end
+ module subroutine s4() bind(c, name=" s4")
+ end
+ module subroutine s5() bind(c)
+ end
+ module subroutine s6() bind(c)
+ end
end interface
end
@@ -148,9 +154,16 @@
!ERROR: Module subprogram 's2' does not have a binding label but the corresponding interface body does
module subroutine s2()
end
- !ERROR: Module subprogram 's3' has binding label "s3_xxx" but the corresponding interface body has "s3"
+ !ERROR: Module subprogram 's3' has binding label 's3_xxx' but the corresponding interface body has 's3'
module subroutine s3() bind(c, name="s3" // suffix)
end
+ module subroutine s4() bind(c, name="s4 ")
+ end
+ module subroutine s5() bind(c, name=" s5")
+ end
+ !ERROR: Module subprogram 's6' has binding label 'not_s6' but the corresponding interface body has 's6'
+ module subroutine s6() bind(c, name="not_s6")
+ end
end
