[flang] Fix analyzed form of type-bound assignment

[tskeith]

Summary

Change the analyzed form of type-bound assignment to match that of call
statements. Resolve the binding name to a specific subprogram when
possible by using GetBindingResolution. Otherwise leave it as a
type-bound procedure call.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Semantics/expression.cpp

static const Symbol *GetBindingResolution(
   }
   return &binding->symbol();
 }
 
 auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
     const parser::ProcComponentRef &pcr, ActualArguments &&arguments)
     -> std::optional<CalleeAndArguments> {
   const parser::StructureComponent &sc{pcr.v.thing};
-  const auto &name{sc.component.source};
   if (MaybeExpr base{Analyze(sc.base)}) {
     if (const Symbol * sym{sc.component.symbol}) {
       if (auto *dtExpr{UnwrapExpr<Expr<SomeDerived>>(*base)}) {
         if (sym->has<semantics::GenericDetails>()) {
           AdjustActuals adjustment{
               [&](const Symbol &proc, ActualArguments &actuals) {
                 if (!proc.attrs().test(semantics::Attr::NOPASS)) {
                   AddPassArg(actuals, std::move(*dtExpr), proc);
if (const Symbol * sym{sc.component.symbol}) {
             AddPassArg(arguments,
                 Expr<SomeDerived>{Designator<SomeDerived>{std::move(*dataRef)}},
                 *sym);
             return CalleeAndArguments{
                 ProcedureDesignator{*sym}, std::move(arguments)};
           }
         }
       }
-      Say(name,
+      Say(sc.component.source,
           "Base of procedure component reference is not a derived-type object"_err_en_US);
     }
   }
   CHECK(!GetContextualMessages().empty());
   return std::nullopt;
 }
 
 // Can actual be argument associated with dummy?
if (const Symbol * symbol{scope.FindSymbol(oprName)}) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
     if (const Symbol *
         specific{context_.ResolveGeneric(*symbol, actuals_, noAdjustment)}) {
       proc = specific;
     } else {
       context_.EmitGenericResolutionError(*symbol);
     }
   }
-  for (std::size_t passIndex{0}; passIndex < actuals_.size(); ++passIndex) {
-    if (const Symbol * specific{FindBoundOp(oprName, passIndex)}) {
+  int passedObjectIndex{-1};
+  for (std::size_t i{0}; i < actuals_.size(); ++i) {
+    if (const Symbol * specific{FindBoundOp(oprName, i)}) {
+      if (const Symbol *
+          resolution{GetBindingResolution(GetType(i), *specific)}) {
+        proc = resolution;
+      } else {
         proc = specific;
+        passedObjectIndex = i;
       }
     }
-  if (proc) {
-    ActualArguments actualsCopy{actuals_};
-    actualsCopy[1]->Parenthesize();
-    return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
-  } else {
+  }
+  if (!proc) {
     return std::nullopt;
   }
+  ActualArguments actualsCopy{actuals_};
+  if (passedObjectIndex >= 0) {
+    actualsCopy[passedObjectIndex]->set_isPassedObject();
+  }
+  return ProcedureRef{ProcedureDesignator{*proc}, std::move(actualsCopy)};
 }
 
 void ArgumentAnalyzer::Dump(llvm::raw_ostream &os) {
   os << "source_: " << source_.ToString() << " fatalErrors_ = " << fatalErrors_
      << '\n';
   for (const auto &actual : actuals_) {
     if (!actual.has_value()) {
       os << "- error\n";

flang/test/Semantics/defined-ops.f90

+! RUN: %f18 -funparse %s 2>&1 | FileCheck %s
+
+! Check the analyzed form of a defined operator or assignment.
+
+! Type-bound defined assignment
+module m1
+  type :: t
+  contains
+    procedure :: b1 => s1
+    procedure, pass(y) :: b2 => s2
+    generic :: assignment(=) => b1, b2
+  end type
+contains
+  subroutine s1(x, y)
+    class(t), intent(out) :: x
+    integer, intent(in) :: y
+  end
+  subroutine s2(x, y)
+    real, intent(out) :: x
+    class(t), intent(in) :: y
+  end
+  subroutine test1(x)
+    type(t) :: x
+    real :: a
+    !CHECK: CALL s1(x,1_4)
+    x = 1
+    !CHECK: CALL s2(a,x)
+    a = x
+  end
+  subroutine test2(x)
+    class(t) :: x
+    real :: a
+    !CHECK: CALL x%b1(1_4)
+    x = 1
+    !CHECK: CALL x%b2(a)
+    a = x
+  end
+end
+
+! Type-bound operator
+module m2
+  type :: t2
+  contains
+    procedure, pass(x2) :: b2 => f
+    generic :: operator(+) => b2
+  end type
+contains
+  integer pure function f(x1, x2)
+    class(t2), intent(in) :: x1
+    class(t2), intent(in) :: x2
+  end
+  subroutine test2(x, y)
+    class(t2) :: x
+    type(t2) :: y
+    !CHECK: i=f(x,y)
+    i = x + y
+    !CHECK: i=x%b2(y)
+    i = y + x
+  end
+end module
+
+! Non-type-bound assignment and operator
+module m3
+  type t
+  end type
+  interface assignment(=)
+    subroutine s1(x, y)
+      import
+      class(t), intent(out) :: x
+      integer, intent(in) :: y
+    end
+  end interface
+  interface operator(+)
+    integer function f(x, y)
+      import
+      class(t), intent(in) :: x, y
+    end
+  end interface
+contains
+  subroutine test(x, y)
+    class(t) :: x, y
+    !CHECK: CALL s1(x,2_4)
+    x = 2
+    !CHECK: i=f(x,y)
+    i = x + y
+  end
+end
+