[flang] Intrinsic assignment of distinct but "same" derived types

[klausler]

Summary

Subclause 7.5.2.4 lists conditions under which two distinct derived
types are to be considered the same type for purposes of argument
association, assignment, and so on. These conditions are implemented
in evaluate::IsTkCompatibleWith(), but assignment semantics doesn't
use it for testing for intrinsic assignment compatibility. Fix that.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Semantics/type.h

       return nullptr;
     }
   }
-  bool MightBeAssignmentCompatibleWith(const DerivedTypeSpec &) const;
   bool operator==(const DerivedTypeSpec &that) const {
     return RawEquals(that) && parameters_ == that.parameters_;
   }

flang/lib/Semantics/tools.cpp

   }
 }
 
-static bool MightHaveCompatibleDerivedtypes(
+// 7.5.2.4 "same derived type" test -- rely on IsTkCompatibleWith() and its
+// infrastructure to detect and handle comparisons on distinct (but "same")
+// sequence/bind(C) derived types
+static bool MightBeSameDerivedType(
     const std::optional<evaluate::DynamicType> &lhsType,
     const std::optional<evaluate::DynamicType> &rhsType) {
-  const DerivedTypeSpec *lhsDerived{evaluate::GetDerivedTypeSpec(lhsType)};
-  const DerivedTypeSpec *rhsDerived{evaluate::GetDerivedTypeSpec(rhsType)};
-  if (!lhsDerived || !rhsDerived) {
-    return false;
-  }
-  return *lhsDerived == *rhsDerived ||
-      lhsDerived->MightBeAssignmentCompatibleWith(*rhsDerived);
+  return lhsType && rhsType && rhsType->IsTkCompatibleWith(*lhsType);
 }
 
 Tristate IsDefinedAssignment(

   } else if (lhsCat != TypeCategory::Derived) {
     return ToTristate(lhsCat != rhsCat &&
         (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat)));
-  } else if (MightHaveCompatibleDerivedtypes(lhsType, rhsType)) {
+  } else if (MightBeSameDerivedType(lhsType, rhsType)) {
     return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
   } else {
     return Tristate::Yes;

flang/lib/Semantics/type.cpp

       const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
 }
 
-// Objects of derived types might be assignment compatible if they are equal
-// with respect to everything other than their instantiated type parameters
-// and their constant instantiated type parameters have the same values.
-bool DerivedTypeSpec::MightBeAssignmentCompatibleWith(
-    const DerivedTypeSpec &that) const {
-  if (!RawEquals(that)) {
-    return false;
-  }
-  return AreTypeParamCompatible(*this, that);
-}
-
 class InstantiateHelper {
 public:
   InstantiateHelper(Scope &scope) : scope_{scope} {}

flang/test/Semantics/assign08.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! "Same type" checking for intrinsic assignment
+module m1
+  type :: nonSeqType
+    integer :: n1
+  end type
+  type :: seqType
+    sequence
+    integer :: n2
+  end type
+  type, bind(c) :: bindCType
+    integer :: n3
+  end type
+end module
+
+program test
+  use m1, modNonSeqType => nonSeqType, modSeqType => seqType, modBindCType => bindCType
+  type :: nonSeqType
+    integer :: n1
+  end type
+  type :: seqType
+    sequence
+    integer :: n2
+  end type
+  type, bind(c) :: bindCType
+    integer :: n3
+  end type
+  type(modNonSeqType) :: mns1, mns2
+  type(modSeqType) :: ms1, ms2
+  type(modBindCType) :: mb1, mb2
+  type(nonSeqType) :: ns1, ns2
+  type(seqType) :: s1, s2
+  type(bindCType) :: b1, b2
+  ! These are trivially ok
+  mns1 = mns2
+  ms1 = ms2
+  mb1 = mb2
+  ns1 = ns2
+  s1 = s2
+  b1 = b2
+  ! These are ok per 7.5.2.4
+  ms1 = s1
+  mb1 = b1
+  !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(modnonseqtype) and TYPE(nonseqtype)
+  mns1 = ns1
+  !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(nonseqtype) and TYPE(modnonseqtype)
+  ns1 = mns1
+end