[flang] Make source location more accurate for actual arguments

[klausler]

Summary

Track source location information when available for actual arguments
to procedure references, and use this information when checking constraints
on calls so that error messages refer to specific actual arguments
rather than to the entire call.

flang/include/flang/Evaluate/call.h

public:
   }
 
   bool Matches(const characteristics::DummyArgument &) const;
   common::Intent dummyIntent() const { return dummyIntent_; }
   ActualArgument &set_dummyIntent(common::Intent intent) {
     dummyIntent_ = intent;
     return *this;
   }
+  std::optional<parser::CharBlock> sourceLocation() const {
+    return sourceLocation_;
+  }
+  ActualArgument &set_sourceLocation(std::optional<parser::CharBlock> at) {
+    sourceLocation_ = at;
+    return *this;
+  }
 
   // Wrap this argument in parentheses
   void Parenthesize();
 
   // TODO: Mark legacy %VAL and %REF arguments
 
 private:
   // Subtlety: There is a distinction that must be maintained here between an
   // actual argument expression that is a variable and one that is not,
   // e.g. between X and (X).  The parser attempts to parse each argument
   // first as a variable, then as an expression, and the distinction appears
   // in the parse tree.
   std::variant<common::CopyableIndirection<Expr<SomeType>>, AssumedType,
       common::Label>
       u_;
   std::optional<parser::CharBlock> keyword_;
   bool isPassedObject_{false};
   common::Intent dummyIntent_{common::Intent::Default};
+  std::optional<parser::CharBlock> sourceLocation_;
 };
 
 using ActualArguments = std::vector<std::optional<ActualArgument>>;
 
 // Intrinsics are identified by their names and the characteristics
 // of their arguments, at least for now.
 using IntrinsicProcedure = std::string;
 

flang/lib/Semantics/check-call.cpp

 
 using namespace Fortran::parser::literals;
 namespace characteristics = Fortran::evaluate::characteristics;
 
 namespace Fortran::semantics {
 
 static void CheckImplicitInterfaceArg(
     evaluate::ActualArgument &arg, parser::ContextualMessages &messages) {
+  auto restorer{
+      messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   if (auto kw{arg.keyword()}) {
     messages.Say(*kw,
         "Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
         *kw);
   }
   if (auto type{arg.GetType()}) {
     if (type->IsAssumedType()) {
       messages.Say(
static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   }
 }
 
 static void CheckProcedureArg(evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc,
     const characteristics::DummyProcedure &dummy, const std::string &dummyName,
     evaluate::FoldingContext &context) {
   parser::ContextualMessages &messages{context.messages()};
+  auto restorer{
+      messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   const characteristics::Procedure &interface { dummy.procedure.value() };
   if (const auto *expr{arg.UnwrapExpr()}) {
     bool dummyIsPointer{
         dummy.attrs.test(characteristics::DummyProcedure::Attr::Pointer)};
     const auto *argProcDesignator{
         std::get_if<evaluate::ProcedureDesignator>(&expr->u)};
     const auto *argProcSymbol{
         argProcDesignator ? argProcDesignator->GetSymbol() : nullptr};
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
     const characteristics::Procedure &proc, evaluate::FoldingContext &context,
     const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
     bool allowIntegerConversions) {
   auto &messages{context.messages()};
   std::string dummyName{"dummy argument"};
   if (!dummy.name.empty()) {
     dummyName += " '"s + parser::ToLowerCaseLetters(dummy.name) + "='";
   }
+  auto restorer{
+      messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   std::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &object) {
             ConvertBOZLiteralArg(arg, object.type.type());
             if (auto *expr{arg.UnwrapExpr()}) {
               if (auto type{characteristics::TypeAndShape::Characterize(
                       *expr, context)}) {
                 arg.set_dummyIntent(object.intent);

flang/lib/Semantics/expression.cpp

if (const semantics::DeclTypeSpec * typeSpec{spec->declTypeSpec}) {
           derived{typeSpec->AsDerived()}) {
         return DynamicTypeWithLength{DynamicType{*derived}};
       }
     }
   }
   return std::nullopt;
 }
 
+// Utilities to set a source location, if we have one, on an actual argument,
+// when it is statically present.
+static void SetArgSourceLocation(ActualArgument &x, parser::CharBlock at) {
+  x.set_sourceLocation(at);
+}
+static void SetArgSourceLocation(
+    std::optional<ActualArgument> &x, parser::CharBlock at) {
+  if (x) {
+    x->set_sourceLocation(at);
+  }
+}
+static void SetArgSourceLocation(
+    std::optional<ActualArgument> &x, std::optional<parser::CharBlock> at) {
+  if (x && at) {
+    x->set_sourceLocation(*at);
+  }
+}
+
 class ArgumentAnalyzer {
 public:
   explicit ArgumentAnalyzer(ExpressionAnalyzer &context)
       : context_{context}, source_{context.GetContextualMessages().at()},
         isProcedureCall_{false} {}
   ArgumentAnalyzer(ExpressionAnalyzer &context, parser::CharBlock source,
       bool isProcedureCall = false)
       : context_{context}, source_{source}, isProcedureCall_{isProcedureCall} {}
   bool fatalErrors() const { return fatalErrors_; }
   ActualArguments &&GetActuals() {
     CHECK(!fatalErrors_);
     return std::move(actuals_);
   }
   const Expr<SomeType> &GetExpr(std::size_t i) const {
     return DEREF(actuals_.at(i).value().UnwrapExpr());
   }
   Expr<SomeType> &&MoveExpr(std::size_t i) {
     return std::move(DEREF(actuals_.at(i).value().UnwrapExpr()));
   }
   void Analyze(const common::Indirection<parser::Expr> &x) {
     Analyze(x.value());
   }
   void Analyze(const parser::Expr &x) {
     actuals_.emplace_back(AnalyzeExpr(x));
+    SetArgSourceLocation(actuals_.back(), x.source);
     fatalErrors_ |= !actuals_.back();
   }
   void Analyze(const parser::Variable &);
   void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
   void ConvertBOZ(std::optional<DynamicType> &thisType, std::size_t i,
       std::optional<DynamicType> otherType);
 
   bool IsIntrinsicRelational(
if (kind == MiscKind::ComplexPartRe || kind == MiscKind::ComplexPartIm) {
               },
               zExpr->u)};
           return AsGenericExpr(std::move(realExpr));
         }
       }
     } else if (kind == MiscKind::KindParamInquiry ||
         kind == MiscKind::LenParamInquiry) {
       // Convert x%KIND -> intrinsic KIND(x), x%LEN -> intrinsic LEN(x)
-      return MakeFunctionRef(
-          name, ActualArguments{ActualArgument{std::move(*base)}});
+      ActualArgument arg{std::move(*base)};
+      SetArgSourceLocation(arg, name);
+      return MakeFunctionRef(name, ActualArguments{std::move(arg)});
     } else {
       DIE("unexpected MiscDetails::Kind");
     }
   } else {
     Say(name, "derived type required before component reference"_err_en_US);
   }
   return std::nullopt;
 }
MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
   }
 }
 
 void ArgumentAnalyzer::Analyze(const parser::Variable &x) {
   source_.ExtendToCover(x.GetSource());
   if (MaybeExpr expr{context_.Analyze(x)}) {
     if (!IsConstantExpr(*expr)) {
       actuals_.emplace_back(std::move(*expr));
+      SetArgSourceLocation(actuals_.back(), x.GetSource());
       return;
     }
     const Symbol *symbol{GetLastSymbol(*expr)};
     if (!symbol) {
       context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US,
           x.GetSource());
     } else if (auto *subp{symbol->detailsIf<semantics::SubprogramDetails>()}) {
       auto *msg{context_.SayAt(x,
void ArgumentAnalyzer::Analyze(
     const parser::ActualArgSpec &arg, bool isSubroutine) {
   // TODO: Actual arguments that are procedures and procedure pointers need to
   // be detected and represented (they're not expressions).
   // TODO: C1534: Don't allow a "restricted" specific intrinsic to be passed.
   std::optional<ActualArgument> actual;
   std::visit(common::visitors{
                  [&](const common::Indirection<parser::Expr> &x) {
                    actual = AnalyzeExpr(x.value());
+                   SetArgSourceLocation(actual, x.value().source);
                  },
                  [&](const parser::AltReturnSpec &label) {
                    if (!isSubroutine) {
                      context_.Say(
                          "alternate return specification may not appear on"
                          " function reference"_err_en_US);
                    }
                    actual = ActualArgument(label.v);

 }
 
 std::optional<ActualArgument> ArgumentAnalyzer::AnalyzeExpr(
     const parser::Expr &expr) {
   source_.ExtendToCover(expr.source);
   if (const Symbol * assumedTypeDummy{AssumedTypeDummy(expr)}) {
     expr.typedExpr.Reset(new GenericExprWrapper{}, GenericExprWrapper::Deleter);
     if (isProcedureCall_) {
-      return ActualArgument{ActualArgument::AssumedType{*assumedTypeDummy}};
+      ActualArgument arg{ActualArgument::AssumedType{*assumedTypeDummy}};
+      SetArgSourceLocation(arg, expr.source);
+      return std::move(arg);
     }
     context_.SayAt(expr.source,
         "TYPE(*) dummy argument may only be used as an actual argument"_err_en_US);
   } else if (MaybeExpr argExpr{AnalyzeExprOrWholeAssumedSizeArray(expr)}) {
     if (isProcedureCall_ || !IsProcedure(*argExpr)) {
-      return ActualArgument{std::move(*argExpr)};
+      ActualArgument arg{std::move(*argExpr)};
+      SetArgSourceLocation(arg, expr.source);
+      return std::move(arg);
     }
     context_.SayAt(expr.source,
         IsFunction(*argExpr) ? "Function call must have argument list"_err_en_US
                              : "Subroutine name is not allowed here"_err_en_US);
   }
   return std::nullopt;
 }
 

 
 // If there is an implicit conversion between intrinsic types, make it explicit
 void ArgumentAnalyzer::AddAssignmentConversion(
     const DynamicType &lhsType, const DynamicType &rhsType) {
   if (lhsType.category() == rhsType.category() &&
       lhsType.kind() == rhsType.kind()) {
     // no conversion necessary
   } else if (auto rhsExpr{evaluate::ConvertToType(lhsType, MoveExpr(1))}) {
+    std::optional<parser::CharBlock> source;
+    if (actuals_[1]) {
+      source = actuals_[1]->sourceLocation();
+    }
     actuals_[1] = ActualArgument{*rhsExpr};
+    SetArgSourceLocation(actuals_[1], source);
   } else {
     actuals_[1] = std::nullopt;
   }
 }
 
 std::optional<DynamicType> ArgumentAnalyzer::GetType(std::size_t i) const {
   return i < actuals_.size() ? actuals_[i].value().GetType() : std::nullopt;
 }