[flang] Lower simple character return

Handles function with character return.

Character scalar results are passed as arguments in lowering so
that an assumed length character function callee can access the result
length.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld, schweitz

Differential Revision: https://reviews.llvm.org/D120558

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: V Donaldson <vdonaldson@nvidia.com>

flang/lib/Lower/Bridge.cpp

@@ -24,6 +24,7 @@
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Semantics/tools.h"
@@ -248,13 +249,13 @@ public:
     using PassBy = Fortran::lower::CalleeInterface::PassEntityBy;
     auto mapPassedEntity = [&](const auto arg) -> void {
       if (arg.passBy == PassBy::AddressAndLength) {
-        // // TODO: now that fir call has some attributes regarding character
-        // // return, PassBy::AddressAndLength should be retired.
-        // mlir::Location loc = toLocation();
-        // fir::factory::CharacterExprHelper charHelp{*builder, loc};
-        // mlir::Value box =
-        //     charHelp.createEmboxChar(arg.firArgument, arg.firLength);
-        // addSymbol(arg.entity->get(), box);
+        // TODO: now that fir call has some attributes regarding character
+        // return, PassBy::AddressAndLength should be retired.
+        mlir::Location loc = toLocation();
+        fir::factory::CharacterExprHelper charHelp{*builder, loc};
+        mlir::Value box =
+            charHelp.createEmboxChar(arg.firArgument, arg.firLength);
+        addSymbol(arg.entity->get(), box);
       } else {
         if (arg.entity.has_value()) {
           addSymbol(arg.entity->get(), arg.firArgument);
@@ -444,7 +445,8 @@ private:
     }
     mlir::Value resultVal = resultSymBox.match(
         [&](const fir::CharBoxValue &x) -> mlir::Value {
-          TODO(loc, "Function return CharBoxValue");
+          return fir::factory::CharacterExprHelper{*builder, loc}
+              .createEmboxChar(x.getBuffer(), x.getLen());
         },
         [&](const auto &) -> mlir::Value {
           mlir::Value resultRef = resultSymBox.getAddr();

flang/lib/Lower/CallInterface.cpp

@@ -443,6 +443,18 @@ getDataObjectEntity(const Fortran::semantics::Symbol *arg) {
   return *arg;
 }
 
+static const Fortran::evaluate::ActualArgument *
+getResultEntity(const Fortran::evaluate::ProcedureRef &) {
+  return nullptr;
+}
+
+static const Fortran::semantics::Symbol &
+getResultEntity(Fortran::lower::pft::FunctionLikeUnit &funit) {
+  return funit.getSubprogramSymbol()
+      .get<Fortran::semantics::SubprogramDetails>()
+      .result();
+}
+
 //===----------------------------------------------------------------------===//
 // CallInterface implementation: this part is common to both caller and caller
 // sides.
@@ -455,6 +467,7 @@ class Fortran::lower::CallInterfaceImpl {
   using CallInterface = Fortran::lower::CallInterface<T>;
   using PassEntityBy = typename CallInterface::PassEntityBy;
   using PassedEntity = typename CallInterface::PassedEntity;
+  using FirValue = typename CallInterface::FirValue;
   using FortranEntity = typename CallInterface::FortranEntity;
   using FirPlaceHolder = typename CallInterface::FirPlaceHolder;
   using Property = typename CallInterface::Property;
@@ -549,9 +562,9 @@ private:
         result.GetTypeAndShape();
     assert(typeAndShape && "expect type for non proc pointer result");
     Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
+    // Character result allocated by caller and passed as hidden arguments
     if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
-      TODO(interface.converter.getCurrentLocation(),
-           "implicit result character type");
+      handleImplicitCharacterResult(dynamicType);
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Derived) {
       TODO(interface.converter.getCurrentLocation(),
@@ -566,6 +579,24 @@ private:
     }
   }
 
+  void
+  handleImplicitCharacterResult(const Fortran::evaluate::DynamicType &type) {
+    int resultPosition = FirPlaceHolder::resultEntityPosition;
+    setPassedResult(PassEntityBy::AddressAndLength,
+                    getResultEntity(interface.side().getCallDescription()));
+    mlir::Type lenTy = mlir::IndexType::get(&mlirContext);
+    std::optional<std::int64_t> constantLen = type.knownLength();
+    fir::CharacterType::LenType len =
+        constantLen ? *constantLen : fir::CharacterType::unknownLen();
+    mlir::Type charRefTy = fir::ReferenceType::get(
+        fir::CharacterType::get(&mlirContext, type.kind(), len));
+    mlir::Type boxCharTy = fir::BoxCharType::get(&mlirContext, type.kind());
+    addFirOperand(charRefTy, resultPosition, Property::CharAddress);
+    addFirOperand(lenTy, resultPosition, Property::CharLength);
+    /// For now, also return it by boxchar
+    addFirResult(boxCharTy, resultPosition, Property::BoxChar);
+  }
+
   void handleExplicitResult(
       const Fortran::evaluate::characteristics::FunctionResult &result) {
     using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr;
@@ -576,17 +607,7 @@ private:
     const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape =
         result.GetTypeAndShape();
     assert(typeAndShape && "expect type for non proc pointer result");
-    Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
-    if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
-      TODO(interface.converter.getCurrentLocation(),
-           "implicit result character type");
-    } else if (dynamicType.category() ==
-               Fortran::common::TypeCategory::Derived) {
-      TODO(interface.converter.getCurrentLocation(),
-           "implicit result derived type");
-    }
-    mlir::Type mlirType =
-        getConverter().genType(dynamicType.category(), dynamicType.kind());
+    mlir::Type mlirType = translateDynamicType(typeAndShape->type());
     fir::SequenceType::Shape bounds = getBounds(typeAndShape->shape());
     if (!bounds.empty())
       mlirType = fir::SequenceType::get(bounds, mlirType);
@@ -595,8 +616,21 @@ private:
     if (result.attrs.test(Attr::Pointer))
       mlirType = fir::BoxType::get(fir::PointerType::get(mlirType));
 
+    if (fir::isa_char(mlirType)) {
+      // Character scalar results must be passed as arguments in lowering so
+      // that an assumed length character function callee can access the result
+      // length. A function with a result requiring an explicit interface does
+      // not have to be compatible with assumed length function, but most
+      // compilers supports it.
+      handleImplicitCharacterResult(typeAndShape->type());
+      return;
+    }
+
     addFirResult(mlirType, FirPlaceHolder::resultEntityPosition,
                  Property::Value);
+    // Explicit results require the caller to allocate the storage and save the
+    // function result in the storage with a fir.save_result.
+    setSaveResult();
   }
 
   fir::SequenceType::Shape getBounds(const Fortran::evaluate::Shape &shape) {
@@ -817,8 +851,21 @@ private:
     interface.passedArguments.emplace_back(
         PassedEntity{p, entity, {}, {}, characteristics});
   }
+  void setPassedResult(PassEntityBy p, FortranEntity entity) {
+    interface.passedResult =
+        PassedEntity{p, entity, emptyValue(), emptyValue()};
+  }
+  void setSaveResult() { interface.saveResult = true; }
   int nextPassedArgPosition() { return interface.passedArguments.size(); }
 
+  static FirValue emptyValue() {
+    if constexpr (std::is_same_v<Fortran::lower::CalleeInterface, T>) {
+      return {};
+    } else {
+      return -1;
+    }
+  }
+
   Fortran::lower::AbstractConverter &getConverter() {
     return interface.converter;
   }

flang/lib/Lower/ConvertVariable.cpp

@@ -301,7 +301,25 @@ void Fortran::lower::mapSymbolAttributes(
       //===--------------------------------------------------------------===//
 
       [&](const Fortran::lower::details::ScalarStaticChar &x) {
-        TODO(loc, "ScalarStaticChar variable lowering");
+        // type is a CHARACTER, determine the LEN value
+        auto charLen = x.charLen();
+        if (replace) {
+          Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
+          std::pair<mlir::Value, mlir::Value> unboxchar =
+              charHelp.createUnboxChar(symBox.getAddr());
+          mlir::Value boxAddr = unboxchar.first;
+          // Set/override LEN with a constant
+          mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
+          symMap.addCharSymbol(sym, boxAddr, len, true);
+          return;
+        }
+        mlir::Value len = builder.createIntegerConstant(loc, idxTy, charLen);
+        if (preAlloc) {
+          symMap.addCharSymbol(sym, preAlloc, len);
+          return;
+        }
+        mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
+        symMap.addCharSymbol(sym, local, len);
       },
 
       //===--------------------------------------------------------------===//

flang/test/Lower/basic-function.f90

@@ -141,3 +141,10 @@ complex(16) function cplxfct6()
 end
 ! CHECK-LABEL: func @_QPcplxfct6() -> !fir.complex<16>
 ! CHECK:         return %{{.*}} : !fir.complex<16>
+
+function fct_with_character_return(i)
+  character(10) :: fct_with_character_return
+  integer :: i
+end
+! CHECK-LABEL: func @_QPfct_with_character_return(
+! CHECK-SAME: %{{.*}}: !fir.ref<!fir.char<1,10>>{{.*}}, %{{.*}}: index{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) -> !fir.boxchar<1> {