[flang] Upstream the Mangler module from lowering.

This upstreams the internal name mangling used in the bridge to generate
unique names from symbols.

Replace InternalNamesTest with the actual, functional unittest.

Differential revision: https://reviews.llvm.org/D81764

diff --git a/flang/include/flang/Lower/Mangler.h b/flang/include/flang/Lower/Mangler.h
new file mode 100644 (file)
index 0000000..b13b513
--- /dev/null
+++ b/flang/include/flang/Lower/Mangler.h
@@ -0,0 +1,44 @@
+//===-- Lower/Mangler.h -- name mangling ------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_MANGLER_H_
+#define FORTRAN_LOWER_MANGLER_H_
+
+#include <string>
+
+namespace fir {
+struct NameUniquer;
+}
+
+namespace llvm {
+class StringRef;
+}
+
+namespace Fortran {
+namespace common {
+template <typename>
+class Reference;
+}
+
+namespace semantics {
+class Symbol;
+}
+
+namespace lower {
+namespace mangle {
+
+/// Convert a front-end Symbol to an internal name
+std::string mangleName(fir::NameUniquer &uniquer, const semantics::Symbol &);
+
+std::string demangleName(llvm::StringRef name);
+
+} // namespace mangle
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_MANGLER_H_

diff --git a/flang/include/flang/Optimizer/Support/InternalNames.h b/flang/include/flang/Optimizer/Support/InternalNames.h
index 05b2ed4..33583d6 100644 (file)
--- a/flang/include/flang/Optimizer/Support/InternalNames.h
+++ b/flang/include/flang/Optimizer/Support/InternalNames.h
@@ -65,6 +65,7 @@ struct NameUniquer {
 
   /// Unique a (global) constant name
   std::string doConstant(llvm::ArrayRef<llvm::StringRef> modules,
+                         llvm::Optional<llvm::StringRef> host,
                          llvm::StringRef name);
 
   /// Unique a dispatch table name

diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index 8bdac3c..fe49e2d 100644 (file)
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -4,6 +4,7 @@ add_flang_library(FortranLower
   ComplexExpr.cpp
   ConvertType.cpp
   DoLoopHelper.cpp
+  Mangler.cpp
   OpenMP.cpp
   PFTBuilder.cpp
 

diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
new file mode 100644 (file)
index 0000000..ad20c92
--- /dev/null
+++ b/flang/lib/Lower/Mangler.cpp
@@ -0,0 +1,120 @@
+//===-- Mangler.cpp -------------------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/Mangler.h"
+#include "flang/Common/reference.h"
+#include "flang/Lower/Utils.h"
+#include "flang/Optimizer/Support/InternalNames.h"
+#include "flang/Semantics/tools.h"
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/Optional.h"
+#include "llvm/ADT/SmallVector.h"
+#include "llvm/ADT/Twine.h"
+
+// recursively build the vector of module scopes
+static void moduleNames(const Fortran::semantics::Scope &scope,
+                        llvm::SmallVector<llvm::StringRef, 2> &result) {
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Global) {
+    return;
+  }
+  moduleNames(scope.parent(), result);
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Module)
+    if (auto *symbol = scope.symbol())
+      result.emplace_back(toStringRef(symbol->name()));
+}
+
+static llvm::SmallVector<llvm::StringRef, 2>
+moduleNames(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  llvm::SmallVector<llvm::StringRef, 2> result;
+  moduleNames(scope, result);
+  return result;
+}
+
+static llvm::Optional<llvm::StringRef>
+hostName(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  if (scope.kind() == Fortran::semantics::Scope::Kind::Subprogram) {
+    assert(scope.symbol() && "subprogram scope must have a symbol");
+    return {toStringRef(scope.symbol()->name())};
+  }
+  return {};
+}
+
+static const Fortran::semantics::Symbol *
+findInterfaceIfSeperateMP(const Fortran::semantics::Symbol &symbol) {
+  const auto &scope = symbol.owner();
+  if (symbol.attrs().test(Fortran::semantics::Attr::MODULE) &&
+      scope.IsSubmodule()) {
+    // FIXME symbol from MpSubprogramStmt do not seem to have
+    // Attr::MODULE set.
+    const auto *iface = scope.parent().FindSymbol(symbol.name());
+    assert(iface && "Separate module procedure must be declared");
+    return iface;
+  }
+  return nullptr;
+}
+
+// Mangle the name of `symbol` to make it unique within FIR's symbol table using
+// the FIR name mangler, `mangler`
+std::string
+Fortran::lower::mangle::mangleName(fir::NameUniquer &uniquer,
+                                   const Fortran::semantics::Symbol &symbol) {
+  // Resolve host and module association before mangling
+  const auto &ultimateSymbol = symbol.GetUltimate();
+  auto symbolName = toStringRef(ultimateSymbol.name());
+
+  return std::visit(
+      Fortran::common::visitors{
+          [&](const Fortran::semantics::MainProgramDetails &) {
+            return uniquer.doProgramEntry().str();
+          },
+          [&](const Fortran::semantics::SubprogramDetails &) {
+            // Mangle external procedure without any scope prefix.
+            if (Fortran::semantics::IsExternal(ultimateSymbol))
+              return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
+            // Separate module subprograms must be mangled according to the
+            // scope where they were declared (the symbol we have is the
+            // definition).
+            const auto *interface = &ultimateSymbol;
+            if (const auto *mpIface = findInterfaceIfSeperateMP(ultimateSymbol))
+              interface = mpIface;
+            auto modNames = moduleNames(*interface);
+            return uniquer.doProcedure(modNames, hostName(*interface),
+                                       symbolName);
+          },
+          [&](const Fortran::semantics::ProcEntityDetails &) {
+            // Mangle procedure pointers and dummy procedures as variables
+            if (Fortran::semantics::IsPointer(ultimateSymbol) ||
+                Fortran::semantics::IsDummy(ultimateSymbol))
+              return uniquer.doVariable(moduleNames(ultimateSymbol),
+                                        hostName(ultimateSymbol), symbolName);
+            // Otherwise, this is an external procedure, even if it does not
+            // have an explicit EXTERNAL attribute. Mangle it without any
+            // prefix.
+            return uniquer.doProcedure(llvm::None, llvm::None, symbolName);
+          },
+          [&](const Fortran::semantics::ObjectEntityDetails &) {
+            auto modNames = moduleNames(ultimateSymbol);
+            auto optHost = hostName(ultimateSymbol);
+            if (Fortran::semantics::IsNamedConstant(ultimateSymbol))
+              return uniquer.doConstant(modNames, optHost, symbolName);
+            return uniquer.doVariable(modNames, optHost, symbolName);
+          },
+          [](const auto &) -> std::string {
+            assert(false);
+            return {};
+          },
+      },
+      ultimateSymbol.details());
+}
+
+std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
+  auto result = fir::NameUniquer::deconstruct(name);
+  return result.second.name;
+}

diff --git a/flang/lib/Optimizer/Support/InternalNames.cpp b/flang/lib/Optimizer/Support/InternalNames.cpp
index 2511b8c..bbe1c78 100644 (file)
--- a/flang/lib/Optimizer/Support/InternalNames.cpp
+++ b/flang/lib/Optimizer/Support/InternalNames.cpp
@@ -23,7 +23,7 @@ static std::string doModules(llvm::ArrayRef<llvm::StringRef> mods) {
   std::string result;
   auto *token = "M";
   for (auto mod : mods) {
-    result.append(token).append(mod);
+    result.append(token).append(mod.lower());
     token = "S";
   }
   return result;
@@ -33,7 +33,7 @@ static std::string doModulesHost(llvm::ArrayRef<llvm::StringRef> mods,
                                  llvm::Optional<llvm::StringRef> host) {
   std::string result = doModules(mods);
   if (host.hasValue())
-    result.append("F").append(*host);
+    result.append("F").append(host->lower());
   return result;
 }
 
@@ -52,10 +52,10 @@ convertToStringRef(const llvm::Optional<std::string> &from) {
 
 static std::string readName(llvm::StringRef uniq, std::size_t &i,
                             std::size_t init, std::size_t end) {
-  for (i = init; i < end && uniq[i] >= 'a' && uniq[i] <= 'z'; ++i) {
+  for (i = init; i < end && (uniq[i] < 'A' || uniq[i] > 'Z'); ++i) {
     // do nothing
   }
-  return uniq.substr(init, i).str();
+  return uniq.substr(init, i - init).str();
 }
 
 static std::int64_t readInt(llvm::StringRef uniq, std::size_t &i,
@@ -64,7 +64,7 @@ static std::int64_t readInt(llvm::StringRef uniq, std::size_t &i,
     // do nothing
   }
   std::int64_t result = BAD_VALUE;
-  if (uniq.substr(init, i).getAsInteger(10, result))
+  if (uniq.substr(init, i - init).getAsInteger(10, result))
     return BAD_VALUE;
   return result;
 }
@@ -99,9 +99,11 @@ std::string fir::NameUniquer::doCommonBlock(llvm::StringRef name) {
 
 std::string
 fir::NameUniquer::doConstant(llvm::ArrayRef<llvm::StringRef> modules,
+                             llvm::Optional<llvm::StringRef> host,
                              llvm::StringRef name) {
   std::string result = prefix();
-  return result.append(doModules(modules)).append("EC").append(toLower(name));
+  result.append(doModulesHost(modules, host)).append("EC");
+  return result.append(toLower(name));
 }
 
 std::string

diff --git a/flang/unittests/Optimizer/InternalNamesTest.cpp b/flang/unittests/Optimizer/InternalNamesTest.cpp
index 60e1296..07373ee 100644 (file)
--- a/flang/unittests/Optimizer/InternalNamesTest.cpp
+++ b/flang/unittests/Optimizer/InternalNamesTest.cpp
@@ -1,4 +1,4 @@
-//===- InternalNames.cpp - InternalNames unit tests ---------------===//
+//===- InternalNamesTest.cpp -- InternalNames unit tests ------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
@@ -8,13 +8,202 @@
 
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "gtest/gtest.h"
+#include <string>
 
 using namespace fir;
-using namespace llvm;
+using llvm::SmallVector;
+using llvm::StringRef;
 
-TEST(genericName, MyTest) {
+struct DeconstructedName {
+  DeconstructedName(llvm::ArrayRef<std::string> modules,
+      llvm::Optional<std::string> host, llvm::StringRef name,
+      llvm::ArrayRef<std::int64_t> kinds)
+      : modules{modules.begin(), modules.end()}, host{host}, name{name},
+        kinds{kinds.begin(), kinds.end()} {}
+
+  bool isObjEqual(const NameUniquer::DeconstructedName &actualObj) {
+    if ((actualObj.name == name) && (actualObj.modules == modules) &&
+        (actualObj.host == host) && (actualObj.kinds == kinds)) {
+      return true;
+    }
+    return false;
+  }
+
+private:
+  llvm::SmallVector<std::string, 2> modules;
+  llvm::Optional<std::string> host;
+  std::string name;
+  llvm::SmallVector<std::int64_t, 4> kinds;
+};
+
+void validateDeconstructedName(
+    std::pair<NameUniquer::NameKind, NameUniquer::DeconstructedName> &actual,
+    NameUniquer::NameKind &expectedNameKind,
+    struct DeconstructedName &components) {
+  EXPECT_EQ(actual.first, expectedNameKind)
+      << "Possible error: NameKind mismatch";
+  ASSERT_TRUE(components.isObjEqual(actual.second))
+      << "Possible error: DeconstructedName mismatch";
+}
+
+TEST(InternalNamesTest, doCommonBlockTest) {
+  NameUniquer obj;
+  std::string actual = obj.doCommonBlock("hello");
+  std::string actualBlank = obj.doCommonBlock("");
+  std::string expectedMangledName = "_QBhello";
+  std::string expectedMangledNameBlank = "_QB";
+  ASSERT_EQ(actual, expectedMangledName);
+  ASSERT_EQ(actualBlank, expectedMangledNameBlank);
+}
+
+TEST(InternalNamesTest, doGeneratedTest) {
   NameUniquer obj;
-  std::string val = obj.doCommonBlock("hello");
-  std::string val2 = "_QBhello";
-  EXPECT_EQ(val, val2);
+  std::string actual = obj.doGenerated("@MAIN");
+  std::string expectedMangledName = "_QQ@MAIN";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  std::string actual1 = obj.doGenerated("@_ZNSt8ios_base4InitC1Ev");
+  std::string expectedMangledName1 = "_QQ@_ZNSt8ios_base4InitC1Ev";
+  ASSERT_EQ(actual1, expectedMangledName1);
+
+  std::string actual2 = obj.doGenerated("_QQ@MAIN");
+  std::string expectedMangledName2 = "_QQ_QQ@MAIN";
+  ASSERT_EQ(actual2, expectedMangledName2);
+}
+
+TEST(InternalNamesTest, doConstantTest) {
+  NameUniquer obj;
+  std::string actual = obj.doConstant({"mod1", "mod2"}, {"foo"}, "Hello");
+  std::string expectedMangledName = "_QMmod1Smod2FfooEChello";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doProcedureTest) {
+  NameUniquer obj;
+  std::string actual = obj.doProcedure({"mod1", "mod2"}, {}, "HeLLo");
+  std::string expectedMangledName = "_QMmod1Smod2Phello";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doTypeTest) {
+  NameUniquer obj;
+  std::string actual = obj.doType({}, {}, "mytype", {4, -1});
+  std::string expectedMangledName = "_QTmytypeK4KN1";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doIntrinsicTypeDescriptorTest) {
+  using IntrinsicType = fir::NameUniquer::IntrinsicType;
+  NameUniquer obj;
+  std::string actual =
+      obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, 42);
+  std::string expectedMangledName = "_QCrealK42";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::REAL, {});
+  expectedMangledName = "_QCrealK0";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::INTEGER, 3);
+  expectedMangledName = "_QCintegerK3";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::LOGICAL, 2);
+  expectedMangledName = "_QClogicalK2";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::CHARACTER, 4);
+  expectedMangledName = "_QCcharacterK4";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  actual = obj.doIntrinsicTypeDescriptor({}, {}, IntrinsicType::COMPLEX, 4);
+  expectedMangledName = "_QCcomplexK4";
+  ASSERT_EQ(actual, expectedMangledName);
 }
+
+TEST(InternalNamesTest, doDispatchTableTest) {
+  NameUniquer obj;
+  std::string actual = obj.doDispatchTable({}, {}, "MyTYPE", {2, 8, 18});
+  std::string expectedMangledName = "_QDTmytypeK2K8K18";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doTypeDescriptorTest) {
+  NameUniquer obj;
+  std::string actual = obj.doTypeDescriptor(
+      {StringRef("moD1")}, {StringRef("foo")}, "MyTYPE", {2, 8});
+  std::string expectedMangledName = "_QMmod1FfooCTmytypeK2K8";
+  ASSERT_EQ(actual, expectedMangledName);
+}
+
+TEST(InternalNamesTest, doVariableTest) {
+  NameUniquer obj;
+  std::string actual = obj.doVariable(
+      {"mod1", "mod2"}, {""}, "intvar"); // Function is present and is blank.
+  std::string expectedMangledName = "_QMmod1Smod2FEintvar";
+  ASSERT_EQ(actual, expectedMangledName);
+
+  std::string actual2 = obj.doVariable(
+      {"mod1", "mod2"}, {}, "intVariable"); // Function is not present.
+  std::string expectedMangledName2 = "_QMmod1Smod2Eintvariable";
+  ASSERT_EQ(actual2, expectedMangledName2);
+}
+
+TEST(InternalNamesTest, doProgramEntry) {
+  NameUniquer obj;
+  llvm::StringRef actual = obj.doProgramEntry();
+  std::string expectedMangledName = "_QQmain";
+  ASSERT_EQ(actual.str(), expectedMangledName);
+}
+
+TEST(InternalNamesTest, deconstructTest) {
+  NameUniquer obj;
+  std::pair actual = obj.deconstruct("_QBhello");
+  auto expectedNameKind = NameUniquer::NameKind::COMMON;
+  struct DeconstructedName expectedComponents {
+    {}, {}, "hello", {}
+  };
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+}
+
+TEST(InternalNamesTest, complexdeconstructTest) {
+  using NameKind = fir::NameUniquer::NameKind;
+  NameUniquer obj;
+  std::pair actual = obj.deconstruct("_QMmodSs1modSs2modFsubPfun");
+  auto expectedNameKind = NameKind::PROCEDURE;
+  struct DeconstructedName expectedComponents = {
+      {"mod", "s1mod", "s2mod"}, {"sub"}, "fun", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QPsub");
+  expectedNameKind = NameKind::PROCEDURE;
+  expectedComponents = {{}, {}, "sub", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QBvariables");
+  expectedNameKind = NameKind::COMMON;
+  expectedComponents = {{}, {}, "variables", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QMmodEintvar");
+  expectedNameKind = NameKind::VARIABLE;
+  expectedComponents = {{"mod"}, {}, "intvar", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QMmodECpi");
+  expectedNameKind = NameKind::CONSTANT;
+  expectedComponents = {{"mod"}, {}, "pi", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QTyourtypeK4KN6");
+  expectedNameKind = NameKind::DERIVED_TYPE;
+  expectedComponents = {{}, {}, "yourtype", {4, -6}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+
+  actual = obj.deconstruct("_QDTt");
+  expectedNameKind = NameKind::DISPATCH_TABLE;
+  expectedComponents = {{}, {}, "t", {}};
+  validateDeconstructedName(actual, expectedNameKind, expectedComponents);
+}
+
+// main() from gtest_main