[flang][NFC] Simplify mapSymbolAttributes in symbol lowering

[jeanPerier]

Summary

mapSymbolAttributes currently has a lot of very similar code for
each kind of explicit shape and scalar symbols.

Refactor it so that the change to lower symbols with fir.declare
can be added in centralized places instead of being scattered.
This is a preparation patch and fir.declare is not yet added.

[clementval]

LGTM. You need a clang-format on ConvertVariable.cpp

[jeanPerier]

Clang-format fix

[PeteSteinfeld]

All builds and tests correctly and looks good.

[jeanPerier]

Prevent re-instantiation of global symbols (instantiateVariable may be called
several times on the same symbol in some cases with namelists).

flang/lib/Lower/Bridge.cpp

void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     }
 
     // TODO: should use same mechanism as equivalence?
     // One blocking point is character entry returns that need special handling
     // since they are not locally allocated but come as argument. CHARACTER(*)
     // is not something that fits well with equivalence lowering.
     for (const Fortran::lower::pft::Variable &altResult :
          deferredFuncResultList) {
+      Fortran::lower::StatementContext stmtCtx;
       if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
-              passedResult = callee.getPassedResult())
+              passedResult = callee.getPassedResult()) {
         addSymbol(altResult.getSymbol(), resultArg.getAddr());
-      Fortran::lower::StatementContext stmtCtx;
+        Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
+                                            stmtCtx);
+      } else {
         Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols,
                                             stmtCtx, primaryFuncResultStorage);
       }
+    }
 
     // If this is a host procedure with host associations, then create the tuple
     // of pointers for passing to the internal procedures.
     if (!funit.getHostAssoc().empty())
       funit.getHostAssoc().hostProcedureBindings(*this, localSymbols);
 
     // Create most function blocks in advance.
     createEmptyBlocks(funit.evaluationList);

flang/lib/Lower/ConvertVariable.cpp

if (auto seqTy = fir::unwrapUntilSeqType(initVal.getType())) {
                                                                       : fst);
       return result;
     }
   }
   result.assign(shapeVec.begin(), shapeVec.end());
   return result;
 }
 
+/// Map a symbol to its FIR address and evaluated specification expressions.
+/// Not for symbols lowered to fir.box.
+/// Will optionally create fir.declare.
+static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
+                             Fortran::lower::SymMap &symMap,
+                             const Fortran::semantics::Symbol &sym,
+                             mlir::Value base, mlir::Value len = {},
+                             llvm::ArrayRef<mlir::Value> shape = llvm::None,
+                             llvm::ArrayRef<mlir::Value> lbounds = llvm::None,
+                             bool force = false) {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    TODO(genLocation(converter, sym),
+         "generate fir.declare when lowering symbol");
+    
+  if (len) {
+    if (!shape.empty()) {
+      if (!lbounds.empty())
+        symMap.addCharSymbolWithBounds(sym, base, len, shape, lbounds, force);
+      else
+        symMap.addCharSymbolWithShape(sym, base, len, shape, force);
+    } else {
+      symMap.addCharSymbol(sym, base, len, force);
+    }
+  } else {
+    if (!shape.empty()) {
+      if (!lbounds.empty())
+        symMap.addSymbolWithBounds(sym, base, shape, lbounds, force);
+      else
+        symMap.addSymbolWithShape(sym, base, shape, force);
+    } else {
+      symMap.addSymbol(sym, base, force);
+    }
+  }
+}
+
+/// Map a symbol to its FIR address and evaluated specification expressions
+/// provided as a fir::ExtendedValue. Will optionally create fir.declare.
+static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
+                             Fortran::lower::SymMap &symMap,
+                             const Fortran::semantics::Symbol &sym,
+                             const fir::ExtendedValue &exv) {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    TODO(genLocation(converter, sym),
+         "generate fir.declare from ExtendedValue");
+  symMap.addSymbol(sym, exv);
+}
+
+/// Map an allocatable or pointer symbol to its FIR address and evaluated
+/// specification expressions. Will optionally create fir.declare.
+static void
+genAllocatableOrPointerDeclare(Fortran::lower::AbstractConverter &converter,
+                               Fortran::lower::SymMap &symMap,
+                               const Fortran::semantics::Symbol &sym,
+                               fir::MutableBoxValue box, bool force = false) {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    TODO(genLocation(converter, sym),
+         "generate fir.declare for allocatable or pointers");
+  symMap.addAllocatableOrPointer(sym, box, force);
+}
+
+/// Map a symbol represented with a runtime descriptor to its FIR fir.box and
+/// evaluated specification expressions. Will optionally create fir.declare.
+static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
+                          Fortran::lower::SymMap &symMap,
+                          const Fortran::semantics::Symbol &sym,
+                          mlir::Value box, llvm::ArrayRef<mlir::Value> lbounds,
+                          llvm::ArrayRef<mlir::Value> explicitParams,
+                          llvm::ArrayRef<mlir::Value> explicitExtents,
+                          bool replace = false) {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    TODO(genLocation(converter, sym), "generate fir.declare for box");
+  symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,
+                      replace);
+}
+
 /// Lower specification expressions and attributes of variable \p var and
 /// add it to the symbol map.  For a global or an alias, the address must be
 /// pre-computed and provided in \p preAlloc.  A dummy argument for the current
 /// entry point has already been mapped to an mlir block argument in
 /// mapDummiesAndResults.  Its mapping may be updated here.
 void Fortran::lower::mapSymbolAttributes(
     AbstractConverter &converter, const Fortran::lower::pft::Variable &var,
     Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx,
void Fortran::lower::mapSymbolAttributes(
   fir::factory::CharacterExprHelper charHelp{builder, loc};
 
   if (Fortran::semantics::IsProcedure(sym)) {
     if (isUnusedEntryDummy) {
       // Additional discussion below.
       mlir::Type dummyProcType =
           Fortran::lower::getDummyProcedureType(sym, converter);
       mlir::Value undefOp = builder.create<fir::UndefOp>(loc, dummyProcType);
-      symMap.addSymbol(sym, undefOp);
+
+      genDeclareSymbol(converter, symMap, sym, undefOp);
     }
     if (Fortran::semantics::IsPointer(sym))
       TODO(loc, "procedure pointers");
     return;
   }
 
   Fortran::lower::BoxAnalyzer ba;
   ba.analyze(sym);
if (ba.isChar()) {
       if (const Fortran::semantics::DerivedTypeSpec *derived =
               declTy->AsDerived())
         if (Fortran::semantics::CountLenParameters(*derived) != 0)
           TODO(loc,
                "derived type allocatable or pointer with length parameters");
     }
     fir::MutableBoxValue box = Fortran::lower::createMutableBox(
         converter, loc, var, boxAlloc, nonDeferredLenParams);
-    symMap.addAllocatableOrPointer(var.getSymbol(), box, replace);
+    genAllocatableOrPointerDeclare(converter, symMap, var.getSymbol(), box,
+                                   replace);
     return;
   }
 
   if (isDummy) {
     mlir::Value dummyArg = symMap.lookupSymbol(sym).getAddr();
     if (lowerToBoxValue(sym, dummyArg)) {
       llvm::SmallVector<mlir::Value> lbounds;
       llvm::SmallVector<mlir::Value> explicitExtents;
       llvm::SmallVector<mlir::Value> explicitParams;
       // Lower lower bounds, explicit type parameters and explicit
       // extents if any.
       if (ba.isChar())
         if (mlir::Value len =
                 lowerExplicitCharLen(converter, loc, ba, symMap, stmtCtx))
           explicitParams.push_back(len);
       // TODO: derived type length parameters.
       lowerExplicitLowerBounds(converter, loc, ba, lbounds, symMap, stmtCtx);
       lowerExplicitExtents(converter, loc, ba, lbounds, explicitExtents, symMap,
                            stmtCtx);
-      symMap.addBoxSymbol(sym, dummyArg, lbounds, explicitParams,
-                          explicitExtents, replace);
+      genBoxDeclare(converter, symMap, sym, dummyArg, lbounds, explicitParams,
       return;
     }
   }
 
   // A dummy from another entry point that is not declared in the current
   // entry point requires a skeleton definition.  Most such "unused" dummies
   // will not survive into final generated code, but some will.  It is illegal
   // to reference one at run time if it does.  Such a dummy is mapped to a
void Fortran::lower::mapSymbolAttributes(
   //    for dynamic objects via calls to genUnusedEntryPointBox.
 
   auto genUnusedEntryPointBox = [&]() {
     if (isUnusedEntryDummy) {
       assert(!Fortran::semantics::IsAllocatableOrPointer(sym) &&
              "handled above");
       // The box is read right away because lowering code does not expect
       // a non pointer/allocatable symbol to be mapped to a MutableBox.
-      symMap.addSymbol(sym, fir::factory::genMutableBoxRead(
-                                builder, loc,
-                                fir::factory::createTempMutableBox(
-                                    builder, loc, converter.genType(var))));
+      genDeclareSymbol(converter, symMap, sym,
+                       fir::factory::genMutableBoxRead(
       return true;
     }
     return false;
   };
 
   // Helper to generate scalars for the symbol properties.
   auto genValue = [&](const Fortran::lower::SomeExpr &expr) {
     return genScalarValue(converter, loc, expr, symMap, stmtCtx);
for (auto iter : llvm::enumerate(bounds)) {
           // An assumed size array. The extent is not computed.
           assert(spec->ubound().isStar() && "expected assumed size");
           extents.emplace_back(builder.create<fir::UndefOp>(loc, idxTy));
         }
       }
     }
   };
 
-  // Lower length expression for non deferred and non dummy assumed length
-  // characters.
-  auto genExplicitCharLen =
-      [&](llvm::Optional<Fortran::lower::SomeExpr> charLen) -> mlir::Value {
-    if (!charLen)
-      fir::emitFatalError(loc, "expected explicit character length");
-    mlir::Value rawLen = genValue(*charLen);
-    // If the length expression is negative, the length is zero. See
-    // F2018 7.4.4.2 point 5.
-    return fir::factory::genMaxWithZero(builder, loc, rawLen);
-  };
-
-  ba.match(
-      //===--------------------------------------------------------------===//
-      // Trivial case.
-      //===--------------------------------------------------------------===//
-      [&](const Fortran::lower::details::ScalarSym &) {
-        if (isDummy) {
-          // This is an argument.
-          if (!symMap.lookupSymbol(sym))
-            mlir::emitError(loc, "symbol \"")
-                << toStringRef(sym.name()) << "\" must already be in map";
-          return;
-        } else if (isResult) {
-          // Some Fortran results may be passed by argument (e.g. derived
-          // types)
-          if (symMap.lookupSymbol(sym))
-            return;
-        }
-        // Otherwise, it's a local variable or function result.
-        mlir::Value local = createNewLocal(converter, loc, var, preAlloc);
-        symMap.addSymbol(sym, local);
-      },
-
-      //===--------------------------------------------------------------===//
-      // The non-trivial cases are when we have an argument or local that has
-      // a repetition value. Arguments might be passed as simple pointers and
-      // need to be cast to a multi-dimensional array with constant bounds
-      // (possibly with a missing column), bounds computed in the callee
-      // (here), or with bounds from the caller (boxed somewhere else). Locals
-      // have the same properties except they are never boxed arguments from
-      // the caller and never having a missing column size.
-      //===--------------------------------------------------------------===//
+  // Non Pointer non allocatable scalar, explicit shape, and assumed
+  // size arrays.
+  // Lower the specification expressions.
 
-      [&](const Fortran::lower::details::ScalarStaticChar &x) {
-        // type is a CHARACTER, determine the LEN value
-        auto charLen = x.charLen();
-        if (replace) {
-          Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
-          if (symBox) {
-            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);
-      },
-
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::ScalarDynamicChar &x) {
-        if (genUnusedEntryPointBox())
-          return;
-        // type is a CHARACTER, determine the LEN value
-        auto charLen = x.charLen();
-        if (replace) {
-          Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
-          mlir::Value boxAddr = symBox.getAddr();
-          mlir::Value len;
-          mlir::Type addrTy = boxAddr.getType();
-          if (addrTy.isa<fir::BoxCharType>() || addrTy.isa<fir::BoxType>())
-            std::tie(boxAddr, len) = charHelp.createUnboxChar(symBox.getAddr());
-          // Override LEN with an expression
-          if (charLen)
-            len = genExplicitCharLen(charLen);
-          symMap.addCharSymbol(sym, boxAddr, len, true);
-          return;
-        }
-        // local CHARACTER variable
-        mlir::Value len = genExplicitCharLen(charLen);
-        if (preAlloc) {
-          symMap.addCharSymbol(sym, preAlloc, len);
-          return;
-        }
-        llvm::SmallVector<mlir::Value> lengths = {len};
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
-        symMap.addCharSymbol(sym, local, len);
-      },
-
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::StaticArray &x) {
-        // object shape is constant, not a character
-        mlir::Type castTy = builder.getRefType(converter.genType(var));
-        mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
-        if (addr)
-          addr = builder.createConvert(loc, castTy, addr);
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shape;
-          for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
-            shape.push_back(genExtentValue(builder, loc, idxTy, i));
-          mlir::Value local =
-              isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
-          symMap.addSymbolWithShape(sym, local, shape, isDummy);
-          return;
-        }
-        // If object is an array process the lower bound and extent values by
-        // constructing constants and populating the lbounds and extents.
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-        for (auto [fst, snd] :
-             llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
-          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
-          extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
-        }
-        mlir::Value local =
-            isDummy ? addr
-                    : createNewLocal(converter, loc, var, preAlloc, extents);
-        // Must be a dummy argument, have an explicit shape, or be a PARAMETER.
-        assert(isDummy || Fortran::lower::isExplicitShape(sym) ||
-               Fortran::semantics::IsNamedConstant(sym));
-        symMap.addSymbolWithBounds(sym, local, extents, lbounds, isDummy);
-      },
+  auto arg = symMap.lookupSymbol(sym).getAddr();
+  mlir::Value addr = preAlloc;
 
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::DynamicArray &x) {
-        if (genUnusedEntryPointBox())
-          return;
-        // cast to the known constant parts from the declaration
-        mlir::Type varType = converter.genType(var);
-        mlir::Value addr = symMap.lookupSymbol(sym).getAddr();
-        mlir::Value argBox;
-        mlir::Type castTy = builder.getRefType(varType);
-        if (addr) {
-          if (auto boxTy = addr.getType().dyn_cast<fir::BaseBoxType>()) {
-            argBox = addr;
-            mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
-            addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
-          }
-          addr = builder.createConvert(loc, castTy, addr);
-        }
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shapes;
-          populateShape(shapes, x.bounds, argBox);
-          if (isDummy) {
-            symMap.addSymbolWithShape(sym, addr, shapes, true);
-            return;
-          }
-          // local array with computed bounds
-          assert(Fortran::lower::isExplicitShape(sym) ||
-                 Fortran::semantics::IsAllocatableOrPointer(sym));
-          mlir::Value local =
-              createNewLocal(converter, loc, var, preAlloc, shapes);
-          symMap.addSymbolWithShape(sym, local, shapes);
-          return;
-        }
-        // if object is an array process the lower bound and extent values
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-        populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
-        if (isDummy) {
-          symMap.addSymbolWithBounds(sym, addr, extents, lbounds, true);
-          return;
-        }
-        // local array with computed bounds
-        assert(Fortran::lower::isExplicitShape(sym));
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, extents);
-        symMap.addSymbolWithBounds(sym, local, extents, lbounds);
-      },
+  if (arg)
+    if (auto boxTy = arg.getType().dyn_cast<fir::BaseBoxType>()) {
+      // Contiguous assumed shape that can be tracked without a fir.box.
+      addr = builder.create<fir::BoxAddrOp>(loc, refTy, arg);
 
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::StaticArrayStaticChar &x) {
-        // if element type is a CHARACTER, determine the LEN value
-        auto charLen = x.charLen();
-        mlir::Value addr;
-        mlir::Value len;
-        if (isDummy) {
-          Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
-          std::pair<mlir::Value, mlir::Value> unboxchar =
-              charHelp.createUnboxChar(symBox.getAddr());
-          addr = unboxchar.first;
-          // Set/override LEN with a constant
-          len = builder.createIntegerConstant(loc, idxTy, charLen);
-        } else {
-          // local CHARACTER variable
-          len = builder.createIntegerConstant(loc, idxTy, charLen);
-        }
-
-        // object shape is constant
-        mlir::Type castTy = builder.getRefType(converter.genType(var));
-        if (addr)
-          addr = builder.createConvert(loc, castTy, addr);
-
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shape;
-          for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
-            shape.push_back(genExtentValue(builder, loc, idxTy, i));
-          mlir::Value local =
-              isDummy ? addr : createNewLocal(converter, loc, var, preAlloc);
-          symMap.addCharSymbolWithShape(sym, local, len, shape, isDummy);
-          return;
-        }
-
-        // if object is an array process the lower bound and extent values
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-        // construct constants and populate `bounds`
-        for (auto [fst, snd] :
-             llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
-          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
-          extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
-        }
-
-        if (isDummy) {
-          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
-                                         true);
-          return;
-        }
-        // local CHARACTER array with computed bounds
-        assert(Fortran::lower::isExplicitShape(sym));
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, extents);
-        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
-      },
-
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::StaticArrayDynamicChar &x) {
-        if (genUnusedEntryPointBox())
-          return;
-        mlir::Value addr;
-        mlir::Value len;
-        [[maybe_unused]] bool mustBeDummy = false;
-        auto charLen = x.charLen();
-        // if element type is a CHARACTER, determine the LEN value
-        if (isDummy) {
-          Fortran::lower::SymbolBox symBox = symMap.lookupSymbol(sym);
-          std::pair<mlir::Value, mlir::Value> unboxchar =
-              charHelp.createUnboxChar(symBox.getAddr());
-          addr = unboxchar.first;
-          if (charLen) {
-            // Set/override LEN with an expression
-            len = genExplicitCharLen(charLen);
-          } else {
-            // LEN is from the boxchar
-            len = unboxchar.second;
-            mustBeDummy = true;
-          }
-        } else {
-          // local CHARACTER variable
-          len = genExplicitCharLen(charLen);
-        }
-        llvm::SmallVector<mlir::Value> lengths = {len};
-
-        // cast to the known constant parts from the declaration
-        mlir::Type castTy = builder.getRefType(converter.genType(var));
-        if (addr)
-          addr = builder.createConvert(loc, castTy, addr);
-
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shape;
-          for (int64_t i : recoverShapeVector(x.shapes, preAlloc))
-            shape.push_back(genExtentValue(builder, loc, idxTy, i));
-          if (isDummy) {
-            symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
-            return;
-          }
-          // local CHARACTER array with constant size
-          mlir::Value local = createNewLocal(converter, loc, var, preAlloc,
-                                             llvm::None, lengths);
-          symMap.addCharSymbolWithShape(sym, local, len, shape);
-          return;
-        }
-
-        // if object is an array process the lower bound and extent values
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-
-        // construct constants and populate `bounds`
-        for (auto [fst, snd] :
-             llvm::zip(x.lbounds, recoverShapeVector(x.shapes, preAlloc))) {
-          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, fst));
-          extents.emplace_back(genExtentValue(builder, loc, idxTy, snd));
-        }
-        if (isDummy) {
-          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
-                                         true);
-          return;
-        }
-        // local CHARACTER array with computed bounds
-        assert((!mustBeDummy) && (Fortran::lower::isExplicitShape(sym)));
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, llvm::None, lengths);
-        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
-      },
-
-      //===--------------------------------------------------------------===//
+  // Compute/Extract character length.
+  if (ba.isChar()) {
+    if (arg) {
+      assert(!preAlloc && "dummy cannot be pre-allocated");
+      if (arg.getType().isa<fir::BoxCharType>())
+        std::tie(addr, len) = charHelp.createUnboxChar(arg);
+    }
+    if (llvm::Optional<int64_t> cstLen = ba.getCharLenConst()) {
+      // Static length
+      len = builder.createIntegerConstant(loc, idxTy, *cstLen);
+      // Dynamic length
+      if (llvm::Optional<Fortran::lower::SomeExpr> charLenExpr =
+              ba.getCharLenExpr()) {
+        // Explicit length
+        mlir::Value rawLen = genValue(*charLenExpr);
+        // If the length expression is negative, the length is zero. See
+        // F2018 7.4.4.2 point 5.
+        len = fir::factory::genMaxWithZero(builder, loc, rawLen);
+      } else if (!len) {
+        // Assumed length fir.box (possible for contiguous assumed shapes).
+        // Read length from box.
+        assert(arg && arg.getType().isa<fir::BoxType>() &&
+               "must be character dummy fir.box");
+        len = charHelp.readLengthFromBox(arg);
 
-      [&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
-        if (genUnusedEntryPointBox())
-          return;
-        mlir::Value addr;
-        mlir::Value len;
-        mlir::Value argBox;
-        auto charLen = x.charLen();
-        // if element type is a CHARACTER, determine the LEN value
-        if (isDummy) {
-          mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
-          if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
-            argBox = actualArg;
-            mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
-            addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
-          } else {
-            addr = charHelp.createUnboxChar(actualArg).first;
-          }
-          // Set/override LEN with a constant
-          len = builder.createIntegerConstant(loc, idxTy, charLen);
-        } else {
-          // local CHARACTER variable
-          len = builder.createIntegerConstant(loc, idxTy, charLen);
-        }
-
-        // cast to the known constant parts from the declaration
-        mlir::Type castTy = builder.getRefType(converter.genType(var));
-        if (addr)
-          addr = builder.createConvert(loc, castTy, addr);
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shape;
-          populateShape(shape, x.bounds, argBox);
-          if (isDummy) {
-            symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
-            return;
-          }
-          // local CHARACTER array
-          mlir::Value local =
-              createNewLocal(converter, loc, var, preAlloc, shape);
-          symMap.addCharSymbolWithShape(sym, local, len, shape);
-          return;
+  // Compute array extents and lower bounds.
+  if (ba.isArray()) {
+    if (addr && addr.getDefiningOp<fir::UnboxCharOp>()) {
+      // Ensure proper type is given to array that transited via fir.boxchar
+      // arg.
+    if (ba.isStaticArray()) {
+      if (ba.lboundIsAllOnes()) {
+        for (std::int64_t extent :
+             recoverShapeVector(ba.staticShape(), preAlloc))
+          extents.push_back(genExtentValue(builder, loc, idxTy, extent));
+      } else {
+        for (auto [lb, extent] :
+             llvm::zip(ba.staticLBound(),
+                       recoverShapeVector(ba.staticShape(), preAlloc))) {
+          lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
+          extents.emplace_back(genExtentValue(builder, loc, idxTy, extent));
         }
-        // if object is an array process the lower bound and extent values
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-        populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
-        if (isDummy) {
-          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
-                                         true);
-          return;
-        }
-        // local CHARACTER array with computed bounds
-        assert(Fortran::lower::isExplicitShape(sym));
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, extents);
-        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
-      },
-
-      //===--------------------------------------------------------------===//
-
-      [&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
-        if (genUnusedEntryPointBox())
-          return;
-        mlir::Value addr;
-        mlir::Value len;
-        mlir::Value argBox;
-        auto charLen = x.charLen();
-        // if element type is a CHARACTER, determine the LEN value
-        if (isDummy) {
-          mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
-          if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
-            argBox = actualArg;
-            mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
-            addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
-            if (charLen)
-              // Set/override LEN with an expression.
-              len = genExplicitCharLen(charLen);
-            else
-              // Get the length from the actual arguments.
-              len = charHelp.readLengthFromBox(argBox);
-          } else {
-            std::pair<mlir::Value, mlir::Value> unboxchar =
-                charHelp.createUnboxChar(actualArg);
-            addr = unboxchar.first;
-            if (charLen) {
-              // Set/override LEN with an expression
-              len = genExplicitCharLen(charLen);
-            } else {
-              // Get the length from the actual arguments.
-              len = unboxchar.second;
-            }
-          }
-        } else {
-          // local CHARACTER variable
-          len = genExplicitCharLen(charLen);
-        }
-        llvm::SmallVector<mlir::Value> lengths = {len};
+    } else {
+      // Non compile time constant shape.
+      if (ba.lboundIsAllOnes())
+        populateShape(extents, ba.dynamicBound(), arg);
+        populateLBoundsExtents(lbounds, extents, ba.dynamicBound(), arg);
 
-        // cast to the known constant parts from the declaration
-        mlir::Type castTy = builder.getRefType(converter.genType(var));
-        if (addr)
-          addr = builder.createConvert(loc, castTy, addr);
-        if (x.lboundAllOnes()) {
-          // if lower bounds are all ones, build simple shaped object
-          llvm::SmallVector<mlir::Value> shape;
-          populateShape(shape, x.bounds, argBox);
-          if (isDummy) {
-            symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
-            return;
-          }
-          // local CHARACTER array
-          mlir::Value local =
-              createNewLocal(converter, loc, var, preAlloc, shape, lengths);
-          symMap.addCharSymbolWithShape(sym, local, len, shape);
-          return;
-        }
-        // Process the lower bound and extent values.
-        llvm::SmallVector<mlir::Value> extents;
-        llvm::SmallVector<mlir::Value> lbounds;
-        populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
-        if (isDummy) {
-          symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
-                                         true);
-          return;
-        }
-        // local CHARACTER array with computed bounds
-        assert(Fortran::lower::isExplicitShape(sym));
-        mlir::Value local =
-            createNewLocal(converter, loc, var, preAlloc, extents, lengths);
-        symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
-      },
-
-      //===--------------------------------------------------------------===//
+  // Allocate or extract raw address for the entity
+  if (!addr) {
+    if (arg) {
+      if (fir::isa_trivial(arg.getType())) {
+        // FIXME: Argument passed in registers (like scalar VALUE in BIND(C)
+        // procedures) Should allocate local + store. Nothing done for now to
+        // keep the NFC aspect.
+        addr = arg;
+      } else {
+        // Dummy address, or address of result whose storage is passed by the
+        // caller.
+        assert(fir::isa_ref_type(arg.getType()) && "must be a memory address");
+        addr = arg;
+    } else {
+      // Local variables
+      llvm::SmallVector<mlir::Value> typeParams;
+      if (len)
+        typeParams.emplace_back(len);
+      addr = createNewLocal(converter, loc, var, preAlloc, extents, typeParams);
 
-      [&](const Fortran::lower::BoxAnalyzer::None &) {
-        mlir::emitError(loc, "symbol analysis failed on ")
-            << toStringRef(sym.name());
-      });
+  genDeclareSymbol(converter, symMap, sym, addr, len, extents, lbounds,
+                   replace);
+  return;
 }
 
 void Fortran::lower::defineModuleVariable(
     AbstractConverter &converter, const Fortran::lower::pft::Variable &var) {
   // Use empty linkage for module variables, which makes them available
   // for use in another unit.
   mlir::StringAttr linkage =
       getLinkageAttribute(converter.getFirOpBuilder(), var);

flang/test/Lower/HLFIR/expr-addr.f90

 ! Test lowering of of expressions as address
 ! RUN: %not_todo_cmd bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
 
 subroutine foo(x)
   integer :: x
-  ! CHECK: not yet implemented: lower expr to HLFIR address
+  ! CHECK: not yet implemented: generate fir.declare when lowering symbol
   read (*,*) x
 end subroutine

flang/test/Lower/HLFIR/expr-box.f90

 ! Test lowering of of expressions as fir.box
 ! RUN: %not_todo_cmd bbc -emit-fir -hlfir -o - %s 2>&1 | FileCheck %s
 
 subroutine foo(x)
   integer :: x(:)
-  ! CHECK: not yet implemented: lower expr to HLFIR box
+  ! CHECK: not yet implemented: generate fir.declare for box
   print *, x 
 end subroutine