diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h index 75ebc9bc2e4d3..5d59c1cad0569 100644 --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -173,7 +173,7 @@ class AbstractConverter { /// Get the converter's current location virtual mlir::Location getCurrentLocation() = 0; /// Generate a dummy location - virtual mlir::Location genLocation() = 0; + virtual mlir::Location genUnknownLocation() = 0; /// Generate the location as converted from a CharBlock virtual mlir::Location genLocation(const Fortran::parser::CharBlock &) = 0; diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp index 365ff3f5169e0..5086012c97512 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -426,7 +426,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { mlir::Location getCurrentLocation() override final { return toLocation(); } /// Generate a dummy location. - mlir::Location genLocation() override final { + mlir::Location genUnknownLocation() override final { // Note: builder may not be instantiated yet return mlir::UnknownLoc::get(&getMLIRContext()); } @@ -445,7 +445,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { filePos.line, filePos.column); } } - return genLocation(); + return genUnknownLocation(); } fir::FirOpBuilder &getFirOpBuilder() override final { return *builder; } @@ -901,7 +901,7 @@ class FirConverter : public Fortran::lower::AbstractConverter { /// - structured and unstructured increment loops /// - structured and unstructured concurrent loops void genFIR(const Fortran::parser::DoConstruct &doConstruct) { - setCurrentPosition(Fortran::parser::FindSourceLocation(doConstruct)); + setCurrentPositionAt(doConstruct); // Collect loop nest information. // Generate begin loop code directly for infinite and while loops. Fortran::lower::pft::Evaluation &eval = getEval(); @@ -1694,7 +1694,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { } } - void genFIR(const Fortran::parser::BlockConstruct &) { + void genFIR(const Fortran::parser::BlockConstruct &blockConstruct) { + setCurrentPositionAt(blockConstruct); TODO(toLocation(), "BlockConstruct lowering"); } void genFIR(const Fortran::parser::BlockStmt &) { @@ -1714,7 +1715,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { genEndChangeTeamStmt(*this, getEval(), stmt); } - void genFIR(const Fortran::parser::CriticalConstruct &) { + void genFIR(const Fortran::parser::CriticalConstruct &criticalConstruct) { + setCurrentPositionAt(criticalConstruct); TODO(toLocation(), "CriticalConstruct lowering"); } void genFIR(const Fortran::parser::CriticalStmt &) { @@ -1724,7 +1726,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(toLocation(), "EndCriticalStmt lowering"); } - void genFIR(const Fortran::parser::SelectRankConstruct &) { + void genFIR(const Fortran::parser::SelectRankConstruct &selectRankConstruct) { + setCurrentPositionAt(selectRankConstruct); TODO(toLocation(), "SelectRankConstruct lowering"); } void genFIR(const Fortran::parser::SelectRankStmt &) { @@ -1734,7 +1737,8 @@ class FirConverter : public Fortran::lower::AbstractConverter { TODO(toLocation(), "SelectRankCaseStmt lowering"); } - void genFIR(const Fortran::parser::SelectTypeConstruct &) { + void genFIR(const Fortran::parser::SelectTypeConstruct &selectTypeConstruct) { + setCurrentPositionAt(selectTypeConstruct); TODO(toLocation(), "SelectTypeConstruct lowering"); } void genFIR(const Fortran::parser::SelectTypeStmt &) { @@ -2726,6 +2730,15 @@ class FirConverter : public Fortran::lower::AbstractConverter { currentPosition = position; } + /// Set current position at the location of \p parseTreeNode. Note that the + /// position is updated automatically when visiting statements, but not when + /// entering higher level nodes like constructs or procedures. This helper is + /// intended to cover the latter cases. + template + void setCurrentPositionAt(const A &parseTreeNode) { + setCurrentPosition(Fortran::parser::FindSourceLocation(parseTreeNode)); + } + //===--------------------------------------------------------------------===// // Utility methods //===--------------------------------------------------------------------===// diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp index bfc739d72f5a4..47fbceb7ad6ba 100644 --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -91,8 +91,8 @@ mlir::Location Fortran::lower::CallerInterface::getCalleeLocation() const { // wrong location (i.e, the caller location). if (const Fortran::semantics::Symbol *symbol = proc.GetSymbol()) return converter.genLocation(symbol->name()); - // Unknown location for intrinsics. - return converter.genLocation(); + // Use current location for intrinsics. + return converter.getCurrentLocation(); } // Get dummy argument characteristic for a procedure with implicit interface @@ -217,7 +217,7 @@ void Fortran::lower::CallerInterface::walkResultLengths( const Fortran::semantics::DerivedTypeSpec &derivedTypeSpec = dynamicType.GetDerivedTypeSpec(); if (Fortran::semantics::CountLenParameters(derivedTypeSpec) > 0) - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "function result with derived type length parameters"); } } @@ -275,7 +275,7 @@ bool Fortran::lower::CallerInterface::mustMapInterfaceSymbols() const { mlir::Value Fortran::lower::CallerInterface::getArgumentValue( const semantics::Symbol &sym) const { - mlir::Location loc = converter.genLocation(); + mlir::Location loc = converter.getCurrentLocation(); const Fortran::semantics::Symbol *iface = procRef.proc().GetInterfaceSymbol(); if (!iface) fir::emitFatalError( @@ -298,7 +298,7 @@ mlir::Type Fortran::lower::CallerInterface::getResultStorageType() const { const Fortran::semantics::Symbol & Fortran::lower::CallerInterface::getResultSymbol() const { - mlir::Location loc = converter.genLocation(); + mlir::Location loc = converter.getCurrentLocation(); const Fortran::semantics::Symbol *iface = procRef.proc().GetInterfaceSymbol(); if (!iface) fir::emitFatalError( @@ -610,7 +610,7 @@ class Fortran::lower::CallInterfaceImpl { void handleImplicitResult( const Fortran::evaluate::characteristics::FunctionResult &result) { if (result.IsProcedurePointer()) - TODO(interface.converter.genLocation(), + TODO(interface.converter.getCurrentLocation(), "procedure pointer result not yet handled"); const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape = result.GetTypeAndShape(); @@ -701,7 +701,7 @@ class Fortran::lower::CallInterfaceImpl { // DERIVED if (cat == Fortran::common::TypeCategory::Derived) { if (dynamicType.IsPolymorphic()) - TODO(interface.converter.genLocation(), + TODO(interface.converter.getCurrentLocation(), "[translateDynamicType] polymorphic types"); return getConverter().genType(dynamicType.GetDerivedTypeSpec()); } @@ -721,7 +721,8 @@ class Fortran::lower::CallInterfaceImpl { using Attrs = Fortran::evaluate::characteristics::DummyDataObject::Attr; bool isValueAttr = false; - [[maybe_unused]] mlir::Location loc = interface.converter.genLocation(); + [[maybe_unused]] mlir::Location loc = + interface.converter.getCurrentLocation(); llvm::SmallVector attrs; auto addMLIRAttr = [&](llvm::StringRef attr) { attrs.emplace_back(mlir::Identifier::get(attr, &mlirContext), @@ -801,7 +802,8 @@ class Fortran::lower::CallInterfaceImpl { const FortranEntity &entity) { if (proc.attrs.test( Fortran::evaluate::characteristics::DummyProcedure::Attr::Pointer)) - llvm_unreachable("TODO: procedure pointer arguments"); + TODO(interface.converter.getCurrentLocation(), + "procedure pointer arguments"); // Otherwise, it is a dummy procedure mlir::Type funcType = getDummyProcedureTypeImpl(&proc.procedure.value(), interface.converter); @@ -815,8 +817,8 @@ class Fortran::lower::CallInterfaceImpl { using Attr = Fortran::evaluate::characteristics::FunctionResult::Attr; if (result.IsProcedurePointer()) - TODO(interface.converter.genLocation(), - "procedure pointer result not yet handled"); + TODO(interface.converter.getCurrentLocation(), + "procedure pointer results"); const Fortran::evaluate::characteristics::TypeAndShape *typeAndShape = result.GetTypeAndShape(); assert(typeAndShape && "expect type for non proc pointer result"); diff --git a/flang/lib/Lower/Coarray.cpp b/flang/lib/Lower/Coarray.cpp index d31b2d73ff935..6bc7dfde13463 100644 --- a/flang/lib/Lower/Coarray.cpp +++ b/flang/lib/Lower/Coarray.cpp @@ -27,27 +27,27 @@ void Fortran::lower::genChangeTeamConstruct( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &, const Fortran::parser::ChangeTeamConstruct &) { - TODO(converter.genLocation(), "CHANGE TEAM construct"); + TODO(converter.getCurrentLocation(), "CHANGE TEAM construct"); } void Fortran::lower::genChangeTeamStmt( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &, const Fortran::parser::ChangeTeamStmt &) { - TODO(converter.genLocation(), "CHANGE TEAM stmt"); + TODO(converter.getCurrentLocation(), "CHANGE TEAM stmt"); } void Fortran::lower::genEndChangeTeamStmt( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &, const Fortran::parser::EndChangeTeamStmt &) { - TODO(converter.genLocation(), "END CHANGE TEAM"); + TODO(converter.getCurrentLocation(), "END CHANGE TEAM"); } void Fortran::lower::genFormTeamStatement( Fortran::lower::AbstractConverter &converter, Fortran::lower::pft::Evaluation &, const Fortran::parser::FormTeamStmt &) { - TODO(converter.genLocation(), "FORM TEAM"); + TODO(converter.getCurrentLocation(), "FORM TEAM"); } //===----------------------------------------------------------------------===// @@ -59,10 +59,10 @@ fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genAddr( (void)converter; (void)symMap; (void)loc; - TODO(converter.genLocation(), "co-array address"); + TODO(converter.getCurrentLocation(), "co-array address"); } fir::ExtendedValue Fortran::lower::CoarrayExprHelper::genValue( const Fortran::evaluate::CoarrayRef &expr) { - TODO(converter.genLocation(), "co-array value"); + TODO(converter.getCurrentLocation(), "co-array value"); } diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp index b564b56bcbe80..cecc3793c4fd7 100644 --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -162,7 +162,8 @@ struct TypeBuilder { // Use unknown extents. int rank = expr.Rank(); if (rank < 0) - TODO(converter.genLocation(), "Assumed rank expression type lowering"); + TODO(converter.getCurrentLocation(), + "Assumed rank expression type lowering"); for (int dim = 0; dim < rank; ++dim) shape.emplace_back(fir::SequenceType::getUnknownExtent()); } @@ -326,7 +327,8 @@ struct TypeBuilder { if (!ps.empty()) { // This type is a PDT (parametric derived type). Create the functions to // use for allocation, dereferencing, and address arithmetic here. - TODO_NOLOC("PDT"); + TODO(converter.genLocation(typeSymbol.name()), + "parametrized derived types lowering"); } LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n'); return rec; @@ -355,7 +357,8 @@ struct TypeBuilder { if (category == Fortran::common::TypeCategory::Character) params.push_back(getCharacterLength(exprOrSym)); else if (category == Fortran::common::TypeCategory::Derived) - TODO(converter.genLocation(), "lowering derived type length parameters"); + TODO(converter.getCurrentLocation(), + "lowering derived type length parameters"); return; } Fortran::lower::LenParameterTy diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp index ec1082710b876..197316daae6f5 100644 --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -1751,7 +1751,7 @@ void Fortran::lower::defineModuleVariable( // for use in another unit. mlir::StringAttr externalLinkage; if (!var.isGlobal()) - fir::emitFatalError(converter.genLocation(), + fir::emitFatalError(converter.getCurrentLocation(), "attempting to lower module variable as local"); // Define aggregate storages for equivalenced objects. if (var.isAggregateStore()) { diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp index 4e3ae5596d53f..d98923a7040db 100644 --- a/flang/lib/Lower/HostAssociations.cpp +++ b/flang/lib/Lower/HostAssociations.cpp @@ -483,7 +483,7 @@ void Fortran::lower::HostAssociations::hostProcedureBindings( // Create the tuple variable. mlir::TupleType tupTy = unwrapTupleTy(getArgumentType(converter)); fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mlir::Location loc = converter.genLocation(); + mlir::Location loc = converter.getCurrentLocation(); auto hostTuple = builder.create(loc, tupTy); mlir::IntegerType offTy = builder.getIntegerType(32); @@ -511,7 +511,7 @@ void Fortran::lower::HostAssociations::internalProcedureBindings( fir::FirOpBuilder &builder = converter.getFirOpBuilder(); mlir::Type argTy = getArgumentType(converter); mlir::TupleType tupTy = unwrapTupleTy(argTy); - mlir::Location loc = converter.genLocation(); + mlir::Location loc = converter.getCurrentLocation(); mlir::FuncOp func = builder.getFunction(); mlir::Value tupleArg; for (auto [ty, arg] : llvm::reverse( diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp index 93693675d14bd..a725672dfbfff 100644 --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -1265,17 +1265,17 @@ maybeGetInternalIODescriptor( } template -static bool isDataTransferAsynchronous(const A &stmt) { +static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) { if (auto *asynch = getIOControl(stmt)) { // FIXME: should contain a string of YES or NO - TODO_NOLOC("asynchronous transfers not implemented in runtime"); + TODO(loc, "asynchronous transfers not implemented in runtime"); } return false; } template <> -constexpr bool isDataTransferAsynchronous( - const Fortran::parser::PrintStmt &) { +bool isDataTransferAsynchronous( + mlir::Location, const Fortran::parser::PrintStmt &) { return false; } @@ -1741,7 +1741,7 @@ genDataTransferStmt(Fortran::lower::AbstractConverter &converter, isInternal ? maybeGetInternalIODescriptor(converter, stmt, stmtCtx) : llvm::None; const bool isInternalWithDesc = descRef.hasValue(); - const bool isAsync = isDataTransferAsynchronous(stmt); + const bool isAsync = isDataTransferAsynchronous(loc, stmt); const bool isNml = isDataTransferNamelist(stmt); // Generate the begin data transfer function call. diff --git a/flang/lib/Lower/OpenACC.cpp b/flang/lib/Lower/OpenACC.cpp index 606fd163b8120..b6caad07831d5 100644 --- a/flang/lib/Lower/OpenACC.cpp +++ b/flang/lib/Lower/OpenACC.cpp @@ -643,12 +643,12 @@ genACC(Fortran::lower::AbstractConverter &converter, std::get(beginCombinedDirective.t); if (combinedDirective.v == llvm::acc::ACCD_kernels_loop) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Kernels Loop construct not lowered yet!"); } else if (combinedDirective.v == llvm::acc::ACCD_parallel_loop) { genACCParallelLoopOps(converter, accClauseList); } else if (combinedDirective.v == llvm::acc::ACCD_serial_loop) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Serial Loop construct not lowered yet!"); } else { llvm::report_fatal_error( @@ -930,7 +930,8 @@ genACC(Fortran::lower::AbstractConverter &converter, } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_shutdown) { genACCInitShutdownOp(converter, accClauseList); } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_set) { - TODO(converter.genLocation(), "OpenACC set directive not lowered yet!"); + TODO(converter.getCurrentLocation(), + "OpenACC set directive not lowered yet!"); } else if (standaloneDirective.v == llvm::acc::Directive::ACCD_update) { genACCUpdateOp(converter, accClauseList); } @@ -1025,14 +1026,14 @@ void Fortran::lower::genOpenACCConstruct( genACC(converter, eval, standaloneConstruct); }, [&](const Fortran::parser::OpenACCCacheConstruct &cacheConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Cache construct not lowered yet!"); }, [&](const Fortran::parser::OpenACCWaitConstruct &waitConstruct) { genACC(converter, eval, waitConstruct); }, [&](const Fortran::parser::OpenACCAtomicConstruct &atomicConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Atomic construct not lowered yet!"); }, }, @@ -1048,12 +1049,12 @@ void Fortran::lower::genOpenACCDeclarativeConstruct( common::visitors{ [&](const Fortran::parser::OpenACCStandaloneDeclarativeConstruct &standaloneDeclarativeConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Standalone Declarative construct not lowered yet!"); }, [&](const Fortran::parser::OpenACCRoutineConstruct &routineConstruct) { - TODO(converter.genLocation(), + TODO(converter.getCurrentLocation(), "OpenACC Routine construct not lowered yet!"); }, },