private:
};
-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 {
+class SubprogramDetails {
public:
bool isFunction() const { return result_ != nullptr; }
bool isInterface() const { return isInterface_; }
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_;
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
};
// A name from an entity-decl -- could be object or function.
-class EntityDetails : public WithBindName {
+class EntityDetails {
public:
explicit EntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
const DeclTypeSpec *type() const { return type_; }
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 &);
};
SymbolVector objects_;
};
-class CommonBlockDetails : public WithBindName {
+class CommonBlockDetails {
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
};
inline DeclTypeSpec *GetType();
inline const DeclTypeSpec *GetType() const;
- void SetType(const DeclTypeSpec &);
- const std::string *GetBindName() const;
- void SetBindName(std::string &&);
+ void SetType(const DeclTypeSpec &);
bool IsFuncResult() const;
bool IsObjectArray() const;
bool IsSubprogram() const;
+
add_flang_library(FortranSemantics
assignment.cpp
attr.cpp
: "Module subprogram '%s' does not have NON_RECURSIVE prefix but "
"the corresponding interface body does"_err_en_US);
}
- const std::string *bindName1{details1.bindName()};
- const std::string *bindName2{details2.bindName()};
- if (!bindName1 && !bindName2) {
- // OK - neither has a binding label
- } else if (!bindName1) {
+ MaybeExpr bindName1{details1.bindName()};
+ MaybeExpr bindName2{details2.bindName()};
+ if (bindName1.has_value() != bindName2.has_value()) {
Say(symbol1, symbol2,
- "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());
+ 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);
+ }
}
const Procedure *proc1{checkHelper.Characterize(symbol1)};
const Procedure *proc2{checkHelper.Characterize(symbol2)};
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 &);
-llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
- const std::string * = nullptr, std::string before = ","s,
+static llvm::raw_ostream &PutAttrs(llvm::raw_ostream &, Attrs,
+ const MaybeExpr & = std::nullopt, std::string before = ","s,
std::string after = ""s);
static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
if (isInterface) {
os << (isAbstract ? "abstract " : "") << "interface\n";
}
- PutAttrs(os, prefixAttrs, nullptr, ""s, " "s);
+ PutAttrs(os, prefixAttrs, std::nullopt, ""s, " "s);
os << (details.isFunction() ? "function " : "subroutine ");
os << symbol.name() << '(';
int n = 0;
void PutEntity(llvm::raw_ostream &os, const Symbol &symbol,
std::function<void()> writeType, Attrs attrs) {
writeType();
- PutAttrs(os, attrs, symbol.GetBindName());
+ 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);
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 std::string *bindName, std::string before, std::string after) {
+ const MaybeExpr &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) {
- os << before << "bind(c, name=\"" << *bindName << "\")" << after;
+ bindName->AsFortran(os << before << "bind(c, name=") << ')' << after;
attrs.set(Attr::BIND_C, false);
}
for (std::size_t i{0}; i < Attr_enumSize; ++i) {
}
bool AttrsVisitor::SetBindNameOn(Symbol &symbol) {
- if (!attrs_ || !attrs_->test(Attr::BIND_C)) {
+ if (!bindName_) {
return false;
}
- 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));
+ 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());
return true;
}
#include "flang/Semantics/tools.h"
#include "llvm/Support/raw_ostream.h"
#include <string>
-#include <type_traits>
namespace Fortran::semantics {
llvm::raw_ostream &operator<<(
llvm::raw_ostream &os, const SubprogramDetails &x) {
DumpBool(os, "isInterface", x.isInterface_);
- DumpOptional(os, "bindName", x.bindName());
+ DumpExpr(os, "bindName", x.bindName_);
if (x.result_) {
DumpType(os << " result:", x.result());
os << x.result_->name();
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(); },
if (x.type()) {
os << " type: " << *x.type();
}
- DumpOptional(os, "bindName", x.bindName());
+ DumpExpr(os, "bindName", x.bindName_);
return os;
}
} else {
DumpType(os, x.interface_.type());
}
- DumpOptional(os, "bindName", x.bindName());
+ DumpExpr(os, "bindName", x.bindName());
DumpOptional(os, "passName", x.passName());
if (x.init()) {
if (const Symbol * target{*x.init()}) {
DumpSymbolVector(os, x.objects());
},
[&](const CommonBlockDetails &x) {
- DumpOptional(os, "bindName", x.bindName());
if (x.alignment()) {
os << " alignment=" << x.alignment();
}
end type
contains
- pure subroutine Ss(x, y) bind(c)
+ pure subroutine s(x, y) bind(c)
logical x
intent(inout) y
intent(in) x
!type::t
!end type
!contains
-!pure subroutine ss(x,y) bind(c, name="ss")
+!pure subroutine s(x,y) bind(c)
!logical(4),intent(in)::x
!real(4),intent(inout)::y
!end
! common/cb/x,y,z
! bind(c, name="CB")::/cb/
! common/cb2/a,b,c
-! bind(c, name="cb2")::/cb2/
+! bind(c)::/cb2/
! common/b/cb
! common//t,w,u,v
!end
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
!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