[flang-commits] [flang] 5d3249e - [flang] Save binding labels as strings

Tim Keith via flang-commits flang-commits at lists.llvm.org
Wed Mar 24 11:25:52 PDT 2021


Author: Tim Keith
Date: 2021-03-24T11:25:23-07:00
New Revision: 5d3249e9af9086a29214312af18651ebb769eb71

URL: https://github.com/llvm/llvm-project/commit/5d3249e9af9086a29214312af18651ebb769eb71
DIFF: https://github.com/llvm/llvm-project/commit/5d3249e9af9086a29214312af18651ebb769eb71.diff

LOG: [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

Added: 
    

Modified: 
    flang/include/flang/Semantics/symbol.h
    flang/lib/Semantics/CMakeLists.txt
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/mod-file.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/symbol.cpp
    flang/test/Semantics/modfile04.f90
    flang/test/Semantics/modfile21.f90
    flang/test/Semantics/separate-mp02.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 0078d2567473..4586ad9f864d 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -60,7 +60,18 @@ class MainProgramDetails {
 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 @@ class SubprogramDetails {
   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 @@ class SubprogramDetails {
 
 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 @@ class SubprogramNameDetails {
 };
 
 // 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 @@ class EntityDetails {
   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 @@ class NamelistDetails {
   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 @@ class Symbol {
 
   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/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt
index 4bab4b16149d..9e7c07b9c55f 100644
--- a/flang/lib/Semantics/CMakeLists.txt
+++ b/flang/lib/Semantics/CMakeLists.txt
@@ -1,4 +1,3 @@
-
 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 0dad3c6e8d9b..69607c466e16 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1687,24 +1687,23 @@ void SubprogramMatchHelper::Check(
             : "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/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 1e2a5c6728b7..a60c8dd1cd02 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 &);
-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 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
   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 PutBound(llvm::raw_ostream &os, const Bound &x) {
 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/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 2d1d513c427e..6818686f43e7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1528,19 +1528,26 @@ bool AttrsVisitor::SetPassNameOn(Symbol &symbol) {
 }
 
 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/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index edd2c84218c1..7d439df75c2e 100644
--- a/flang/lib/Semantics/symbol.cpp
+++ b/flang/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 @@ void ModuleDetails::set_scope(const Scope *scope) {
 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 @@ void Symbol::SetType(const DeclTypeSpec &type) {
       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 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const EntityDetails &x) {
   if (x.type()) {
     os << " type: " << *x.type();
   }
-  DumpExpr(os, "bindName", x.bindName_);
+  DumpOptional(os, "bindName", x.bindName());
   return os;
 }
 
@@ -361,7 +389,7 @@ llvm::raw_ostream &operator<<(
   } 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 @@ 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 bc4d8d4895ad..9312b756513c 100644
--- a/flang/test/Semantics/modfile04.f90
+++ b/flang/test/Semantics/modfile04.f90
@@ -6,7 +6,7 @@ module m1
   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 @@ end module m3
 !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/flang/test/Semantics/modfile21.f90 b/flang/test/Semantics/modfile21.f90
index e48f6334fa37..73cf59f827a2 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)::/cb2/
+!  bind(c, name="cb2")::/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 6d620e71118b..3dd717dbc90a 100644
--- a/flang/test/Semantics/separate-mp02.f90
+++ b/flang/test/Semantics/separate-mp02.f90
@@ -136,6 +136,12 @@ 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
 
@@ -148,9 +154,16 @@ 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
 
 


        


More information about the flang-commits mailing list