diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index 4586ad9f864d8..0078d25674733 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -60,18 +60,7 @@ class MainProgramDetails { 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 bindName_; -}; - -class SubprogramDetails : public WithBindName { +class SubprogramDetails { public: bool isFunction() const { return result_ != nullptr; } bool isInterface() const { return isInterface_; } @@ -79,6 +68,8 @@ class SubprogramDetails : public WithBindName { 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_; @@ -95,6 +86,7 @@ class SubprogramDetails : public WithBindName { private: bool isInterface_{false}; // true if this represents an interface-body + MaybeExpr bindName_; std::vector dummyArgs_; // nullptr -> alternate return indicator Symbol *result_{nullptr}; Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope @@ -125,7 +117,7 @@ class SubprogramNameDetails { }; // 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_; } @@ -135,11 +127,14 @@ class EntityDetails : public WithBindName { 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 &); }; @@ -315,16 +310,19 @@ class NamelistDetails { 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 }; @@ -567,10 +565,8 @@ class Symbol { 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; diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index 9e7c07b9c55fa..4bab4b16149db 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -1,3 +1,4 @@ + add_flang_library(FortranSemantics assignment.cpp attr.cpp diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 69607c466e162..0dad3c6e8d9b9 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1687,23 +1687,24 @@ void SubprogramMatchHelper::Check( : "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)}; diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index a60c8dd1cd020..1e2a5c6728b76 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -54,8 +54,8 @@ static void PutEntity( 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); @@ -346,7 +346,7 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) { 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; @@ -636,18 +636,26 @@ void PutBound(llvm::raw_ostream &os, const Bound &x) { void PutEntity(llvm::raw_ostream &os, const Symbol &symbol, std::function 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) { diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 6938a4dc9b28c..2d1d513c427eb 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -1528,26 +1528,19 @@ bool AttrsVisitor::SetPassNameOn(Symbol &symbol) { } bool AttrsVisitor::SetBindNameOn(Symbol &symbol) { - if (!attrs_ || !attrs_->test(Attr::BIND_C)) { + if (!bindName_) { return false; } - std::optional label{evaluate::GetScalarConstantValue< - evaluate::Type>(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; } diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index 7d439df75c2ef..edd2c84218c1d 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -14,7 +14,6 @@ #include "flang/Semantics/tools.h" #include "llvm/Support/raw_ostream.h" #include -#include namespace Fortran::semantics { @@ -85,7 +84,7 @@ void ModuleDetails::set_scope(const Scope *scope) { 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(); @@ -291,33 +290,6 @@ void Symbol::SetType(const DeclTypeSpec &type) { details_); } -template -constexpr bool HasBindName{std::is_convertible_v}; - -const std::string *Symbol::GetBindName() const { - return std::visit( - [&](auto &x) -> const std::string * { - if constexpr (HasBindName) { - return x.bindName(); - } else { - return nullptr; - } - }, - details_); -} - -void Symbol::SetBindName(std::string &&name) { - std::visit( - [&](auto &x) { - if constexpr (HasBindName) { - 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(); }, @@ -359,7 +331,7 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) { if (x.type()) { os << " type: " << *x.type(); } - DumpOptional(os, "bindName", x.bindName()); + DumpExpr(os, "bindName", x.bindName_); return os; } @@ -389,7 +361,7 @@ llvm::raw_ostream &operator<<( } 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()}) { @@ -476,7 +448,6 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { DumpSymbolVector(os, x.objects()); }, [&](const CommonBlockDetails &x) { - DumpOptional(os, "bindName", x.bindName()); if (x.alignment()) { os << " alignment=" << x.alignment(); } diff --git a/flang/test/Semantics/modfile04.f90 b/flang/test/Semantics/modfile04.f90 index 9312b756513c5..bc4d8d4895ad2 100644 --- a/flang/test/Semantics/modfile04.f90 +++ b/flang/test/Semantics/modfile04.f90 @@ -6,7 +6,7 @@ module m1 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 @@ -53,7 +53,7 @@ end module m3 !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 diff --git a/flang/test/Semantics/modfile21.f90 b/flang/test/Semantics/modfile21.f90 index 73cf59f827a20..e48f6334fa370 100644 --- a/flang/test/Semantics/modfile21.f90 +++ b/flang/test/Semantics/modfile21.f90 @@ -29,7 +29,7 @@ module m ! 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 diff --git a/flang/test/Semantics/separate-mp02.f90 b/flang/test/Semantics/separate-mp02.f90 index 3dd717dbc90a9..6d620e71118b1 100644 --- a/flang/test/Semantics/separate-mp02.f90 +++ b/flang/test/Semantics/separate-mp02.f90 @@ -136,12 +136,6 @@ module subroutine s2() bind(c, name="s2") 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 @@ -154,16 +148,9 @@ module subroutine s1() bind(c, name="s1") !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