diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2887,12 +2887,16 @@ // is not something that fits well with equivalence lowering. for (const Fortran::lower::pft::Variable &altResult : deferredFuncResultList) { + Fortran::lower::StatementContext stmtCtx; if (std::optional - passedResult = callee.getPassedResult()) + passedResult = callee.getPassedResult()) { addSymbol(altResult.getSymbol(), resultArg.getAddr()); - Fortran::lower::StatementContext stmtCtx; - Fortran::lower::mapSymbolAttributes(*this, altResult, localSymbols, - stmtCtx, primaryFuncResultStorage); + 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 diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1293,6 +1293,81 @@ 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 shape = llvm::None, + llvm::ArrayRef 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 lbounds, + llvm::ArrayRef explicitParams, + llvm::ArrayRef 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 @@ -1321,7 +1396,8 @@ mlir::Type dummyProcType = Fortran::lower::getDummyProcedureType(sym, converter); mlir::Value undefOp = builder.create(loc, dummyProcType); - symMap.addSymbol(sym, undefOp); + + genDeclareSymbol(converter, symMap, sym, undefOp); } if (Fortran::semantics::IsPointer(sym)) TODO(loc, "procedure pointers"); @@ -1363,7 +1439,8 @@ } 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; } @@ -1383,8 +1460,8 @@ 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, + explicitExtents, replace); return; } } @@ -1416,10 +1493,11 @@ "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( + builder, loc, + fir::factory::createTempMutableBox( + builder, loc, converter.genType(var)))); return true; } return false; @@ -1505,461 +1583,114 @@ } }; - // Lower length expression for non deferred and non dummy assumed length - // characters. - auto genExplicitCharLen = - [&](llvm::Optional 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. - //===--------------------------------------------------------------===// - - [&](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 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() || addrTy.isa()) - 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 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 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 extents; - llvm::SmallVector 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); - }, - - //===--------------------------------------------------------------===// - - [&](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()) { - argBox = addr; - mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); - addr = builder.create(loc, refTy, argBox); - } - addr = builder.createConvert(loc, castTy, addr); - } - if (x.lboundAllOnes()) { - // if lower bounds are all ones, build simple shaped object - llvm::SmallVector 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 extents; - llvm::SmallVector 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); - }, - - //===--------------------------------------------------------------===// - - [&](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 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 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; - } + //===--------------------------------------------------------------===// + // Non Pointer non allocatable scalar, explicit shape, and assumed + // size arrays. + // Lower the specification expressions. + //===--------------------------------------------------------------===// + + mlir::Value len; + llvm::SmallVector extents; + llvm::SmallVector lbounds; + auto arg = symMap.lookupSymbol(sym).getAddr(); + mlir::Value addr = preAlloc; + + if (arg) + if (auto boxTy = arg.getType().dyn_cast()) { + // Contiguous assumed shape that can be tracked without a fir.box. + mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); + addr = builder.create(loc, refTy, arg); + } - // if object is an array process the lower bound and extent values - llvm::SmallVector extents; - llvm::SmallVector 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)); - } + // Compute/Extract character length. + if (ba.isChar()) { + if (arg) { + assert(!preAlloc && "dummy cannot be pre-allocated"); + if (arg.getType().isa()) + std::tie(addr, len) = charHelp.createUnboxChar(arg); + } + if (llvm::Optional cstLen = ba.getCharLenConst()) { + // Static length + len = builder.createIntegerConstant(loc, idxTy, *cstLen); + } else { + // Dynamic length + if (genUnusedEntryPointBox()) + return; + if (llvm::Optional 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() && + "must be character dummy fir.box"); + len = charHelp.readLengthFromBox(arg); + } + } + } - 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 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 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 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; + // Compute array extents and lower bounds. + if (ba.isArray()) { + if (addr && addr.getDefiningOp()) { + // Ensure proper type is given to array that transited via fir.boxchar + // arg. + mlir::Type castTy = builder.getRefType(converter.genType(var)); + addr = builder.createConvert(loc, castTy, addr); + } + 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)); } + } + } else { + // Non compile time constant shape. + if (genUnusedEntryPointBox()) + return; + if (ba.lboundIsAllOnes()) + populateShape(extents, ba.dynamicBound(), arg); + else + populateLBoundsExtents(lbounds, extents, ba.dynamicBound(), arg); + } + } - // if object is an array process the lower bound and extent values - llvm::SmallVector extents; - llvm::SmallVector 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); - }, - - //===--------------------------------------------------------------===// - - [&](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()) { - argBox = actualArg; - mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); - addr = builder.create(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); - } + // 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 typeParams; + if (len) + typeParams.emplace_back(len); + addr = createNewLocal(converter, loc, var, preAlloc, extents, typeParams); + } + } - // 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 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; - } - // if object is an array process the lower bound and extent values - llvm::SmallVector extents; - llvm::SmallVector 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()) { - argBox = actualArg; - mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); - addr = builder.create(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 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 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 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 extents; - llvm::SmallVector 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); - }, - - //===--------------------------------------------------------------===// - - [&](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( @@ -1997,6 +1728,14 @@ const pft::Variable &var, Fortran::lower::SymMap &symMap, AggregateStoreMap &storeMap) { + if (var.hasSymbol()) { + // Do not try to instantiate symbols twice, except for dummies and results, + // that may have been mapped to the MLIR entry block arguments, and for + // which the explicit specifications, if any, has not yet been lowered. + const auto &sym = var.getSymbol(); + if (!IsDummy(sym) && !IsFunctionResult(sym) && symMap.lookupSymbol(sym)) + return; + } if (var.isAggregateStore()) { instantiateAggregateStore(converter, var, storeMap); } else if (const Fortran::semantics::Symbol *common = diff --git a/flang/test/Lower/HLFIR/expr-addr.f90 b/flang/test/Lower/HLFIR/expr-addr.f90 --- a/flang/test/Lower/HLFIR/expr-addr.f90 +++ b/flang/test/Lower/HLFIR/expr-addr.f90 @@ -3,6 +3,6 @@ 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 diff --git a/flang/test/Lower/HLFIR/expr-box.f90 b/flang/test/Lower/HLFIR/expr-box.f90 --- a/flang/test/Lower/HLFIR/expr-box.f90 +++ b/flang/test/Lower/HLFIR/expr-box.f90 @@ -3,6 +3,6 @@ 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