Add location to some lowering TODOs that missed it (#1387)

Improve TODO messages:

- `genLocation()` was used instead of `getCurrentLocation` in many places that
intended to print the current location. Rename it to `genUnknownLocation()` to avoid
confusion in the futur.
- Thread/Compute the location when possible instead of using TODO_NOLOC.
- Ensure the location is set when entering not yet implemented
constructs (toLocation() might return an empty location in case the
construct is the first of an anonymous program)

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;
 

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 <typename A>
+  void setCurrentPositionAt(const A &parseTreeNode) {
+    setCurrentPosition(Fortran::parser::FindSourceLocation(parseTreeNode));
+  }
+
   //===--------------------------------------------------------------------===//
   // Utility methods
   //===--------------------------------------------------------------------===//

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<mlir::NamedAttribute> 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");

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");
 }

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

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()) {

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<fir::AllocaOp>(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(

flang/lib/Lower/IO.cpp

@@ -1265,17 +1265,17 @@ maybeGetInternalIODescriptor<Fortran::parser::PrintStmt>(
 }
 
 template <typename A>
-static bool isDataTransferAsynchronous(const A &stmt) {
+static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) {
   if (auto *asynch =
           getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(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<Fortran::parser::PrintStmt>(
-    const Fortran::parser::PrintStmt &) {
+bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>(
+    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.

flang/lib/Lower/OpenACC.cpp

@@ -643,12 +643,12 @@ genACC(Fortran::lower::AbstractConverter &converter,
       std::get<Fortran::parser::AccClauseList>(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<mlir::acc::ShutdownOp>(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!");
           },
       },